Arc Forum | dsb: A lite version of Common Lisp destructuring-bind

Arc Forum

dsb: A lite version of Common Lisp destructuring-bind

20 points by kennytilton 6085 days ago | 21 comments

This is one crazy macro, one of the wildest I have done, because it is pretty interesting handling optional and keyword parameters at runtime to boot. Begins with some utilities needed by dsb itself. But first the usage:

First of all, we want runtime destructuring, so the expansion itself has to deal with possibly missing optional parameters and then keyword parameters offered in any order.

Second, we want optional and keyword parameters to accept default values, and we want those optionally to be forms referring back to earlier parameters.

So:

  (let data (list 1 2 nil nil 'p 5)
    (dsb (x y &o (a (+ y 1)) z &k (p 98) (q (+ a 1))) data
      ;; we want to see identical pairs, cuz next I
      ;; print first a variables runtime binding
      ;; and then its expected value
      (prs "args" x 1 y a 3 z nil p 5 q 4)
      (prn)))

;; above -> args 1 1 2 2 3 3 nil nil 5 5 4 4

That is more than a little lame as test harnesses go. :) Now first my add-ons:

  (mac assert (c . msg)
  `(unless ,c
     (prs "Assert NG:" ',c 'deets: ,@msg)
     (ero "See console for assert failure deets")))

  (mac push-end (x place)
  `(if (no ,place)
       (= ,place (list ,x))
     (aif (lastcons ,place)
       (do (= (cdr it) (cons ,x nil))
           ,place))))

  (def cadrif (x) (when (acons x) (cadr x)))

  (def nth (i lst)
  "Indexed list access but returns NIL if index out of bounds"
  (let x -1
    (some [when (is (++ x) i) _] lst)))

  (def lastcons (seq)
  (when (acons seq)
    (if (no (cdr seq))
        seq
      (lastcons (cdr seq)))))

And now the money:

  (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
                    (prs 'param p)(prn)
                    (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)
                       (prs 'push-end p 'place reqs)
                       (push-end p reqs)
                     (prs 'reqs-now reqs) (prn))))
                  (with (n -1)
                    (+ (mappend [list _ `(nth ,(++ n) ,tree)] reqs)
                      (mappend [list (carif _) `(or (nth ,(++ n) ,tree)
                                                  ,(cadrif _))] opts)
                      `(,kvs (pair (nthcdr ,(++ n) ,tree)))
                      (mappend [list (carif _)
                                 `(or (alref ,kvs ',(carif _))
                                    ,(cadrif _))] keys)))))
       ,@body)))

That was lightly tested and I wager is especially easy to break given the helter-skelter mixture of compile-time and runtime values it juggles. The scotch probably does not help either. :)

4 points by kennytilton 6085 days ago | link

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 6084 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.

-----

3 points by lojic 6085 days ago | link

Nice touch with the back references. As a Ruby programmer, I must defer to the power of Lisp on this one :)

x, y = [1, 2, 3] is handy, but it only takes you so far.

-----

3 points by kennytilton 6085 days ago | link

Oops, left some debug prints in there. :(

-----

2 points by NickSmith 6085 days ago | link

Kenny, please excuse my noobiness but I'm struggling to work out what this is for exactly. Could you give an example use case. :)

-----

6 points by kennytilton 6085 days ago | link

(a) No apologies needed, I kinda anticipated this question. :) (b) Perhaps the best use case was just added, the application of DSB to DEFUN. I should extend the examples, tho. (c) In simple cases where one bit of application generates a result in the form of a list of values, native Arc destructuring such as:

  (let (x y . z) data-genned-elsewhere ...)

...works fine, and indeed is the most common case. But as the application becomes more elaborate we might start having one bit of code emitting data of a more interesting nature, and then at the point of consumption we want to be able to parse that data tersely and in a self-documenting way.

