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/ast.boot | 10 +++++----- src/boot/strap/ast.clisp | 31 ++++++++++++++++--------------- src/boot/strap/tokens.clisp | 6 +++--- src/boot/strap/utility.clisp | 23 ++++++++++++++++++----- src/boot/tokens.boot | 1 - src/boot/utility.boot | 19 ++++++++++++++++--- 6 files changed, 58 insertions(+), 32 deletions(-) (limited to 'src/boot') 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 -- cgit v1.2.3