aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog7
-rw-r--r--src/algebra/strap/EUCDOM-.lsp16
-rw-r--r--src/algebra/strap/FFIELDC-.lsp16
-rw-r--r--src/algebra/strap/ILIST.lsp2
-rw-r--r--src/algebra/strap/ISTRING.lsp97
-rw-r--r--src/algebra/strap/LSAGG-.lsp4
-rw-r--r--src/algebra/strap/OUTFORM.lsp2
-rw-r--r--src/algebra/strap/POLYCAT-.lsp4
-rw-r--r--src/algebra/strap/QFCAT-.lsp4
-rw-r--r--src/interp/g-opt.boot7
-rw-r--r--src/interp/g-util.boot10
11 files changed, 88 insertions, 81 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index fbfcf287..de27a6a5 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,12 @@
2010-07-23 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/g-opt.boot (optBind): Check for dependencies in
+ initializations in %bind expressions.
+ * interp/g-util.boot (expandBind): The body of s %bind expression
+ may be a sequence of statements.
+
+2010-07-23 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/g-util.boot: Remove expansion for %ble, %bgt, %bge.
* interp/g-opt.boot (optMINUS): Remove.
(opt_-): Likewise.
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp
index 50fe1009..8e091370 100644
--- a/src/algebra/strap/EUCDOM-.lsp
+++ b/src/algebra/strap/EUCDOM-.lsp
@@ -100,14 +100,14 @@
(DEFUN |EUCDOM-;extendedEuclidean;2SR;7| (|x| |y| $)
(PROG (|s3| |qr|)
(RETURN
- (LET* ((|s1| (|EUCDOM-;unitNormalizeIdealElt|
- (VECTOR (|spadConstant| $ 30)
- (|spadConstant| $ 19) |x|)
- $))
- (|s2| (|EUCDOM-;unitNormalizeIdealElt|
- (VECTOR (|spadConstant| $ 19)
- (|spadConstant| $ 30) |y|)
- $)))
+ (LET ((|s1| (|EUCDOM-;unitNormalizeIdealElt|
+ (VECTOR (|spadConstant| $ 30)
+ (|spadConstant| $ 19) |x|)
+ $))
+ (|s2| (|EUCDOM-;unitNormalizeIdealElt|
+ (VECTOR (|spadConstant| $ 19)
+ (|spadConstant| $ 30) |y|)
+ $)))
(COND
((SPADCALL |y| (|getShellEntry| $ 8)) |s1|)
((SPADCALL |x| (|getShellEntry| $ 8)) |s2|)
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp
index 12fb4f77..8126e2db 100644
--- a/src/algebra/strap/FFIELDC-.lsp
+++ b/src/algebra/strap/FFIELDC-.lsp
@@ -89,14 +89,14 @@
(DEFUN |FFIELDC-;createPrimitiveElement;S;8| ($)
(PROG (|e|)
(RETURN
- (LET* ((|sm1| (- (SPADCALL (|getShellEntry| $ 40)) 1))
- (|start| (COND
- ((SPADCALL (SPADCALL (|getShellEntry| $ 48))
- (CONS 1 "polynomial")
- (|getShellEntry| $ 49))
- (|spadConstant| $ 41))
- ('T 1)))
- (|found| NIL))
+ (LET ((|sm1| (- (SPADCALL (|getShellEntry| $ 40)) 1))
+ (|start| (COND
+ ((SPADCALL (SPADCALL (|getShellEntry| $ 48))
+ (CONS 1 "polynomial")
+ (|getShellEntry| $ 49))
+ (|spadConstant| $ 41))
+ ('T 1)))
+ (|found| NIL))
(SEQ (LET ((|i| |start|))
(LOOP
(COND
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index b9fcc572..bd099bd0 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -211,7 +211,7 @@
(DEFUN |ILIST;coerce;$Of;21| (|x| $)
(PROG (|z|)
(RETURN
- (LET* ((|y| NIL) (|s| (SPADCALL |x| (|getShellEntry| $ 40))))
+ (LET ((|y| NIL) (|s| (SPADCALL |x| (|getShellEntry| $ 40))))
(SEQ (LOOP
(COND
((NOT (NOT (EQ |x| |s|))) (RETURN NIL))
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index e1760a16..435801a9 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -180,16 +180,16 @@
(DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $)
(PROG (|r| |k|)
(RETURN
- (LET* ((|l| (- (SPADCALL |sg| (|getShellEntry| $ 44))
- (|getShellEntry| $ 6)))
- (|m| (QCSIZE |s|)) (|n| (QCSIZE |t|))
- (|h| (COND
- ((SPADCALL |sg| (|getShellEntry| $ 45))
- (- (SPADCALL |sg| (|getShellEntry| $ 46))
- (|getShellEntry| $ 6)))
- ('T
- (- (SPADCALL |s| (|getShellEntry| $ 47))
- (|getShellEntry| $ 6))))))
+ (LET ((|l| (- (SPADCALL |sg| (|getShellEntry| $ 44))
+ (|getShellEntry| $ 6)))
+ (|m| (QCSIZE |s|)) (|n| (QCSIZE |t|))
+ (|h| (COND
+ ((SPADCALL |sg| (|getShellEntry| $ 45))
+ (- (SPADCALL |sg| (|getShellEntry| $ 46))
+ (|getShellEntry| $ 6)))
+ ('T
+ (- (SPADCALL |s| (|getShellEntry| $ 47))
+ (|getShellEntry| $ 6))))))
(SEQ (COND
((OR (OR (MINUSP |l|) (NOT (< |h| |m|)))
(< |h| (- |l| 1)))
@@ -236,7 +236,7 @@
(EXIT |c|))))))
(DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $)
- (LET* ((|np| (QCSIZE |part|)) (|nw| (QCSIZE |whole|)))
+ (LET ((|np| (QCSIZE |part|)) (|nw| (QCSIZE |whole|)))
(SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
(EXIT (COND
((MINUSP |startpos|) (|error| "index out of bounds"))
@@ -317,8 +317,8 @@
(EXIT (- (|getShellEntry| $ 6) 1))))))))
(DEFUN |ISTRING;suffix?;2$B;21| (|s| |t| $)
- (LET* ((|m| (SPADCALL |s| (|getShellEntry| $ 47)))
- (|n| (SPADCALL |t| (|getShellEntry| $ 47))))
+ (LET ((|m| (SPADCALL |s| (|getShellEntry| $ 47)))
+ (|n| (SPADCALL |t| (|getShellEntry| $ 47))))
(COND
((< |n| |m|) NIL)
('T
@@ -328,8 +328,8 @@
(DEFUN |ISTRING;split;$CL;22| (|s| |c| $)
(PROG (|l| |j|)
(RETURN
- (LET* ((|n| (SPADCALL |s| (|getShellEntry| $ 47)))
- (|i| (|getShellEntry| $ 6)))
+ (LET ((|n| (SPADCALL |s| (|getShellEntry| $ 47)))
+ (|i| (|getShellEntry| $ 6)))
(SEQ (LOOP
(COND
((NOT (COND
@@ -384,8 +384,8 @@
(DEFUN |ISTRING;split;$CcL;23| (|s| |cc| $)
(PROG (|l| |j|)
(RETURN
- (LET* ((|n| (SPADCALL |s| (|getShellEntry| $ 47)))
- (|i| (|getShellEntry| $ 6)))
+ (LET ((|n| (SPADCALL |s| (|getShellEntry| $ 47)))
+ (|i| (|getShellEntry| $ 6)))
(SEQ (LOOP
(COND
((NOT (COND
@@ -438,8 +438,8 @@
(EXIT (NREVERSE |l|)))))))
(DEFUN |ISTRING;leftTrim;$C$;24| (|s| |c| $)
- (LET* ((|n| (SPADCALL |s| (|getShellEntry| $ 47)))
- (|i| (|getShellEntry| $ 6)))
+ (LET ((|n| (SPADCALL |s| (|getShellEntry| $ 47)))
+ (|i| (|getShellEntry| $ 6)))
(SEQ (LOOP
(COND
((NOT (COND
@@ -453,8 +453,8 @@
(SPADCALL |i| |n| (|getShellEntry| $ 24)) $)))))
(DEFUN |ISTRING;leftTrim;$Cc$;25| (|s| |cc| $)
- (LET* ((|n| (SPADCALL |s| (|getShellEntry| $ 47)))
- (|i| (|getShellEntry| $ 6)))
+ (LET ((|n| (SPADCALL |s| (|getShellEntry| $ 47)))
+ (|i| (|getShellEntry| $ 6)))
(SEQ (LOOP
(COND
((NOT (COND
@@ -500,23 +500,23 @@
$)))))
(DEFUN |ISTRING;concat;L$;28| (|l| $)
- (LET* ((|t| (SPADCALL
- (LET ((#0=#:G1497 NIL) (#1=#:G1498 T)
- (#2=#:G1542 |l|))
- (LOOP
- (COND
- ((ATOM #2#) (RETURN (COND (#1# 0) (T #0#))))
- (T (LET ((|s| (CAR #2#)))
- (LET ((#3=#:G1496
- (SPADCALL |s|
- (|getShellEntry| $ 16))))
- (COND
- (#1# (SETQ #0# #3#))
- (T (SETQ #0# (+ #0# #3#))))
- (SETQ #1# NIL)))))
- (SETQ #2# (CDR #2#))))
- (|spadConstant| $ 53) (|getShellEntry| $ 9)))
- (|i| (|getShellEntry| $ 6)))
+ (LET ((|t| (SPADCALL
+ (LET ((#0=#:G1497 NIL) (#1=#:G1498 T)
+ (#2=#:G1542 |l|))
+ (LOOP
+ (COND
+ ((ATOM #2#) (RETURN (COND (#1# 0) (T #0#))))
+ (T (LET ((|s| (CAR #2#)))
+ (LET ((#3=#:G1496
+ (SPADCALL |s|
+ (|getShellEntry| $ 16))))
+ (COND
+ (#1# (SETQ #0# #3#))
+ (T (SETQ #0# (+ #0# #3#))))
+ (SETQ #1# NIL)))))
+ (SETQ #2# (CDR #2#))))
+ (|spadConstant| $ 53) (|getShellEntry| $ 9)))
+ (|i| (|getShellEntry| $ 6)))
(SEQ (LET ((#4=#:G1541 |l|))
(LOOP
(COND
@@ -528,8 +528,7 @@
(EXIT |t|))))
(DEFUN |ISTRING;copyInto!;2$I$;29| (|y| |x| |s| $)
- (LET* ((|m| (SPADCALL |x| (|getShellEntry| $ 16)))
- (|n| (QCSIZE |y|)))
+ (LET ((|m| (SPADCALL |x| (|getShellEntry| $ 16))) (|n| (QCSIZE |y|)))
(SEQ (SETQ |s| (- |s| (|getShellEntry| $ 6)))
(COND
((OR (MINUSP |s|) (< |n| (+ |s| |m|)))
@@ -544,15 +543,15 @@
('T (CHAR |s| (- |i| (|getShellEntry| $ 6))))))
(DEFUN |ISTRING;elt;$Us$;31| (|s| |sg| $)
- (LET* ((|l| (- (SPADCALL |sg| (|getShellEntry| $ 44))
- (|getShellEntry| $ 6)))
- (|h| (COND
- ((SPADCALL |sg| (|getShellEntry| $ 45))
- (- (SPADCALL |sg| (|getShellEntry| $ 46))
- (|getShellEntry| $ 6)))
- ('T
- (- (SPADCALL |s| (|getShellEntry| $ 47))
- (|getShellEntry| $ 6))))))
+ (LET ((|l| (- (SPADCALL |sg| (|getShellEntry| $ 44))
+ (|getShellEntry| $ 6)))
+ (|h| (COND
+ ((SPADCALL |sg| (|getShellEntry| $ 45))
+ (- (SPADCALL |sg| (|getShellEntry| $ 46))
+ (|getShellEntry| $ 6)))
+ ('T
+ (- (SPADCALL |s| (|getShellEntry| $ 47))
+ (|getShellEntry| $ 6))))))
(SEQ (COND
((OR (MINUSP |l|) (NOT (< |h| (QCSIZE |s|))))
(EXIT (|error| "index out of bound"))))
diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp
index eac3d76a..85d05973 100644
--- a/src/algebra/strap/LSAGG-.lsp
+++ b/src/algebra/strap/LSAGG-.lsp
@@ -318,8 +318,8 @@
(DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| $)
(PROG (|h| |t|)
(RETURN
- (LET* ((|l| (SPADCALL |i| (|getShellEntry| $ 46)))
- (|m| (SPADCALL |x| (|getShellEntry| $ 33))))
+ (LET ((|l| (SPADCALL |i| (|getShellEntry| $ 46)))
+ (|m| (SPADCALL |x| (|getShellEntry| $ 33))))
(COND
((< |l| |m|) (|error| "index out of range"))
('T
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index 6bfe294e..400131f1 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -657,7 +657,7 @@
(CONS 'AGGSET |l|))
(DEFUN |OUTFORM;blankSeparate;L$;35| (|l| $)
- (LET* ((|c| 'CONCATB) (|l1| NIL))
+ (LET ((|c| 'CONCATB) (|l1| NIL))
(SEQ (LET ((#0=#:G1555 (REVERSE |l|)))
(LOOP
(COND
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index 30873d70..439ed083 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -1074,8 +1074,8 @@
1))
(DEFUN |POLYCAT-;before?;2SB;38| (|p| |q| $)
- (LET* ((|dp| (SPADCALL |p| (|getShellEntry| $ 75)))
- (|dq| (SPADCALL |q| (|getShellEntry| $ 75))))
+ (LET ((|dp| (SPADCALL |p| (|getShellEntry| $ 75)))
+ (|dq| (SPADCALL |q| (|getShellEntry| $ 75))))
(COND
((SPADCALL |dp| |dq| (|getShellEntry| $ 214))
(SPADCALL (|spadConstant| $ 28)
diff --git a/src/algebra/strap/QFCAT-.lsp b/src/algebra/strap/QFCAT-.lsp
index 15cc7091..49aa6887 100644
--- a/src/algebra/strap/QFCAT-.lsp
+++ b/src/algebra/strap/QFCAT-.lsp
@@ -115,8 +115,8 @@
(DEFUN |QFCAT-;characteristic;Nni;7| ($) (|spadConstant| $ 30))
(DEFUN |QFCAT-;differentiate;AMA;8| (|x| |deriv| $)
- (LET* ((|n| (SPADCALL |x| (|getShellEntry| $ 8)))
- (|d| (SPADCALL |x| (|getShellEntry| $ 11))))
+ (LET ((|n| (SPADCALL |x| (|getShellEntry| $ 8)))
+ (|d| (SPADCALL |x| (|getShellEntry| $ 11))))
(SPADCALL
(SPADCALL
(SPADCALL (SPADCALL |n| |deriv|) |d|
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 543cf45e..a42dc1ac 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -590,8 +590,11 @@ optLET_* form ==
optLET form
optBind form ==
- form.first := "LET*"
- optLET_* form
+ form isnt ['%bind,inits,body] => form -- inline only simple expressions
+ inits = nil => body -- no local variable, OK.
+ inits isnt [[var,expr]] => form -- too many local variables
+ canInlineVarDefinition(var,expr,body) => substitute(expr,var,body)
+ form
optLIST form ==
form is ["LIST"] => nil
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 5889fc2a..13acbdc6 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -305,16 +305,14 @@ expandFgt ['%fgt,x,y] ==
expandFlt ['%flt,y,x]
-- Local variable bindings
-expandBind ['%bind,inits,body] ==
+expandBind ['%bind,inits,:body] ==
body := expandToVMForm body
inits := [[first x,expandToVMForm second x] for x in inits]
- n := #inits
- n = 0 => body
-- FIXME: we should consider turning LET* into LET or direct inlining.
op :=
- n = 1 => 'LET
- 'LET_*
- [op,inits,body]
+ or/[CONTAINED(v,x) for [[v,.],:x] in tails inits] => 'LET_*
+ 'LET
+ [op,inits,:body]
-- Memory load/store
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 15:52:59 +0000