So I might have an application where RGB triples are being passed around and eventually handed to OpenGL and app code just emits (list r g b) and the code that talks to OpenGL looks like:

   (dsb (r g b) color-data
      ...tell ogl about r g and b ...)

Fine, but now I decide in one place to emit an alpha value as well. No problem, all the code just emitting RGB stays unchanged, but in one place I can emit RGBA and then modify the consuming location thus:

   (dsb (r g b &o a) color-data
     ...etc...)

If I now want to get into shininess or material or other ogl options, the optional thing gets nuts because I have to remember in which position shininess goes and then make sure I supply enough nils for other optionals to get the right alignment, and that breaks if I have a fun default for one of the optionals I am bogusly providing just to get alignment. keyword args get us out of that trap, and we do not even have to list them in the right order, they get worked out at call time (so, yes, do not abuse this feature).

  (dsb (r g b &k (a 255) shiny mat) color-data
     ... etc)

Now in CL we have DEFSTRUCT and can at some point punt on lists and get into emitting:

   (make-coloring :r 42 :g 42 :b 42 :shiny +gl-shiny-super+)

...and then the consumer reads the structure attributes so it can talk to OpenGL. The Arc DEFTEM is a solution here if we are restricting ourselves to keyword args. And as I said at the outset, a CL-style DEFUN might be the posterboy for DSB, because we can now decide a DEF needs a new parameter and add it as an optional or keyword arg without changing every call. And where an especially hairy DEF such as open-file will end up with a kazillion parameters, keyword args make calling the function a lot slicker.

-----

1 point by NickSmith 6085 days ago | link

Thanks Kenny, that hit the Mark :)

Looking at mac dsb I realise just how much I have to learn :(

-----

4 points by kennytilton 6085 days ago | link

heh-heh, don't feel bad, i was not kidding when I said it is one of the craziest macros I ever wrote, and I have written over five hundred. Might be the craziest, actually. Macros are normally hard because we are writing code to write code, bouncing back and forth between the mindset of the expanding code and that of the expanded code we are after as we go from backquote to unquote and back.

But in this case with the keyword args the expanded code then had to include code to continue the binding process, because the expander code cannot guess which keywords had been supplied by the caller. Hence the rather sick stop mid-expansion to produce the kvs binding with remaining runtime args paired into an assoc before continuing on to produce the other keyword bindings, each necessitating a runtime lookup of the keyword before deciding if any default should be used, which default might itself still be code!

Man, I now I am confused. Good thing I wrote the macro before I wrote this comment. :)

Needless to say, the macro was evolved: first just getting required params to work. Trivial, but still. Then optionals, with defaults, including computed defaults. I had a bug here, recall, forgetting nil supplied in an optional position means nil, not the default. Then keyword args.

A bit of a giveaway, btw, is my apology above for leaving behind some print statements in the expanding code. We debug macros just like we debug any other code.

Another tip is that I might have broken out that little state machine in the beginning as a separate function to parse the params like:

  (a b c &o (d 42) (e (+ c 1)) &k x)

...into an assoc:

   '((reqs a b c)(opts (d 42)(e (+ c 1))(keys x))

ie, Divide and conquer: get that working separately, then tackle the rest. I did not do that because of insufficient lookahead (did not realize what I got myself into). :)

-----

1 point by cchooper 6085 days ago | link

Now that I understand it, I love it.

-----

2 points by kennytilton 6085 days ago | link

I should add that dsb and thus defun support optional and keyword args at the same time only because it is possible; I cannot imagine it ever being sensible. :)

-----

2 points by are 6084 days ago | link

Very nice work on supporting both opt and key args.

Although if you had something like this:

