diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2015-10-04 10:22:08 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2015-10-04 10:22:08 -0700 |
| commit | 75ddca922ba8dcaf696f23f613b1a9f594a1884f (patch) | |
| tree | 2792a86030426b5e170edfc4acd294e218d8a987 /share | |
| parent | 0b587e521b5bee74c530adcf4636993ed91036c4 (diff) | |
| download | txr-75ddca922ba8dcaf696f23f613b1a9f594a1884f.tar.gz txr-75ddca922ba8dcaf696f23f613b1a9f594a1884f.tar.bz2 txr-75ddca922ba8dcaf696f23f613b1a9f594a1884f.zip | |
Optional arguments in boa construction.
* share/txr/stdlib/struct.tl (defstruct): Split boa
arguments on colon and generate the lambda
accordingly. The generated function detects which
optional arguments are actually present and only
performs the slot updates for those.
* tests/012/struct.tl: Corrected boa test case.
* txr.1: Documented.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/struct.tl | 25 |
1 files changed, 20 insertions, 5 deletions
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl index f943c06f..bd049f75 100644 --- a/share/txr/stdlib/struct.tl +++ b/share/txr/stdlib/struct.tl @@ -134,11 +134,26 @@ ^((finalize ,arg-sym (lambda (,(car instance-fini-form)) ,*(cdr instance-fini-form)) t))))) - ,(if args - (let ((gens (mapcar (ret (gensym)) args))) - ^(lambda (,arg-sym ,*gens) - ,*(mapcar (ret ^(slotset ,arg-sym ',@1 ,@2)) - args gens))))))))) + ,(when args + (when (> (countql : args) 1) + (throwf 'eval-error "~s: multiple colons in boa syntax" + 'defstruct)) + (let ((col-pos (posq : args))) + (let ((req-args [args 0..col-pos]) + (opt-args (if col-pos [args (succ col-pos)..:]))) + (let ((r-gens (mapcar (ret (gensym)) req-args)) + (o-gens (mapcar (ret (gensym)) opt-args)) + (p-gens (mapcar (ret (gensym)) opt-args))) + ^(lambda (,arg-sym ,*r-gens + ,*(if opt-args '(:)) + ,*(if opt-args + (mapcar (ret ^(,@1 nil ,@2)) + o-gens p-gens))) + ,*(mapcar (ret ^(slotset ,arg-sym ',@1 ,@2)) + req-args r-gens) + ,*(mapcar (ret ^(if ,@3 + (slotset ,arg-sym ',@1 ,@2))) + opt-args o-gens p-gens))))))))))) (defmacro sys:struct-lit (name . plist) ^(make-struct ',name ',plist)) |