From f5a47d23d57cb91b89254c7a5904baee0f004e2b Mon Sep 17 00:00:00 2001 From: dos-reis Date: Thu, 21 Apr 2011 14:59:12 +0000 Subject: * boot/tokens.boot: Don't translate lastNode anymore. * boot/utility.boot (lastNode): Define. --- src/ChangeLog | 5 +++++ src/boot/strap/tokens.clisp | 5 ++--- src/boot/strap/utility.clisp | 15 ++++++++++++++- src/boot/tokens.boot | 1 - src/boot/utility.boot | 8 +++++++- 5 files changed, 28 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index e848b3e5..48ee4e22 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-04-21 Gabriel Dos Reis + + * boot/tokens.boot: Don't translate lastNode anymore. + * boot/utility.boot (lastNode): Define. + 2011-04-21 Gabriel Dos Reis * boot/utility.boot (objectMember?): Don't rely non tail recursion diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 9f1694f6..0de0c434 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -219,9 +219,8 @@ (LIST '|fourth| 'CADDDR) (LIST '|function| 'FUNCTION) (LIST '|function?| 'FUNCTIONP) (LIST '|gensym| 'GENSYM) (LIST '|genvar| 'GENVAR) - (LIST '|integer?| 'INTEGERP) (LIST '|lastNode| 'LAST) - (LIST 'LAST '|last|) (LIST '|list| 'LIST) - (LIST '|listEq?| 'EQUAL) + (LIST '|integer?| 'INTEGERP) (LIST 'LAST '|last|) + (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL) (LIST '|lowerCase?| 'LOWER-CASE-P) (LIST '|makeSymbol| 'INTERN) (LIST '|maxIndex| 'MAXINDEX) (LIST '|mkpf| 'MKPF) diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp index 9b394a17..9b7dbef4 100644 --- a/src/boot/strap/utility.clisp +++ b/src/boot/strap/utility.clisp @@ -6,7 +6,8 @@ (PROVIDE "utility") (EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?| - |scalarMember?| |listMember?| |reverse| |reverse!|)) + |scalarMember?| |listMember?| |reverse| |reverse!| + |lastNode|)) (DEFUN |objectMember?| (|x| |l|) (LOOP @@ -86,3 +87,15 @@ (SETQ |l1| |l|) (SETQ |l| |l2|)) (T (RETURN |l1|)))))))) +(DEFUN |lastNode| (|l|) + (PROG (|l'|) + (RETURN + (PROGN + (LOOP + (COND + ((NOT (AND (CONSP |l|) (PROGN (SETQ |l'| (CDR |l|)) T) + (CONSP |l'|))) + (RETURN NIL)) + (T (SETQ |l| |l'|)))) + |l|)))) + diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index 8f291306..b89a2b67 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -272,7 +272,6 @@ for i in [ _ ["gensym", "GENSYM"] , _ ["genvar", "GENVAR"] , _ ["integer?","INTEGERP"] , _ - ["lastNode", "LAST"] , _ ["LAST", "last"] , _ ["list", "LIST"] , _ ["listEq?", "EQUAL"] , _ diff --git a/src/boot/utility.boot b/src/boot/utility.boot index a7545688..8b1f242f 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -33,7 +33,7 @@ import initial_-env namespace BOOTTRAN module utility (objectMember?, symbolMember?, stringMember?, - charMember?, scalarMember?, listMember?, reverse, reverse!) + charMember?, scalarMember?, listMember?, reverse, reverse!, lastNode) --% membership operators @@ -106,3 +106,9 @@ reverse! l == l := l2 return l1 +--% return a pointer to the last cons-cell in the list `l'. + +lastNode l == + while l is [.,:l'] and cons? l' repeat + l := l' + l -- cgit v1.2.3