Skip to content
This repository has been archived by the owner on Mar 7, 2018. It is now read-only.

Commit

Permalink
Cosmetic changes, mostly linebreaks.
Browse files Browse the repository at this point in the history 
Removed linebreaks when unnecessary (mostly in docstrings), added them
when they make the visual layout better (eg enumerations in system
definitions).
  • Loading branch information
@tpapp
tpapp committed Jan 9, 2013
1 parent 65f47a5 commit 583df73
Show file tree
Hide file tree
Showing 3 changed files with 25 additions and 47 deletions.
11 changes: 4 additions & 7 deletions extensions.lisp
View file
Expand Up @@ -3,8 +3,7 @@
(in-package #:let-plus)

(defun destructured-lambda-list-forms (lambda-list body)
"Return (list ARGUMENTS BODY), ie the arguments for the lambda list to be
destructured and the destructing form, wrapping the original body."
"Return (list ARGUMENTS BODY), ie the arguments for the lambda list to be destructured and the destructing form, wrapping the original body."
(let ((arguments (loop repeat (length lambda-list) collect (gensym))))
(list arguments
`(let+ ,(mapcar #'list lambda-list arguments)
Expand Down Expand Up @@ -39,8 +38,7 @@ destructured and the destructing form, wrapping the original body."
(r/w (symbolicate #\& name))
(r/o (symbolicate #\& name '#:-r/o)))
&rest slot-names)
"Define a LET+ expansion for accessing slots of a structure in a fixed
order."
"Define a LET+ expansion for accessing slots of a structure in a fixed order."
(let ((variable-name-pairs
(loop for slot-name in slot-names collect
``(,,slot-name ,',slot-name))))
Expand All @@ -57,15 +55,14 @@ order."
,@body)))))

(define-let+-expansion (&fwrap (name))
"Wrap closure in the local function NAME. Calls to name will call the
closure"
"Wrap closure in the local function NAME. Calls to NAME will call the closure."
`(let+ (((&flet ,name (&rest arguments)
(apply ,value arguments))))
,@body))

(define-let+-expansion (&assert (test-form &rest arguments)
:uses-value? nil)
"Expand to (assert test-form arguments) before body."
"Expand to (ASSERT TEST-FORM ARGUMENTS) before body."
`(progn
(assert ,test-form ,@arguments)
,@body))
Expand Down
6 changes: 4 additions & 2 deletions let-plus.asd
View file
Expand Up @@ -9,7 +9,8 @@
:components ((:file "package")
(:file "let-plus")
(:file "extensions"))
:depends-on (#:alexandria #:anaphora))
:depends-on (#:alexandria
#:anaphora))

(defmethod perform ((op test-op) (sys (eql (find-system '#:let-plus))))
(operate 'test-op '#:let-plus-tests))
Expand All @@ -20,7 +21,8 @@
:license "Same as LET-PLUS -- this is part of the latter."
:serial t
:components ((:file "tests"))
:depends-on (#:lift #:let-plus))
:depends-on (#:lift
#:let-plus))

(defmethod perform ((op test-op) (sys (eql (find-system '#:let-plus-tests))))
(operate 'load-op '#:let-plus-tests)
Expand Down
55 changes: 17 additions & 38 deletions let-plus.lisp
View file
Expand Up @@ -30,16 +30,13 @@
(defun ignored? (symbol)
"Return a boolean determining if a variable is to be ignored.
NOTE: It is unlikely that you need to used this function, see the note above
its definition."
NOTE: It is unlikely that you need to used this function, see the note above its definition."
(eq symbol '&ign))

(defun replace-ignored (tree)
"Replace ignored variables in TREE with a gensym, return a list of these as
the second value.
"Replace ignored variables in TREE with a gensym, return a list of these as the second value.
NOTE: It is unlikely that you need to used this function, see the note above
its definition"
NOTE: It is unlikely that you need to used this function, see the note above its definition."
(let (ignored)
(labels ((traverse (tree)
(if (atom tree)
Expand Down Expand Up @@ -84,23 +81,20 @@ its definition"
(let+-expansion-for-list (first form) (rest form) value body)))

(defgeneric let+-expansion-for-list (first rest value body)
(:documentation "LET+-EXPANSION calls this for lists, see the latter for
semantics of returned values.")
(:documentation "LET+-EXPANSION calls this for lists, see the latter for semantics of returned values.")
(:method (first rest value body)
;; forms not recognized as anything else are destructured
(when (and (symbolp first) (not (ignored? first)) (&-symbol? first)
(not (find first lambda-list-keywords)))
(warn "~A looks like a LET+ keyword, but it has no expansion method ~
defined. Treating it as a lambda list." first))
(warn "~A looks like a LET+ keyword, but it has no expansion method defined. Treating it as a lambda list." first))
(let ((form (cons first rest)))
(multiple-value-bind (form ignored) (replace-ignored form)
`(destructuring-bind ,form ,value
(declare (ignore ,@ignored))
,@body)))))

