From f5a47d23d57cb91b89254c7a5904baee0f004e2b Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Thu, 21 Apr 2011 14:59:12 +0000
Subject: 	* boot/tokens.boot: Don't translate lastNode anymore. 	*
 boot/utility.boot (lastNode): Define.

---
 src/boot/strap/tokens.clisp  |  5 ++---
 src/boot/strap/utility.clisp | 15 ++++++++++++++-
 src/boot/tokens.boot         |  1 -
 src/boot/utility.boot        |  8 +++++++-
 4 files changed, 23 insertions(+), 6 deletions(-)

(limited to 'src/boot')

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