From e2587f659cb1f58cb198ce0c841f43015378457f Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sat, 4 Jul 2009 19:00:59 +0000 Subject: * interp/c-util.boot (simplifySEQ): New. (transformToBackendCode): Use it. --- src/ChangeLog | 5 ++ src/algebra/strap/CLAGG-.lsp | 66 +++++++-------- src/algebra/strap/EUCDOM-.lsp | 34 ++++---- src/algebra/strap/FFIELDC-.lsp | 47 +++++------ src/algebra/strap/HOAGG-.lsp | 102 +++++++++++------------ src/algebra/strap/ILIST.lsp | 32 +++----- src/algebra/strap/LIST.lsp | 11 ++- src/algebra/strap/LNAGG-.lsp | 3 +- src/algebra/strap/LSAGG-.lsp | 44 +++++----- src/algebra/strap/POLYCAT-.lsp | 178 +++++++++++++++++++---------------------- src/algebra/strap/STAGG-.lsp | 19 +++-- src/algebra/strap/SYMBOL.lsp | 108 ++++++++++++------------- src/algebra/strap/UFD-.lsp | 27 +++---- src/algebra/strap/URAGG-.lsp | 18 ++--- src/interp/c-util.boot | 11 ++- 15 files changed, 319 insertions(+), 386 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index a0bf2157..0dc7f2d2 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2009-07-04 Gabriel Dos Reis + + * interp/c-util.boot (simplifySEQ): New. + (transformToBackendCode): Use it. + 2009-07-03 Gabriel Dos Reis * interp/sys-macros.lisp (PRIMVEC2ARR): Remove. diff --git a/src/algebra/strap/CLAGG-.lsp b/src/algebra/strap/CLAGG-.lsp index 6f4a5528..6dae1744 100644 --- a/src/algebra/strap/CLAGG-.lsp +++ b/src/algebra/strap/CLAGG-.lsp @@ -59,20 +59,17 @@ (LETT |x| (CAR #0#) |CLAGG-;count;MANni;2|) NIL)) (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |x| |f|) - (PROGN - (LETT #1# 1 |CLAGG-;count;MANni;2|) - (COND - (#3# - (LETT #2# (+ #2# #1#) - |CLAGG-;count;MANni;2|)) - ('T - (PROGN - (LETT #2# #1# - |CLAGG-;count;MANni;2|) - (LETT #3# 'T - |CLAGG-;count;MANni;2|))))))))) + (COND + ((SPADCALL |x| |f|) + (PROGN + (LETT #1# 1 |CLAGG-;count;MANni;2|) + (COND + (#3# (LETT #2# (+ #2# #1#) + |CLAGG-;count;MANni;2|)) + ('T + (PROGN + (LETT #2# #1# |CLAGG-;count;MANni;2|) + (LETT #3# 'T |CLAGG-;count;MANni;2|))))))) (LETT #0# (CDR #0#) |CLAGG-;count;MANni;2|) (GO G190) G191 (EXIT NIL)) (COND (#3# #2#) ('T 0))))))) @@ -92,17 +89,15 @@ (LETT |x| (CAR #0#) |CLAGG-;any?;MAB;3|) NIL)) (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (SPADCALL |x| |f|) - |CLAGG-;any?;MAB;3|) - (COND - (#3# (LETT #2# - (COND (#2# 'T) ('T #1#)) - |CLAGG-;any?;MAB;3|)) - ('T - (PROGN - (LETT #2# #1# |CLAGG-;any?;MAB;3|) - (LETT #3# 'T |CLAGG-;any?;MAB;3|))))))) + (PROGN + (LETT #1# (SPADCALL |x| |f|) |CLAGG-;any?;MAB;3|) + (COND + (#3# (LETT #2# (COND (#2# 'T) ('T #1#)) + |CLAGG-;any?;MAB;3|)) + ('T + (PROGN + (LETT #2# #1# |CLAGG-;any?;MAB;3|) + (LETT #3# 'T |CLAGG-;any?;MAB;3|))))) (LETT #0# (CDR #0#) |CLAGG-;any?;MAB;3|) (GO G190) G191 (EXIT NIL)) (COND (#3# #2#) ('T 'NIL))))))) @@ -122,18 +117,15 @@ (LETT |x| (CAR #0#) |CLAGG-;every?;MAB;4|) NIL)) (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (SPADCALL |x| |f|) - |CLAGG-;every?;MAB;4|) - (COND - (#3# (LETT #2# - (COND (#2# #1#) ('T 'NIL)) - |CLAGG-;every?;MAB;4|)) - ('T - (PROGN - (LETT #2# #1# - |CLAGG-;every?;MAB;4|) - (LETT #3# 'T |CLAGG-;every?;MAB;4|))))))) + (PROGN + (LETT #1# (SPADCALL |x| |f|) |CLAGG-;every?;MAB;4|) + (COND + (#3# (LETT #2# (COND (#2# #1#) ('T 'NIL)) + |CLAGG-;every?;MAB;4|)) + ('T + (PROGN + (LETT #2# #1# |CLAGG-;every?;MAB;4|) + (LETT #3# 'T |CLAGG-;every?;MAB;4|))))) (LETT #0# (CDR #0#) |CLAGG-;every?;MAB;4|) (GO G190) G191 (EXIT NIL)) (COND (#3# #2#) ('T 'T))))))) diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp index 6e7b0c5f..acd6d919 100644 --- a/src/algebra/strap/EUCDOM-.lsp +++ b/src/algebra/strap/EUCDOM-.lsp @@ -274,15 +274,12 @@ |EUCDOM-;principalIdeal;LR;9|) NIL)) (GO G191))) - (SEQ - (EXIT - (LETT #0# - (CONS - (SPADCALL (QVELT |u| 1) - |vv| - (|getShellEntry| $ 29)) - #0#) - |EUCDOM-;principalIdeal;LR;9|))) + (LETT #0# + (CONS + (SPADCALL (QVELT |u| 1) |vv| + (|getShellEntry| $ 29)) + #0#) + |EUCDOM-;principalIdeal;LR;9|) (LETT #1# (CDR #1#) |EUCDOM-;principalIdeal;LR;9|) (GO G190) G191 @@ -311,9 +308,8 @@ |EUCDOM-;expressIdealMember;LSU;10|) NIL)) (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS (|spadConstant| $ 19) #0#) - |EUCDOM-;expressIdealMember;LSU;10|))) + (LETT #0# (CONS (|spadConstant| $ 19) #0#) + |EUCDOM-;expressIdealMember;LSU;10|) (LETT #1# (CDR #1#) |EUCDOM-;expressIdealMember;LSU;10|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))))) @@ -344,14 +340,12 @@ |EUCDOM-;expressIdealMember;LSU;10|) NIL)) (GO G191))) - (SEQ - (EXIT - (LETT #2# - (CONS - (SPADCALL (QCDR |q|) |v| - (|getShellEntry| $ 29)) - #2#) - |EUCDOM-;expressIdealMember;LSU;10|))) + (LETT #2# + (CONS + (SPADCALL (QCDR |q|) |v| + (|getShellEntry| $ 29)) + #2#) + |EUCDOM-;expressIdealMember;LSU;10|) (LETT #3# (CDR #3#) |EUCDOM-;expressIdealMember;LSU;10|) (GO G190) G191 diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp index b55925bc..d2fcf373 100644 --- a/src/algebra/strap/FFIELDC-.lsp +++ b/src/algebra/strap/FFIELDC-.lsp @@ -146,13 +146,13 @@ NIL) (NULL (NOT |equalone|))) (GO G191))) - (SEQ (EXIT (LETT |equalone| - (SPADCALL - (SPADCALL |a| + (LETT |equalone| + (SPADCALL + (SPADCALL |a| (QUOTIENT2 |q| (QCAR |exp|)) (|getShellEntry| $ 58)) - (|getShellEntry| $ 59)) - |FFIELDC-;primitive?;SB;9|))) + (|getShellEntry| $ 59)) + |FFIELDC-;primitive?;SB;9|) (LETT #0# (CDR #0#) |FFIELDC-;primitive?;SB;9|) (GO G190) G191 (EXIT NIL)) (EXIT (NOT |equalone|))))))))) @@ -535,26 +535,23 @@ |FFIELDC-;factorSquareFreePolynomial|) NIL)) (GO G191))) - (SEQ - (EXIT - (PROGN - (LETT #1# - (SPADCALL (QCAR |u|) - (QCDR |u|) - (|getShellEntry| $ 109)) - |FFIELDC-;factorSquareFreePolynomial|) - (COND - (#3# - (LETT #2# - (SPADCALL #2# #1# - (|getShellEntry| $ 110)) - |FFIELDC-;factorSquareFreePolynomial|)) - ('T - (PROGN - (LETT #2# #1# - |FFIELDC-;factorSquareFreePolynomial|) - (LETT #3# 'T - |FFIELDC-;factorSquareFreePolynomial|))))))) + (PROGN + (LETT #1# + (SPADCALL (QCAR |u|) (QCDR |u|) + (|getShellEntry| $ 109)) + |FFIELDC-;factorSquareFreePolynomial|) + (COND + (#3# + (LETT #2# + (SPADCALL #2# #1# + (|getShellEntry| $ 110)) + |FFIELDC-;factorSquareFreePolynomial|)) + ('T + (PROGN + (LETT #2# #1# + |FFIELDC-;factorSquareFreePolynomial|) + (LETT #3# 'T + |FFIELDC-;factorSquareFreePolynomial|))))) (LETT #0# (CDR #0#) |FFIELDC-;factorSquareFreePolynomial|) (GO G190) G191 (EXIT NIL)) diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp index 713e069d..0b0cd4b0 100644 --- a/src/algebra/strap/HOAGG-.lsp +++ b/src/algebra/strap/HOAGG-.lsp @@ -59,17 +59,15 @@ (LETT |x| (CAR #0#) |HOAGG-;any?;MAB;3|) NIL)) (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (SPADCALL |x| |f|) - |HOAGG-;any?;MAB;3|) - (COND - (#3# (LETT #2# - (COND (#2# 'T) ('T #1#)) - |HOAGG-;any?;MAB;3|)) - ('T - (PROGN - (LETT #2# #1# |HOAGG-;any?;MAB;3|) - (LETT #3# 'T |HOAGG-;any?;MAB;3|))))))) + (PROGN + (LETT #1# (SPADCALL |x| |f|) |HOAGG-;any?;MAB;3|) + (COND + (#3# (LETT #2# (COND (#2# 'T) ('T #1#)) + |HOAGG-;any?;MAB;3|)) + ('T + (PROGN + (LETT #2# #1# |HOAGG-;any?;MAB;3|) + (LETT #3# 'T |HOAGG-;any?;MAB;3|))))) (LETT #0# (CDR #0#) |HOAGG-;any?;MAB;3|) (GO G190) G191 (EXIT NIL)) (COND (#3# #2#) ('T 'NIL))))))) @@ -89,18 +87,15 @@ (LETT |x| (CAR #0#) |HOAGG-;every?;MAB;4|) NIL)) (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (SPADCALL |x| |f|) - |HOAGG-;every?;MAB;4|) - (COND - (#3# (LETT #2# - (COND (#2# #1#) ('T 'NIL)) - |HOAGG-;every?;MAB;4|)) - ('T - (PROGN - (LETT #2# #1# - |HOAGG-;every?;MAB;4|) - (LETT #3# 'T |HOAGG-;every?;MAB;4|))))))) + (PROGN + (LETT #1# (SPADCALL |x| |f|) |HOAGG-;every?;MAB;4|) + (COND + (#3# (LETT #2# (COND (#2# #1#) ('T 'NIL)) + |HOAGG-;every?;MAB;4|)) + ('T + (PROGN + (LETT #2# #1# |HOAGG-;every?;MAB;4|) + (LETT #3# 'T |HOAGG-;every?;MAB;4|))))) (LETT #0# (CDR #0#) |HOAGG-;every?;MAB;4|) (GO G190) G191 (EXIT NIL)) (COND (#3# #2#) ('T 'T))))))) @@ -120,20 +115,17 @@ (LETT |x| (CAR #0#) |HOAGG-;count;MANni;5|) NIL)) (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |x| |f|) - (PROGN - (LETT #1# 1 |HOAGG-;count;MANni;5|) - (COND - (#3# - (LETT #2# (+ #2# #1#) - |HOAGG-;count;MANni;5|)) - ('T - (PROGN - (LETT #2# #1# - |HOAGG-;count;MANni;5|) - (LETT #3# 'T - |HOAGG-;count;MANni;5|))))))))) + (COND + ((SPADCALL |x| |f|) + (PROGN + (LETT #1# 1 |HOAGG-;count;MANni;5|) + (COND + (#3# (LETT #2# (+ #2# #1#) + |HOAGG-;count;MANni;5|)) + ('T + (PROGN + (LETT #2# #1# |HOAGG-;count;MANni;5|) + (LETT #3# 'T |HOAGG-;count;MANni;5|))))))) (LETT #0# (CDR #0#) |HOAGG-;count;MANni;5|) (GO G190) G191 (EXIT NIL)) (COND (#3# #2#) ('T 0))))))) @@ -183,20 +175,17 @@ (LETT |b| (CAR #0#) |HOAGG-;=;2AB;9|) NIL)) (GO G191))) - (SEQ (EXIT (PROGN - (LETT #2# - (SPADCALL |a| |b| - (|getShellEntry| $ 30)) - |HOAGG-;=;2AB;9|) - (COND - (#4# - (LETT #3# - (COND (#3# #2#) ('T 'NIL)) - |HOAGG-;=;2AB;9|)) - ('T - (PROGN - (LETT #3# #2# |HOAGG-;=;2AB;9|) - (LETT #4# 'T |HOAGG-;=;2AB;9|))))))) + (PROGN + (LETT #2# + (SPADCALL |a| |b| (|getShellEntry| $ 30)) + |HOAGG-;=;2AB;9|) + (COND + (#4# (LETT #3# (COND (#3# #2#) ('T 'NIL)) + |HOAGG-;=;2AB;9|)) + ('T + (PROGN + (LETT #3# #2# |HOAGG-;=;2AB;9|) + (LETT #4# 'T |HOAGG-;=;2AB;9|))))) (LETT #1# (PROG1 (CDR #1#) (LETT #0# (CDR #0#) |HOAGG-;=;2AB;9|)) @@ -224,12 +213,11 @@ |HOAGG-;coerce;AOf;10|) NIL)) (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |a| - (|getShellEntry| $ 39)) - #0#) - |HOAGG-;coerce;AOf;10|))) + (LETT #0# + (CONS (SPADCALL |a| + (|getShellEntry| $ 39)) + #0#) + |HOAGG-;coerce;AOf;10|) (LETT #1# (CDR #1#) |HOAGG-;coerce;AOf;10|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) (|getShellEntry| $ 41)) diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp index 774a8248..bdcde3bb 100644 --- a/src/algebra/strap/ILIST.lsp +++ b/src/algebra/strap/ILIST.lsp @@ -342,9 +342,8 @@ (SEQ G190 (COND ((NULL (NOT (NULL (QCDR |z|)))) (GO G191))) - (SEQ (EXIT (LETT |z| (QCDR |z|) - |ILIST;concat!;3$;25|))) - NIL (GO G190) G191 (EXIT NIL)) + (LETT |z| (QCDR |z|) |ILIST;concat!;3$;25|) NIL + (GO G190) G191 (EXIT NIL)) (QRPLACD |z| |y|) (EXIT |x|)))))))) (DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $) @@ -407,22 +406,17 @@ ((NULL |p|) 'NIL) ('T (NOT (NULL |q|))))) (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL (QCAR |p|) (QCAR |q|) - |f|) - (SEQ (QRPLACD |t| |p|) - (LETT |t| |p| - |ILIST;merge!;M3$;28|) - (EXIT - (LETT |p| (QCDR |p|) - |ILIST;merge!;M3$;28|)))) - ('T - (SEQ (QRPLACD |t| |q|) - (LETT |t| |q| - |ILIST;merge!;M3$;28|) - (EXIT - (LETT |q| (QCDR |q|) - |ILIST;merge!;M3$;28|))))))) + (COND + ((SPADCALL (QCAR |p|) (QCAR |q|) |f|) + (SEQ (QRPLACD |t| |p|) + (LETT |t| |p| |ILIST;merge!;M3$;28|) + (EXIT (LETT |p| (QCDR |p|) + |ILIST;merge!;M3$;28|)))) + ('T + (SEQ (QRPLACD |t| |q|) + (LETT |t| |q| |ILIST;merge!;M3$;28|) + (EXIT (LETT |q| (QCDR |q|) + |ILIST;merge!;M3$;28|))))) NIL (GO G190) G191 (EXIT NIL)) (QRPLACD |t| (COND ((NULL |p|) |q|) ('T |p|))) (EXIT |r|)))))))) diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp index 26eaf30c..4e255fbb 100644 --- a/src/algebra/strap/LIST.lsp +++ b/src/algebra/strap/LIST.lsp @@ -170,12 +170,11 @@ |LIST;convert;$If;13|) NIL)) (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |a| - (|getShellEntry| $ 48)) - #0#) - |LIST;convert;$If;13|))) + (LETT #0# + (CONS (SPADCALL |a| + (|getShellEntry| $ 48)) + #0#) + |LIST;convert;$If;13|) (LETT #1# (CDR #1#) |LIST;convert;$If;13|) (GO G190) G191 (EXIT (NREVERSE0 #0#))))) (|getShellEntry| $ 52)))))) diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp index 7182758d..2d48d5c5 100644 --- a/src/algebra/strap/LNAGG-.lsp +++ b/src/algebra/strap/LNAGG-.lsp @@ -30,8 +30,7 @@ (LETT #1# (SPADCALL |a| (|getShellEntry| $ 10)) |LNAGG-;indices;AL;1|) G190 (COND ((> |i| #1#) (GO G191))) - (SEQ (EXIT (LETT #0# (CONS |i| #0#) - |LNAGG-;indices;AL;1|))) + (LETT #0# (CONS |i| #0#) |LNAGG-;indices;AL;1|) (LETT |i| (+ |i| 1) |LNAGG-;indices;AL;1|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))))))) diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp index 1c940eea..91682b5f 100644 --- a/src/algebra/strap/LSAGG-.lsp +++ b/src/algebra/strap/LSAGG-.lsp @@ -201,34 +201,26 @@ (SPADCALL |q| (|getShellEntry| $ 16)))))) (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL + (COND + ((SPADCALL + (SPADCALL |p| (|getShellEntry| $ 18)) + (SPADCALL |q| (|getShellEntry| $ 18)) + |f|) + (SEQ (SPADCALL |t| |p| + (|getShellEntry| $ 27)) + (LETT |t| |p| |LSAGG-;merge!;M3A;6|) + (EXIT (LETT |p| (SPADCALL |p| - (|getShellEntry| $ 18)) + (|getShellEntry| $ 17)) + |LSAGG-;merge!;M3A;6|)))) + ('T + (SEQ (SPADCALL |t| |q| + (|getShellEntry| $ 27)) + (LETT |t| |q| |LSAGG-;merge!;M3A;6|) + (EXIT (LETT |q| (SPADCALL |q| - (|getShellEntry| $ 18)) - |f|) - (SEQ - (SPADCALL |t| |p| - (|getShellEntry| $ 27)) - (LETT |t| |p| - |LSAGG-;merge!;M3A;6|) - (EXIT - (LETT |p| - (SPADCALL |p| - (|getShellEntry| $ 17)) - |LSAGG-;merge!;M3A;6|)))) - ('T - (SEQ - (SPADCALL |t| |q| - (|getShellEntry| $ 27)) - (LETT |t| |q| - |LSAGG-;merge!;M3A;6|) - (EXIT - (LETT |q| - (SPADCALL |q| - (|getShellEntry| $ 17)) - |LSAGG-;merge!;M3A;6|))))))) + (|getShellEntry| $ 17)) + |LSAGG-;merge!;M3A;6|))))) NIL (GO G190) G191 (EXIT NIL)) (SPADCALL |t| (COND diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp index eb53dedb..2b11a078 100644 --- a/src/algebra/strap/POLYCAT-.lsp +++ b/src/algebra/strap/POLYCAT-.lsp @@ -158,21 +158,19 @@ |POLYCAT-;eval;SLS;1|) NIL)) (GO G191))) - (SEQ - (EXIT - (COND - ((QEQCAR - (SPADCALL - (SPADCALL |e| - (|getShellEntry| $ 14)) - (|getShellEntry| $ 16)) - 1) - (PROGN - (LETT #1# - (|error| - "cannot find a variable to evaluate") - |POLYCAT-;eval;SLS;1|) - (GO #1#)))))) + (COND + ((QEQCAR + (SPADCALL + (SPADCALL |e| + (|getShellEntry| $ 14)) + (|getShellEntry| $ 16)) + 1) + (PROGN + (LETT #1# + (|error| + "cannot find a variable to evaluate") + |POLYCAT-;eval;SLS;1|) + (GO #1#)))) (LETT #0# (CDR #0#) |POLYCAT-;eval;SLS;1|) (GO G190) G191 (EXIT NIL))) @@ -190,15 +188,14 @@ |POLYCAT-;eval;SLS;1|) NIL)) (GO G191))) - (SEQ (EXIT - (LETT #2# - (CONS - (SPADCALL - (SPADCALL |e| - (|getShellEntry| $ 14)) - (|getShellEntry| $ 17)) - #2#) - |POLYCAT-;eval;SLS;1|))) + (LETT #2# + (CONS + (SPADCALL + (SPADCALL |e| + (|getShellEntry| $ 14)) + (|getShellEntry| $ 17)) + #2#) + |POLYCAT-;eval;SLS;1|) (LETT #3# (CDR #3#) |POLYCAT-;eval;SLS;1|) (GO G190) G191 (EXIT (NREVERSE0 #2#)))) @@ -218,14 +215,12 @@ |POLYCAT-;eval;SLS;1|) NIL)) (GO G191))) - (SEQ - (EXIT - (LETT #4# - (CONS - (SPADCALL |e| - (|getShellEntry| $ 18)) - #4#) - |POLYCAT-;eval;SLS;1|))) + (LETT #4# + (CONS + (SPADCALL |e| + (|getShellEntry| $ 18)) + #4#) + |POLYCAT-;eval;SLS;1|) (LETT #5# (CDR #5#) |POLYCAT-;eval;SLS;1|) (GO G190) G191 @@ -283,16 +278,15 @@ |POLYCAT-;isTimes;SU;4|) NIL)) (GO G191))) - (SEQ (EXIT - (LETT #0# - (CONS - (SPADCALL (|spadConstant| $ 43) - |v| - (SPADCALL |p| |v| - (|getShellEntry| $ 46)) - (|getShellEntry| $ 47)) - #0#) - |POLYCAT-;isTimes;SU;4|))) + (LETT #0# + (CONS + (SPADCALL (|spadConstant| $ 43) + |v| + (SPADCALL |p| |v| + (|getShellEntry| $ 46)) + (|getShellEntry| $ 47)) + #0#) + |POLYCAT-;isTimes;SU;4|) (LETT #1# (CDR #1#) |POLYCAT-;isTimes;SU;4|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) @@ -419,9 +413,8 @@ |POLYCAT-;primitiveMonomials;SL;12|) NIL)) (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS (|POLYCAT-;mkPrim| |q| $) #0#) - |POLYCAT-;primitiveMonomials;SL;12|))) + (LETT #0# (CONS (|POLYCAT-;mkPrim| |q| $) #0#) + |POLYCAT-;primitiveMonomials;SL;12|) (LETT #1# (CDR #1#) |POLYCAT-;primitiveMonomials;SL;12|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))))))) @@ -539,12 +532,11 @@ |POLYCAT-;allMonoms|) NIL)) (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |p| - (|getShellEntry| $ 98)) - #0#) - |POLYCAT-;allMonoms|))) + (LETT #0# + (CONS (SPADCALL |p| + (|getShellEntry| $ 98)) + #0#) + |POLYCAT-;allMonoms|) (LETT #1# (CDR #1#) |POLYCAT-;allMonoms|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) (|getShellEntry| $ 99)) @@ -594,38 +586,31 @@ (LETT |bj| (CAR #1#) |POLYCAT-;eq2R|) NIL)) (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (PROGN - (LETT #2# NIL - |POLYCAT-;eq2R|) - (SEQ - (LETT |p| NIL - |POLYCAT-;eq2R|) - (LETT #3# |l| - |POLYCAT-;eq2R|) - G190 - (COND - ((OR (ATOM #3#) - (PROGN - (LETT |p| (CAR #3#) - |POLYCAT-;eq2R|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #2# - (CONS - (SPADCALL |p| |bj| - (|getShellEntry| $ 106)) - #2#) - |POLYCAT-;eq2R|))) - (LETT #3# (CDR #3#) + (LETT #0# + (CONS (PROGN + (LETT #2# NIL |POLYCAT-;eq2R|) + (SEQ (LETT |p| NIL |POLYCAT-;eq2R|) + (LETT #3# |l| |POLYCAT-;eq2R|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |p| (CAR #3#) |POLYCAT-;eq2R|) - (GO G190) G191 - (EXIT (NREVERSE0 #2#)))) - #0#) - |POLYCAT-;eq2R|))) + NIL)) + (GO G191))) + (LETT #2# + (CONS + (SPADCALL |p| |bj| + (|getShellEntry| $ 106)) + #2#) + |POLYCAT-;eq2R|) + (LETT #3# (CDR #3#) + |POLYCAT-;eq2R|) + (GO G190) G191 + (EXIT (NREVERSE0 #2#)))) + #0#) + |POLYCAT-;eq2R|) (LETT #1# (CDR #1#) |POLYCAT-;eq2R|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) (|getShellEntry| $ 111)))))) @@ -1426,21 +1411,20 @@ |POLYCAT-;squareFreePart;2S;34|) NIL)) (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (QCAR |f|) - |POLYCAT-;squareFreePart;2S;34|) - (COND - (#3# - (LETT #2# - (SPADCALL #2# #1# - (|getShellEntry| $ 182)) - |POLYCAT-;squareFreePart;2S;34|)) - ('T - (PROGN - (LETT #2# #1# - |POLYCAT-;squareFreePart;2S;34|) - (LETT #3# 'T - |POLYCAT-;squareFreePart;2S;34|))))))) + (PROGN + (LETT #1# (QCAR |f|) + |POLYCAT-;squareFreePart;2S;34|) + (COND + (#3# (LETT #2# + (SPADCALL #2# #1# + (|getShellEntry| $ 182)) + |POLYCAT-;squareFreePart;2S;34|)) + ('T + (PROGN + (LETT #2# #1# + |POLYCAT-;squareFreePart;2S;34|) + (LETT #3# 'T + |POLYCAT-;squareFreePart;2S;34|))))) (LETT #0# (CDR #0#) |POLYCAT-;squareFreePart;2S;34|) (GO G190) G191 (EXIT NIL)) diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp index 5785250c..97751dd5 100644 --- a/src/algebra/strap/STAGG-.lsp +++ b/src/algebra/strap/STAGG-.lsp @@ -57,16 +57,15 @@ (LETT #0# NIL |STAGG-;first;ANniA;3|) (SEQ (LETT |i| 1 |STAGG-;first;ANniA;3|) G190 (COND ((QSGREATERP |i| |n|) (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (|STAGG-;c2| |x| - (LETT |x| - (SPADCALL |x| - (|getShellEntry| $ 17)) - |STAGG-;first;ANniA;3|) - $) - #0#) - |STAGG-;first;ANniA;3|))) + (LETT #0# + (CONS (|STAGG-;c2| |x| + (LETT |x| + (SPADCALL |x| + (|getShellEntry| $ 17)) + |STAGG-;first;ANniA;3|) + $) + #0#) + |STAGG-;first;ANniA;3|) (LETT |i| (QSADD1 |i|) |STAGG-;first;ANniA;3|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) (|getShellEntry| $ 19)))))) diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp index 3231df82..1142c59e 100644 --- a/src/algebra/strap/SYMBOL.lsp +++ b/src/algebra/strap/SYMBOL.lsp @@ -638,19 +638,18 @@ (|getShellEntry| $ 108)) (|getShellEntry| $ 144)))) (GO G191))) - (SEQ (EXIT (SPADCALL |nscripts| |i| - (PROG1 - (LETT #0# - (- - (SPADCALL - (SPADCALL |str| |j| - (|getShellEntry| $ 108)) - (|getShellEntry| $ 44)) - (|getShellEntry| $ 45)) - |SYMBOL;scripts;$R;32|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 151)))) + (SPADCALL |nscripts| |i| + (PROG1 (LETT #0# + (- + (SPADCALL + (SPADCALL |str| |j| + (|getShellEntry| $ 108)) + (|getShellEntry| $ 44)) + (|getShellEntry| $ 45)) + |SYMBOL;scripts;$R;32|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 151)) (LETT |i| (PROG1 (+ |i| 1) (LETT |j| (+ |j| 1) @@ -679,52 +678,45 @@ |SYMBOL;scripts;$R;32|) NIL)) (GO G191))) - (SEQ (EXIT (COND - ((< - (SPADCALL |allscripts| - (|getShellEntry| $ 157)) - |n|) - (|error| - "Improper script count in symbol")) - ('T + (COND + ((< (SPADCALL |allscripts| + (|getShellEntry| $ 157)) + |n|) + (|error| "Improper script count in symbol")) + ('T + (SEQ (SPADCALL |lscripts| |i| + (PROGN + (LETT #2# NIL + |SYMBOL;scripts;$R;32|) (SEQ - (SPADCALL |lscripts| |i| - (PROGN - (LETT #2# NIL - |SYMBOL;scripts;$R;32|) - (SEQ - (LETT |a| NIL - |SYMBOL;scripts;$R;32|) - (LETT #3# - (SPADCALL |allscripts| |n| - (|getShellEntry| $ 159)) - |SYMBOL;scripts;$R;32|) - G190 - (COND - ((OR (ATOM #3#) - (PROGN - (LETT |a| (CAR #3#) - |SYMBOL;scripts;$R;32|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #2# - (CONS - (|SYMBOL;coerce;$Of;11| - |a| $) - #2#) - |SYMBOL;scripts;$R;32|))) - (LETT #3# (CDR #3#) - |SYMBOL;scripts;$R;32|) - (GO G190) G191 - (EXIT (NREVERSE0 #2#)))) - (|getShellEntry| $ 160)) - (EXIT - (LETT |allscripts| - (SPADCALL |allscripts| |n| - (|getShellEntry| $ 161)) - |SYMBOL;scripts;$R;32|))))))) + (LETT |a| NIL + |SYMBOL;scripts;$R;32|) + (LETT #3# + (SPADCALL |allscripts| |n| + (|getShellEntry| $ 159)) + |SYMBOL;scripts;$R;32|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |a| (CAR #3#) + |SYMBOL;scripts;$R;32|) + NIL)) + (GO G191))) + (LETT #2# + (CONS + (|SYMBOL;coerce;$Of;11| |a| $) + #2#) + |SYMBOL;scripts;$R;32|) + (LETT #3# (CDR #3#) + |SYMBOL;scripts;$R;32|) + (GO G190) G191 + (EXIT (NREVERSE0 #2#)))) + (|getShellEntry| $ 160)) + (EXIT (LETT |allscripts| + (SPADCALL |allscripts| |n| + (|getShellEntry| $ 161)) + |SYMBOL;scripts;$R;32|))))) (LETT |i| (PROG1 (+ |i| 1) (LETT #1# (CDR #1#) diff --git a/src/algebra/strap/UFD-.lsp b/src/algebra/strap/UFD-.lsp index 786f9f7f..b82436ab 100644 --- a/src/algebra/strap/UFD-.lsp +++ b/src/algebra/strap/UFD-.lsp @@ -28,21 +28,18 @@ |UFD-;squareFreePart;2S;1|) NIL)) (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (QCAR |f|) - |UFD-;squareFreePart;2S;1|) - (COND - (#3# - (LETT #2# - (SPADCALL #2# #1# - (|getShellEntry| $ 15)) - |UFD-;squareFreePart;2S;1|)) - ('T - (PROGN - (LETT #2# #1# - |UFD-;squareFreePart;2S;1|) - (LETT #3# 'T - |UFD-;squareFreePart;2S;1|))))))) + (PROGN + (LETT #1# (QCAR |f|) + |UFD-;squareFreePart;2S;1|) + (COND + (#3# (LETT #2# + (SPADCALL #2# #1# + (|getShellEntry| $ 15)) + |UFD-;squareFreePart;2S;1|)) + ('T + (PROGN + (LETT #2# #1# |UFD-;squareFreePart;2S;1|) + (LETT #3# 'T |UFD-;squareFreePart;2S;1|))))) (LETT #0# (CDR #0#) |UFD-;squareFreePart;2S;1|) (GO G190) G191 (EXIT NIL)) (COND (#3# #2#) ('T (|spadConstant| $ 16)))) diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp index c8424408..8cb8d4dc 100644 --- a/src/algebra/strap/URAGG-.lsp +++ b/src/algebra/strap/URAGG-.lsp @@ -363,20 +363,16 @@ ((NULL (NOT (SPADCALL |y| |z| (|getShellEntry| $ 53)))) (GO G191))) - (SEQ (EXIT (LETT |z| - (SPADCALL |z| - (|getShellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|))) + (LETT |z| (SPADCALL |z| (|getShellEntry| $ 14)) + |URAGG-;cycleEntry;2A;19|) (LETT |l| (QSADD1 |l|) |URAGG-;cycleEntry;2A;19|) (GO G190) G191 (EXIT NIL)) (LETT |y| |x| |URAGG-;cycleEntry;2A;19|) (SEQ (LETT |k| 1 |URAGG-;cycleEntry;2A;19|) G190 (COND ((QSGREATERP |k| |l|) (GO G191))) - (SEQ (EXIT (LETT |y| - (SPADCALL |y| - (|getShellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|))) + (LETT |y| (SPADCALL |y| (|getShellEntry| $ 14)) + |URAGG-;cycleEntry;2A;19|) (LETT |k| (QSADD1 |k|) |URAGG-;cycleEntry;2A;19|) (GO G190) G191 (EXIT NIL)) @@ -414,10 +410,8 @@ ((NULL (NOT (SPADCALL |x| |y| (|getShellEntry| $ 53)))) (GO G191))) - (SEQ (EXIT (LETT |y| - (SPADCALL |y| - (|getShellEntry| $ 14)) - |URAGG-;cycleLength;ANni;20|))) + (LETT |y| (SPADCALL |y| (|getShellEntry| $ 14)) + |URAGG-;cycleLength;ANni;20|) (LETT |k| (QSADD1 |k|) |URAGG-;cycleLength;ANni;20|) (GO G190) G191 (EXIT NIL)) diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index e8e11234..c7cdd14f 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -989,7 +989,7 @@ mutateLETFormWithUnaryFunction(form,fun) == -- element of $middleEndMacroList is actually a macro call $middleEndMacroList == '(COLLECT REPEAT SUCHTHATCLAUSE THETA COLLECTV - COLLECTVEC THETA1 SPADREDUCE SPADDO) + THETA1 SPADREDUCE SPADDO) middleEndExpand: %Form -> %Form middleEndExpand x == @@ -1419,6 +1419,13 @@ declareGlobalVariables: %List -> %List declareGlobalVariables vars == ["DECLARE",["SPECIAL",:vars]] +simplifySEQ form == + isAtomicForm form => form + form is ["SEQ",[op,a]] and MEMQ(op, '(EXIT RETURN)) => simplifySEQ a + for stmts in tails form repeat + rplac(first stmts, simplifySEQ first stmts) + form + ++ Generate Lisp code by lowering middle end defining form `x'. ++ x has the strucrure: transformToBackendCode: %Form -> %Code @@ -1435,7 +1442,7 @@ transformToBackendCode x == null rest body and (atom stmt or first stmt = "SEQ" or not CONTAINED("EXIT",stmt)) => body - [["SEQ",:body]] + [simplifySEQ ["SEQ",:body]] $FluidVars := REMDUP nreverse $FluidVars $LocalVars := S_-(S_-(REMDUP nreverse $LocalVars,$FluidVars), LISTOFATOMS second x) -- cgit v1.2.3