Arc Forumnew | comments | leaders | submitlogin
Unsafe-def
4 points by conanite 5296 days ago | 4 comments
Sometimes tracking down errors can be a pain.

  Function call on inappropriate object nil
Here's a snippet that helps to trace some errors by rebinding 'def to a wrapper macro that generates error-tracking code:

  (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)) 
                                      "\n"
                                      (details   ex)))
                 (fn ()   ,@body)))))

In arc3.1, this gives

  arc> (def mymap (f xs) (map f xs))
  #<procedure: mymap>
  arc> (def foo (bar) (mymap bar (list 1 2 3)))
  #<procedure: foo>
  arc> (foo nil)
  Error: "error in foo(nil)\nerror in mymap(nil (1 2 3))\nFunction call on inappropriate object nil (1)"
I don't know how to make the top-level error handler "disp" instead of "write" the error message, but you see the idea.

It's primitive but helpful. The "unless (bound ..." guard is necessary if you reload your code during development; without it 'def becomes an infinite recursion.



4 points by fallintothis 5296 days ago | link

I don't know how to make the top-level error handler "disp" instead of "write" the error message, but you see the idea.

I always thought it was silly for Arc to use write for error messages. It seems deliberate, but I'm not sure why. The fix is simple:

  $ diff -u old-ac.scm new-ac.scm
  --- old-ac.scm  2010-05-22 21:32:25.000000000 -0700
  +++ new-ac.scm  2010-05-22 21:34:04.000000000 -0700
  @@ -1137,7 +1137,7 @@
     (on-err (lambda (c)
               (set! last-condition* c)
               (display "Error: ")
  -            (write (exn-message c))
  +            (display (exn-message c))
               (newline)
               (tl2))
       (lambda ()

-----

3 points by akkartik 5296 days ago | link

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 5295 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 5295 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.)

-----