aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-12-28 06:12:21 +0000
committerdos-reis <gdr@axiomatics.org>2011-12-28 06:12:21 +0000
commit292bd212f1c30a51f0191128d5a9cd2691c5ccf9 (patch)
treeb3df4b4c43f312e5f0ac52dde5de9b3791833714
parent1fd6a63bbce9234ba3b8efa12c9a91643f0a87a1 (diff)
downloadopen-axiom-292bd212f1c30a51f0191128d5a9cd2691c5ccf9.tar.gz
* boot/tokens.boot: Remove redundant renaming of REM.
loopBody and loopExit are not selectors. * interp/i-output.boot: Include sys-utility. * interp/sys-utility.boot (last): New macro. (loopBody): Likewise. * interp/vmlisp.lisp (LASTNODE): Remove. (LASTPAIR): Likewise. (last): Do not define here.
-rw-r--r--src/ChangeLog11
-rw-r--r--src/boot/strap/tokens.clisp47
-rw-r--r--src/boot/tokens.boot3
-rw-r--r--src/boot/utility.boot36
-rw-r--r--src/interp/Makefile.in2
-rw-r--r--src/interp/g-opt.boot2
-rw-r--r--src/interp/i-output.boot1
-rw-r--r--src/interp/slam.boot2
-rw-r--r--src/interp/sys-utility.boot8
-rw-r--r--src/interp/vmlisp.lisp10
10 files changed, 68 insertions, 54 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 59992dbb..ebc8a2a5 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
+2011-12-28 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * boot/tokens.boot: Remove redundant renaming of REM.
+ loopBody and loopExit are not selectors.
+ * interp/i-output.boot: Include sys-utility.
+ * interp/sys-utility.boot (last): New macro.
+ (loopBody): Likewise.
+ * interp/vmlisp.lisp (LASTNODE): Remove.
+ (LASTPAIR): Likewise.
+ (last): Do not define here.
+
2011-12-27 Gabriel Dos Reis <gdr@cs.tamu.edu>
* boot/tokens.boot: Do not rewrite drop and take.
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 3d170958..e59680a6 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -219,9 +219,9 @@
(LIST '|writeLine| 'WRITE-LINE) (LIST '|writeNewline| 'TERPRI)
(LIST '|writeString| 'WRITE-STRING) (LIST 'PLUS '+)
(LIST 'MINUS '-) (LIST 'TIMES '*) (LIST 'POWER 'EXPT)
- (LIST 'REM 'REM) (LIST 'QUO 'TRUNCATE) (LIST 'SLASH '/)
- (LIST 'LT '<) (LIST 'GT '>) (LIST 'LE '<=) (LIST 'GE '>=)
- (LIST 'SHOEEQ 'EQUAL) (LIST 'SHOENE '/=) (LIST 'T 'T$)))
+ (LIST 'QUO 'TRUNCATE) (LIST 'SLASH '/) (LIST 'LT '<) (LIST 'GT '>)
+ (LIST 'LE '<=) (LIST 'GE '>=) (LIST 'SHOEEQ 'EQUAL)
+ (LIST 'SHOENE '/=) (LIST 'T 'T$)))
(|i| NIL))
(LOOP
(COND
@@ -232,26 +232,27 @@
(LET ((|bfVar#1|
(LIST (LIST '|absKind| 'CAR) (LIST '|absParms| 'CADR)
- (LIST '|absBody| 'CADDR) (LIST '|setName| 0) (LIST '|setLabel| 1)
- (LIST '|setLevel| 2) (LIST '|setType| 3) (LIST '|setVar| 4)
- (LIST '|setLeaf| 5) (LIST '|setDef| 6) (LIST '|aGeneral| 4)
- (LIST '|aMode| 1) (LIST '|aModeSet| 3) (LIST '|aTree| 0)
- (LIST '|aValue| 2) (LIST '|args| 'CDR) (LIST '|attributes| 'CADDR)
- (LIST '|cacheCount| 'CADDDDR) (LIST '|cacheName| 'CADR)
- (LIST '|cacheReset| 'CADDDR) (LIST '|cacheType| 'CADDR)
- (LIST '|env| 'CADDR) (LIST '|expr| 'CAR) (LIST 'CAR 'CAR)
- (LIST '|mmCondition| 'CAADR) (LIST '|mmDC| 'CAAR)
- (LIST '|mmImplementation| 'CADADR) (LIST '|mmSignature| 'CDAR)
- (LIST '|mmTarget| 'CADAR) (LIST '|mmSource| 'CDDAR)
- (LIST '|mapOpsig| 'CAR) (LIST '|mapOperation| 'CAAR)
- (LIST '|mapSignature| 'CADAR) (LIST '|mapTarget| 'CAADAR)
- (LIST '|mapSource| 'CDADAR) (LIST '|mapPredicate| 'CADR)
- (LIST '|mapImpl| 'CADDR) (LIST '|mapKind| 'CAADDR)
- (LIST '|mode| 'CADR) (LIST '|op| 'CAR) (LIST '|opcode| 'CADR)
- (LIST '|opSig| 'CADR) (LIST 'CDR 'CDR) (LIST '|sig| 'CDDR)
- (LIST '|source| 'CDR) (LIST '|streamCode| 'CADDDR)
- (LIST '|streamDef| 'CADDR) (LIST '|streamName| 'CADR)
- (LIST '|target| 'CAR)))
+ (LIST '|absBody| 'CADDR) (LIST '|loopBody| '|loopBody|)
+ (LIST '|loopExit| '|last|) (LIST '|setName| 0)
+ (LIST '|setLabel| 1) (LIST '|setLevel| 2) (LIST '|setType| 3)
+ (LIST '|setVar| 4) (LIST '|setLeaf| 5) (LIST '|setDef| 6)
+ (LIST '|aGeneral| 4) (LIST '|aMode| 1) (LIST '|aModeSet| 3)
+ (LIST '|aTree| 0) (LIST '|aValue| 2) (LIST '|args| 'CDR)
+ (LIST '|attributes| 'CADDR) (LIST '|cacheCount| 'CADDDDR)
+ (LIST '|cacheName| 'CADR) (LIST '|cacheReset| 'CADDDR)
+ (LIST '|cacheType| 'CADDR) (LIST '|env| 'CADDR)
+ (LIST '|expr| 'CAR) (LIST 'CAR 'CAR) (LIST '|mmCondition| 'CAADR)
+ (LIST '|mmDC| 'CAAR) (LIST '|mmImplementation| 'CADADR)
+ (LIST '|mmSignature| 'CDAR) (LIST '|mmTarget| 'CADAR)
+ (LIST '|mmSource| 'CDDAR) (LIST '|mapOpsig| 'CAR)
+ (LIST '|mapOperation| 'CAAR) (LIST '|mapSignature| 'CADAR)
+ (LIST '|mapTarget| 'CAADAR) (LIST '|mapSource| 'CDADAR)
+ (LIST '|mapPredicate| 'CADR) (LIST '|mapImpl| 'CADDR)
+ (LIST '|mapKind| 'CAADDR) (LIST '|mode| 'CADR) (LIST '|op| 'CAR)
+ (LIST '|opcode| 'CADR) (LIST '|opSig| 'CADR) (LIST 'CDR 'CDR)
+ (LIST '|sig| 'CDDR) (LIST '|source| 'CDR)
+ (LIST '|streamCode| 'CADDDR) (LIST '|streamDef| 'CADDR)
+ (LIST '|streamName| 'CADR) (LIST '|target| 'CAR)))
(|i| NIL))
(LOOP
(COND
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 77b29cb2..2adea400 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -323,7 +323,6 @@ for i in [ _
["MINUS", "-"] , _
["TIMES", "*"] , _
["POWER", "EXPT"] , _
- ['REM, 'REM],_
['QUO, 'TRUNCATE],_
["SLASH", "/"] , _
["LT", "<"], _
@@ -341,6 +340,8 @@ for i in [ _
["absKind", "CAR"] ,_
["absParms", "CADR"] ,_
["absBody", "CADDR"] ,_
+ ["loopBody", "loopBody"] ,_
+ ["loopExit", "last"] ,_
["setName", 0] , _
["setLabel", 1] , _
["setLevel", 2] , _
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 52593e5d..5ba81a1e 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -120,7 +120,7 @@ copyTree t ==
objectMember?(x,l) ==
repeat
l = nil => return false
- cons? l =>
+ l is [.,:.] =>
sameObject?(x,first l) => return true
l := rest l
return sameObject?(x,l)
@@ -128,7 +128,7 @@ objectMember?(x,l) ==
symbolMember?(s,l) ==
repeat
l = nil => return false
- cons? l =>
+ l is [.,:.] =>
symbolEq?(s,first l) => return true
l := rest l
return symbolEq?(s,l)
@@ -136,7 +136,7 @@ symbolMember?(s,l) ==
stringMember?(s,l) ==
repeat
l = nil => return false
- cons? l =>
+ l is [.,:.] =>
stringEq?(s,first l) => return true
l := rest l
return stringEq?(s,l)
@@ -144,7 +144,7 @@ stringMember?(s,l) ==
charMember?(c,l) ==
repeat
l = nil => return false
- cons? l =>
+ l is [.,:.] =>
charEq?(c,first l) => return true
l := rest l
return charEq?(c,l)
@@ -152,7 +152,7 @@ charMember?(c,l) ==
scalarMember?(s,l) ==
repeat
l = nil => return false
- cons? l =>
+ l is [.,:.] =>
scalarEq?(s,first l) => return true
l := rest l
return scalarEq?(s,l)
@@ -160,7 +160,7 @@ scalarMember?(s,l) ==
listMember?(x,l) ==
repeat
l = nil => return false
- cons? l =>
+ l is [.,:.] =>
listEq?(x,first l) => return true
l := rest l
return listEq?(x,l)
@@ -170,7 +170,7 @@ listMember?(x,l) ==
reverse l ==
r := nil
repeat
- cons? l =>
+ l is [.,:.] =>
r := [first l,:r]
l := rest l
return r
@@ -178,7 +178,7 @@ reverse l ==
reverse! l ==
l1 := nil
repeat
- cons? l =>
+ l is [.,:.] =>
l2 := rest l
l.rest := l1
l1 := l
@@ -188,17 +188,17 @@ reverse! l ==
--% return a pointer to the last cons-cell in the list `l'.
lastNode l ==
- while l is [.,:l'] and cons? l' repeat
+ while l is [.,:l'] and l' is [.,:.] repeat
l := l'
l
--% list copying
copyList l ==
- not cons? l => l
+ l isnt [.,:.] => l
l' := t := [first l]
repeat
l := rest l
- cons? l =>
+ l is [.,:.] =>
t.rest := [first l]
t := rest t
t.rest := l
@@ -232,7 +232,7 @@ objectAssoc(x,l) ==
substitute!(y,x,s) ==
s = nil => nil
sameObject?(x,s) => y
- if cons? s then
+ if s is [.,:.] then
s.first := substitute!(y,x,first s)
s.rest := substitute!(y,x,rest s)
s
@@ -240,7 +240,7 @@ substitute!(y,x,s) ==
substitute(y,x,s) ==
s = nil => nil
sameObject?(x,s) => y
- cons? s =>
+ s is [.,:.] =>
h := substitute(y,x,first s)
t := substitute(y,x,rest s)
sameObject?(h,first s) and sameObject?(t,rest s) => s
@@ -249,7 +249,7 @@ substitute(y,x,s) ==
applySubst(sl,t) ==
sl = nil => t
- cons? t =>
+ t is [.,:.] =>
hd := applySubst(sl,first t)
tl := applySubst(sl,rest t)
sameObject?(hd,first t) and sameObject?(tl,rest t) => t
@@ -259,7 +259,7 @@ applySubst(sl,t) ==
applySubst!(sl,t) ==
sl = nil => t
- cons? t =>
+ t is [.,:.] =>
hd := applySubst!(sl,first t)
tl := applySubst!(sl,rest t)
t.first := hd
@@ -309,7 +309,7 @@ removeSymbol(l,x) ==
before := nil
l' := l
repeat
- not cons? l' => return l
+ l' isnt [.,:.] => return l
[y,:l'] := l'
symbolEq?(x,y) => return append!(reverse! before,l')
before := [y,:before]
@@ -318,7 +318,7 @@ removeScalar(l,x) ==
before := nil
l' := l
repeat
- not cons? l' => return l
+ l' isnt [.,:.] => return l
[y,:l'] := l'
scalarEq?(x,y) => return append!(reverse! before,l')
before := [y,:before]
@@ -327,7 +327,7 @@ removeValue(l,x) ==
before := nil
l' := l
repeat
- not cons? l' => return l
+ l' isnt [.,:.] => return l
[y,:l'] := l'
valueEq?(x,y) => return append!(reverse! before,l')
before := [y,:before]
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 2157553b..5930d44f 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -279,7 +279,7 @@ osyscmd.$(FASLEXT): int-top.$(FASLEXT)
int-top.$(FASLEXT): incl.$(FASLEXT) i-toplev.$(FASLEXT) unlisp.$(FASLEXT)
i-toplev.$(FASLEXT): i-analy.$(FASLEXT)
i-syscmd.$(FASLEXT): i-object.$(FASLEXT)
-i-output.$(FASLEXT): sys-macros.$(FASLEXT)
+i-output.$(FASLEXT): sys-utility.$(FASLEXT) sys-macros.$(FASLEXT)
i-special.$(FASLEXT): i-analy.$(FASLEXT)
i-funsel.$(FASLEXT): i-coerfn.$(FASLEXT)
i-map.$(FASLEXT): i-object.$(FASLEXT)
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 880d088b..ef5b6a51 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -317,6 +317,8 @@ unnestWhen! x == f x where
x is ['%seq,:.] =>
for stmts in tails x.args repeat
stmts.first := f first stmts
+ x is ['%repeat,:.] =>
+ x.loopBody := unnestWhen! x.loopBody
x
++ Transform nested-to-tower.
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 20028fc4..421e9386 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -32,6 +32,7 @@
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+import sys_-utility
import sys_-macros
namespace BOOT
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index 11816e99..13768228 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -298,7 +298,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
newValueCode:= ["%LET",g,substitute(gIndex,sharpArg,
applySubst(pairList(rest $TriangleVariableList,gsList),body))]
['%bind,decomposeBindings,
- ['%repeat,["WHILE",true],["PROGN",endTest,advanceCode,
+ ['%repeat,["WHILE",'%true],["PROGN",endTest,advanceCode,
newValueCode,:rotateCode],voidValue()]]
fromScratchInit:=
[["%LET",gIndex,n],:[["%LET",g,x] for g in gsList for x in initCode]]
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index f9f7cbf8..96bd829b 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -406,6 +406,14 @@ displayTextFile f ==
stream ~= nil => closeStream stream
--%
+macro last x ==
+ lastNode(x).first
+
+--%
+macro loopBody x ==
+ take(-2,x).first
+
+--%
macro constructorDB ctor ==
property(ctor,'DATABASE)
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index e922e1de..e571a161 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -174,12 +174,6 @@
(defmacro lam (&rest body)
(list 'quote (*lam (copy-tree body))))
-(defmacro lastnode (l)
- `(last ,l))
-
-(defmacro lastpair (l)
- `(last ,l))
-
(defmacro lessp (&rest args)
`(< ,@args))
@@ -665,10 +659,6 @@
((and (atom item) (not (arrayp item))) (member item sequence))
(T (member item sequence :test #'equalp))))
-; 14.2 Accessing
-
-(defun |last| (x) (car (lastpair x)))
-
; 14.3 Searching
(DEFUN |assoc| (X Y)