← Back to branch summary

~ubuntu-branches/debian/squeeze/maxima/squeeze

« back to all changes in this revision

Viewing changes to share/misc/smacro.mac

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2006-10-18 14:52:42 UTC
  • mto: (1.1.5 upstream)
  • mto: This revision was merged to the branch mainline in revision 4.
  • Revision ID: james.westby@ubuntu.com-20061018145242-vzyrm5hmxr8kiosf
Import upstream version 5.10.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
share/misc/smacro.mac
3
3
/* A macro for defining simple substitution macros.
4
4
   George Carrette, 12:20am  Tuesday, 12 August 1980 */
5
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 FALSE
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)],
 
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 false
 
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
30