aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog8
-rw-r--r--src/boot/ast.boot4
-rw-r--r--src/boot/strap/ast.clisp8
-rw-r--r--src/boot/strap/tokens.clisp4
-rw-r--r--src/boot/strap/utility.clisp65
-rw-r--r--src/boot/tokens.boot2
-rw-r--r--src/boot/utility.boot47
-rw-r--r--src/interp/as.boot2
-rw-r--r--src/interp/sys-utility.boot22
9 files changed, 110 insertions, 52 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index ea46d38b..45d82a45 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2011-04-20 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/sys-utility.boot (substitute): Define.
+ (substitute!): Likewise.
+ * boot/utility.boot: Do not rely on tail recursion removal.
+ * boot/tokens.boot: Don't translate substitute and substitute!.
+ * boot/ast.boot (bfLp1): Tidy.
+
2011-04-19 Gabriel Dos Reis <gdr@cs.tamu.edu>
* boot/tokens.boot: charUpcase, charDowncase, stringUpcase,
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 719d583d..3e0fdc5d 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -411,7 +411,9 @@ bfLp1(iters,body)==
value :=
value = nil => "NIL"
first value
- exits := ["COND",[bfOR exits,["RETURN",value]],['T,nbody]]
+ exits :=
+ exits = nil => nbody
+ ["COND",[bfOR exits,["RETURN",value]],['T,nbody]]
loop := ["LOOP",exits,:sucs]
if vars then loop :=
["LET",[[v, i] for v in vars for i in inits], loop]
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index b1e8ab77..95ca0d0d 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -551,9 +551,11 @@
(T (|bfAND| (APPEND |filters| (CONS |body| NIL))))))
(SETQ |value| (COND ((NULL |value|) 'NIL) (T (CAR |value|))))
(SETQ |exits|
- (LIST 'COND
- (LIST (|bfOR| |exits|) (LIST 'RETURN |value|))
- (LIST 'T |nbody|)))
+ (COND
+ ((NULL |exits|) |nbody|)
+ (T (LIST 'COND
+ (LIST (|bfOR| |exits|) (LIST 'RETURN |value|))
+ (LIST 'T |nbody|)))))
(SETQ |loop| (CONS 'LOOP (CONS |exits| |sucs|)))
(COND
(|vars| (SETQ |loop|
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 7a032a5f..7ec5fb63 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -248,9 +248,7 @@
(LIST '|string?| 'STRINGP)
(LIST '|stringEq?| 'STRING=)
(LIST '|stringUpcase| 'STRING-UPCASE)
- (LIST '|subSequence| 'SUBSEQ)
- (LIST '|substitute| 'SUBST)
- (LIST '|substitute!| 'NSUBST) (LIST '|symbolEq?| 'EQ)
+ (LIST '|subSequence| 'SUBSEQ) (LIST '|symbolEq?| 'EQ)
(LIST '|symbolFunction| 'SYMBOL-FUNCTION)
(LIST '|symbolName| 'SYMBOL-NAME)
(LIST '|symbolValue| 'SYMBOL-VALUE)
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index c1799071..dac91a2b 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -15,37 +15,50 @@
(T (EQ |x| |l|))))
(DEFUN |symbolMember?| (|s| |l|)
- (COND
- ((NULL |l|) NIL)
- ((CONSP |l|)
- (OR (EQ |s| (CAR |l|)) (|symbolMember?| |s| (CDR |l|))))
- (T (EQ |s| |l|))))
+ (LOOP
+ (COND
+ ((NULL |l|) (RETURN NIL))
+ ((CONSP |l|)
+ (COND ((EQ |s| (CAR |l|)) (RETURN T)) (T (SETQ |l| (CDR |l|)))))
+ (T (RETURN (EQ |s| |l|))))))
(DEFUN |stringMember?| (|s| |l|)
- (COND
- ((NULL |l|) NIL)
- ((CONSP |l|)
- (OR (STRING= |s| (CAR |l|)) (|stringMember?| |s| (CDR |l|))))
- (T (STRING= |s| |l|))))
+ (LOOP
+ (COND
+ ((NULL |l|) (RETURN NIL))
+ ((CONSP |l|)
+ (COND
+ ((STRING= |s| (CAR |l|)) (RETURN T))
+ (T (SETQ |l| (CDR |l|)))))
+ (T (RETURN (STRING= |s| |l|))))))
(DEFUN |charMember?| (|c| |l|)
- (COND
- ((NULL |l|) NIL)
- ((CONSP |l|)
- (OR (CHAR= |c| (CAR |l|)) (|charMember?| |c| (CDR |l|))))
- (T (CHAR= |c| |l|))))
+ (LOOP
+ (COND
+ ((NULL |l|) (RETURN NIL))
+ ((CONSP |l|)
+ (COND
+ ((CHAR= |c| (CAR |l|)) (RETURN T))
+ (T (SETQ |l| (CDR |l|)))))
+ (T (RETURN (CHAR= |c| |l|))))))
-(DEFUN |scalarMember?| (|x| |l|)
- (COND
- ((NULL |l|) NIL)
- ((CONSP |l|)
- (OR (EQL |x| (CAR |l|)) (|scalarMember?| |x| (CDR |l|))))
- (T (CHAR= |x| |l|))))
+(DEFUN |scalarMember?| (|s| |l|)
+ (LOOP
+ (COND
+ ((NULL |l|) (RETURN NIL))
+ ((CONSP |l|)
+ (COND
+ ((EQL |s| (CAR |l|)) (RETURN T))
+ (T (SETQ |l| (CDR |l|)))))
+ (T (RETURN (EQL |s| |l|))))))
(DEFUN |listMember?| (|x| |l|)
- (COND
- ((NULL |l|) NIL)
- ((CONSP |l|)
- (OR (EQUAL |x| (CAR |l|)) (|listMember?| |x| (CDR |l|))))
- (T (EQUAL |x| |l|))))
+ (LOOP
+ (COND
+ ((NULL |l|) (RETURN NIL))
+ ((CONSP |l|)
+ (COND
+ ((EQUAL |x| (CAR |l|)) (RETURN T))
+ (T (SETQ |l| (CDR |l|)))))
+ (T (RETURN (EQUAL |x| |l|))))))
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index b12e5991..f87da75f 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -313,8 +313,6 @@ for i in [ _
["stringEq?","STRING="] , _
["stringUpcase", "STRING-UPCASE"] , _
["subSequence", "SUBSEQ"] , _
- ["substitute", "SUBST"] , _
- ["substitute!", "NSUBST"] , _
["symbolEq?", "EQ"], _
["symbolFunction", "SYMBOL-FUNCTION"], _
["symbolName", "SYMBOL-NAME"], _
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 6ee1e180..78e01a97 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -40,26 +40,41 @@ objectMember?(x,l) ==
sameObject?(x,l)
symbolMember?(s,l) ==
- l = nil => false
- cons? l => symbolEq?(s,first l) or symbolMember?(s,rest l)
- symbolEq?(s,l)
+ repeat
+ l = nil => return false
+ cons? l =>
+ symbolEq?(s,first l) => return true
+ l := rest l
+ return symbolEq?(s,l)
stringMember?(s,l) ==
- l = nil => false
- cons? l => stringEq?(s,first l) or stringMember?(s,rest l)
- stringEq?(s,l)
+ repeat
+ l = nil => return false
+ cons? l =>
+ stringEq?(s,first l) => return true
+ l := rest l
+ return stringEq?(s,l)
charMember?(c,l) ==
- l = nil => false
- cons? l => charEq?(c,first l) or charMember?(c,rest l)
- charEq?(c,l)
+ repeat
+ l = nil => return false
+ cons? l =>
+ charEq?(c,first l) => return true
+ l := rest l
+ return charEq?(c,l)
-scalarMember?(x,l) ==
- l = nil => false
- cons? l => scalarEq?(x,first l) or scalarMember?(x,rest l)
- charEq?(x,l)
+scalarMember?(s,l) ==
+ repeat
+ l = nil => return false
+ cons? l =>
+ scalarEq?(s,first l) => return true
+ l := rest l
+ return scalarEq?(s,l)
listMember?(x,l) ==
- l = nil => false
- cons? l => listEq?(x,first l) or listMember?(x,rest l)
- listEq?(x,l)
+ repeat
+ l = nil => return false
+ cons? l =>
+ listEq?(x,first l) => return true
+ l := rest l
+ return listEq?(x,l)
diff --git a/src/interp/as.boot b/src/interp/as.boot
index 7108d5a4..9bdaaf85 100644
--- a/src/interp/as.boot
+++ b/src/interp/as.boot
@@ -283,7 +283,7 @@ asGetModemaps(opAlist,oform,kind,modemap) ==
for [op,:itemlist] in SUBLISLIS(rpvl, $FormalMapVariableList,opAlist) repeat
for [sig0, pred] in itemlist repeat
sig := substitute(dc,"$",sig0)
- pred:= subtitute(dc,"$",pred)
+ pred:= substitute(dc,"$",pred)
sig := SUBLISLIS(rpvl,KDR oform,sig)
pred:= SUBLISLIS(rpvl,KDR oform,pred)
pred := pred or 'T
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index d047296e..6895926e 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -391,3 +391,25 @@ stringAssoc(s,l) ==
symbolLassoc(s,l) ==
p := symbolAssoc(s,l) => rest p
nil
+
+
+--% substitute
+
+substitute(new,old,tree) ==
+ sameObject?(old,tree) => new
+ cons? tree =>
+ h := substitute(new,old,first tree)
+ t := substitute(new,old,rest tree)
+ sameObject?(h,first tree) and sameObject?(t,rest tree) => tree
+ [h,:t]
+ tree
+
+substitute!(new,old,tree) ==
+ sameObject?(old,tree) => new
+ cons? tree =>
+ h := substitute!(new,old,first tree)
+ t := substitute!(new,old,rest tree)
+ tree.first := h
+ tree.rest := t
+ tree
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-05 03:06:10 +0000