From 8672c9ca7ea2f66a0ab372697c258dac5bb43382 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Thu, 21 Apr 2011 13:47:27 +0000 Subject: * boot/utility.boot (objectMember?): Don't rely non tail recursion removal. (reverse): Define. * boot/tokens.boot: Don't rename reverse anymore. * boot/ast.boot: Generate reverse forms instead of REVERSE. --- src/boot/strap/ast.clisp | 31 ++++++++++++++++--------------- src/boot/strap/tokens.clisp | 6 +++--- src/boot/strap/utility.clisp | 23 ++++++++++++++++++----- 3 files changed, 37 insertions(+), 23 deletions(-) (limited to 'src/boot/strap') 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 -- cgit v1.2.3