diff options
Diffstat (limited to 'src/boot')
-rw-r--r-- | src/boot/ast.boot | 4 | ||||
-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 | ||||
-rw-r--r-- | src/boot/tokens.boot | 2 | ||||
-rw-r--r-- | src/boot/utility.boot | 47 |
6 files changed, 79 insertions, 51 deletions
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) |