aboutsummaryrefslogtreecommitdiff
path: root/src/algebra
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-02-03 19:16:25 +0000
committerdos-reis <gdr@axiomatics.org>2011-02-03 19:16:25 +0000
commita6dfd60ca4931a8c11f0afbd4533d4c6cc960e1e (patch)
treea892bbc7fb9390dc1f73cc5d341b0c3d0e7fc056 /src/algebra
parent8ea3a4b4aae5c6c1287bc4e48a2fcdd33a51a7f5 (diff)
downloadopen-axiom-a6dfd60ca4931a8c11f0afbd4533d4c6cc960e1e.tar.gz
* algebra/stream.spad.pamphlet (Stream): Remove bogus assignment
to Rep. Rework local function definitions.
Diffstat (limited to 'src/algebra')
-rw-r--r--src/algebra/strap/CLAGG-.lsp3
-rw-r--r--src/algebra/strap/HOAGG-.lsp9
-rw-r--r--src/algebra/strap/LSAGG-.lsp5
-rw-r--r--src/algebra/stream.spad.pamphlet51
4 files changed, 32 insertions, 36 deletions
diff --git a/src/algebra/strap/CLAGG-.lsp b/src/algebra/strap/CLAGG-.lsp
index 021832f1..91ec911e 100644
--- a/src/algebra/strap/CLAGG-.lsp
+++ b/src/algebra/strap/CLAGG-.lsp
@@ -112,8 +112,7 @@
(|getShellEntry| $ 39)))
(DEFUN |CLAGG-;remove;S2A;10!0| (|#1| $$)
- (SPADCALL |#1| (|getShellEntry| $$ 1)
- (|getShellEntry| (|getShellEntry| $$ 0) 38)))
+ (SPADCALL |#1| (SVREF $$ 1) (|getShellEntry| (SVREF $$ 0) 38)))
(DEFUN |CLAGG-;reduce;MA3S;11| (|f| |x| |s1| |s2| $)
(SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 9)) |s1| |s2|
diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp
index faa12149..53a50ebe 100644
--- a/src/algebra/strap/HOAGG-.lsp
+++ b/src/algebra/strap/HOAGG-.lsp
@@ -38,8 +38,7 @@
(|getShellEntry| $ 12)))
(DEFUN |HOAGG-;eval;ALA;1!0| (|#1| $$)
- (SPADCALL |#1| (|getShellEntry| $$ 1)
- (|getShellEntry| (|getShellEntry| $$ 0) 10)))
+ (SPADCALL |#1| (SVREF $$ 1) (|getShellEntry| (SVREF $$ 0) 10)))
(DEFUN |HOAGG-;#;ANni;2| (|c| $)
(LIST-LENGTH (SPADCALL |c| (|getShellEntry| $ 15))))
@@ -114,16 +113,14 @@
(|getShellEntry| $ 36)))
(DEFUN |HOAGG-;count;SANni;8!0| (|#1| $$)
- (SPADCALL (|getShellEntry| $$ 1) |#1|
- (|getShellEntry| (|getShellEntry| $$ 0) 34)))
+ (SPADCALL (SVREF $$ 1) |#1| (|getShellEntry| (SVREF $$ 0) 34)))
(DEFUN |HOAGG-;member?;SAB;9| (|e| |c| $)
(SPADCALL (CONS #'|HOAGG-;member?;SAB;9!0| (VECTOR $ |e|)) |c|
(|getShellEntry| $ 38)))
(DEFUN |HOAGG-;member?;SAB;9!0| (|#1| $$)
- (SPADCALL (|getShellEntry| $$ 1) |#1|
- (|getShellEntry| (|getShellEntry| $$ 0) 34)))
+ (SPADCALL (SVREF $$ 1) |#1| (|getShellEntry| (SVREF $$ 0) 34)))
(DEFUN |HOAGG-;coerce;AOf;10| (|x| $)
(SPADCALL
diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp
index 8adc9781..f0fa12ff 100644
--- a/src/algebra/strap/LSAGG-.lsp
+++ b/src/algebra/strap/LSAGG-.lsp
@@ -642,9 +642,8 @@
(EXIT |l|))))
(DEFUN |LSAGG-;removeDuplicates!;2A;24!0| (|#1| $$)
- (LET (($ (|getShellEntry| $$ 0)))
- (SPADCALL |#1|
- (SPADCALL (|getShellEntry| $$ 1) (|getShellEntry| $ 18))
+ (LET (($ (SVREF $$ 0)))
+ (SPADCALL |#1| (SPADCALL (SVREF $$ 1) (|getShellEntry| $ 18))
(|getShellEntry| $ 72))))
(DEFUN |LSAGG-;<;2AB;25| (|x| |y| $)
diff --git a/src/algebra/stream.spad.pamphlet b/src/algebra/stream.spad.pamphlet
index fc4be2d0..2056d151 100644
--- a/src/algebra/stream.spad.pamphlet
+++ b/src/algebra/stream.spad.pamphlet
@@ -549,9 +549,6 @@ CyclicStreamTools(S,ST): Exports == Implementation where
@
\section{domain STREAM Stream}
<<domain STREAM Stream>>=
--- As explained below, in the capsule, the Rep for STREAM is actually
--- a half lie. So, the system should not be allowed to trust it.
-)boot $optProclaim := false
import Void
import Boolean
import Integer
@@ -652,41 +649,42 @@ Stream(S): Exports == Implementation where
--% representation
- -- This description of the rep is not quite true.
-- The Rep is a pair of one of three forms:
-- [value: S, rest: %]
-- [nullstream: Magic, NIL ]
-- [nonnullstream: Magic, fun: () -> %]
-- Could use a record of unions if we could guarantee no tags.
- NullStream: S := _$NullStream$Lisp pretend S
- NonNullStream: S := _$NonNullStream$Lisp pretend S
+ macro NullStream == _$NullStream$Foreign(Builtin)
+ macro NonNullStream == _$NonNullStream$Foreign(Builtin)
- Rep := Record(firstElt: S, restOfStream: %)
+ import %head: % -> S from Foreign Builtin
+ import %tail: % -> % from Foreign Builtin
explicitlyEmpty? x == %peq(frst x,NullStream)$Foreign(Builtin)
lazy? x == %peq(frst x,NonNullStream)$Foreign(Builtin)
--% signatures of local functions
- setfrst! : (%,S) -> S
- setrst! : (%,%) -> %
- setToNil! : % -> %
- setrestt! : (%,I,%) -> %
- lazyEval : % -> %
expand! : (%,I) -> %
--% functions to access or change record fields without lazy evaluation
- frst x == x.firstElt
- rst x == x.restOfStream
+ frst x == %head x
+ rst x == %tail x
- setfrst!(x,s) == x.firstElt := s
- setrst!(x,y) == x.restOfStream := y
+ setfrst!(x: %,s: S): S ==
+ %store(%head x,s)$Foreign(Builtin)
+ %head x
+
+ setrst!(x:%,y: %): % ==
+ %store(%tail x,y)$Foreign(Builtin)
+ %tail x
- setToNil! x ==
-- destructively changes x to a null stream
- setfrst!(x,NullStream); setrst!(x,NIL$Lisp)
+ setToNil!(x: %): % ==
+ setfrst!(x,NullStream)
+ setrst!(x,%nil$Foreign(Builtin))
x
--% SETCAT functions
@@ -915,9 +913,11 @@ Stream(S): Exports == Implementation where
--% RCAGG functions
- empty() == [NullStream, NIL$Lisp]
+ empty() ==
+ %makepair(NullStream,%nil$Foreign(Builtin))$Foreign(Builtin)
- lazyEval x == (rst(x):(()-> %)) ()
+ lazyEval(x: %): % ==
+ (rst(x):(()-> %)) ()
lazyEvaluate x ==
st := lazyEval x
@@ -948,7 +948,9 @@ Stream(S): Exports == Implementation where
n = 0 or empty? x => empty()
(concat(frst x, first(rst x,(n-1) :: NNI)))
- concat(s:S,x:%) == [s,x]
+ concat(s:S,x:%) ==
+ %makepair(s,x)$Foreign(Builtin)
+
cons(s,x) == concat(s,x)
cycleSplit! x ==
@@ -1067,9 +1069,8 @@ Stream(S): Exports == Implementation where
while not eq?(x,xp) repeat (x := rst x; xp := rst xp; npp := npp+1)
[true, npp, periode]
- delay(fs:()->%) == [NonNullStream, fs pretend %]
-
--- explicitlyEmpty? x == markedNull? x
+ delay(fs:()->%) ==
+ %makepair(NonNullStream,fs)$Foreign(Builtin)
explicitEntries? x ==
not explicitlyEmpty? x and not lazy? x
@@ -1085,7 +1086,7 @@ Stream(S): Exports == Implementation where
mathPrint(frst(x)::OUT)$Lisp
output(n-1, rst x)
- setrestt!(x,n,y) ==
+ setrestt!(x: %,n: I,y: %): % ==
n = 0 => setrst!(x,y)
setrestt!(rst x,n-1,y)