[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

optional arguments




>From the minutes of the Scheme implementors meeting:

-------------------------------------------------------------------------------
   OPTIONAL ARGUMENTS

   We agreed to use the #!OPTIONAL syntax as in MIT Scheme.  For example,

       (lambda (x #!optional y z . w) ...)

   evaluates to a procedure with one required argument, two optional arguments,
   and a rest argument.  How do you tell if an optional argument is supplied?
   It is not supplied if its value satisfies the DEFAULT-OBJECT? predicate.
   For example, the WRITE procedure might be written

       (define (write x #!optional p)
         (let ((p (if (default-object? p) (current-output-port) p)))
           ...))

   A feature of this approach is that the caller can pass a default object
   as an argument, thereby faking an unsupplied argument.  This is nice
   when you want to supply a value for one optional argument without
   supplying for any other optional arguments that precede it in the
   argument list.

   We did not decide on a syntax for default objects.  This may have been
   an oversight.  You can get a default object by writing

       ((lambda (#!optional x) x)).
-------------------------------------------------------------------------------

This optional feature seems to be useful mainly for efficiency, in that it
makes it possible to avoid the allocation involved in the following:

  (define (write x . l)
     (let ([p (if (null? l) (current-output-port) (car l))])
        ...))

where a list would have to be allocated for the optional port.
However not much functionality is gained here, except for the error 
checking on the supplied argument count (the second version would swallow 
|(write x y z)|, while hopefully the #!opt interface would choke on it),
and a somewhat more convenient access to supplied optional arguments.
The price paid is a more complicated lambda-list interface, and a 
rather homely one at that.  It is also questionable whether we want to 
introduce another special object, the default object.  Apparently it is 
to be a first class object, which can be referenced and passed around.  

I agree that some sort of improved optional argument interface is needed
if Scheme is to continue to support optional arguments to rrrs-specified
procedures.  A valid criticism of the present Scheme specification is that
it allows optional arguments without providing a reasonable user interface.
Efficiency is certainly a consideration--many users would like to be able 
to write procedures with optional arguments without taking a big efficiency
hit (even worse is the necessity of educating users who need to be concerned
about efficiency of such tradeoffs between functionality and efficiency).
However the issue of usability should also be addressed.  The rest-interface
is most useful for procedures that take an indefinite number of arguments,
and its use is strained at best when used to implement restricted optional
arguments.  Error checking for excess arguments is messy, and usually
ignored (as in my above example).  The process of determining whether
an argument has been supplied, and setting up the correct binding is also
tedious and not very transparent.  What is needed is an interface that makes
the whole process safe and transparent, and at the same time allows efficient
implementation.  The interface should be attractive enough that users aren't
tempted to use the rest-interface unnecessarily.  Of course the usability
problem can be solved by macros, but as long as we are considering moving 
something new into the language, it makes sense to provide it at as close
to desired final form as possible, so as to prevent the explosion of 
incompatible macro interfaces that try to provide convenient access to an
excessively primitive feature.

Looking at the |#!optional| proposal, it is clear that it solves the problem of
error checking for excessive arguments.  It also simplifies checking for the
presence of supplied values and accessing those values for rebinding, since
they may be accessed by name rather than by position in a list.  However the
actual checking and rebinding must still be explicitly carried out, and the
process of rebinding is not very transparent, since it is buried inside of
|let|s and |if|s.  The introduction of a default value is also questionable,
since its main use is to be looked at and thrown away.  The burden of making 
sure that it does get checked and replaced is left to the user, and if he fails 
to handle it correctly the default value remains to slosh around and cause mysterious errors.  (It could get passed along to another procedure with default 
arguments!) The cases where the default value is used other than by 
|default-object?| are probably (hopefully?) few and arcane, and thus of 
questionable significance.

I suspect most users, and systems, would want to build some cleaner interface
on top of the primitive |#!optional| one, so we should investigate such
interfaces with the goal of finding one that can be supported directly by
the Scheme community, keeping optional arguments simple and contained.
One such optional argument interface which has useful features both in terms
of efficient implementation and in terms of a useful user interface is 
|case-lambda|, which dispatches on the number of arguments received.  
For instance:

  (define write
     (rec write
        (case-lambda
           [(x p) ...]
           [(x) (write x (current-output-port))])))

Each branch of a |case-lambda| statement is equivalent to a similarly structured
|lambda| statement, except which branch is applied depends upon how many 
arguments are supplied.  Thus the above is semantically equivalent to:

  (define write
     (rec write 
        (lambda l
           (apply (case (length l)
                     [2 (lambda (x p) ...)]
                     [1 (lambda (x) (write x (current-output-port)))]
                     [else (error 'write "wrong number of arguments")])
                  l))))
                       
However in practice the code can be highly optimized, and the list |l| need
never be created. Since the internal |write| has lexical scoping, the call to 
it in the second case should be just a jump. The actual dispatching on
the argument count can also optimized by the compiler, probably resulting 
in better performance than that provided by checks against a default
value, even if the |default-object?| predicate is recognized by the compiler.
So, provided that one is willing to let the compiler recognize
one more special form, the performance for |case-lambda| should be excellent.

|case-lambda| also provides a simple user interface.  The default value 
problem goes away.  The status and intent of procedure parameters is
signaled immediately--one needn't look at the code body to determine where
the real value is available and where it isn't.  If an argument is visible
in a piece of code, it has a 'real' value.  The number of new identifiers and
forms is also minimized.  While the #!proposal introduces |#!optional|
and |default-object?|, and probably something like |#!optional-default-object|,
|case-lambda| needs only its own name, and for those who like to keep
core special forms to an absolute minimum, |lambda| can clearly be defined
as a special case of |case-lambda|.  One argument for the naturalness of the 
|case-lambda| specification of procedures that take optional arguments is that 
it is very similar to the specification patterns used in the rrrs for
procedures that accept optional arguments.  It seems to be a natural way 
to think and write about them.

Another useful feature of |case-lambda| is that it makes it simple to
treat any of the arguments to a procedure as optional, not just those
on the tail of the argument list.  For instance if one thought the port
should come first (but still be defaulted) in |write|: 

  (define backwards-write
     (case-lambda
        [(p x) (write x p)]
        [(x)   (write x (current-output-port))]))

A more realistic example is |-|, in which it IS the first argument that
is missing when only one is provided:

  (define -
    (case-lambda
       [(x y)   (minus x y)]
       [(x)     (minus 0 y)]
       [(x . l) (let loop ([total x] [rest l])
                   (if (null? l)
                      total
                      (loop (minus total (car l)) (cdr l))))]))

This points out a drawback to all the optional argument interfaces
presented so far--none supply a simple way to avoid the allocation
involved when indefinitely many arguments are allowed.  Often one ends
up with the above situation, in which the list is used as a stack and
never escapes, but still must be allocated.  Note that the following simpler 
definition would be incorrect since the list is reallocated on the recursive
calls to |-| in the third case:

  (define -
     (rec -
        (case-lambda
           [(x y)     (minus x y)]
           [(x)       (minus 0 y)]
           [(x y . l) (apply - (minus x y) l)])))

The problem is that the allocation involved in creating the lists will
be quadratic in relation to the number of arguments, when the algorithm
should of course be linear.  (Perhaps this really points out a problem in
the interaction between |apply| and the rest-interface.)

Either the |#!optional| and |case-lambda| technique can be implemented with 
macros in systems that don't wish to provide the interface as a primitive.
There is a problem in implementing the |#!optional| interace as a macro
though--what is to be the special optional-default-value?  Clearly it 
should be unique--not |eq?| to anything else in the system.  However it is 
also desirable that no primitive type predicates other than |default-value?|
answer yes to it, and it should be atomic--consequently it should not be 
just a unique structured object obtained by something like:

  (define *optional-default-value* '(*optional-default-value*))

The one feature that |#!optional| provides that |case-lambda| doesn't is the
ability to sneak around the normal interface by providing the optional-
default-value in the middle of an argument list--perhaps as an argument
to something like

  (define (substring s #!optional start end)
     (let ([start (if (default-object? start) 0 start)]
           [end (if (default-object? end) (string-length s) end)])
        ...)

which could then be called with something like

  (substring some-string (default-optional-object) some-end)

instead of

  (substring some-string 0 some-end)

which of course is a straw-man argument, but I suspect it might be hard
to come up with many good examples where that feature would be useful. 
It would almost have to be a case where one couldn't know or access the
default.  And of course once such an object "gets loose" it becomes tempting
to use it in other similar contexts.  For instance |(assq x al)| might return
it if |x| isn't found, otherwise it could return the value associated with |x|--
arguably a more useful and natural interface, but as the special optional-
default-value floats around it will become as useful as |#f|, and eventually as
useless.  Perhaps |(values)| should return it to a continuation expecting one
value?  It is worth considering just why |#f| isn't usable as the special
optional-default-value, and wondering whether a new optional-default-value
would eventually suffer a similar fate.  One way to preserve the "odv" for
its original intended use is to forbid its use as a value.  Referencing
a defaulted identifier then forces an error similar to referencing an
unbound symbol.  But then |default-object?| (which should then be renamed 
something like |supplied?|) becomes yet another special form, and the above 
trick goes away (as perhaps it should), and of course implementors have yet
another error to trap, users have yet another error to stumble over, and
the optional-interface becomes even more difficult (if not impossible) to
implement correctly as a macro.

Revising the |#!optional| syntax so that default values are specified
overcomes most of its problems, but is still not useful as |case-lambda|
in many common situations. One might have 
  
  (lambda (x ... #!optional [y v] ... . z) e ...)

or something similar, in which the |v|s are the default values for the
optional |y|s.  For instance:

  (define (write x #!optional [p (current-output-port)])) ...))

One new question this raises is the scoping of the |v|s--which of the
identifiers in the parameter list should they be allowed to see?
The simplest answer is none, but that makes it difficult to write
procedures like |substring| from above, where the defaults depend on
the supplied values.  So perhaps they should be able to see the
required arguments--or even the supplied optionals--or perhaps all the
identifiers to each value's left, with a |let*| semantics...
Unlike |case-lambda|, the scoping is not obvious.  It is also hard
to use it to define certain classes of procedures with optional arguments.
For instance try using this syntax on |-|.

  (define -
     (let ([flag '(flag)])
        (lambda (x #!optional [y flag] . l)
           (if (eq? y flag)
              (minus 0 x)
              (let loop ([total (minus x y)] [rest l])
                 (if (null? l)
                    total
                    (loop (minus total (car l)) (cdr l))))))))
              
is the best I can do, and I don't much care for the way it looks, nor
does it look like it is going to be easy to optimize.
The comparison procedures like |<| lead to equally murky results using
this version of |#!optional|, but are relatively clean using |case-lambda.|


In conclusion, |case-lambda| provides a pretty and simple high-level
optional interface that can be efficiently implemented without further
overloading of the identifier-list and without requiring the introduction 
of new special objects.