diff options
author | dos-reis <gdr@axiomatics.org> | 2010-05-05 13:56:53 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2010-05-05 13:56:53 +0000 |
commit | de2c2df64f452b8b50f94ebc1aec30830b6cc1e0 (patch) | |
tree | fb54894ac4696bd2ffca55ee049b2bc98ca745c6 | |
parent | b380d201d353795ee450ac686132f2849db08b88 (diff) | |
download | open-axiom-de2c2df64f452b8b50f94ebc1aec30830b6cc1e0.tar.gz |
* interp/compiler.boot (compSetq1): Call self, not compSetq.
* interp/c-util.boot (isAtomicForm): Move to g-util.boot.
* interp/g-opt.boot (optSEQ): Splice toplevel PROGN forms.
* interp/g-util.boot (isAtomicForm): Move from c-util.boot. Export.
-rw-r--r-- | src/ChangeLog | 19 | ||||
-rw-r--r-- | src/algebra/strap/DFLOAT.lsp | 66 | ||||
-rw-r--r-- | src/algebra/strap/EUCDOM-.lsp | 30 | ||||
-rw-r--r-- | src/interp/c-util.boot | 5 | ||||
-rw-r--r-- | src/interp/compiler.boot | 5 | ||||
-rw-r--r-- | src/interp/g-opt.boot | 6 | ||||
-rw-r--r-- | src/interp/g-util.boot | 5 |
7 files changed, 75 insertions, 61 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 4ccdb7dc..562ca4b9 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,22 @@ +2010-05-05 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/compiler.boot (compSetq1): Call self, not compSetq. + * interp/c-util.boot (isAtomicForm): Move to g-util.boot. + * interp/g-opt.boot (optSEQ): Splice toplevel PROGN forms. + * interp/g-util.boot (isAtomicForm): Move from c-util.boot. Export. + +2010-05-05 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/c-util.boot: Change middle-end instruction "call" to + "%Call". + * interp/compiler.boot: Likewise. + * interp/functor.boot: Likewise. + * interp/g-opt.boot: Likewise. + * interp/mark.boot: Likewise. + * interp/nrunfast.boot: Likewise. + * interp/wi1.boot: Likewise. + * interp/wi2.boot: Likewise. + 2010-05-04 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/compiler.boot: Miscellaneous cleanup. diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp index 5609b7fc..776ae048 100644 --- a/src/algebra/strap/DFLOAT.lsp +++ b/src/algebra/strap/DFLOAT.lsp @@ -736,14 +736,13 @@ #0=#:G1538 |#G111| |#G112| |p0| |p1| |#G113| |#G114| |q0| |q1| |#G115| |#G116| |s| |t|) (RETURN - (SEQ (EXIT (SEQ (PROGN - (LETT |#G109| (|DFLOAT;manexp| |f| $) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |nu| (QCAR |#G109|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |ex| (QCDR |#G109|) - |DFLOAT;rationalApproximation;$2NniF;87|) - |#G109|) + (SEQ (EXIT (SEQ (LETT |#G109| (|DFLOAT;manexp| |f| $) + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |nu| (QCAR |#G109|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |ex| (QCDR |#G109|) + |DFLOAT;rationalApproximation;$2NniF;87|) + |#G109| (LETT BASE (FLOAT-RADIX 0.0) |DFLOAT;rationalApproximation;$2NniF;87|) (EXIT (COND @@ -784,15 +783,14 @@ (EXIT (SEQ G190 NIL (SEQ - (PROGN - (LETT |#G110| - (DIVIDE2 |s| |t|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q| (QCAR |#G110|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |r| (QCDR |#G110|) - |DFLOAT;rationalApproximation;$2NniF;87|) - |#G110|) + (LETT |#G110| + (DIVIDE2 |s| |t|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |q| (QCAR |#G110|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |r| (QCDR |#G110|) + |DFLOAT;rationalApproximation;$2NniF;87|) + |#G110| (LETT |p2| (+ (* |q| |p1|) |p0|) |DFLOAT;rationalApproximation;$2NniF;87|) @@ -817,24 +815,22 @@ 143)) |DFLOAT;rationalApproximation;$2NniF;87|) (GO #0#))))) - (PROGN - (LETT |#G111| |p1| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |#G112| |p2| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |p0| |#G111| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |p1| |#G112| - |DFLOAT;rationalApproximation;$2NniF;87|)) - (PROGN - (LETT |#G113| |q1| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |#G114| |q2| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q0| |#G113| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q1| |#G114| - |DFLOAT;rationalApproximation;$2NniF;87|)) + (LETT |#G111| |p1| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |#G112| |p2| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |p0| |#G111| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |p1| |#G112| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |#G113| |q1| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |#G114| |q2| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |q0| |#G113| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |q1| |#G114| + |DFLOAT;rationalApproximation;$2NniF;87|) (EXIT (PROGN (LETT |#G115| |t| diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp index c7b5d022..adf7a481 100644 --- a/src/algebra/strap/EUCDOM-.lsp +++ b/src/algebra/strap/EUCDOM-.lsp @@ -76,13 +76,12 @@ (COND ((NULL (NOT (SPADCALL |y| (|getShellEntry| $ 8)))) (GO G191))) - (SEQ (PROGN - (LETT |#G13| |y| |EUCDOM-;gcd;3S;5|) - (LETT |#G14| - (SPADCALL |x| |y| (|getShellEntry| $ 24)) - |EUCDOM-;gcd;3S;5|) - (LETT |x| |#G13| |EUCDOM-;gcd;3S;5|) - (LETT |y| |#G14| |EUCDOM-;gcd;3S;5|)) + (SEQ (LETT |#G13| |y| |EUCDOM-;gcd;3S;5|) + (LETT |#G14| + (SPADCALL |x| |y| (|getShellEntry| $ 24)) + |EUCDOM-;gcd;3S;5|) + (LETT |x| |#G13| |EUCDOM-;gcd;3S;5|) + (LETT |y| |#G14| |EUCDOM-;gcd;3S;5|) (EXIT (LETT |y| (SPADCALL |y| (|getShellEntry| $ 22)) |EUCDOM-;gcd;3S;5|))) @@ -92,17 +91,12 @@ (DEFUN |EUCDOM-;unitNormalizeIdealElt| (|s| $) (PROG (|#G16| |u| |c| |a|) (RETURN - (SEQ (PROGN - (LETT |#G16| - (SPADCALL (QVELT |s| 2) (|getShellEntry| $ 27)) - |EUCDOM-;unitNormalizeIdealElt|) - (LETT |u| (QVELT |#G16| 0) - |EUCDOM-;unitNormalizeIdealElt|) - (LETT |c| (QVELT |#G16| 1) - |EUCDOM-;unitNormalizeIdealElt|) - (LETT |a| (QVELT |#G16| 2) - |EUCDOM-;unitNormalizeIdealElt|) - |#G16|) + (SEQ (LETT |#G16| (SPADCALL (QVELT |s| 2) (|getShellEntry| $ 27)) + |EUCDOM-;unitNormalizeIdealElt|) + (LETT |u| (QVELT |#G16| 0) |EUCDOM-;unitNormalizeIdealElt|) + (LETT |c| (QVELT |#G16| 1) |EUCDOM-;unitNormalizeIdealElt|) + (LETT |a| (QVELT |#G16| 2) |EUCDOM-;unitNormalizeIdealElt|) + |#G16| (EXIT (COND ((SPADCALL |a| (|getShellEntry| $ 28)) |s|) ('T diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 58f830df..46417f08 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1098,11 +1098,6 @@ eqSubst(args,parms,body) == NSUBLIS(pairList(parms,args),body,KEYWORD::TEST,function EQ) -++ returns true if `form' does not really induce computations. -isAtomicForm: %Form -> %Boolean -isAtomicForm form == - atom form or first form = "QUOTE" - ++ Walk `form' and replace simple functions as appropriate. replaceSimpleFunctions form == isAtomicForm form => form diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 15edaf3c..96661790 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -788,7 +788,7 @@ compSetq1(form,val,m,E) == IDENTP form => setqSingle(form,val,m,E) form is [":",x,y] => [.,.,E']:= compMakeDeclaration(x,y,E) - compSetq(["%LET",x,val],m,E') + compSetq1(x,val,m,E') form is [op,:l] => op="CONS" => setqMultiple(uncons form,val,m,E) op="%Comma" => setqMultiple(l,val,m,E) @@ -854,7 +854,8 @@ assignError(val,m',form,m) == setqMultiple(nameList,val,m,e) == val is ["CONS",:.] and m=$NoValueMode => setqMultipleExplicit(nameList,uncons val,m,e) - val is ["%Comma",:l] and m=$NoValueMode => setqMultipleExplicit(nameList,l,m,e) + val is ["%Comma",:l] and m=$NoValueMode => + setqMultipleExplicit(nameList,l,m,e) -- 1. create a gensym, %add to local environment, compile and assign rhs g:= genVariable() e:= addBinding(g,nil,e) diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index aedaa218..cfaa3730 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -315,7 +315,11 @@ optCONDtail l == [frst,:optCONDtail l'] optSEQ ["SEQ",:l] == - tryToRemoveSEQ SEQToCOND getRidOfTemps l where + tryToRemoveSEQ SEQToCOND getRidOfTemps splicePROGN l where + splicePROGN l == + isAtomicForm l => l + l is [["PROGN",:stmts],:l'] => [:stmts,:l'] + rplac(rest l, splicePROGN rest l) getRidOfTemps l == null l => nil l is [["%LET",g,x,:.],:r] and GENSYMP g and 2>numOfOccurencesOf(g,r) => diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 6e81bee5..a2815575 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -38,6 +38,7 @@ import sys_-utility namespace BOOT module g_-util where + isAtomicForm: %Form -> %Boolean getTypeOfSyntax: %Form -> %Mode pairList: (%List,%List) -> %List mkList: %List -> %List @@ -66,6 +67,10 @@ isSharpVarWithNum x == ok := DIGITP d => c := 10*c + DIG2FIX d if ok then c else nil +++ Returns true if `form' is either an atom or a quotation. +isAtomicForm form == + atom form or first form = "QUOTE" + --% Sub-domains information handlers |