share/macro/keyarg.mac

   1 /*-*-macsyma-*-*/
   2
   3 /* macros to define functions which take their arguments
   4    via keywords. */
   5
   6 eval_when([translate,batch,demo],
   7           load_package(sharem,"autolo"))$
   8
   9 herald_package(keyarg)$
  10
  11 /* The idea is to be able to say:
  12
  13   FOO(X_ZONE=3.3, LOGLIN, FOOSWITCH, BAR=0)
  14
  15   Specify the arguments/options to a function in terms of
  16   keywords.
  17
  18 And have unspecified arguments default. */
  19
  20
  21 def_keyarg(header,body)::=
  22  buildq([mname:part(header,0), body,
  23          sname:concat(part(header,0),"-internal"),
  24          sargs:maplist(lambda([u],if atom(u) then u else part(u,1)),
  25                        args(header)),
  26          dispatch:maplist(lambda([u],if atom(u) then ['key_atom,[u]]
  27                                         else ['key_pair,[part(u,1),part(u,2)]]),
  28                           args(header))],
  29         (eval_when(loadfile,
  30                    setup_autoload("keyarg",translate_keyarg)),
  31          put('mname,'dispatch,'translate_keyarg),
  32          mname([macro_argl])::=translate_keyarg(macro_argl,'mname,'sname),
  33          sname(splice(sargs)):=body))$
  34
  35 /* This routine must be around during the macro-expansion */
  36
  37 translate_keyarg(macro_argl,mname,sname):=
  38  /* for now I am not going to do the order-of-evaluation guarantee */
  39  block([sargl:[],temp,dispatch:get(mname,'translate_keyarg)],
  40        for d in dispatch
  41        do(temp:apply(d[1],cons(macro_argl,d[2])),
  42           push(temp[1],sargl),
  43           macro_argl:temp[2]),
  44        if not macro_argl=[] then error("unknown arguments to",mname,":",macro_argl),
  45        funmake(sname,reverse(sargl)))$
  46
  47 key_indicator(argl,atom,value):=
  48  (for a in argl
  49   do(if atom(a) then(if a=atom then(value:true,argl:delete(a,argl),return(done)))
  50      else if part(a,1)=atom then(value:part(a,2),argl:delete(a,argl),return(done))),
  51   [value,argl])$
  52
  53 /* I am thinking of having KEY_ATOM and KEY_PAIR do different things. */
  54
  55 key_atom(argl,atom):=key_indicator(argl,atom,false)$
  56
  57 key_pair(argl,atom,value):=key_indicator(argl,atom,value)$
  58