diff options
| -rw-r--r-- | src/ChangeLog | 8 | ||||
| -rw-r--r-- | src/boot/ast.boot | 10 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 31 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 6 | ||||
| -rw-r--r-- | src/boot/strap/utility.clisp | 23 | ||||
| -rw-r--r-- | src/boot/tokens.boot | 1 | ||||
| -rw-r--r-- | src/boot/utility.boot | 19 | ||||
| -rw-r--r-- | src/interp/debug.lisp | 2 | ||||
| -rw-r--r-- | src/interp/lisp-backend.boot | 2 | ||||
| -rw-r--r-- | src/interp/preparse.lisp | 6 | ||||
| -rw-r--r-- | src/interp/sys-macros.lisp | 2 | ||||
| -rw-r--r-- | src/interp/vmlisp.lisp | 9 |
12 files changed, 73 insertions, 46 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 0e35daa0..e848b3e5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,13 @@ 2011-04-21 Gabriel Dos Reis <gdr@cs.tamu.edu> + * 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. + +2011-04-21 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/tokens.boot: Don't rename nreverse. * boot/utility.boot (reverse!): Define. * boot/parser.boot: Use reverse! instead of NREVERSE. 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 diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp index c38f8c8e..71098c9c 100644 --- a/src/interp/debug.lisp +++ b/src/interp/debug.lisp @@ -1014,7 +1014,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|)) (PRIN1 /CALLER CURSTRM))) (MONITOR-PRINARGS (if (SPADSYSNAMEP NAME) - (|reverse!| (REVERSE (|coerceTraceArgs2E| + (|reverse!| (|reverse| (|coerceTraceArgs2E| (INTERN NAME1) (INTERN NAME) /ARGS))) diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index 0fbb0f33..e5d07fe2 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -562,7 +562,7 @@ for x in [ ['%lempty?, :'NULL], ['%lfirst, :'CAR], ['%llength, :'LIST_-LENGTH], - ['%lreverse, :'REVERSE], + ['%lreverse, :'reverse], ['%lreverse!, :'reverse!], ['%lsecond, :'CADR], ['%lthird, :'CADDR], diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp index 586bca51..1285de92 100644 --- a/src/interp/preparse.lisp +++ b/src/interp/preparse.lisp @@ -209,7 +209,7 @@ ;; NCBLOCK is the current comment block (DEFUN FINCOMBLOCK (NUM OLDNUMS OLDLOCS NCBLOCK linelist) (PUSH - (COND ((EQL (CAR NCBLOCK) 0) (CONS (1- NUM) (REVERSE (CDR NCBLOCK)))) + (COND ((EQL (CAR NCBLOCK) 0) (CONS (1- NUM) (|reverse| (CDR NCBLOCK)))) ;; comment for constructor itself paired with 1st line -1 ('T (COND ($EchoLineStack @@ -225,7 +225,7 @@ (if (and (numberp (car olocs)) (<= (car olocs) sloc)) (return (car onums)))) - (REVERSE (CDR NCBLOCK))))) + (|reverse| (CDR NCBLOCK))))) $COMBLOCKLIST)) (defun PARSEPRINT (L) @@ -342,7 +342,7 @@ ;; LINE))))) (defun PREPARSE-ECHO (linelist) - (if |$Echo| (REPEAT (IN X (REVERSE $EchoLineStack)) + (if |$Echo| (REPEAT (IN X (|reverse| $EchoLineStack)) (format out-stream "~&;~A~%" X))) (setq $EchoLineStack ())) diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp index cda2479d..33e18eb3 100644 --- a/src/interp/sys-macros.lisp +++ b/src/interp/sys-macros.lisp @@ -977,7 +977,7 @@ (LIST 'THETACHECK G (MKQ G)(MKQ OP))) (G) )) (COND ((EQ OP 'CONS) - (SETQ EXIT (LIST 'NREVERSE0 EXIT)))) + (SETQ EXIT (LIST '|reverse!| EXIT)))) ;; CONSCODE= code which conses a member onto the list (SETQ VALUE (COND ((EQ Y 'NO_THETA_PROPERTY) diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp index 3023a662..b5eeb762 100644 --- a/src/interp/vmlisp.lisp +++ b/src/interp/vmlisp.lisp @@ -216,13 +216,6 @@ (defmacro ne (a b) `(not (equal ,a ,b))) -(defmacro nreverse0 (x) - (if (atom x) - `(if (atom ,x) ,x (|reverse!| ,x)) - (let ((xx (gensym))) - `(let ((,xx ,x)) - (if (atom ,xx) ,xx (|reverse!| ,xx)))))) - (defmacro nump (n) `(numberp ,n)) @@ -406,7 +399,7 @@ `(,(dcqexp pattern '=) ,exp)) (defmacro seq (&rest form) - (let* ((body (reverse form)) + (let* ((body (|reverse| form)) (val `(return-from seq ,(pop body)))) (nsubstitute '(progn) nil body) ;don't treat NIL as a label `(block seq (tagbody ,@(|reverse!| body) ,val)))) |