From a6dfd60ca4931a8c11f0afbd4533d4c6cc960e1e Mon Sep 17 00:00:00 2001 From: dos-reis Date: Thu, 3 Feb 2011 19:16:25 +0000 Subject: * algebra/stream.spad.pamphlet (Stream): Remove bogus assignment to Rep. Rework local function definitions. --- src/ChangeLog | 5 ++++ src/algebra/strap/CLAGG-.lsp | 3 +-- src/algebra/strap/HOAGG-.lsp | 9 +++---- src/algebra/strap/LSAGG-.lsp | 5 ++-- src/algebra/stream.spad.pamphlet | 51 ++++++++++++++++++++-------------------- 5 files changed, 37 insertions(+), 36 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index 2dfc475f..d3c63c89 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-02-03 Gabriel Dos Reis + + * algebra/stream.spad.pamphlet (Stream): Remove bogus assignment + to Rep. Rework local function definitions. + 2011-02-03 Gabriel Dos Reis * interp/c-util.boot: Replace COND with %when throught. 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} <>= --- 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) -- cgit v1.2.3