diff options
| author | dos-reis <gdr@axiomatics.org> | 2011-04-20 23:31:24 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2011-04-20 23:31:24 +0000 |
| commit | 1ca37b944b566ef3f0479d4c2fe6895e9fbd3785 (patch) | |
| tree | e4d75111b770366bac08174a5bf47f4bdaaee1eb /src/boot/strap | |
| parent | 1e67a3445ddda759c38b455494350ed00390d73f (diff) | |
| download | open-axiom-1ca37b944b566ef3f0479d4c2fe6895e9fbd3785.tar.gz | |
* 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.
Diffstat (limited to 'src/boot/strap')
| -rw-r--r-- | src/boot/strap/ast.clisp | 8 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 4 | ||||
| -rw-r--r-- | src/boot/strap/utility.clisp | 65 |
3 files changed, 45 insertions, 32 deletions
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|)))))) |