aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog19
-rw-r--r--src/algebra/strap/DFLOAT.lsp66
-rw-r--r--src/algebra/strap/EUCDOM-.lsp30
-rw-r--r--src/interp/c-util.boot5
-rw-r--r--src/interp/compiler.boot5
-rw-r--r--src/interp/g-opt.boot6
-rw-r--r--src/interp/g-util.boot5
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-03 10:20:24 +0000