(defun fn (a &o (b 'b) (c 'c) &k (d 'd))

with a usage like this:

(fn 1 'd 'e)

... how would you know whether:

1) 'd is the value of the first opt arg and 'e is the value of the second (the key arg unsupplied)

2) 'd is the key for the key arg, and 'e is its supplied value (the 2 opt args unsupplied)

Maybe I'm missing something here, but it seems to me that unless you have special syntax for keywords, you will get into trouble.

And if you have to introduce special syntax for keys anyway, it is just as well to make every single argument keyable on its symbol (even vanilla ones), and just worry about combining &o and &rest (which should then be doable).

-----

3 points by kennytilton 6084 days ago | link

"with a usage like this: (fn 1 'd 'e) how would you know..."

The interpretation is that d and e are the two optional args, so any caller wanting to supply a keyword arg has to supply the optionals. Recall that I said it was possible, not sensible. :) But in tool design I think we should let users hang themselves rather than guess (perhaps wrongly) that no one would ever come up with a good use for such a thing.

A second, lesser motivation is that CL works that way.

-----

2 points by kennytilton 6084 days ago | link

The gang on comp.lang.lisp reminded me of (in effect):

  (def read-from-string (s &o eof-error-p eof-value 
                           &k start end preserve-whitespace)
     ...)

Which does make me think the guess about keywords being added as an afterthought might be spot on.

-----

2 points by kennytilton 6084 days ago | link

c.l.lisp just offered a much better observation: the optional args above are standard for the various "read" functions, and the start and end keywords are standard for string functions. Read-from-string then is inheriting consistently from both families.

-----

2 points by eds 6084 days ago | link

