From f7ca9bfa04d335e47daab91fa556b43a5369270e Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 24 Jan 2011 17:10:48 +0000 Subject: * algebra/array1.spad.pamphlet: Use %aref instead of %vref. * interp/g-opt.boot (optSETRECORDELT): Tidy code generation. (optRECORDCOPY): Likewise. (optRECORDELT): Likewise. ($VMsideEffectFreeOperators): Include %aref. Translate. --- src/algebra/array1.spad.pamphlet | 22 +++++++------- src/algebra/strap/EUCDOM-.lsp | 64 ++++++++++++++++++++-------------------- src/algebra/strap/INTDOM-.lsp | 6 ++-- src/algebra/strap/POLYCAT-.lsp | 16 +++++----- src/algebra/strap/SYMBOL.lsp | 40 ++++++++++++------------- 5 files changed, 74 insertions(+), 74 deletions(-) (limited to 'src/algebra') diff --git a/src/algebra/array1.spad.pamphlet b/src/algebra/array1.spad.pamphlet index 7eb4c367..92feee53 100644 --- a/src/algebra/array1.spad.pamphlet +++ b/src/algebra/array1.spad.pamphlet @@ -17,7 +17,7 @@ PrimitiveArray(S:Type): OneDimensionalArrayAggregate S == add macro NNI == NonNegativeInteger import %vlength: % -> NonNegativeInteger from Foreign Builtin - import %vref: (%,Integer) -> S from Foreign Builtin + import %aref: (%,Integer) -> S from Foreign Builtin import makeSimpleArray: (Domain,NNI) -> % from Foreign Builtin #x == %vlength x @@ -34,8 +34,8 @@ PrimitiveArray(S:Type): OneDimensionalArrayAggregate S == add new(n, x) == makeFilledSimpleArray(getVMType(S)$Lisp,n,x)$Lisp - qelt(x, i) == %vref(x,i) - elt(x:%, i:Integer) == %vref(x,i) + qelt(x, i) == %aref(x,i) + elt(x:%, i:Integer) == %aref(x,i) qsetelt!(x, i, s) == setSimpleArrayEntry(x,i,s)$Lisp @@ -373,7 +373,7 @@ FlexibleArray(S: Type) == Implementation where IndexedOneDimensionalArray(S:Type, mn:Integer): OneDimensionalArrayAggregate S == add import %vlength: % -> NonNegativeInteger from Foreign Builtin - import %vref: (%,Integer) -> S from Foreign Builtin + import %aref: (%,Integer) -> S from Foreign Builtin macro Qmax == maxIndexOfSimpleArray$Foreign(Builtin) macro Qsetelt == setSimpleArrayEntry$Foreign(Builtin) @@ -395,14 +395,14 @@ IndexedOneDimensionalArray(S:Type, mn:Integer): map!(f, s1) == n: Integer := Qmax(s1) n < 0 => s1 - for i in 0..n repeat Qsetelt(s1, i, f(%vref(s1,i))) + for i in 0..n repeat Qsetelt(s1, i, f(%aref(s1,i))) s1 map(f, s1) == n:Integer := Qmax(s1) n < 0 => s1 ss2:% := newArray(n+1) - for i in 0..n repeat Qsetelt(ss2, i, f(%vref(s1,i))) + for i in 0..n repeat Qsetelt(ss2, i, f(%aref(s1,i))) ss2 map(f, a, b) == @@ -410,11 +410,11 @@ IndexedOneDimensionalArray(S:Type, mn:Integer): maxind < 0 => empty() c:% := newArray(maxind+1) for i in 0..maxind repeat - Qsetelt(c, i, f(%vref(a,i),%vref(b,i))) + Qsetelt(c, i, f(%aref(a,i),%aref(b,i))) c if zero? mn then - qelt(x, i) == %vref(x, i) + qelt(x, i) == %aref(x, i) qsetelt!(x, i, s) == Qsetelt(x, i, s) elt(x:%, i:I) == @@ -427,13 +427,13 @@ IndexedOneDimensionalArray(S:Type, mn:Integer): else if one? mn then maxIndex x == %vlength x - qelt(x, i) == %vref(x, i-1) + qelt(x, i) == %aref(x, i-1) qsetelt!(x, i, s) == Qsetelt(x, i-1, s) elt(x:%, i:I) == QSLESSP(i,1@I)$Lisp or QSLESSP(%vlength x,i)$Lisp => error "index out of range" - %vref(x, i-1) + %aref(x, i-1) setelt(x:%, i:I, s:S) == QSLESSP(i,1@I)$Lisp or QSLESSP(%vlength x,i)$Lisp => @@ -441,7 +441,7 @@ IndexedOneDimensionalArray(S:Type, mn:Integer): Qsetelt(x, i-1, s) else - qelt(x, i) == %vref(x, i - mn) + qelt(x, i) == %aref(x, i - mn) qsetelt!(x, i, s) == Qsetelt(x, i - mn, s) elt(x:%, i:I) == diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp index 84a6ab20..d9375a0c 100644 --- a/src/algebra/strap/EUCDOM-.lsp +++ b/src/algebra/strap/EUCDOM-.lsp @@ -84,15 +84,15 @@ (EXIT |x|))))) (DEFUN |EUCDOM-;unitNormalizeIdealElt| (|s| $) - (LET* ((|#G16| (SPADCALL (QVELT |s| 2) (|getShellEntry| $ 27))) - (|u| (QVELT |#G16| 0)) (|c| (QVELT |#G16| 1)) - (|a| (QVELT |#G16| 2))) + (LET* ((|#G16| (SPADCALL (SVREF |s| 2) (|getShellEntry| $ 27))) + (|u| (SVREF |#G16| 0)) (|c| (SVREF |#G16| 1)) + (|a| (SVREF |#G16| 2))) (SEQ |#G16| (EXIT (COND ((SPADCALL |a| (|getShellEntry| $ 28)) |s|) - (T (VECTOR (SPADCALL |a| (QVELT |s| 0) + (T (VECTOR (SPADCALL |a| (SVREF |s| 0) (|getShellEntry| $ 29)) - (SPADCALL |a| (QVELT |s| 1) + (SPADCALL |a| (SVREF |s| 1) (|getShellEntry| $ 29)) |c|))))))) @@ -112,24 +112,24 @@ ((SPADCALL |x| (|getShellEntry| $ 8)) |s2|) (T (SEQ (LOOP (COND - ((NOT (NOT (SPADCALL (QVELT |s2| 2) + ((NOT (NOT (SPADCALL (SVREF |s2| 2) (|getShellEntry| $ 8)))) (RETURN NIL)) (T (SEQ (LETT |qr| - (SPADCALL (QVELT |s1| 2) - (QVELT |s2| 2) + (SPADCALL (SVREF |s1| 2) + (SVREF |s2| 2) (|getShellEntry| $ 16)) |EUCDOM-;extendedEuclidean;2SR;7|) (LETT |s3| (VECTOR - (SPADCALL (QVELT |s1| 0) + (SPADCALL (SVREF |s1| 0) (SPADCALL (CAR |qr|) - (QVELT |s2| 0) + (SVREF |s2| 0) (|getShellEntry| $ 29)) (|getShellEntry| $ 31)) - (SPADCALL (QVELT |s1| 1) + (SPADCALL (SVREF |s1| 1) (SPADCALL (CAR |qr|) - (QVELT |s2| 1) + (SVREF |s2| 1) (|getShellEntry| $ 29)) (|getShellEntry| $ 31)) (CDR |qr|)) @@ -139,21 +139,21 @@ (|EUCDOM-;unitNormalizeIdealElt| |s3| $))))))) (COND - ((NOT (SPADCALL (QVELT |s1| 0) + ((NOT (SPADCALL (SVREF |s1| 0) (|getShellEntry| $ 8))) (COND - ((NOT (SPADCALL (QVELT |s1| 0) |y| + ((NOT (SPADCALL (SVREF |s1| 0) |y| (|getShellEntry| $ 32))) (SEQ (LETT |qr| - (SPADCALL (QVELT |s1| 0) |y| + (SPADCALL (SVREF |s1| 0) |y| (|getShellEntry| $ 16)) |EUCDOM-;extendedEuclidean;2SR;7|) - (QSETVELT |s1| 0 (CDR |qr|)) - (QSETVELT |s1| 1 - (SPADCALL (QVELT |s1| 1) - (SPADCALL (CAR |qr|) |x| - (|getShellEntry| $ 29)) - (|getShellEntry| $ 33))) + (SETF (SVREF |s1| 0) (CDR |qr|)) + (SETF (SVREF |s1| 1) + (SPADCALL (SVREF |s1| 1) + (SPADCALL (CAR |qr|) |x| + (|getShellEntry| $ 29)) + (|getShellEntry| $ 33))) (EXIT (SETQ |s1| (|EUCDOM-;unitNormalizeIdealElt| |s1| $)))))))) @@ -170,7 +170,7 @@ (SPADCALL |x| |y| (|getShellEntry| $ 36)) |EUCDOM-;extendedEuclidean;3SU;8|) (LETT |w| - (SPADCALL |z| (QVELT |s| 2) + (SPADCALL |z| (SVREF |s| 2) (|getShellEntry| $ 37)) |EUCDOM-;extendedEuclidean;3SU;8|) (EXIT (COND @@ -178,13 +178,13 @@ ((SPADCALL |y| (|getShellEntry| $ 8)) (CONS 0 (CONS - (SPADCALL (QVELT |s| 0) (CDR |w|) + (SPADCALL (SVREF |s| 0) (CDR |w|) (|getShellEntry| $ 29)) - (SPADCALL (QVELT |s| 1) (CDR |w|) + (SPADCALL (SVREF |s| 1) (CDR |w|) (|getShellEntry| $ 29))))) (T (SEQ (LETT |qr| (SPADCALL - (SPADCALL (QVELT |s| 0) + (SPADCALL (SVREF |s| 0) (CDR |w|) (|getShellEntry| $ 29)) |y| (|getShellEntry| $ 16)) @@ -193,7 +193,7 @@ (CONS 0 (CONS (CDR |qr|) (SPADCALL - (SPADCALL (QVELT |s| 1) + (SPADCALL (SVREF |s| 1) (CDR |w|) (|getShellEntry| $ 29)) (SPADCALL (CAR |qr|) |x| @@ -211,15 +211,15 @@ (SPADCALL (|SPADfirst| |l|) (|getShellEntry| $ 27)) |EUCDOM-;principalIdeal;LR;9|) - (EXIT (CONS (LIST (QVELT |uca| 0)) (QVELT |uca| 1))))) + (EXIT (CONS (LIST (SVREF |uca| 0)) (SVREF |uca| 1))))) ((SPADCALL (CDR (CDR |l|)) NIL (|getShellEntry| $ 42)) (SEQ (LETT |u| (SPADCALL (|SPADfirst| |l|) (SPADCALL |l| (|getShellEntry| $ 45)) (|getShellEntry| $ 36)) |EUCDOM-;principalIdeal;LR;9|) - (EXIT (CONS (LIST (QVELT |u| 0) (QVELT |u| 1)) - (QVELT |u| 2))))) + (EXIT (CONS (LIST (SVREF |u| 0) (SVREF |u| 1)) + (SVREF |u| 2))))) (T (SEQ (LETT |v| (SPADCALL (CDR |l|) (|getShellEntry| $ 48)) |EUCDOM-;principalIdeal;LR;9|) @@ -227,7 +227,7 @@ (SPADCALL (|SPADfirst| |l|) (CDR |v|) (|getShellEntry| $ 36)) |EUCDOM-;principalIdeal;LR;9|) - (EXIT (CONS (CONS (QVELT |u| 0) + (EXIT (CONS (CONS (SVREF |u| 0) (LET ((#0=#:G1494 (CAR |v|)) (#1=#:G1493 NIL)) @@ -240,12 +240,12 @@ (SETQ #1# (CONS (SPADCALL - (QVELT |u| 1) |vv| + (SVREF |u| 1) |vv| (|getShellEntry| $ 29)) #1#))))) (SETQ #0# (CDR #0#))))) - (QVELT |u| 2)))))))))) + (SVREF |u| 2)))))))))) (DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $) (PROG (|pid| |q|) diff --git a/src/algebra/strap/INTDOM-.lsp b/src/algebra/strap/INTDOM-.lsp index 2f3a9cc0..6936faf3 100644 --- a/src/algebra/strap/INTDOM-.lsp +++ b/src/algebra/strap/INTDOM-.lsp @@ -23,7 +23,7 @@ (VECTOR (|spadConstant| $ 7) |x| (|spadConstant| $ 7))) (DEFUN |INTDOM-;unitCanonical;2S;2| (|x| $) - (QVELT (SPADCALL |x| (|getShellEntry| $ 10)) 1)) + (SVREF (SPADCALL |x| (|getShellEntry| $ 10)) 1)) (DEFUN |INTDOM-;recip;SU;3| (|x| $) (COND @@ -36,8 +36,8 @@ (T T))) (DEFUN |INTDOM-;associates?;2SB;5| (|x| |y| $) - (SPADCALL (QVELT (SPADCALL |x| (|getShellEntry| $ 10)) 1) - (QVELT (SPADCALL |y| (|getShellEntry| $ 10)) 1) + (SPADCALL (SVREF (SPADCALL |x| (|getShellEntry| $ 10)) 1) + (SVREF (SPADCALL |y| (|getShellEntry| $ 10)) 1) (|getShellEntry| $ 21))) (DEFUN |INTDOM-;associates?;2SB;6| (|x| |y| $) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp index 705c2f82..e5cbc3a6 100644 --- a/src/algebra/strap/POLYCAT-.lsp +++ b/src/algebra/strap/POLYCAT-.lsp @@ -615,10 +615,10 @@ (T (LET ((|w| (CAR #0#))) (SETQ #1# (CONS - (VECTOR (QVELT |w| 0) - (SPADCALL (QVELT |w| 1) + (VECTOR (SVREF |w| 0) + (SPADCALL (SVREF |w| 1) (|getShellEntry| $ 51)) - (QVELT |w| 2)) + (SVREF |w| 2)) #1#))))) (SETQ #0# (CDR #0#)))) (|getShellEntry| $ 159))))) @@ -643,11 +643,11 @@ (T (LET ((|ww| (CAR #2#))) (SETQ #3# (CONS - (VECTOR (QVELT |ww| 0) - (SPADCALL (QVELT |ww| 1) + (VECTOR (SVREF |ww| 0) + (SPADCALL (SVREF |ww| 1) (CDR |v|) (|getShellEntry| $ 161)) - (QVELT |ww| 2)) + (SVREF |ww| 2)) #3#))))) (SETQ #2# (CDR #2#)))) (|getShellEntry| $ 159)))))))))) @@ -1036,7 +1036,7 @@ (|getShellEntry| $ 204))) (DEFUN |POLYCAT-;primitivePart;2S;36| (|p| $) - (QVELT (SPADCALL + (SVREF (SPADCALL (LET ((#0=#:G1633 (SPADCALL |p| (SPADCALL |p| (|getShellEntry| $ 206)) @@ -1048,7 +1048,7 @@ 1)) (DEFUN |POLYCAT-;primitivePart;SVarSetS;37| (|p| |v| $) - (QVELT (SPADCALL + (SVREF (SPADCALL (LET ((#0=#:G1639 (SPADCALL |p| (SPADCALL |p| |v| (|getShellEntry| $ 211)) diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp index 583b62d2..ce590b2c 100644 --- a/src/algebra/strap/SYMBOL.lsp +++ b/src/algebra/strap/SYMBOL.lsp @@ -195,10 +195,10 @@ (SPADCALL |x| (|getShellEntry| $ 79))) (DEFUN |SYMBOL;syprefix| (|sc| $) - (LET ((|ns| (LIST (LIST-LENGTH (QVELT |sc| 3)) - (LIST-LENGTH (QVELT |sc| 2)) - (LIST-LENGTH (QVELT |sc| 1)) - (LIST-LENGTH (QVELT |sc| 0))))) + (LET ((|ns| (LIST (LIST-LENGTH (SVREF |sc| 3)) + (LIST-LENGTH (SVREF |sc| 2)) + (LIST-LENGTH (SVREF |sc| 1)) + (LIST-LENGTH (SVREF |sc| 0))))) (SEQ (LOOP (COND ((NOT (COND @@ -210,7 +210,7 @@ (EXIT (SPADCALL (CONS (STRCONC (|getShellEntry| $ 38) (|SYMBOL;istring| - (LIST-LENGTH (QVELT |sc| 4)) $)) + (LIST-LENGTH (SVREF |sc| 4)) $)) (LET ((#0=#:G1524 (NREVERSE |ns|)) (#1=#:G1523 NIL)) (LOOP @@ -224,36 +224,36 @@ (|getShellEntry| $ 93)))))) (DEFUN |SYMBOL;syscripts| (|sc| $) - (LET ((|all| (QVELT |sc| 3))) + (LET ((|all| (SVREF |sc| 3))) (SEQ (SETQ |all| - (SPADCALL (QVELT |sc| 2) |all| (|getShellEntry| $ 94))) + (SPADCALL (SVREF |sc| 2) |all| (|getShellEntry| $ 94))) (SETQ |all| - (SPADCALL (QVELT |sc| 1) |all| (|getShellEntry| $ 94))) + (SPADCALL (SVREF |sc| 1) |all| (|getShellEntry| $ 94))) (SETQ |all| - (SPADCALL (QVELT |sc| 0) |all| (|getShellEntry| $ 94))) - (EXIT (SPADCALL |all| (QVELT |sc| 4) (|getShellEntry| $ 94)))))) + (SPADCALL (SVREF |sc| 0) |all| (|getShellEntry| $ 94))) + (EXIT (SPADCALL |all| (SVREF |sc| 4) (|getShellEntry| $ 94)))))) (DEFUN |SYMBOL;script;$L$;22| (|sy| |ls| $) (LET ((|sc| (VECTOR NIL NIL NIL NIL NIL))) (SEQ (COND ((NOT (NULL |ls|)) - (SEQ (QSETVELT |sc| 0 (|SPADfirst| |ls|)) + (SEQ (SETF (SVREF |sc| 0) (|SPADfirst| |ls|)) (EXIT (SETQ |ls| (CDR |ls|)))))) (COND ((NOT (NULL |ls|)) - (SEQ (QSETVELT |sc| 1 (|SPADfirst| |ls|)) + (SEQ (SETF (SVREF |sc| 1) (|SPADfirst| |ls|)) (EXIT (SETQ |ls| (CDR |ls|)))))) (COND ((NOT (NULL |ls|)) - (SEQ (QSETVELT |sc| 2 (|SPADfirst| |ls|)) + (SEQ (SETF (SVREF |sc| 2) (|SPADfirst| |ls|)) (EXIT (SETQ |ls| (CDR |ls|)))))) (COND ((NOT (NULL |ls|)) - (SEQ (QSETVELT |sc| 3 (|SPADfirst| |ls|)) + (SEQ (SETF (SVREF |sc| 3) (|SPADfirst| |ls|)) (EXIT (SETQ |ls| (CDR |ls|)))))) (COND ((NOT (NULL |ls|)) - (SEQ (QSETVELT |sc| 4 (|SPADfirst| |ls|)) + (SEQ (SETF (SVREF |sc| 4) (|SPADfirst| |ls|)) (EXIT (SETQ |ls| (CDR |ls|)))))) (EXIT (|SYMBOL;script;$R$;23| |sy| |sc| $))))) @@ -291,7 +291,7 @@ ((NOT (|SYMBOL;scripted?;$B;30| |e| $)) (EXIT |s|))) (LETT |ss| (|SYMBOL;scripts;$R;32| |e| $) |SYMBOL;latex;$S;25|) - (LETT |lo| (QVELT |ss| 0) |SYMBOL;latex;$S;25|) + (LETT |lo| (SVREF |ss| 0) |SYMBOL;latex;$S;25|) (COND ((NOT (NULL |lo|)) (SEQ (LETT |sc| "_{" |SYMBOL;latex;$S;25|) @@ -309,7 +309,7 @@ (STRCONC |sc| ", "))))))))) (SETQ |sc| (STRCONC |sc| "}")) (EXIT (SETQ |s| (STRCONC |s| |sc|)))))) - (SETQ |lo| (QVELT |ss| 1)) + (SETQ |lo| (SVREF |ss| 1)) (COND ((NOT (NULL |lo|)) (SEQ (LETT |sc| "^{" |SYMBOL;latex;$S;25|) @@ -327,7 +327,7 @@ (STRCONC |sc| ", "))))))))) (SETQ |sc| (STRCONC |sc| "}")) (EXIT (SETQ |s| (STRCONC |s| |sc|)))))) - (SETQ |lo| (QVELT |ss| 2)) + (SETQ |lo| (SVREF |ss| 2)) (COND ((NOT (NULL |lo|)) (SEQ (LETT |sc| "{}^{" |SYMBOL;latex;$S;25|) @@ -345,7 +345,7 @@ (STRCONC |sc| ", "))))))))) (SETQ |sc| (STRCONC |sc| "}")) (EXIT (SETQ |s| (STRCONC |sc| |s|)))))) - (SETQ |lo| (QVELT |ss| 3)) + (SETQ |lo| (SVREF |ss| 3)) (COND ((NOT (NULL |lo|)) (SEQ (LETT |sc| "{}_{" |SYMBOL;latex;$S;25|) @@ -363,7 +363,7 @@ (STRCONC |sc| ", "))))))))) (SETQ |sc| (STRCONC |sc| "}")) (EXIT (SETQ |s| (STRCONC |sc| |s|)))))) - (SETQ |lo| (QVELT |ss| 4)) + (SETQ |lo| (SVREF |ss| 4)) (COND ((NOT (NULL |lo|)) (SEQ (LETT |sc| "\\left( {" |SYMBOL;latex;$S;25|) -- cgit v1.2.3