aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/strap')
-rw-r--r--src/boot/strap/tokens.clisp37
-rw-r--r--src/boot/strap/utility.clisp39
2 files changed, 56 insertions, 20 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|)))