Skip to content
This repository has been archived by the owner on Jan 16, 2021. It is now read-only.


Browse files Browse the repository at this point in the history
241 - defmacro$ requires defun$ to generate comma expressions. Extra …
…complexity is quickly hidden by def/mac.
  • Loading branch information
akkartik committed Jan 19, 2011
1 parent fbb8ab7 commit f4e4859
Show file tree
Hide file tree
Showing 3 changed files with 44 additions and 22 deletions.
11 changes: 11 additions & 0 deletions 005defmacro.lisp
Expand Up @@ -33,3 +33,14 @@
`(defmacro/$ ,name ,args
`(let ,(mapcar #'list (list ,@$s) (list ,@os))
,(progn ,@body)))))

; Use defun$ to generate expressions for defmacro$ to return
(defmacro defun$(name args &rest body)
(let ((syms (remove-duplicates
(remove-if-not #'dollar-symbol-p
(flatten body)))))
`(defun ,name ,args
(let ,(mapcar (lambda(_)
`(,_ (uniq ,(cut (symbol-name _) 1))))
12 changes: 12 additions & 0 deletions 005defmacro.test
Expand Up @@ -10,3 +10,15 @@
(test "defmacro$ handles o$vars - 2"
:valueof (type-of (caar (cadr (macex1 '(foodollar 3)))))
:should be 'symbol)

(defun$ foodef$(x)
`(let ((,$x ,x))
(+ 1 ,$x)))

(defmacro$ foomac$(x)
(list 'quote (foodef$ x)))

(test "defmacro$ handles $vars in comma expressions if they're generated using defun$"
:valueof (foomac$ 3)
:should match '(let ((_ 3))
(+ 1 _)))
43 changes: 21 additions & 22 deletions 019args.lisp
@@ -1,37 +1,36 @@
;; Functions support complex arg lists in wart.

(defmacro def(name params &rest body)
`(defun ,name ,@(compile-params params body)))
(defmacro$ def(name params &rest body)
`(defun ,name(&rest ,$args)
,(compile-params params body $args)))

(defmacro mac(name params &rest body)
(wt-transform `(defmacro$ ,name ,@(compile-params params body))))
(defmacro$ mac(name params &rest body)
`(defmacro$ ,name(&rest ,$args)
,(compile-params params body $args))))

(defmacro fn(params &rest body)
`(lambda ,@(compile-params params body)))
(defmacro$ fn(params &rest body)
`(lambda(&rest ,$args)
,(compile-params params body $args)))

;; Internals
;; Use let* everywhere here because wart will soon override let

; returns arglist and body suitable for insertion into defun or lambda
; new body understands keyword args
; params format (optionals* ? lazy-optionals* . rest)
; convert body to parse keyword args and params format (optionals* ? lazy-optionals . rest)
; optionals can be destructured
; lazy optionals alternate var and default
; lazy optionals require keywords if rest is present
(defun compile-params(params body)
(let* ((args (uniq))
(positionals (uniq))
(keywords (uniq)))
`((&rest ,args)
(let* ((,positionals (positional-args ,args ',(rest-param params)))
(,keywords (keyword-args ,args ',(rest-param params))))
(let* ,(append
(get-required-arg-exprs params positionals keywords)
; args go to rest before optional
(get-rest-arg-expr params positionals keywords)
(get-optional-arg-exprs params positionals keywords))
(defun$ compile-params(params body args)
`(let* ((,$positionals (positional-args ,args ',(rest-param params)))
(,$keywords (keyword-args ,args ',(rest-param params))))
(let* ,(append
(get-required-arg-exprs params $positionals $keywords)
; args go to rest before optional
(get-rest-arg-expr params $positionals $keywords)
(get-optional-arg-exprs params $positionals $keywords))

(defun get-required-arg-exprs(params positionals keywords)
(let ((required-params (required-params params)))
Expand Down

0 comments on commit f4e4859

Please sign in to comment.