(defmacro let+ (bindings &body body)
"Destructuring bindings. See the documentation of the LET-PLUS library.
Most accepted forms start with &."
"Destructuring bindings. See the documentation of the LET-PLUS library. Most accepted forms start with &."
(labels ((expand (bindings)
(destructuring-bind (binding &rest other-bindings) bindings
(destructuring-bind (form &optional value)
Expand All @@ -118,12 +112,7 @@ Most accepted forms start with &."
(uses-value? t)
(once-only? uses-value?))
&body body)
"Define an expansion for LET+ forms which are lists, starting with NAME.
ARGUMENTS is destructured if a list. A placeholder macro is defined with
NAME, using DOCSTRING and ARGUMENTS. The value form is bound to
VALUE-VAR (wrapped in ONCE-ONLY when ONCE-ONLY?), while the body is bound to
BODY-VAR. USES-VALUE? determines if the form uses a value, and generates the
appropriate checks."
"Define an expansion for LET+ forms which are lists, starting with NAME. ARGUMENTS is destructured if a list. A placeholder macro is defined with NAME, using DOCSTRING and ARGUMENTS. The value form is bound to VALUE-VAR (wrapped in ONCE-ONLY when ONCE-ONLY?), while the body is bound to BODY-VAR. USES-VALUE? determines if the form uses a value, and generates the appropriate checks."
(let ((arguments-var (gensym "ARGUMENTS"))
(arguments (if (listp arguments)
arguments
Expand Down Expand Up @@ -197,8 +186,7 @@ appropriate checks."
entries))

(defun expand-array-elements (value array-elements &optional (accessor 'aref))
"Expand a list of (BINDING &REST SUBSCRIPTS) forms to a list of bindings of
the form (ACCESSOR VALUE SUBSCRIPTS)."
"Expand a list of (BINDING &REST SUBSCRIPTS) forms to a list of bindings of the form (ACCESSOR VALUE SUBSCRIPTS)."
(mapcar (lambda (array-element)
`(,(first array-element)
(,accessor ,value ,@(rest array-element))))
Expand Down Expand Up @@ -228,8 +216,7 @@ the form (ACCESSOR VALUE SUBSCRIPTS)."
,@body))

(define-let+-expansion (&structure (conc-name &rest slots))
"LET+ form for slots of a structure, with accessors generated using
CONC-NAME."
"LET+ form for slots of a structure, with accessors generated using CONC-NAME."
(check-type conc-name symbol)
`(symbol-macrolet
,(expand-slot-forms slots
Expand All @@ -238,8 +225,7 @@ CONC-NAME."
,@body))

(define-let+-expansion (&structure-r/o (conc-name &rest slots))
"LET+ form for slots of a structure, with accessors generated using
CONC-NAME. Read-only version."
"LET+ form for slots of a structure, with accessors generated using CONC-NAME. Read-only version."
(check-type conc-name symbol)
`(let+ ,(expand-slot-forms slots
(lambda (slot)
Expand Down Expand Up @@ -275,15 +261,12 @@ CONC-NAME. Read-only version."


(define-let+-expansion (&array-elements array-elements)
"LET+ form, mapping (variable &rest subscripts) specifications to
array-elements. VARIABLE is an accessor, which can be used for reading and
writing array elements."
"LET+ form, mapping (variable &rest subscripts) specifications to array-elements. VARIABLE is an accessor, which can be used for reading and writing array elements."
`(symbol-macrolet ,(expand-array-elements value array-elements)
,@body))

(define-let+-expansion (&array-elements-r/o array-elements)
"LET+ form, mapping (variable &rest subscripts) specifications to
array-elements. Read-only accessor, values assigned to VARIABLEs."
"LET+ form, mapping (variable &rest subscripts) specifications to array-elements. Read-only accessor, values assigned to VARIABLEs."
(once-only (value)
`(let+ ,(expand-array-elements value array-elements)
,@body)))
Expand All @@ -298,8 +281,7 @@ array-elements. Read-only accessor, values assigned to VARIABLEs."
(define-let+-expansion (&labels (function-name lambda-list
&body function-body)
:uses-value? nil)
"LET+ form for function definitions. Expands into an LABELS, thus allowing
recursive functions."
"LET+ form for function definitions. Expands into an LABELS, thus allowing recursive functions."
`(labels ((,function-name ,lambda-list ,@function-body))
,@body))

Expand All @@ -315,33 +297,30 @@ recursive functions."
,@body))

(define-let+-expansion (&plist entries)
"LET+ form for property lists. Each entry is (variable &optional
key default)."
"LET+ form for property lists. Each entry is (variable &optional key default)."
`(symbol-macrolet
,(expand-entry-forms entries
(lambda (key default)
`(getf ,value ,key ,default)))
,@body))

(define-let+-expansion (&plist-r/o entries)
"LET+ form for property lists, read only version."
"LET+ form for property lists, read only version. Each entry is (variable &optional key default)."
`(let* ,(expand-entry-forms entries
(lambda (key default)
`(getf ,value ,key ,default)))
,@body))

(define-let+-expansion (&hash-table entries)
"LET+ form for hash tables. Each entry is (variable &optional key
default)."
"LET+ form for hash tables. Each entry is (variable &optional key default)."
`(symbol-macrolet
,(expand-entry-forms entries
(lambda (key default)
`(gethash ,key ,value ,default)))
,@body))

(define-let+-expansion (&hash-table-r/o entries)
"LET+ form for hash tables. Each entry is (variable &optional key default).
Read only version."
"LET+ form for hash tables. Each entry is (variable &optional key default). Read only version."
`(let+ ,(expand-entry-forms entries
(lambda (key default) `(gethash ,key ,value ,default)))
,@body))

0 comments on commit 583df73

Please sign in to comment.