aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/ast.boot10
-rw-r--r--src/boot/strap/ast.clisp31
-rw-r--r--src/boot/strap/tokens.clisp6
-rw-r--r--src/boot/strap/utility.clisp23
-rw-r--r--src/boot/tokens.boot1
-rw-r--r--src/boot/utility.boot19
6 files changed, 58 insertions, 32 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 8913772f..e58179a2 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -393,7 +393,7 @@ bf0COLLECT(y,itl) ==
bf0APPEND(y,itl)==
g := bfGenSymbol()
- body := ['SETQ,g,['APPEND,['REVERSE,y],g]]
+ body := ['SETQ,g,['APPEND,['reverse,y],g]]
extrait := [[[g],[nil],[],[],[],[['reverse!,g]]]]
bfLp2(extrait,itl,body)
@@ -572,14 +572,14 @@ bfLET2(lhs,rhs) ==
[:l1,:l2]
lhs is ['APPEND,var1,var2] =>
patrev := bfISReverse(var2,var1)
- rev := ['REVERSE,rhs]
+ rev := ['reverse,rhs]
g := makeSymbol strconc('"LETTMP#", toString $letGenVarCounter)
$letGenVarCounter := $letGenVarCounter + 1
l2 := bfLET2(patrev,g)
if cons? l2 and atom first l2 then l2 := [l2,:nil]
var1 = "DOT" => [['L%T,g,rev],:l2]
last l2 is ['L%T, =var1, val1] =>
- [['L%T,g,rev],:REVERSE rest REVERSE l2,
+ [['L%T,g,rev],:reverse rest reverse l2,
bfLetForm(var1,['reverse!,val1])]
[['L%T,g,rev],:l2,bfLetForm(var1,['reverse!,var1])]
lhs is ["EQUAL",var1] => ['COND,[bfQ(var1,rhs),var1]]
@@ -602,7 +602,7 @@ bfLET(lhs,rhs) ==
addCARorCDR(acc,expr) ==
atom expr => [acc,expr]
- acc = 'CAR and expr is ["REVERSE",:.] =>
+ acc = 'CAR and expr is ["reverse",:.] =>
["CAR",["LAST",:rest expr]]
-- ['last,:rest expr]
funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR
@@ -676,7 +676,7 @@ bfIS1(lhs,rhs) ==
patrev := bfISReverse(b,a)
g := makeSymbol strconc('"ISTMP#",toString $isGenVarCounter)
$isGenVarCounter := $isGenVarCounter + 1
- rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['REVERSE,lhs]],'T]]
+ rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['reverse,lhs]],'T]]
l2 := bfIS1(g,patrev)
if cons? l2 and atom first l2 then l2 := [l2,:nil]
a = "DOT" => bfAND [rev,:l2]
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 0f94abac..b903d432 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -516,7 +516,7 @@
(PROGN
(SETQ |g| (|bfGenSymbol|))
(SETQ |body|
- (LIST 'SETQ |g| (LIST 'APPEND (LIST 'REVERSE |y|) |g|)))
+ (LIST 'SETQ |g| (LIST 'APPEND (LIST '|reverse| |y|) |g|)))
(SETQ |extrait|
(LIST (LIST (LIST |g|) (LIST NIL) NIL NIL NIL
(LIST (LIST '|reverse!| |g|)))))
@@ -846,7 +846,7 @@
(AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
(PROGN (SETQ |var2| (CAR |ISTMP#2|)) T))))))
(SETQ |patrev| (|bfISReverse| |var2| |var1|))
- (SETQ |rev| (LIST 'REVERSE |rhs|))
+ (SETQ |rev| (LIST '|reverse| |rhs|))
(SETQ |g|
(INTERN (CONCAT "LETTMP#"
(WRITE-TO-STRING |$letGenVarCounter|))))
@@ -872,7 +872,7 @@
(SETQ |val1| (CAR |ISTMP#3|))
T)))))))
(CONS (LIST 'L%T |g| |rev|)
- (APPEND (REVERSE (CDR (REVERSE |l2|)))
+ (APPEND (|reverse| (CDR (|reverse| |l2|)))
(CONS (|bfLetForm| |var1|
(LIST '|reverse!| |val1|))
NIL))))
@@ -905,7 +905,7 @@
(COND
((ATOM |expr|) (LIST |acc| |expr|))
((AND (EQ |acc| 'CAR) (CONSP |expr|)
- (EQ (CAR |expr|) 'REVERSE))
+ (EQ (CAR |expr|) '|reverse|))
(LIST 'CAR (CONS 'LAST (CDR |expr|))))
(T (SETQ |funs|
'(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR
@@ -1066,7 +1066,7 @@
(|bfAND| (LIST (LIST 'CONSP |lhs|)
(LIST 'PROGN
(LIST 'L%T |g|
- (LIST 'REVERSE |lhs|))
+ (LIST '|reverse| |lhs|))
'T))))
(SETQ |l2| (|bfIS1| |g| |patrev|))
(COND
@@ -1222,7 +1222,7 @@
(PROGN (SETQ |c| (CAR |bfVar#97|)) NIL))
(RETURN (|reverse!| |bfVar#98|)))
(T (SETQ |bfVar#98|
- (APPEND (REVERSE (|bfFlatten| 'OR |c|))
+ (APPEND (|reverse| (|bfFlatten| 'OR |c|))
|bfVar#98|))))
(SETQ |bfVar#97| (CDR |bfVar#97|))))))))
@@ -1238,7 +1238,7 @@
(PROGN (SETQ |c| (CAR |bfVar#99|)) NIL))
(RETURN (|reverse!| |bfVar#100|)))
(T (SETQ |bfVar#100|
- (APPEND (REVERSE (|bfFlatten| 'AND |c|))
+ (APPEND (|reverse| (|bfFlatten| 'AND |c|))
|bfVar#100|))))
(SETQ |bfVar#99| (CDR |bfVar#99|))))))))
@@ -1345,7 +1345,7 @@
(PROGN (SETQ |d| (CAR |bfVar#107|)) NIL))
(RETURN (|reverse!| |bfVar#108|)))
(T (SETQ |bfVar#108|
- (APPEND (REVERSE
+ (APPEND (|reverse|
(|shoeComps| (|bfDef1| |d|)))
|bfVar#108|))))
(SETQ |bfVar#107| (CDR |bfVar#107|)))))))))
@@ -1425,7 +1425,7 @@
(PROGN (SETQ |d| (CAR |bfVar#110|)) NIL))
(RETURN (|reverse!| |bfVar#111|)))
(T (SETQ |bfVar#111|
- (APPEND (REVERSE
+ (APPEND (|reverse|
(|shoeComps| (|bfDef1| |d|)))
|bfVar#111|))))
(SETQ |bfVar#110| (CDR |bfVar#110|))))))))))
@@ -1600,7 +1600,7 @@
(RETURN
(COND
((NULL |b|) (LIST (LIST 'PROG |v|)))
- (T (SETQ |LETTMP#1| (REVERSE |b|))
+ (T (SETQ |LETTMP#1| (|reverse| |b|))
(SETQ |blast| (CAR |LETTMP#1|))
(SETQ |blist| (|reverse!| (CDR |LETTMP#1|)))
(LIST (CONS 'PROG
@@ -1810,7 +1810,7 @@
(COND
((ATOM |c|) (RETURN (|reverse!| |bfVar#119|)))
(T (SETQ |bfVar#119|
- (APPEND (REVERSE (|bfFlattenSeq| |c|))
+ (APPEND (|reverse| (|bfFlattenSeq| |c|))
|bfVar#119|))))
(SETQ |c| (CDR |c|)))))
(COND
@@ -1860,7 +1860,7 @@
(PROGN
(SETQ |ISTMP#1| (CDR |a|))
(AND (CONSP |ISTMP#1|)
- (PROGN (SETQ |ISTMP#2| (REVERSE |ISTMP#1|)) T)
+ (PROGN (SETQ |ISTMP#2| (|reverse| |ISTMP#1|)) T)
(CONSP |ISTMP#2|)
(PROGN
(SETQ |ISTMP#3| (CAR |ISTMP#2|))
@@ -2225,7 +2225,8 @@
(PROGN
(SETQ |g| (GENSYM))
(COND
- ((AND (CONSP |cs|) (PROGN (SETQ |ISTMP#1| (REVERSE |cs|)) T)
+ ((AND (CONSP |cs|)
+ (PROGN (SETQ |ISTMP#1| (|reverse| |cs|)) T)
(CONSP |ISTMP#1|)
(PROGN
(SETQ |f| (CAR |ISTMP#1|))
@@ -2650,7 +2651,7 @@
(CONS (|nativeArgumentType| |x|) |argtypes|))
(SETQ |args| (CONS (GENSYM) |args|)))))
(SETQ |bfVar#146| (CDR |bfVar#146|))))
- (SETQ |args| (REVERSE |args|))
+ (SETQ |args| (|reverse| |args|))
(SETQ |rettype| (|nativeReturnType| |t|))
(LIST (LIST 'DEFUN |op| |args|
(LIST (|bfColonColon| 'FFI 'C-INLINE) |args|
@@ -3103,7 +3104,7 @@
(T
(SETQ |bfVar#187|
(APPEND
- (REVERSE
+ (|reverse|
(LIST |x|
(COND
((SETQ |p'|
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index c4c075ce..9f1694f6 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -236,9 +236,9 @@
(LIST '|readLispFromString| 'READ-FROM-STRING)
(LIST '|readOnly?| 'CONSTANTP)
(LIST '|removeDuplicates| 'REMDUP)
- (LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE)
- (LIST '|sameObject?| 'EQ) (LIST '|scalarEq?| 'EQL)
- (LIST '|scalarEqual?| 'EQL) (LIST '|second| 'CADR)
+ (LIST '|rest| 'CDR) (LIST '|sameObject?| 'EQ)
+ (LIST '|scalarEq?| 'EQL) (LIST '|scalarEqual?| 'EQL)
+ (LIST '|second| 'CADR)
(LIST '|setDifference| 'SETDIFFERENCE)
(LIST '|setIntersection| 'INTERSECTION)
(LIST '|setPart| 'SETELT) (LIST '|setUnion| 'UNION)
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 60df1f22..9b394a17 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -6,13 +6,15 @@
(PROVIDE "utility")
(EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?|
- |scalarMember?| |listMember?| |reverse!|))
+ |scalarMember?| |listMember?| |reverse| |reverse!|))
(DEFUN |objectMember?| (|x| |l|)
- (COND
- ((CONSP |l|)
- (OR (EQ |x| (CAR |l|)) (|objectMember?| |x| (CDR |l|))))
- (T (EQ |x| |l|))))
+ (LOOP
+ (COND
+ ((NULL |l|) (RETURN NIL))
+ ((CONSP |l|)
+ (COND ((EQ |x| (CAR |l|)) (RETURN T)) (T (SETQ |l| (CDR |l|)))))
+ (T (RETURN (EQ |x| |l|))))))
(DEFUN |symbolMember?| (|s| |l|)
(LOOP
@@ -62,6 +64,17 @@
(T (SETQ |l| (CDR |l|)))))
(T (RETURN (EQUAL |x| |l|))))))
+(DEFUN |reverse| (|l|)
+ (PROG (|r|)
+ (RETURN
+ (PROGN
+ (SETQ |r| NIL)
+ (LOOP
+ (COND
+ ((CONSP |l|) (SETQ |r| (CONS (CAR |l|) |r|))
+ (SETQ |l| (CDR |l|)))
+ (T (RETURN |r|))))))))
+
(DEFUN |reverse!| (|l|)
(PROG (|l2| |l1|)
(RETURN
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index fb94ff87..8f291306 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -296,7 +296,6 @@ for i in [ _
["readOnly?","CONSTANTP"], _
["removeDuplicates", "REMDUP"] , _
["rest", "CDR"] , _
- ["reverse", "REVERSE"] , _
["sameObject?", "EQ" ] , _
["scalarEq?", "EQL" ] , _
["scalarEqual?","EQL" ] , _
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 0ce3362a..a7545688 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -33,13 +33,18 @@
import initial_-env
namespace BOOTTRAN
module utility (objectMember?, symbolMember?, stringMember?,
- charMember?, scalarMember?, listMember?, reverse!)
+ charMember?, scalarMember?, listMember?, reverse, reverse!)
--% membership operators
objectMember?(x,l) ==
- cons? l => sameObject?(x,first l) or objectMember?(x,rest l)
- sameObject?(x,l)
+ repeat
+ l = nil => return false
+ cons? l =>
+ sameObject?(x,first l) => return true
+ l := rest l
+ return sameObject?(x,l)
+
symbolMember?(s,l) ==
repeat
@@ -83,6 +88,14 @@ listMember?(x,l) ==
--% list reversal
+reverse l ==
+ r := nil
+ repeat
+ cons? l =>
+ r := [first l,:r]
+ l := rest l
+ return r
+
reverse! l ==
l1 := nil
repeat
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 09:44:17 +0000