diff options
Diffstat (limited to 'src/boot/strap')
| -rw-r--r-- | src/boot/strap/includer.clisp | 50 | ||||
| -rw-r--r-- | src/boot/strap/scanner.clisp | 25 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 1 |
3 files changed, 31 insertions, 45 deletions
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp index 7d47a96c..fc1065fb 100644 --- a/src/boot/strap/includer.clisp +++ b/src/boot/strap/includer.clisp @@ -109,27 +109,20 @@ (DEFUN |bMap| (|f| |x|) (|bDelay| #'|bMap1| (LIST |f| |x|))) -(DEFUN |bMap1| (&REST |z|) - (PROG (|x| |f|) - (RETURN - (PROGN - (SETQ |f| (CAR |z|)) - (SETQ |x| (CADR |z|)) - (COND - ((|bStreamNull| |x|) |$bStreamNil|) - (T (CONS (APPLY |f| (LIST (CAR |x|))) (|bMap| |f| (CDR |x|))))))))) +(DEFUN |bMap1| (|f| |x|) + (COND + ((|bStreamNull| |x|) |$bStreamNil|) + (T (CONS (APPLY |f| (LIST (CAR |x|))) (|bMap| |f| (CDR |x|)))))) (DEFUN |bDelay| (|f| |x|) (CONS '|nonnullstream| (CONS |f| |x|))) (DEFUN |bAppend| (|x| |y|) (|bDelay| #'|bAppend1| (LIST |x| |y|))) -(DEFUN |bAppend1| (&REST |z|) +(DEFUN |bAppend1| (|x| |y|) (COND - ((|bStreamNull| (CAR |z|)) - (COND - ((|bStreamNull| (CADR |z|)) (LIST '|nullstream|)) - (T (CADR |z|)))) - (T (CONS (CAAR |z|) (|bAppend| (CDAR |z|) (CADR |z|)))))) + ((|bStreamNull| |x|) + (COND ((|bStreamNull| |y|) (LIST '|nullstream|)) (T |y|))) + (T (CONS (CAR |x|) (|bAppend| (CDR |x|) |y|))))) (DEFUN |bNext| (|f| |s|) (|bDelay| #'|bNext1| (LIST |f| |s|))) @@ -143,34 +136,29 @@ (DEFUN |bRgen| (|s|) (|bDelay| #'|bRgen1| (LIST |s|))) -(DEFUN |bRgen1| (&REST |s|) +(DEFUN |bRgen1| (|s|) (PROG (|a|) (RETURN (PROGN - (SETQ |a| (|shoeReadLine| (CAR |s|))) + (SETQ |a| (|shoeReadLine| |s|)) (COND ((|shoePLACEP| |a|) (LIST '|nullstream|)) - (T (CONS |a| (|bRgen| (CAR |s|))))))))) + (T (CONS |a| (|bRgen| |s|)))))))) (DEFUN |bIgen| (|n|) (|bDelay| #'|bIgen1| (LIST |n|))) -(DEFUN |bIgen1| (&REST |n|) - (PROGN (SETQ |n| (+ (CAR |n|) 1)) (CONS |n| (|bIgen| |n|)))) +(DEFUN |bIgen1| (|n|) + (PROGN (SETQ |n| (+ |n| 1)) (CONS |n| (|bIgen| |n|)))) (DEFUN |bAddLineNumber| (|f1| |f2|) (|bDelay| #'|bAddLineNumber1| (LIST |f1| |f2|))) -(DEFUN |bAddLineNumber1| (&REST |f|) - (PROG (|f2| |f1|) - (RETURN - (PROGN - (SETQ |f1| (CAR |f|)) - (SETQ |f2| (CADR |f|)) - (COND - ((|bStreamNull| |f1|) (LIST '|nullstream|)) - ((|bStreamNull| |f2|) (LIST '|nullstream|)) - (T (CONS (CONS (CAR |f1|) (CAR |f2|)) - (|bAddLineNumber| (CDR |f1|) (CDR |f2|))))))))) +(DEFUN |bAddLineNumber1| (|f1| |f2|) + (COND + ((|bStreamNull| |f1|) (LIST '|nullstream|)) + ((|bStreamNull| |f2|) (LIST '|nullstream|)) + (T (CONS (CONS (CAR |f1|) (CAR |f2|)) + (|bAddLineNumber| (CDR |f1|) (CDR |f2|)))))) (DEFUN |shoePrefixLisp| (|x|) (CONCAT ")lisp" |x|)) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 36c8ef05..4f17e690 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -28,7 +28,7 @@ (DEFUN |dqToList| (|s|) (COND ((NULL |s|) NIL) (T (CAR |s|)))) -(DEFUN |shoeConstructToken| (|ln| |lp| |b| |n|) +(DEFUN |shoeConstructToken| (|lp| |b| |n|) (CONS (ELT |b| 0) (CONS (ELT |b| 1) (CONS |lp| |n|)))) (DEFUN |shoeTokType| (|x|) (CAR |x|)) @@ -80,7 +80,7 @@ ((SETQ |command| (|shoeLine?| |$ln|)) (SETQ |dq| (|dqUnit| - (|shoeConstructToken| |$ln| |$linepos| + (|shoeConstructToken| |$linepos| (|shoeLeafLine| |command|) 0))) (CONS (LIST |dq|) |$r|)) ((SETQ |command| (|shoeLisp?| |$ln|)) @@ -100,12 +100,10 @@ (DECLARE (SPECIAL |$linepos| |$ln|)) (RETURN (PROGN - (SETQ |string| - (COND - ((OR (EQL (LENGTH |string|) 0) - (CHAR= (SCHAR |string| 0) (|char| '|;|))) - "") - (T |string|))) + (COND + ((OR (EQL (LENGTH |string|) 0) + (CHAR= (SCHAR |string| 0) (|char| '|;|))) + (SETQ |string| ""))) (SETQ |ln| |$ln|) (SETQ |linepos| |$linepos|) (SETQ |LETTMP#1| (|shoeAccumulateLines| |s| |string|)) @@ -113,8 +111,8 @@ (SETQ |st| (CDR |LETTMP#1|)) (SETQ |dq| (|dqUnit| - (|shoeConstructToken| |ln| |linepos| - (|shoeLeafLisp| |st|) 0))) + (|shoeConstructToken| |linepos| (|shoeLeafLisp| |st|) + 0))) (CONS (LIST |dq|) |r|))))) (DEFUN |shoeAccumulateLines| (|s| |string|) @@ -145,11 +143,10 @@ (DEFUN |shoeCloser| (|t|) (MEMQ (|shoeKeyWord| |t|) '(CPAREN CBRACK))) (DEFUN |shoeToken| () - (PROG (|b| |ch| |n| |linepos| |ln|) - (DECLARE (SPECIAL |$n| |$linepos| |$ln|)) + (PROG (|b| |ch| |n| |linepos|) + (DECLARE (SPECIAL |$ln| |$n| |$linepos|)) (RETURN (PROGN - (SETQ |ln| |$ln|) (SETQ |linepos| |$linepos|) (SETQ |n| |$n|) (SETQ |ch| (SCHAR |$ln| |$n|)) @@ -168,7 +165,7 @@ (T (|shoeError|)))) (COND ((NULL |b|) NIL) - (T (|dqUnit| (|shoeConstructToken| |ln| |linepos| |b| |n|)))))))) + (T (|dqUnit| (|shoeConstructToken| |linepos| |b| |n|)))))))) (DEFUN |shoeLeafId| (|x|) (LIST 'ID (INTERN |x|))) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 80875ca7..5eb38696 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -226,6 +226,7 @@ (LIST '|readByte| 'READ-BYTE) (LIST '|readInteger| 'PARSE-INTEGER) (LIST '|readLine| 'READ-LINE) + (LIST '|readLispFromString| 'READ-FROM-STRING) (LIST '|readOnly?| 'CONSTANTP) (LIST '|removeDuplicates| 'REMDUP) (LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE) |