Even CL's special keyword syntax doesn't save you from optional and keyword confusion:

  [1]> (defun test (a &optional (b 'b) (c 'c) &key (d 'd))
         (list a b c d))
  TEST
  [2]> (test 1 :d :e)
  (1 :D :E D)

Optional parameters always bind first in CL, and I believe dsb is written to mimic that behavior.

Having all parameters be keyword arguments as well might be interesting, but it wouldn't avoid optional/keyword confusion.

-----

1 point by are 6083 days ago | link

> Having all parameters be keyword arguments as well might be interesting, but it wouldn't avoid optional/keyword confusion.

Why not?

Let's say you have a function with 3 standard args followed by 2 opt args. So you have 5 args, all keyable on the symbol you give them in the def.

Let's further say that in a call to this function, I key the middle standard arg (#2 in the def) plus the first opt arg (#4 in the def) and also, I omit the second opt arg (#5 in the def). So, I'm supplying two standard args apart from the two args I'm keying. Then the function call parser would know, after identifying the 2 keyed args and matching them to positions #2 and #4 in the def, that the first non-key arg supplied corresponds to position #1 in the def, the second non-key arg supplied corresponds to position #3 in the def, and that an arg for position #5 in the def is missing, leading to the usage of the default value for this opt arg.

This would even work when you want to raise an error for a non-supplied, non-opt arg.

Wouldn't this work quite intuitively (keying an arg when calling a function "lifts it out" of the normal "vanillas then optionals" argument sequence, shortening that sequence, put keeping a well-defined order for it)? (You would need special syntax for keys in this proposal. My suggestion is a colon appended to the arg symbol, rather than prepended, like in CL.)

Can someone give a counterexample if they think this somehow wouldn't work?

&rest args are left as an exercise for the reader :-)

-----

2 points by almkglor 6084 days ago | link

It could be, if you had an old function that was using optional arguments, and then eventually had to add even more arguments, which you finally decide to make keyworded; without breaking existing code, you can support both optional and keyword args.

What I would like to see is optional, keyword, and rest arguments. Imagine something like this:

  (def foo (k v)
    'type (k int)
    (+ k v))

-----

3 points by kennytilton 6084 days ago | link

The syntax to add rest args, if it followed the CL example, would be:

  (dsb (r1 &o o1 &r rest &k k1) data ....)

If data was (1 2 'k1 3) then most params would be bound as expected and then rest would be bound to (k1 3).

But now the data (1 2 'k1 3 4) causes an error "Key list is not even", ie, once you say &k you undertake certain obligations as the caller. Even if you even up the list:

   (1 2 'k1 2 3 5)

...you get an error "3 is an invalid keyword", because 3 appears in a keyword position. This can be avoided by announcing your intention to have undeclared keywords:

   (a b &rest rest &key k1 &allow-other-keys)

That of course is CL, and it kinda makes my day that if I were crazy enough to extend dsb in Arc I would end up with:

   (a b &r rest &k k1 &aok)

-----

1 point by kennytilton 6083 days ago | link

"...if I were crazy enough to extend dsb..."

Was there ever any doubt? :)

Still requiring extensions from earlier posts:

  (def dsb-params-parse (params)
    (withs (reqs nil key? nil opt? nil keys nil opts nil
          rest (mem '&r params)
          rest-var (cadr rest)
          aok? (find '&aok cddr.rest)
           resting? nil
           no-mas nil)
    (each p params
      (if no-mas (assert nil "No params &aok, OK?" ',params)
        (is p '&o) (do (assert ~opt? "Duplicate &o:" ',params)
                       (assert ~key? "&k cannot precede &o:" ',params)
                     (= opt? t))
        (is p '&k) (do (assert ~key? "Duplicate &k:" ',params)
                       (= key? t))
        (is p '&r) (= resting? t)
        (is p '&aok) (= no-mas t)
        key? (push-end p keys)
        (and opt? (no resting?)) (push-end p opts)
        (no resting?) (do (assert (~acons p) "Reqd parameters need not be defaulted:" p)
                           (push-end p reqs))))
    (prt 're-obj!!!!! reqs opts rest-var keys aok?)
    (obj reqs reqs opts opts rst rest-var keys keys aok? aok?)))

And man was I happy to have the above as a breakout from the macro itself:

  (mac dsb (params data . body)
  (w/uniq (tree kvs valid-keys aok?)
    `(withs (,tree ,data
              ,@(let plist (dsb-params-parse params)
                  (prn `(reqs ,plist!reqs))
                  (prn `(rst ,plist!rst))
                  (prn `(keys ,plist!keys))
                  (prn `(&aok ,plist!aok?))
                  (with (n -1)
                    (+ (mappend [list _ `(nth ,(++ n) ,tree)] plist!reqs)
                      (mappend [list (carif _) `(if (< ,(++ n) (len ,tree))
                                                    (nth ,n ,tree)
                                                  ,(cadrif _))] plist!opts)
                      `(,plist!rst (nthcdr ,(++ n) ,tree))
                      `(,valid-keys ',plist!keys)
                      `(,aok? ',plist!aok?)
                      `(,kvs (do (prt 'foing ,valid-keys)
                                 (when (and ,plist!rst ,valid-keys)
                                   (assert (even (len ,plist!rst)) "Keyword list not even" ,plist!rst)
                                   (let ,kvs (pair ,plist!rst)
                                     (prt 'vetting ,valid-keys 'againt ,kvs)
                                     (unless ,aok?
                                       (assert (all [find (car _) ,valid-keys] ,kvs)
                                         "Invalid key in" (map car ,kvs)))
                                     (prt 'kvs!!!!! ,kvs)
                                     ,kvs))))
                      (mappend [list (carif _)
                                 `(do (prt 'kvs!!! ',(carif _) ,kvs)
                                      (aif (assoc ',(carif _) ,kvs)
                                        cadr.it
                                        ,(cadrif _)))] plist!keys)))))
       ,@body)))

What is missing (largely) is graceful handling of invalid use.

-----

1 point by almkglor 6083 days ago | link

> What is missing (largely) is graceful handling of invalid use.

(err:tostring:write ...) works fine for me for reporting errors and aborting

-----

2 points by kennytilton 6084 days ago | link

Ok, and then going forward only the new code has the burden of supplying optionals... hmmm, refactoring at 7am with the demo to the CEO scheduled for 9am?...

Lock and load! Add the keywords!! :)

-----