aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-04-21 05:56:14 +0000
committerdos-reis <gdr@axiomatics.org>2011-04-21 05:56:14 +0000
commit97463cc77bbec1c33f46ceb44584a180264682c3 (patch)
tree61d9cf3e25771fbdd5de776ea989aff622684aa3 /src/boot
parent1ca37b944b566ef3f0479d4c2fe6895e9fbd3785 (diff)
downloadopen-axiom-97463cc77bbec1c33f46ceb44584a180264682c3.tar.gz
* boot/tokens.boot: Don't rename nreverse.
* boot/utility.boot (reverse!): Define. * boot/parser.boot: Use reverse! instead of NREVERSE. * boot/ast.boot: Generate reverse! forms instead of NREVERSE.
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/Makefile.in2
-rw-r--r--src/boot/ast.boot18
-rw-r--r--src/boot/parser.boot14
-rw-r--r--src/boot/strap/ast.clisp103
-rw-r--r--src/boot/strap/parser.clisp14
-rw-r--r--src/boot/strap/tokens.clisp9
-rw-r--r--src/boot/strap/translator.clisp15
-rw-r--r--src/boot/strap/utility.clisp13
-rw-r--r--src/boot/tokens.boot3
-rw-r--r--src/boot/utility.boot17
10 files changed, 118 insertions, 90 deletions
diff --git a/src/boot/Makefile.in b/src/boot/Makefile.in
index c223c0b4..dac491f3 100644
--- a/src/boot/Makefile.in
+++ b/src/boot/Makefile.in
@@ -193,7 +193,7 @@ stage2/%.clisp: %.boot stage1/stamp stage2/.started
%/utility.$(LNKEXT): %/utility.clisp %/initial-env.$(LNKEXT)
$(DRIVER) --execpath=$(AXIOM_LOCAL_LISP) --output=$@ --compile --load-directory=$* $<
-%/tokens.$(LNKEXT): %/tokens.clisp %/initial-env.$(LNKEXT)
+%/tokens.$(LNKEXT): %/tokens.clisp %/utility.$(LNKEXT)
$(DRIVER) --execpath=$(AXIOM_LOCAL_LISP) --output=$@ --compile --load-directory=$* $<
%/includer.$(LNKEXT): %/includer.clisp %/tokens.$(LNKEXT)
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 3e0fdc5d..8913772f 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -394,13 +394,13 @@ bf0COLLECT(y,itl) ==
bf0APPEND(y,itl)==
g := bfGenSymbol()
body := ['SETQ,g,['APPEND,['REVERSE,y],g]]
- extrait := [[[g],[nil],[],[],[],[['NREVERSE,g]]]]
+ extrait := [[[g],[nil],[],[],[],[['reverse!,g]]]]
bfLp2(extrait,itl,body)
bfListReduce(op,y,itl)==
g := bfGenSymbol()
body := ['SETQ,g,[op,y,g]]
- extrait := [[[g],[nil],[],[],[],[['NREVERSE,g]]]]
+ extrait := [[[g],[nil],[],[],[],[['reverse!,g]]]]
bfLp2(extrait,itl,body)
bfLp1(iters,body)==
@@ -580,8 +580,8 @@ bfLET2(lhs,rhs) ==
var1 = "DOT" => [['L%T,g,rev],:l2]
last l2 is ['L%T, =var1, val1] =>
[['L%T,g,rev],:REVERSE rest REVERSE l2,
- bfLetForm(var1,['NREVERSE,val1])]
- [['L%T,g,rev],:l2,bfLetForm(var1,['NREVERSE,var1])]
+ bfLetForm(var1,['reverse!,val1])]
+ [['L%T,g,rev],:l2,bfLetForm(var1,['reverse!,var1])]
lhs is ["EQUAL",var1] => ['COND,[bfQ(var1,rhs),var1]]
-- The original expression may be one that involves literals as
-- sub-patterns, e.g.
@@ -680,7 +680,7 @@ bfIS1(lhs,rhs) ==
l2 := bfIS1(g,patrev)
if cons? l2 and atom first l2 then l2 := [l2,:nil]
a = "DOT" => bfAND [rev,:l2]
- bfAND [rev,:l2,['PROGN,bfLetForm(a,['NREVERSE,a]),'T]]
+ bfAND [rev,:l2,['PROGN,bfLetForm(a,['reverse!,a]),'T]]
bpSpecificErrorHere '"bad IS code is generated"
bpTrap()
@@ -1185,7 +1185,7 @@ bfHandlers(n,e,hs) == main(n,e,hs,nil) where
main(n,e,hs,xs) ==
hs = nil =>
["COND",
- :nreverse
+ :reverse!
[[true,["THROW",KEYWORD::OPEN_-AXIOM_-CATCH_-POINT,n]],:xs]]
hs is [['%Catch,['%Signature,v,t],s],:hs'] =>
t :=
@@ -1521,7 +1521,7 @@ genECLnativeTranslation(op,s,t,op') ==
args := reverse args
rettype := nativeReturnType t
[["DEFUN",op, args,
- [bfColonColon("FFI","C-INLINE"),args, nreverse argtypes,
+ [bfColonColon("FFI","C-INLINE"),args, reverse! argtypes,
rettype, callTemplate(op',#args,s),
KEYWORD::ONE_-LINER, true]]] where
callTemplate(op,n,s) ==
@@ -1639,10 +1639,10 @@ genSBCLnativeTranslation(op,s,t,op') ==
[makeSymbol('"EXTERN-ALIEN",'"SB-ALIEN"), op',
["FUNCTION",rettype,:argtypes]], :args]]]
[["DEFUN",op,args,
- [bfColonColon("SB-SYS","WITH-PINNED-OBJECTS"), nreverse unstableArgs,
+ [bfColonColon("SB-SYS","WITH-PINNED-OBJECTS"), reverse! unstableArgs,
[makeSymbol('"ALIEN-FUNCALL",'"SB-ALIEN"),
[makeSymbol('"EXTERN-ALIEN",'"SB-ALIEN"), op',
- ["FUNCTION",rettype,:argtypes]], :nreverse newArgs]]]]
+ ["FUNCTION",rettype,:argtypes]], :reverse! newArgs]]]]
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 7bf4bef4..e90d057e 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -167,7 +167,7 @@ bpListof(f,str1,g)==
a:=$stack
$stack:=nil
while bpEqKey str1 and (apply(f,nil) or bpTrap()) repeat 0
- $stack:=[NREVERSE $stack,:a]
+ $stack:=[reverse! $stack,:a]
bpPush FUNCALL(g, [bpPop3(),bpPop2(),:bpPop1()])
true
false
@@ -180,7 +180,7 @@ bpListofFun(f,h,g)==
a:=$stack
$stack:=nil
while apply(h,nil) and (apply(f,nil) or bpTrap()) repeat 0
- $stack:=[NREVERSE $stack,:a]
+ $stack:=[reverse! $stack,:a]
bpPush FUNCALL(g, [bpPop3(),bpPop2(),:bpPop1()])
true
false
@@ -191,7 +191,7 @@ bpList(f,str1)==
a:=$stack
$stack:=nil
while bpEqKey str1 and (apply(f,nil) or bpTrap()) repeat 0
- $stack:=[NREVERSE $stack,:a]
+ $stack:=[reverse! $stack,:a]
bpPush [bpPop3(),bpPop2(),:bpPop1()]
bpPush [bpPop1()]
bpPush nil
@@ -201,7 +201,7 @@ bpOneOrMore f==
a:=$stack
$stack:=nil
while apply(f,nil) repeat 0
- $stack:=[NREVERSE $stack,:a]
+ $stack:=[reverse! $stack,:a]
bpPush [bpPop2(),:bpPop1()]
false
@@ -310,7 +310,7 @@ bpListAndRecover(f)==
c := $inputStream
b := [bpPop1(),:b]
$stack := a
- bpPush NREVERSE b
+ bpPush reverse! b
bpMoveTo n==
$inputStream = nil => true
@@ -717,9 +717,9 @@ bpTry() ==
cs := [bpPop1(),:cs]
bpHandler "FINALLY" =>
bpFinally() and
- bpPush bfTry(bpPop2(),nreverse [bpPop1(),:cs])
+ bpPush bfTry(bpPop2(),reverse! [bpPop1(),:cs])
cs = nil => bpTrap() -- missing handlers
- bpPush bfTry(bpPop1(),nreverse cs)
+ bpPush bfTry(bpPop1(),reverse! cs)
nil
bpCatchItem() ==
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 95ca0d0d..0f94abac 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -434,7 +434,7 @@
(PROGN (SETQ |i| (CAR |bfVar#89|)) NIL)
(ATOM |bfVar#90|)
(PROGN (SETQ |j| (CAR |bfVar#90|)) NIL))
- (RETURN (NREVERSE |bfVar#91|)))
+ (RETURN (|reverse!| |bfVar#91|)))
(T (SETQ |bfVar#91|
(CONS (APPEND |i| |j|) |bfVar#91|))))
(SETQ |bfVar#89| (CDR |bfVar#89|))
@@ -519,7 +519,7 @@
(LIST 'SETQ |g| (LIST 'APPEND (LIST 'REVERSE |y|) |g|)))
(SETQ |extrait|
(LIST (LIST (LIST |g|) (LIST NIL) NIL NIL NIL
- (LIST (LIST 'NREVERSE |g|)))))
+ (LIST (LIST '|reverse!| |g|)))))
(|bfLp2| |extrait| |itl| |body|)))))
(DEFUN |bfListReduce| (|op| |y| |itl|)
@@ -530,7 +530,7 @@
(SETQ |body| (LIST 'SETQ |g| (LIST |op| |y| |g|)))
(SETQ |extrait|
(LIST (LIST (LIST |g|) (LIST NIL) NIL NIL NIL
- (LIST (LIST 'NREVERSE |g|)))))
+ (LIST (LIST '|reverse!| |g|)))))
(|bfLp2| |extrait| |itl| |body|)))))
(DEFUN |bfLp1| (|iters| |body|)
@@ -573,7 +573,7 @@
(PROGN
(SETQ |i| (CAR |bfVar#93|))
NIL))
- (RETURN (NREVERSE |bfVar#94|)))
+ (RETURN (|reverse!| |bfVar#94|)))
(T
(SETQ |bfVar#94|
(CONS (LIST |v| |i|) |bfVar#94|))))
@@ -874,12 +874,12 @@
(CONS (LIST 'L%T |g| |rev|)
(APPEND (REVERSE (CDR (REVERSE |l2|)))
(CONS (|bfLetForm| |var1|
- (LIST 'NREVERSE |val1|))
+ (LIST '|reverse!| |val1|))
NIL))))
(T (CONS (LIST 'L%T |g| |rev|)
(APPEND |l2|
(CONS (|bfLetForm| |var1|
- (LIST 'NREVERSE |var1|))
+ (LIST '|reverse!| |var1|))
NIL))))))
((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'EQUAL)
(PROGN
@@ -1079,7 +1079,7 @@
(CONS
(LIST 'PROGN
(|bfLetForm| |a|
- (LIST 'NREVERSE |a|))
+ (LIST '|reverse!| |a|))
'T)
NIL)))))))
(T (|bpSpecificErrorHere| "bad IS code is generated")
@@ -1220,7 +1220,7 @@
(COND
((OR (ATOM |bfVar#97|)
(PROGN (SETQ |c| (CAR |bfVar#97|)) NIL))
- (RETURN (NREVERSE |bfVar#98|)))
+ (RETURN (|reverse!| |bfVar#98|)))
(T (SETQ |bfVar#98|
(APPEND (REVERSE (|bfFlatten| 'OR |c|))
|bfVar#98|))))
@@ -1236,7 +1236,7 @@
(COND
((OR (ATOM |bfVar#99|)
(PROGN (SETQ |c| (CAR |bfVar#99|)) NIL))
- (RETURN (NREVERSE |bfVar#100|)))
+ (RETURN (|reverse!| |bfVar#100|)))
(T (SETQ |bfVar#100|
(APPEND (REVERSE (|bfFlatten| 'AND |c|))
|bfVar#100|))))
@@ -1311,7 +1311,7 @@
(PROGN (SETQ |i| (CAR |bfVar#101|)) NIL)
(ATOM |bfVar#102|)
(PROGN (SETQ |j| (CAR |bfVar#102|)) NIL))
- (RETURN (NREVERSE |bfVar#103|)))
+ (RETURN (|reverse!| |bfVar#103|)))
(T (SETQ |bfVar#103|
(CONS (CONS |i| |j|) |bfVar#103|))))
(SETQ |bfVar#101| (CDR |bfVar#101|))
@@ -1326,7 +1326,7 @@
(PROGN (SETQ |i| (CAR |bfVar#104|)) NIL)
(ATOM |bfVar#105|)
(PROGN (SETQ |j| (CAR |bfVar#105|)) NIL))
- (RETURN (NREVERSE |bfVar#106|)))
+ (RETURN (|reverse!| |bfVar#106|)))
(T (SETQ |bfVar#106|
(CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|)
|bfVar#106|))))
@@ -1343,7 +1343,7 @@
(COND
((OR (ATOM |bfVar#107|)
(PROGN (SETQ |d| (CAR |bfVar#107|)) NIL))
- (RETURN (NREVERSE |bfVar#108|)))
+ (RETURN (|reverse!| |bfVar#108|)))
(T (SETQ |bfVar#108|
(APPEND (REVERSE
(|shoeComps| (|bfDef1| |d|)))
@@ -1423,7 +1423,7 @@
(COND
((OR (ATOM |bfVar#110|)
(PROGN (SETQ |d| (CAR |bfVar#110|)) NIL))
- (RETURN (NREVERSE |bfVar#111|)))
+ (RETURN (|reverse!| |bfVar#111|)))
(T (SETQ |bfVar#111|
(APPEND (REVERSE
(|shoeComps| (|bfDef1| |d|)))
@@ -1436,7 +1436,7 @@
(COND
((OR (ATOM |bfVar#112|)
(PROGN (SETQ |def| (CAR |bfVar#112|)) NIL))
- (RETURN (NREVERSE |bfVar#113|)))
+ (RETURN (|reverse!| |bfVar#113|)))
(T (SETQ |bfVar#113| (CONS (|shoeComp| |def|) |bfVar#113|))))
(SETQ |bfVar#112| (CDR |bfVar#112|)))))
@@ -1602,7 +1602,7 @@
((NULL |b|) (LIST (LIST 'PROG |v|)))
(T (SETQ |LETTMP#1| (REVERSE |b|))
(SETQ |blast| (CAR |LETTMP#1|))
- (SETQ |blist| (NREVERSE (CDR |LETTMP#1|)))
+ (SETQ |blist| (|reverse!| (CDR |LETTMP#1|)))
(LIST (CONS 'PROG
(CONS |v|
(APPEND |blist|
@@ -1710,7 +1710,7 @@
(PROGN
(SETQ |y| (CAR |bfVar#117|))
NIL))
- (RETURN (NREVERSE |bfVar#118|)))
+ (RETURN (|reverse!| |bfVar#118|)))
(T (AND (NOT (MEMQ |y| |newbindings|))
(SETQ |bfVar#118|
(CONS |y| |bfVar#118|)))))
@@ -1808,7 +1808,7 @@
(LET ((|bfVar#119| NIL) (|c| |l|))
(LOOP
(COND
- ((ATOM |c|) (RETURN (NREVERSE |bfVar#119|)))
+ ((ATOM |c|) (RETURN (|reverse!| |bfVar#119|)))
(T (SETQ |bfVar#119|
(APPEND (REVERSE (|bfFlattenSeq| |c|))
|bfVar#119|))))
@@ -1835,7 +1835,7 @@
(COND
((OR (ATOM |bfVar#120|)
(PROGN (SETQ |i| (CAR |bfVar#120|)) NIL))
- (RETURN (NREVERSE |bfVar#121|)))
+ (RETURN (|reverse!| |bfVar#121|)))
(T (AND (NOT (ATOM |i|))
(SETQ |bfVar#121|
(CONS |i| |bfVar#121|)))))
@@ -1876,7 +1876,7 @@
(NULL (CDR |ISTMP#5|))
(EQ (CAR |ISTMP#5|) 'T)))))))
(PROGN (SETQ |conds| (CDR |ISTMP#2|)) T)
- (PROGN (SETQ |conds| (NREVERSE |conds|)) T))))
+ (PROGN (SETQ |conds| (|reverse!| |conds|)) T))))
(CONS (CONS 'AND |conds|)
(|bfWashCONDBranchBody| (|bfMKPROGN| (LIST |stmt| |b|)))))
(T (CONS |a| (|bfWashCONDBranchBody| |b|)))))))
@@ -1926,7 +1926,7 @@
(SETQ |b|
(CAR |ISTMP#5|))
T))))))))))))))
- (RETURN (NREVERSE |bfVar#123|)))
+ (RETURN (|reverse!| |bfVar#123|)))
(T (SETQ |bfVar#123|
(CONS (|bfAlternative| |a| |b|)
|bfVar#123|))))
@@ -1967,7 +1967,7 @@
(COND
((OR (ATOM |bfVar#124|)
(PROGN (SETQ |d| (CAR |bfVar#124|)) NIL))
- (RETURN (NREVERSE |bfVar#125|)))
+ (RETURN (|reverse!| |bfVar#125|)))
(T (SETQ |bfVar#125|
(CONS (LIST (CAR |d|) (CADR |d|)
(|bfSUBLIS| |opassoc| (CADDR |d|)))
@@ -2062,7 +2062,7 @@
(COND
((OR (ATOM |bfVar#126|)
(PROGN (SETQ |i| (CAR |bfVar#126|)) NIL))
- (RETURN (NREVERSE |bfVar#127|)))
+ (RETURN (|reverse!| |bfVar#127|)))
(T (SETQ |bfVar#127|
(CONS (|bfGenSymbol|) |bfVar#127|))))
(SETQ |bfVar#126| (CDR |bfVar#126|)))))
@@ -2097,7 +2097,7 @@
(COND
((OR (ATOM |bfVar#129|)
(PROGN (SETQ |bfVar#128| (CAR |bfVar#129|)) NIL))
- (RETURN (NREVERSE |bfVar#130|)))
+ (RETURN (|reverse!| |bfVar#130|)))
(T (AND (CONSP |bfVar#128|)
(PROGN
(SETQ |i| (CAR |bfVar#128|))
@@ -2124,7 +2124,7 @@
(COND
((OR (ATOM |bfVar#131|)
(PROGN (SETQ |i| (CAR |bfVar#131|)) NIL))
- (RETURN (NREVERSE |bfVar#132|)))
+ (RETURN (|reverse!| |bfVar#132|)))
(T (AND (NOT (EQ |i| 'DOT))
(SETQ |bfVar#132|
(CONS
@@ -2156,10 +2156,10 @@
(COND
((NULL |hs|)
(CONS 'COND
- (NREVERSE (CONS (LIST T
- (LIST 'THROW
- :OPEN-AXIOM-CATCH-POINT |n|))
- |xs|))))
+ (|reverse!| (CONS (LIST T
+ (LIST 'THROW
+ :OPEN-AXIOM-CATCH-POINT |n|))
+ |xs|))))
((AND (CONSP |hs|)
(PROGN
(SETQ |ISTMP#1| (CAR |hs|))
@@ -2231,7 +2231,7 @@
(SETQ |f| (CAR |ISTMP#1|))
(SETQ |cs'| (CDR |ISTMP#1|))
T)
- (PROGN (SETQ |cs'| (NREVERSE |cs'|)) T) (CONSP |f|)
+ (PROGN (SETQ |cs'| (|reverse!| |cs'|)) T) (CONSP |f|)
(EQ (CAR |f|) '|%Finally|)
(PROGN
(SETQ |ISTMP#1| (CDR |f|))
@@ -2271,7 +2271,7 @@
(COND
((OR (ATOM |bfVar#133|)
(PROGN (SETQ |t| (CAR |bfVar#133|)) NIL))
- (RETURN (NREVERSE |bfVar#134|)))
+ (RETURN (|reverse!| |bfVar#134|)))
(T (SETQ |bfVar#134|
(CONS (|backquote| |t| |params|)
|bfVar#134|))))
@@ -2481,7 +2481,7 @@
(COND
((OR (ATOM |bfVar#135|)
(PROGN (SETQ |x| (CAR |bfVar#135|)) NIL))
- (RETURN (NREVERSE |bfVar#136|)))
+ (RETURN (|reverse!| |bfVar#136|)))
(T (SETQ |bfVar#136|
(CONS (|nativeArgumentType| |x|)
|bfVar#136|))))
@@ -2508,7 +2508,7 @@
(LOOP
(COND
((> |i| |bfVar#144|)
- (RETURN (NREVERSE |bfVar#145|)))
+ (RETURN (|reverse!| |bfVar#145|)))
(T (SETQ |bfVar#145|
(CONS (|genGCLnativeTranslation,mkCArgName|
|i|)
@@ -2531,7 +2531,8 @@
((OR (ATOM |x|)
(ATOM |a|))
(RETURN
- (NREVERSE |bfVar#139|)))
+ (|reverse!|
+ |bfVar#139|)))
(T
(SETQ |bfVar#139|
(CONS
@@ -2557,7 +2558,7 @@
((OR (ATOM |x|)
(ATOM |a|))
(RETURN
- (NREVERSE
+ (|reverse!|
|bfVar#140|)))
(T
(SETQ |bfVar#140|
@@ -2653,7 +2654,7 @@
(SETQ |rettype| (|nativeReturnType| |t|))
(LIST (LIST 'DEFUN |op| |args|
(LIST (|bfColonColon| 'FFI 'C-INLINE) |args|
- (NREVERSE |argtypes|) |rettype|
+ (|reverse!| |argtypes|) |rettype|
(|genECLnativeTranslation,callTemplate| |op'|
(LENGTH |args|) |s|)
:ONE-LINER T)))))))
@@ -2673,7 +2674,8 @@
(PROGN
(SETQ |x| (CAR |bfVar#148|))
NIL))
- (RETURN (NREVERSE |bfVar#149|)))
+ (RETURN
+ (|reverse!| |bfVar#149|)))
(T
(SETQ |bfVar#149|
(CONS
@@ -2736,7 +2738,7 @@
(COND
((OR (ATOM |bfVar#153|)
(PROGN (SETQ |x| (CAR |bfVar#153|)) NIL))
- (RETURN (NREVERSE |bfVar#154|)))
+ (RETURN (|reverse!| |bfVar#154|)))
(T (SETQ |bfVar#154|
(CONS (|nativeArgumentType| |x|)
|bfVar#154|))))
@@ -2748,7 +2750,7 @@
(COND
((OR (ATOM |bfVar#155|)
(PROGN (SETQ |x| (CAR |bfVar#155|)) NIL))
- (RETURN (NREVERSE |bfVar#156|)))
+ (RETURN (|reverse!| |bfVar#156|)))
(T (SETQ |bfVar#156|
(CONS (GENSYM "parm") |bfVar#156|))))
(SETQ |bfVar#155| (CDR |bfVar#155|)))))
@@ -2790,7 +2792,7 @@
(PROGN
(SETQ |a| (CAR |bfVar#161|))
NIL))
- (RETURN (NREVERSE |bfVar#162|)))
+ (RETURN (|reverse!| |bfVar#162|)))
(T (SETQ |bfVar#162|
(CONS (LIST |a| |x|) |bfVar#162|))))
(SETQ |bfVar#160| (CDR |bfVar#160|))
@@ -2812,7 +2814,7 @@
(SETQ |bfVar#163|
(CAR |bfVar#164|))
NIL))
- (RETURN (NREVERSE |bfVar#165|)))
+ (RETURN (|reverse!| |bfVar#165|)))
(T (AND (CONSP |bfVar#163|)
(PROGN
(SETQ |a| (CAR |bfVar#163|))
@@ -2840,7 +2842,8 @@
(PROGN
(SETQ |p| (CAR |bfVar#166|))
NIL))
- (RETURN (NREVERSE |bfVar#167|)))
+ (RETURN
+ (|reverse!| |bfVar#167|)))
(T
(SETQ |bfVar#167|
(CONS
@@ -2861,7 +2864,7 @@
(SETQ |p| (CAR |bfVar#168|))
NIL))
(RETURN
- (NREVERSE |bfVar#169|)))
+ (|reverse!| |bfVar#169|)))
(T
(AND
(NOT
@@ -2951,7 +2954,7 @@
(COND
((OR (ATOM |bfVar#173|)
(PROGN (SETQ |x| (CAR |bfVar#173|)) NIL))
- (RETURN (NREVERSE |bfVar#174|)))
+ (RETURN (|reverse!| |bfVar#174|)))
(T (SETQ |bfVar#174|
(CONS (|nativeArgumentType| |x|)
|bfVar#174|))))
@@ -2962,7 +2965,7 @@
(COND
((OR (ATOM |bfVar#175|)
(PROGN (SETQ |x| (CAR |bfVar#175|)) NIL))
- (RETURN (NREVERSE |bfVar#176|)))
+ (RETURN (|reverse!| |bfVar#176|)))
(T (SETQ |bfVar#176| (CONS (GENSYM) |bfVar#176|))))
(SETQ |bfVar#175| (CDR |bfVar#175|)))))
(SETQ |unstableArgs| NIL)
@@ -3002,7 +3005,7 @@
(T (LIST (LIST 'DEFUN |op| |args|
(LIST (|bfColonColon| 'SB-SYS
'WITH-PINNED-OBJECTS)
- (NREVERSE |unstableArgs|)
+ (|reverse!| |unstableArgs|)
(CONS (INTERN "ALIEN-FUNCALL"
"SB-ALIEN")
(CONS
@@ -3012,7 +3015,7 @@
|op'|
(CONS 'FUNCTION
(CONS |rettype| |argtypes|)))
- (NREVERSE |newArgs|))))))))))))
+ (|reverse!| |newArgs|))))))))))))
(DEFUN |genCLOZUREnativeTranslation| (|op| |s| |t| |op'|)
(PROG (|call| |p'| |ISTMP#3| |ISTMP#2| |ISTMP#1| |aryPairs|
@@ -3026,7 +3029,7 @@
(COND
((OR (ATOM |bfVar#179|)
(PROGN (SETQ |x| (CAR |bfVar#179|)) NIL))
- (RETURN (NREVERSE |bfVar#180|)))
+ (RETURN (|reverse!| |bfVar#180|)))
(T (SETQ |bfVar#180|
(CONS (|nativeArgumentType| |x|)
|bfVar#180|))))
@@ -3037,7 +3040,7 @@
(COND
((OR (ATOM |bfVar#181|)
(PROGN (SETQ |x| (CAR |bfVar#181|)) NIL))
- (RETURN (NREVERSE |bfVar#182|)))
+ (RETURN (|reverse!| |bfVar#182|)))
(T (SETQ |bfVar#182|
(CONS (GENSYM "parm") |bfVar#182|))))
(SETQ |bfVar#181| (CDR |bfVar#181|)))))
@@ -3096,7 +3099,7 @@
(CAR |bfVar#186|))
NIL))
(RETURN
- (NREVERSE |bfVar#187|)))
+ (|reverse!| |bfVar#187|)))
(T
(SETQ |bfVar#187|
(APPEND
@@ -3143,7 +3146,7 @@
(PROGN
(SETQ |arg| (CAR |bfVar#189|))
NIL))
- (RETURN (NREVERSE |bfVar#190|)))
+ (RETURN (|reverse!| |bfVar#190|)))
(T (SETQ |bfVar#190|
(CONS
(LIST (CDR |arg|) (CAR |arg|))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index b3ef4b0e..a8a0b811 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -189,7 +189,7 @@
(OR (APPLY |f| NIL) (|bpTrap|))))
(RETURN NIL))
(T 0)))
- (SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
+ (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
(|bpPush|
(FUNCALL |g|
(CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
@@ -211,7 +211,7 @@
(OR (APPLY |f| NIL) (|bpTrap|))))
(RETURN NIL))
(T 0)))
- (SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
+ (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
(|bpPush|
(FUNCALL |g|
(CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
@@ -233,7 +233,7 @@
(OR (APPLY |f| NIL) (|bpTrap|))))
(RETURN NIL))
(T 0)))
- (SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
+ (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
(|bpPush| (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|)))))
(T (|bpPush| (LIST (|bpPop1|))))))
(T (|bpPush| NIL))))))
@@ -245,7 +245,7 @@
(COND
((APPLY |f| NIL) (SETQ |a| |$stack|) (SETQ |$stack| NIL)
(LOOP (COND ((NOT (APPLY |f| NIL)) (RETURN NIL)) (T 0)))
- (SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
+ (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
(|bpPush| (CONS (|bpPop2|) (|bpPop1|))))
(T NIL)))))
@@ -388,7 +388,7 @@
(T (|bpNext|) (SETQ |c| |$inputStream|)))))
(SETQ |b| (CONS (|bpPop1|) |b|))))))
(SETQ |$stack| |a|)
- (|bpPush| (NREVERSE |b|))))))
+ (|bpPush| (|reverse!| |b|))))))
(DEFUN |bpMoveTo| (|n|)
(DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$inputStream|))
@@ -783,9 +783,9 @@
(AND (|bpFinally|)
(|bpPush|
(|bfTry| (|bpPop2|)
- (NREVERSE (CONS (|bpPop1|) |cs|))))))
+ (|reverse!| (CONS (|bpPop1|) |cs|))))))
((NULL |cs|) (|bpTrap|))
- (T (|bpPush| (|bfTry| (|bpPop1|) (NREVERSE |cs|))))))
+ (T (|bpPush| (|bfTry| (|bpPop1|) (|reverse!| |cs|))))))
(T NIL)))))
(DEFUN |bpCatchItem| ()
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 7ec5fb63..c4c075ce 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -1,5 +1,5 @@
(PROCLAIM '(OPTIMIZE SPEED))
-(IMPORT-MODULE "initial-env")
+(IMPORT-MODULE "utility")
(IN-PACKAGE "BOOTTRAN")
@@ -228,10 +228,9 @@
(LIST '|nconc| 'NCONC)
(LIST '|newString| 'MAKE-STRING)
(LIST '|newVector| 'MAKE-ARRAY) (LIST '|nil| NIL)
- (LIST '|not| 'NOT) (LIST '|nreverse| 'NREVERSE)
- (LIST '|null| 'NULL) (LIST '|or| 'OR)
- (LIST '|otherwise| 'T) (LIST '|property| 'GET)
- (LIST '|readByte| 'READ-BYTE)
+ (LIST '|not| 'NOT) (LIST '|null| 'NULL)
+ (LIST '|or| 'OR) (LIST '|otherwise| 'T)
+ (LIST '|property| 'GET) (LIST '|readByte| 'READ-BYTE)
(LIST '|readInteger| 'PARSE-INTEGER)
(LIST '|readLine| 'READ-LINE)
(LIST '|readLispFromString| 'READ-FROM-STRING)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index f7dbcb13..5aff56f2 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -49,7 +49,8 @@
(CAR |bfVar#1|))
NIL))
(RETURN
- (NREVERSE |bfVar#2|)))
+ (|reverse!|
+ |bfVar#2|)))
(T
(SETQ |bfVar#2|
(CONS (CADR |d|)
@@ -69,7 +70,7 @@
(CAR |bfVar#3|))
NIL))
(RETURN
- (NREVERSE |bfVar#4|)))
+ (|reverse!| |bfVar#4|)))
(T
(SETQ |bfVar#4|
(CONS
@@ -623,7 +624,7 @@
(CAR |bfVar#10|))
NIL))
(RETURN
- (NREVERSE |bfVar#11|)))
+ (|reverse!| |bfVar#11|)))
(T
(SETQ |bfVar#11|
(CONS
@@ -708,7 +709,7 @@
(PROGN
(SETQ |alt| (CAR |bfVar#12|))
NIL))
- (RETURN (NREVERSE |bfVar#13|)))
+ (RETURN (|reverse!| |bfVar#13|)))
(T (SETQ |bfVar#13|
(CONS (|bfCreateDef| |alt|)
|bfVar#13|))))
@@ -790,7 +791,7 @@
(COND
((OR (ATOM |bfVar#14|)
(PROGN (SETQ |i| (CAR |bfVar#14|)) NIL))
- (RETURN (NREVERSE |bfVar#15|)))
+ (RETURN (|reverse!| |bfVar#15|)))
(T (AND (NOT (GETHASH |i| |$bootUsed|))
(SETQ |bfVar#15| (CONS |i| |bfVar#15|)))))
(SETQ |bfVar#14| (CDR |bfVar#14|)))))
@@ -807,7 +808,7 @@
(COND
((OR (ATOM |bfVar#16|)
(PROGN (SETQ |i| (CAR |bfVar#16|)) NIL))
- (RETURN (NREVERSE |bfVar#17|)))
+ (RETURN (|reverse!| |bfVar#17|)))
(T (AND (NOT (GETHASH |i| |$bootDefined|))
(SETQ |bfVar#17| (CONS |i| |bfVar#17|)))))
(SETQ |bfVar#16| (CDR |bfVar#16|)))))
@@ -1097,7 +1098,7 @@
(PROGN
(SETQ |line| (CAR |bfVar#24|))
NIL))
- (RETURN (NREVERSE |bfVar#25|)))
+ (RETURN (|reverse!| |bfVar#25|)))
(T (SETQ |bfVar#25|
(CONS (CAR |line|) |bfVar#25|))))
(SETQ |bfVar#24| (CDR |bfVar#24|)))))
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index dac91a2b..60df1f22 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -6,7 +6,7 @@
(PROVIDE "utility")
(EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?|
- |scalarMember?| |listMember?|))
+ |scalarMember?| |listMember?| |reverse!|))
(DEFUN |objectMember?| (|x| |l|)
(COND
@@ -62,3 +62,14 @@
(T (SETQ |l| (CDR |l|)))))
(T (RETURN (EQUAL |x| |l|))))))
+(DEFUN |reverse!| (|l|)
+ (PROG (|l2| |l1|)
+ (RETURN
+ (PROGN
+ (SETQ |l1| NIL)
+ (LOOP
+ (COND
+ ((CONSP |l|) (SETQ |l2| (CDR |l|)) (RPLACD |l| |l1|)
+ (SETQ |l1| |l|) (SETQ |l| |l2|))
+ (T (RETURN |l1|))))))))
+
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index f87da75f..fb94ff87 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -32,7 +32,7 @@
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--
-import initial_-env
+import utility
namespace BOOTTRAN
module tokens
@@ -285,7 +285,6 @@ for i in [ _
["newVector", "MAKE-ARRAY"], _
["nil" ,NIL ] , _
["not", "NOT"] , _
- ["nreverse", "NREVERSE"] , _
["null", "NULL"] , _
["or", "OR"] , _
["otherwise", "T"] , _
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 78e01a97..0ce3362a 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -33,7 +33,9 @@
import initial_-env
namespace BOOTTRAN
module utility (objectMember?, symbolMember?, stringMember?,
- charMember?, scalarMember?, listMember?)
+ charMember?, scalarMember?, listMember?, reverse!)
+
+--% membership operators
objectMember?(x,l) ==
cons? l => sameObject?(x,first l) or objectMember?(x,rest l)
@@ -78,3 +80,16 @@ listMember?(x,l) ==
listEq?(x,first l) => return true
l := rest l
return listEq?(x,l)
+
+--% list reversal
+
+reverse! l ==
+ l1 := nil
+ repeat
+ cons? l =>
+ l2 := rest l
+ l.rest := l1
+ l1 := l
+ l := l2
+ return l1
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 05:39:40 +0000