From 75ddca922ba8dcaf696f23f613b1a9f594a1884f Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sun, 4 Oct 2015 10:22:08 -0700 Subject: 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. --- share/txr/stdlib/struct.tl | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) (limited to 'share') 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)) -- cgit v1.2.3