share/misc/smacro.mac

   1 /*-*-macsyma-*-*/
   2
   3 /* A macro for defining simple substitution macros.
   4    George Carrette, 12:20am  Tuesday, 12 August 1980 */
   5
   6 eval_when(translate,modedeclare(function(getcharn),fixnum))$
   7
   8 gensym_conventionp(symbol):=
   9  if getcharn(symbol,1)=getcharn('%,1) and
  10     getcharn(symbol,2)=getcharn('%,1) then true else false$
  11
  12 gensym_conventions(exp):=
  13  if atom(exp) then exp else
  14  block([gens:[],temp:gensym_conventions(part(exp,0))],
  15        if not temp=false then gens:cons(temp,gens),
  16        exp:args(exp),
  17        while not exp=[] do (temp:gensym_conventions(first(exp)),
  18                             if not temp=false then gens:cons(temp,gens),
  19                             exp:rest(exp)),
  20        if gens=[] then false else gens)$
  21
  22 infx("=>")$
  23
  24 "=>"(header,body)::=
  25  (if atom(header) then error("bad arg to \"=>\"")
  26   maplist(lambda([u],if not atom(u)
  27                        then error(u,"bad variable in arglist of \"=>\"")),
  28           args(header)),
  29   block([gens:gensym_conventions(body)],
  30