[gambit-list] looking for a "weak" apply function

Marc Feeley feeley at iro.umontreal.ca
Sun Nov 12 19:10:13 EST 2006


-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

On 12-Nov-06, at 9:07 AM, Christian wrote:

> Hello
>
> apply is quite a handy simple mechanism for destructuring lists, but:
> if the list doesn't match the function prototype, an exception is
> thrown. Sometimes I don't want to get an exception but instead try to
> apply another function (more generally: to back-track).
>
> So I'm looking for an alternative apply function which takes an
> alternative continuation as a third argument (instead of the implicit
> consing mechanism offered by standard apply when giving it multiple
> arguments):
>
>  (cond-apply
>     fn1
>     lis
>     (lambda ()
>        (cond-apply
>           fn2
>           lis
>           (lambda ()
>              (error "no match:" lis)))))
>
> or
>
>  (or (cond-apply fn1 lis)
>      (cond-apply fn2 lis)
>      (error "no match:" lis))
>
> call-with-exception-* don't do any good since it's relatively slow
> and, worse, would leave the handler in place while the called function
> is running.
>
> I'm remembering a lowlevel function to get the arity of a function
> (returning a positive fixnum for a fixed number of arguments, and a
> negative fixnum if the function is taking a rest argument). Strangely,
> I cannot find it again now. What is it called? (Or did I see it in
> Chicken, not Gambit?) If that function is efficient, I could write
> cond-apply in a fairly efficient way.

The concept of "the arity of a procedure" is ill-defined in general  
when you have optional parameters.  The mechanism you mention exists  
at compile-time for macros, but that is of no use at run time.

The simplest thing to do is to use call/cc and exceptions, but as you  
mention that is moderately expensive and has scoping problems.

What you really want is for cond-apply to save the error-continuation  
in the continuation (on the stack), which is really inexpensive, and  
to access the error-continuation only when there is a wrong-number-of- 
arguments exception.  This can be done with this code, which should  
be compiled:


(declare (extended-bindings) (block) (not inline))

(define (cond-apply proc args $wrong-nb-args)

   (declare (not interrupts-enabled) (environment-map))

   (let ((results (##apply proc args)))
     (##first-argument $wrong-nb-args)
     results))

(define (##raise-wrong-number-of-arguments-exception-nary proc . args)

   (declare (not interrupts-enabled))

   (wrong-number-of-arguments proc args))

(define (##raise-wrong-number-of-arguments-exception proc args)

   (declare (not interrupts-enabled))

   (wrong-number-of-arguments proc args))

(define (wrong-number-of-arguments proc args)

   (define (err) (error "wrong number of arguments" proc args))

   (##continuation-capture
    (lambda (cont)
      (if (##eq? cond-apply
                 (##subprocedure-parent (##continuation-ret cont)))
          (let ((binding (##continuation-locals cont '$wrong-nb-args)))
            (if (##pair? binding)
                (let (($wrong-nb-args (##cdr binding)))
                  ($wrong-nb-args))
                (err)))
          (err)))))

(pp (cond-apply
      cons
      '(1 2 3)
      (lambda ()
        (cond-apply
         sin
         '(1 2 3)
         (lambda ()
           999)))))

All of this works because the procedures ##raise-wrong-number-of- 
arguments-exception and ##raise-wrong-number-of-arguments-exception- 
nary are tail-called by ##apply (i.e. continuation = inside the cond- 
apply) so we can simply check the continuation frame at the top of  
the stack to find the value of $wrong-nb-args.   The (declare  
(environment-map)) is necessary to keep the name of the variables in  
the continuation frame so that ##continuation-locals can find it.

Marc

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.3 (Darwin)

iD8DBQFFV7fl//V9Zc2T/v4RAgOBAJsGXMLUC5CdqAy6vP9VYa2RyECJbACdGBOA
xBovEXDMPzPOhM7F3gb7TEU=
=hVuw
-----END PGP SIGNATURE-----



More information about the Gambit-list mailing list