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

Commit f4e4859

Browse files
committed
241 - defmacro$ requires defun$ to generate comma expressions. Extra complexity is quickly hidden by def/mac.
1 parent fbb8ab7 commit f4e4859

File tree

3 files changed

+44
-22
lines changed

3 files changed

+44
-22
lines changed

005defmacro.lisp

+11
Original file line numberDiff line numberDiff line change
@@ -33,3 +33,14 @@
3333
`(defmacro/$ ,name ,args
3434
`(let ,(mapcar #'list (list ,@$s) (list ,@os))
3535
,(progn ,@body)))))
36+
37+
; Use defun$ to generate expressions for defmacro$ to return
38+
(defmacro defun$(name args &rest body)
39+
(let ((syms (remove-duplicates
40+
(remove-if-not #'dollar-symbol-p
41+
(flatten body)))))
42+
`(defun ,name ,args
43+
(let ,(mapcar (lambda(_)
44+
`(,_ (uniq ,(cut (symbol-name _) 1))))
45+
syms)
46+
,@body))))

005defmacro.test

+12
Original file line numberDiff line numberDiff line change
@@ -10,3 +10,15 @@
1010
(test "defmacro$ handles o$vars - 2"
1111
:valueof (type-of (caar (cadr (macex1 '(foodollar 3)))))
1212
:should be 'symbol)
13+
14+
(defun$ foodef$(x)
15+
`(let ((,$x ,x))
16+
(+ 1 ,$x)))
17+
18+
(defmacro$ foomac$(x)
19+
(list 'quote (foodef$ x)))
20+
21+
(test "defmacro$ handles $vars in comma expressions if they're generated using defun$"
22+
:valueof (foomac$ 3)
23+
:should match '(let ((_ 3))
24+
(+ 1 _)))

019args.lisp

+21-22
Original file line numberDiff line numberDiff line change
@@ -1,37 +1,36 @@
11
;; Functions support complex arg lists in wart.
22

3-
(defmacro def(name params &rest body)
4-
`(defun ,name ,@(compile-params params body)))
3+
(defmacro$ def(name params &rest body)
4+
`(defun ,name(&rest ,$args)
5+
,(compile-params params body $args)))
56

6-
(defmacro mac(name params &rest body)
7-
(wt-transform `(defmacro$ ,name ,@(compile-params params body))))
7+
(defmacro$ mac(name params &rest body)
8+
(wt-transform
9+
`(defmacro$ ,name(&rest ,$args)
10+
,(compile-params params body $args))))
811

9-
(defmacro fn(params &rest body)
10-
`(lambda ,@(compile-params params body)))
12+
(defmacro$ fn(params &rest body)
13+
`(lambda(&rest ,$args)
14+
,(compile-params params body $args)))
1115

1216

1317

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

17-
; returns arglist and body suitable for insertion into defun or lambda
18-
; new body understands keyword args
19-
; params format (optionals* ? lazy-optionals* . rest)
21+
; convert body to parse keyword args and params format (optionals* ? lazy-optionals . rest)
2022
; optionals can be destructured
23+
; lazy optionals alternate var and default
2124
; lazy optionals require keywords if rest is present
22-
(defun compile-params(params body)
23-
(let* ((args (uniq))
24-
(positionals (uniq))
25-
(keywords (uniq)))
26-
`((&rest ,args)
27-
(let* ((,positionals (positional-args ,args ',(rest-param params)))
28-
(,keywords (keyword-args ,args ',(rest-param params))))
29-
(let* ,(append
30-
(get-required-arg-exprs params positionals keywords)
31-
; args go to rest before optional
32-
(get-rest-arg-expr params positionals keywords)
33-
(get-optional-arg-exprs params positionals keywords))
34-
,@body)))))
25+
(defun$ compile-params(params body args)
26+
`(let* ((,$positionals (positional-args ,args ',(rest-param params)))
27+
(,$keywords (keyword-args ,args ',(rest-param params))))
28+
(let* ,(append
29+
(get-required-arg-exprs params $positionals $keywords)
30+
; args go to rest before optional
31+
(get-rest-arg-expr params $positionals $keywords)
32+
(get-optional-arg-exprs params $positionals $keywords))
33+
,@body)))
3534

3635
(defun get-required-arg-exprs(params positionals keywords)
3736
(let ((required-params (required-params params)))

0 commit comments

Comments
 (0)