Arc Forum | Great idea. Like my deftimed (http://arclanguage.org/item?id=11556) this kind of...

Arc Forum

3 points by akkartik 5087 days ago | link | parent

Great idea. Like my deftimed (http://arclanguage.org/item?id=11556) this kind of 'codegenerate def' macro has one major limitation: the def can no longer have optional arguments. Anybody have ideas on how to fix that?

4 points by conanite 5087 days ago | link

Thanks, and well spotted. Using this with optional args gives the wrong error message: "reference to undefined identifier: _o"

> Anybody have ideas on how to fix that?

yes! A little function to extract arg names from an arg list:

  (def extract-arg-names (args)
    (flat:afnwith (args args o? nil)
      (if args
          (if atom.args
              args
              (let arg car.args
                (if atom.arg
                    (if (or no.o? (isnt arg 'o))
                        (cons arg (self cdr.args nil))
                        cadr.args)
                    (cons (self car.args t)
                          (self cdr.args nil))))))))

Gives:

  arc> (extract-arg-names 'xs)
  (xs)
  arc> (extract-arg-names '(x))
  (x)
  arc> (extract-arg-names '(a b))
  (a b)
  arc> (extract-arg-names '(a b (c d)))
  (a b c d)
  arc> (extract-arg-names '(a b c (d e (f g) (o h "foo")) (o i a) (o j 1)))
  (a b c d e f g h i j)

So using 'extract-arg-names instead of 'flat removes the problem of optional args. Use this function whenever you have a macro that needs to manipulate parameter lists!

The new and improved 'unsafe-def

  (unless (bound 'unsafe-def)
    (assign unsafe-def def)
    (mac def (name args . body)
      `(unsafe-def ,name ,args
         (on-err (fn (ex) (err:string "error in "
                                      ',name 
                                      (tostring:pr:list ,@(extract-arg-names args)) 
                                      "\n"
                                      (details ex)))
                 (fn ()   ,@body)))))

Which now returns the correct error msg:

  arc> (def myothermap (f (o xs '(a b c)))
    (map f xs))
  #<procedure:zz>
  arc> (def otherfoo (bar)
    (myothermap bar))
  #<procedure: otherfoo>
  arc> (otherfoo nil)
  Error: "error in otherfoo(nil)\nerror in myothermap(nil (a b c))\nFunction call on inappropriate object nil (a)"

-----

3 points by rocketnia 5086 days ago | link

Looks like conanite beat me to it, but I whipped up a solution too:

  (def proper (lst)
    (accum acc
      (while acons.lst
        (do.acc pop.lst))
      only.acc.lst))
  
  (def o-flat (lst)
    (mappend [if (caris _ 'o)  (list cadr._)  ; optional
                 alist._       flat._         ; destructuring
                               list._]        ; normal
             proper.lst))  ; turn rest into normal
  
  ; This returns a two-element list containing a list of all the cars of
  ; the list and the final cdr of the list. For instance,
  ; (iso (split-end '(a b . c)) '((a b) c)). For proper lists, it's the
  ; same as (split lst len.lst).
  (def split-end (lst)
    (let onset (accum acc
                 (while acons.lst
                   (do.acc pop.lst)))
      (list onset lst)))
  
  (def antidestruct (struct)
    (treewise (fn _ `(cons ,@_)) idfn struct))
  
  (def recreate-call (name arglist)
    (withs ((nonrest rest) split-end.arglist
            recreated-nonrest
              (map [if (caris _ 'o)  cadr._
                       alist._       antidestruct._
                                     _]
                   nonrest))
      `(apply ,name ,@recreated-nonrest ,rest)))

Then this should do the trick:

   (unless (bound 'unsafe-def)
     (assign unsafe-def def)
     (mac def (name args . body)
       `(unsafe-def ,name ,args
          (on-err (fn (ex) (err:string "error in "
                                       ',name
  -                                    (tostring:pr:list ,@(flat args))
  +                                    (tostring:pr:list ,@o-flat.args)
                                       "\n"
                                       (details   ex)))
                  (fn ()   ,@body)))))
   
   (mac deftimed(name args . body)
     `(do
        (def ,(symize (stringify name) "_core") ,args
           ,@body)
        (def ,name ,args
         (let t0 (msec)
  -        (ret ans ,(cons (symize (stringify name) "_core") args)
  +        (ret ans ,(recreate-call (sym:string name '_core) args)
             (update-time ,(stringify name) t0))))))

There are really two cases here, and none of the utility functions are used for both. The error message could be modified to use 'recreate-call too (in which case 'o-flat and 'proper would be orphaned), but that would change its behavior with regards to rest args and destructuring args, which already work. (Incidentally, I think conanite and I gave equivalent solutions for the error message case.)

-----