* boot/tokens.boot: Do not rewrite drop and take.

	* boot/utility.boot (drop): Define and export.
	(take): Likewise.
	* interp/br-con.boot: Use take, not TAKE; use drop, not DROP.
	* interp/br-data.boot: Likewise.
	* interp/br-op1.boot: Likewise.
	* interp/br-saturn.boot: Likewise.
	* interp/c-doc.boot: Likewise.
	* interp/c-util.boot: Likewise.
	* interp/cattable.boot: Likewise.
	* interp/clammed.boot: Likewise.
	* interp/compiler.boot: Likewise.
	* interp/database.boot: Likewise.
	* interp/define.boot: Likewise.
	* interp/guess.boot: Likewise.
	* interp/htsetvar.boot: Likewise.
	* interp/i-analy.boot: Likewise.
	* interp/i-eval.boot: Likewise.
	* interp/i-funsel.boot: Likewise.
	* interp/i-map.boot: Likewise.
	* interp/i-output.boot: Likewise.
	* interp/i-special.boot: Likewise.
	* interp/i-syscmd.boot: Likewise.
	* interp/i-toplev.boot: Likewise.
	* interp/i-util.boot: Likewise.
	* interp/nruncomp.boot: Likewise.
	* interp/parse.boot: Likewise.
	* interp/record.boot: Likewise.
	* interp/setvars.boot: Likewise.
	* interp/slam.boot: Likewise.
	* interp/trace.boot: Likewise.
	* interp/word.boot: Likewise.
	* interp/macros.lisp (DROP): Remove.
	(TAKE): Likewise.

4 files changed, 75 insertions, 24 deletions

diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index ceecbce5..3d170958 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -184,13 +184,13 @@
              (LIST '|cons?| 'CONSP) (LIST '|copy| 'COPY)
              (LIST '|copyString| 'COPY-SEQ) (LIST '|copyVector| 'COPY-SEQ)
              (LIST '|croak| 'CROAK) (LIST '|digit?| 'DIGIT-CHAR-P)
