Arc Forum | And now I can redefine a cl-like DEFUN which similarly takes optional and keywor...

Arc Forum

4 points by kennytilton 6137 days ago | link | parent

And now I can redefine a cl-like DEFUN which similarly takes optional and keyword args.

  (mac defun (name params . body)
    (w/uniq (args)
      `(def ,name ,args
         (dsb ,params ,args ,@body))))

Add some more utilities:

  (def prt args
  (apply prs args)
  (prn))

  (mac tst (id form expected)
  (let res (uniq)
  `(let ,res ,form
     (if (iso ,res ,expected)
       (prt 'test ,id 'OK)
     (do
         (prt 'error 'attempting ,id)
         (prt 'expected ,expected)
       (prt 'got ,res)
       (prt 'code ',form))))))

And we can test:

  (defun tabc (a b c)
  (list a b c))

  (tst "vanilla" (tabc 'dog 'cat 3) '(dog cat 3))

  (defun tabc-od (a b c &o (d 42))
    (list a b c d))

  (tst "one optional, nil supplied"
   (tabc-od 'dog 'cat 3 nil)
   '(dog cat 3 nil))

  (tst "one optional, 4 supplied"
   (tabc-od 'dog 'cat 3 4)
   '(dog cat 3 4))

  (tst "one optional, unsupplied"
   (tabc-od 'dog 'cat 3)
   '(dog cat 3 42))

But do not try this at home without the new improved version of dsb below.

I was mishandling nil when supplied as an optional or keyword argument by defaulting the value. When a parameter is missing we use the default if any, but when it is supplied (even if nil, if you can follow that) then that is the value used.

  (mac dsb (params data . body)
  (w/uniq (tree kvs)
    `(withs (,tree ,data
              ,@(with (reqs nil key? nil opt? nil keys nil opts nil)
                  (each p params
                    (if
                        (is p '&o) (do (assert (no opt?) "Duplicate &o:" ',params)
                                       (assert (no key?) "&k cannot precede &o:" ',params)
                                     (= opt? t))
                      (is p '&k) (do (assert (no key?) "Duplicate &k:" ',params)
                                     (= key? t))
                   key? (push-end p keys)
                   opt? (push-end p opts)
                   (do (assert (~acons p) "Reqd parameters need not be defaulted:" p)
                       (push-end p reqs))))
                  (with (n -1)
                    (+ (mappend [list _ `(nth ,(++ n) ,tree)] reqs)
                      (mappend [list (carif _) `(if (< ,(++ n) (len ,tree))
                                                    (nth ,n ,tree)
                                                  ,(cadrif _))] opts)
                      `(,kvs (pair (nthcdr ,(++ n) ,tree)))
                      (mappend [list (carif _)
                                 `(aif (assoc ',(carif _) ,kvs)
                                    (cadr it)
                                    ,(cadrif _))] keys)))))
       ,@body)))

2 points by almkglor 6137 days ago | link

Personally I'd rather do something like this, in imitation of my p-m: modifier macro:

  (dsb:def name params
     (body))

This would also allow (by the magic of hacking the global sig table) us to use (fn ...), (rfn ...), (afn ...), (xxxfn ...) with dsb.

-----