-             (LIST '|drop| 'DROP) (LIST '|exit| 'EXIT) (LIST '|false| 'NIL)
-             (LIST '|fifth| 'FIFTH) (LIST '|first| 'CAR)
-             (LIST '|float?| 'FLOATP) (LIST '|flushOutput| 'FORCE-OUTPUT)
-             (LIST '|fourth| 'CADDDR) (LIST '|function| 'FUNCTION)
-             (LIST '|function?| 'FUNCTIONP) (LIST '|gensym| 'GENSYM)
-             (LIST '|genvar| 'GENVAR) (LIST '|integer?| 'INTEGERP)
-             (LIST 'LAST '|last|) (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL)
+             (LIST '|exit| 'EXIT) (LIST '|false| 'NIL) (LIST '|fifth| 'FIFTH)
+             (LIST '|first| 'CAR) (LIST '|float?| 'FLOATP)
+             (LIST '|flushOutput| 'FORCE-OUTPUT) (LIST '|fourth| 'CADDDR)
+             (LIST '|function| 'FUNCTION) (LIST '|function?| 'FUNCTIONP)
+             (LIST '|gensym| 'GENSYM) (LIST '|genvar| 'GENVAR)
+             (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)
              (LIST '|newVector| 'MAKE-ARRAY) (LIST '|nil| NIL)
@@ -211,18 +211,17 @@
              (LIST '|symbolFunction| 'SYMBOL-FUNCTION)
              (LIST '|symbolName| 'SYMBOL-NAME)
              (LIST '|symbolValue| 'SYMBOL-VALUE) (LIST '|symbol?| 'SYMBOLP)
-             (LIST '|take| 'TAKE) (LIST '|third| 'CADDR)
-             (LIST '|toString| 'WRITE-TO-STRING) (LIST '|true| 'T)
-             (LIST '|upperCase?| 'UPPER-CASE-P) (LIST '|valueEq?| 'EQUAL)
-             (LIST '|vector?| 'SIMPLE-VECTOR-P) (LIST '|vectorRef| 'SVREF)
-             (LIST '|writeByte| 'WRITE-BYTE) (LIST '|writeChar| 'WRITE-CHAR)
-             (LIST '|writeInteger| 'PRINC) (LIST '|writeLine| 'WRITE-LINE)
-             (LIST '|writeNewline| 'TERPRI) (LIST '|writeString| 'WRITE-STRING)
-             (LIST 'PLUS '+) (LIST 'MINUS '-) (LIST 'TIMES '*)
-             (LIST 'POWER 'EXPT) (LIST 'REM 'REM) (LIST 'QUO 'TRUNCATE)
-             (LIST 'SLASH '/) (LIST 'LT '<) (LIST 'GT '>) (LIST 'LE '<=)
-             (LIST 'GE '>=) (LIST 'SHOEEQ 'EQUAL) (LIST 'SHOENE '/=)
-             (LIST 'T 'T$)))
+             (LIST '|third| 'CADDR) (LIST '|toString| 'WRITE-TO-STRING)
+             (LIST '|true| 'T) (LIST '|upperCase?| 'UPPER-CASE-P)
+             (LIST '|valueEq?| 'EQUAL) (LIST '|vector?| 'SIMPLE-VECTOR-P)
+             (LIST '|vectorRef| 'SVREF) (LIST '|writeByte| 'WRITE-BYTE)
+             (LIST '|writeChar| 'WRITE-CHAR) (LIST '|writeInteger| 'PRINC)
+             (LIST '|writeLine| 'WRITE-LINE) (LIST '|writeNewline| 'TERPRI)
+             (LIST '|writeString| 'WRITE-STRING) (LIST 'PLUS '+)
+             (LIST 'MINUS '-) (LIST 'TIMES '*) (LIST 'POWER 'EXPT)
+             (LIST 'REM 'REM) (LIST 'QUO 'TRUNCATE) (LIST 'SLASH '/)
+             (LIST 'LT '<) (LIST 'GT '>) (LIST 'LE '<=) (LIST 'GE '>=)
+             (LIST 'SHOEEQ 'EQUAL) (LIST 'SHOENE '/=) (LIST 'T 'T$)))
       (|i| NIL))
   (LOOP
    (COND
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 73e14218..83ee8844 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -21,7 +21,7 @@
                      |substitute!| |setDifference| |setUnion| |setIntersection|
                      |symbolAssoc| |applySubst| |applySubst!| |applySubstNQ|
                      |objectAssoc| |remove| |removeSymbol| |atomic?| |every?|
-                     |any?| |takeWhile| |copyTree| |finishLine|)))
+                     |any?| |take| |takeWhile| |drop| |copyTree| |finishLine|)))
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|) |substitute|))
 
@@ -83,11 +83,17 @@
   |any?|))
 
 (DECLAIM
+ (FTYPE (FUNCTION (|%Short| (|%List| |%Thing|)) (|%List| |%Thing|)) |take|))
+
+(DECLAIM
  (FTYPE
   (FUNCTION ((FUNCTION (|%Thing|) |%Thing|) (|%List| |%Thing|))
    (|%List| |%Thing|))
   |takeWhile|))
 
+(DECLAIM
+ (FTYPE (FUNCTION (|%Short| (|%List| |%Thing|)) (|%List| |%Thing|)) |drop|))
+
 (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |copyTree|))
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Void|) |finishLine|))
@@ -120,6 +126,26 @@
        (COND (|bfVar#2| (RETURN |bfVar#2|)))))
      (SETQ |bfVar#1| (CDR |bfVar#1|)))))
 
+(DEFUN |take| (|n| |l|)
+  (COND
+   ((NOT (MINUSP |n|))
+    (LET ((|bfVar#3| NIL)
+          (|bfVar#4| NIL)
+          (|bfVar#1| |l|)
+          (|x| NIL)
+          (|bfVar#2| 1))
+      (LOOP
+       (COND
+        ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)
+             (> |bfVar#2| |n|))
+         (RETURN |bfVar#3|))
+        ((NULL |bfVar#3|) (SETQ |bfVar#3| #1=(CONS |x| NIL))
+         (SETQ |bfVar#4| |bfVar#3|))
+        (T (RPLACD |bfVar#4| #1#) (SETQ |bfVar#4| (CDR |bfVar#4|))))
+       (SETQ |bfVar#1| (CDR |bfVar#1|))
+       (SETQ |bfVar#2| (+ |bfVar#2| 1)))))
+   (T (|drop| (+ (LENGTH |l|) |n|) |l|))))
+
 (DEFUN |takeWhile| (|f| |l|)
   (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |l|) (|x| NIL))
     (LOOP
@@ -132,6 +158,17 @@
       (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|))))
      (SETQ |bfVar#1| (CDR |bfVar#1|)))))
 
+(DEFUN |drop| (|n| |l|)
+  (COND
+   ((NOT (MINUSP |n|))
+    (LOOP
+     (COND
+      ((NOT (AND (PLUSP |n|) (CONSP |l|) (PROGN (SETQ |l| (CDR |l|)) T)))
+       (RETURN NIL))
+      (T (SETQ |n| (- |n| 1)))))
+    |l|)
+   (T (|take| (+ (LENGTH |l|) |n|) |l|))))
+
 (DEFUN |copyTree| (|t|)
   (COND ((CONSP |t|) (CONS (|copyTree| (CAR |t|)) (|copyTree| (CDR |t|))))
         (T |t|)))
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index b45cb669..77b29cb2 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -256,7 +256,6 @@ for i in [ _
   ["copyVector", "COPY-SEQ"] , _
   ["croak",      "CROAK"]  , _
   ["digit?",    "DIGIT-CHAR-P"]  , _
-  ["drop",        "DROP"]  , _
   ["exit",        "EXIT"]  , _
   ["false",        'NIL]   , _
   ["fifth",      "FIFTH"]  , _
@@ -307,7 +306,6 @@ for i in [ _
   ["symbolName", "SYMBOL-NAME"], _
   ["symbolValue", "SYMBOL-VALUE"], _
   ["symbol?",  "SYMBOLP"]  , _
-  ["take",        "TAKE"]  , 
   ["third",      "CADDR"] , _
   ["toString", "WRITE-TO-STRING"], _
   ["true",           "T"]  , _
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 6e08acb5..52593e5d 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -48,8 +48,8 @@ module utility (objectMember?, symbolMember?, stringMember?,
   lastNode, append, append!, copyList, substitute, substitute!,
   setDifference, setUnion, setIntersection,
   symbolAssoc, applySubst, applySubst!, applySubstNQ, objectAssoc,
-  remove, removeSymbol, atomic?, every?, any?, takeWhile, copyTree,
-  finishLine) where
+  remove, removeSymbol, atomic?, every?, any?, take, takeWhile, drop,
+  copyTree, finishLine) where
     substitute: (%Thing,%Thing,%Thing) -> %Thing
     substitute!: (%Thing,%Thing,%Thing) -> %Thing
     append: (%List %Thing,%List %Thing) -> %List %Thing
@@ -66,7 +66,9 @@ module utility (objectMember?, symbolMember?, stringMember?,
     atomic?: %Thing -> %Boolean
     every?: (%Thing -> %Thing, %List %Thing) -> %Thing
     any?: (%Thing -> %Thing, %List %Thing) -> %Thing
+    take: (%Short,%List %Thing) -> %List %Thing
     takeWhile: (%Thing -> %Thing, %List %Thing) -> %List %Thing
+    drop: (%Short,%List %Thing) -> %List %Thing
     copyTree: %Thing -> %Thing
     finishLine: %Thing -> %Void
     --FIXME: Next signature commented out because of GCL bugs
@@ -90,10 +92,25 @@ every?(f,l) ==
 any?(f,l) ==
   or/[apply(f,x,nil) for x in l]
 
+++ Return the `n' node prefixes of the list `l'.  If `n' is negative,
+++ take from the end of the list.
+take(n,l) ==
+  n >= 0 => [x for x in l for . in 1..n]
+  drop(#l+n,l)
+
 ++ Return the sublist of `l' whose elements have non-nil image by `f'.
 takeWhile(f,l) ==
   [x for x in l while apply(f,x,nil)]
 
+++ Return the `n+1'th node and its successors of the list `l'.
+++ If `n' is negative, drop from the end.
+drop(n,l) ==
+  n >= 0 =>
+    while n > 0 and l is [.,:l] repeat
+      n := n - 1
+    l
+  take(#l+n,l)
+
 copyTree t ==
   t is [.,:.] => [copyTree first t,:copyTree rest t]
   t