diff options
Diffstat (limited to 'src/boot/strap/scanner.clisp')
-rw-r--r-- | src/boot/strap/scanner.clisp | 146 |
1 files changed, 63 insertions, 83 deletions
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 5590d0ca..21722a2a 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -50,12 +50,11 @@ (COND ((NULL |$n|) T) ((EQUAL (QENUM |$ln| |$n|) |shoeTAB|) - (PROGN - (SETQ |a| (MAKE-FULL-CVEC (- 7 (REM |$n| 8)) " ")) - (SETF (ELT |$ln| |$n|) (ELT " " 0)) - (SETQ |$ln| (CONCAT |a| |$ln|)) - (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|)) - (|shoeNextLine| |s1|))) + (SETQ |a| (MAKE-FULL-CVEC (- 7 (REM |$n| 8)) " ")) + (SETF (ELT |$ln| |$n|) (ELT " " 0)) + (SETQ |$ln| (CONCAT |a| |$ln|)) + (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|)) + (|shoeNextLine| |s1|)) ('T T))))))) (DEFUN |shoeLineToks| (|s|) @@ -74,41 +73,34 @@ (COND ((NOT (|shoeNextLine| |s|)) (CONS NIL NIL)) ((NULL |$n|) (|shoeLineToks| |$r|)) - (#0='T - (PROGN - (SETQ |fst| (QENUM |$ln| 0)) - (COND - ((EQL |fst| |shoeCLOSEPAREN|) + (#0='T (SETQ |fst| (QENUM |$ln| 0)) + (COND + ((EQL |fst| |shoeCLOSEPAREN|) + (COND + ((SETQ |command| (|shoeLine?| |$ln|)) + (SETQ |dq| + (|dqUnit| + (|shoeConstructToken| |$ln| |$linepos| + (|shoeLeafLine| |command|) 0))) + (CONS (LIST |dq|) |$r|)) + ((SETQ |command| (|shoeLisp?| |$ln|)) + (|shoeLispToken| |$r| |command|)) + ((SETQ |command| (|shoePackage?| |$ln|)) + (SETQ |a| (CONCAT "(IN-PACKAGE " |command| ")")) + (SETQ |dq| + (|dqUnit| + (|shoeConstructToken| |$ln| |$linepos| + (|shoeLeafLisp| |a|) 0))) + (CONS (LIST |dq|) |$r|)) + (#0# (|shoeLineToks| |$r|)))) + (#0# (SETQ |toks| NIL) + (LOOP (COND - ((SETQ |command| (|shoeLine?| |$ln|)) - (PROGN - (SETQ |dq| - (|dqUnit| - (|shoeConstructToken| |$ln| |$linepos| - (|shoeLeafLine| |command|) 0))) - (CONS (LIST |dq|) |$r|))) - ((SETQ |command| (|shoeLisp?| |$ln|)) - (|shoeLispToken| |$r| |command|)) - ((SETQ |command| (|shoePackage?| |$ln|)) - (PROGN - (SETQ |a| (CONCAT "(IN-PACKAGE " |command| ")")) - (SETQ |dq| - (|dqUnit| - (|shoeConstructToken| |$ln| |$linepos| - (|shoeLeafLisp| |a|) 0))) - (CONS (LIST |dq|) |$r|))) - (#0# (|shoeLineToks| |$r|)))) - (#0# - (PROGN - (SETQ |toks| NIL) - (LOOP - (COND - ((NOT (< |$n| |$sz|)) (RETURN NIL)) - ('T - (SETQ |toks| (|dqAppend| |toks| (|shoeToken|)))))) - (COND - ((NULL |toks|) (|shoeLineToks| |$r|)) - (#0# (CONS (LIST |toks|) |$r|))))))))))))) + ((NOT (< |$n| |$sz|)) (RETURN NIL)) + ('T (SETQ |toks| (|dqAppend| |toks| (|shoeToken|)))))) + (COND + ((NULL |toks|) (|shoeLineToks| |$r|)) + (#0# (CONS (LIST |toks|) |$r|))))))))))) (DEFUN |shoeLispToken| (|s| |string|) (PROG (|dq| |st| |r| |LETTMP#1| |linepos| |ln|) @@ -140,30 +132,25 @@ ((NOT (|shoeNextLine| |s|)) (CONS |s| |string|)) ((NULL |$n|) (|shoeAccumulateLines| |$r| |string|)) ((EQL (LENGTH |$ln|) 0) (|shoeAccumulateLines| |$r| |string|)) - (#0='T - (PROGN - (SETQ |fst| (QENUM |$ln| 0)) - (COND - ((EQL |fst| |shoeCLOSEPAREN|) - (PROGN - (SETQ |command| (|shoeLisp?| |$ln|)) - (COND - ((AND |command| (< 0 (LENGTH |command|))) - (COND - ((EQL (QENUM |command| 0) (QENUM ";" 0)) - (|shoeAccumulateLines| |$r| |string|)) - (#0# - (PROGN - (SETQ |a| (STRPOS ";" |command| 0 NIL)) - (COND - (|a| (|shoeAccumulateLines| |$r| - (CONCAT |string| - (SUBSTRING |command| 0 (- |a| 1))))) - (#0# - (|shoeAccumulateLines| |$r| - (CONCAT |string| |command|)))))))) - (#0# (|shoeAccumulateLines| |$r| |string|))))) - (#0# (CONS |s| |string|))))))))) + (#0='T (SETQ |fst| (QENUM |$ln| 0)) + (COND + ((EQL |fst| |shoeCLOSEPAREN|) + (SETQ |command| (|shoeLisp?| |$ln|)) + (COND + ((AND |command| (< 0 (LENGTH |command|))) + (COND + ((EQL (QENUM |command| 0) (QENUM ";" 0)) + (|shoeAccumulateLines| |$r| |string|)) + (#0# (SETQ |a| (STRPOS ";" |command| 0 NIL)) + (COND + (|a| (|shoeAccumulateLines| |$r| + (CONCAT |string| + (SUBSTRING |command| 0 (- |a| 1))))) + (#0# + (|shoeAccumulateLines| |$r| + (CONCAT |string| |command|))))))) + (#0# (|shoeAccumulateLines| |$r| |string|)))) + (#0# (CONS |s| |string|)))))))) (DEFUN |shoeCloser| (|t|) (MEMBER (|shoeKeyWord| |t|) '(CPAREN CBRACK))) @@ -180,18 +167,16 @@ (SETQ |ch| (ELT |$ln| |$n|)) (SETQ |b| (COND - ((|shoeStartsComment|) (PROGN (|shoeComment|) NIL)) - ((|shoeStartsNegComment|) - (PROGN (|shoeNegComment|) NIL)) + ((|shoeStartsComment|) (|shoeComment|) NIL) + ((|shoeStartsNegComment|) (|shoeNegComment|) NIL) ((EQUAL |c| |shoeLispESCAPE|) (|shoeLispEscape|)) ((|shoePunctuation| |c|) (|shoePunct|)) ((|shoeStartsId| |ch|) (|shoeWord| NIL)) - ((EQUAL |c| |shoeSPACE|) (PROGN (|shoeSpace|) NIL)) + ((EQUAL |c| |shoeSPACE|) (|shoeSpace|) NIL) ((EQUAL |c| |shoeSTRINGCHAR|) (|shoeString|)) ((|shoeDigit| |ch|) (|shoeNumber|)) ((EQUAL |c| |shoeESCAPE|) (|shoeEscape|)) - ((EQUAL |c| |shoeTAB|) - (PROGN (SETQ |$n| (+ |$n| 1)) NIL)) + ((EQUAL |c| |shoeTAB|) (SETQ |$n| (+ |$n| 1)) NIL) (#0='T (|shoeError|)))) (COND ((NULL |b|) NIL) @@ -243,19 +228,14 @@ ('T (SETQ |a| (|shoeReadLispString| |$ln| |$n|)) (COND ((NULL |a|) - (PROGN - (|SoftShoeError| (CONS |$linepos| |$n|) - "lisp escape error") - (|shoeLeafError| (ELT |$ln| |$n|)))) - (#0='T - (PROGN - (SETQ |exp| (CAR |a|)) - (SETQ |n| (CADR |a|)) - (COND - ((NULL |n|) - (PROGN (SETQ |$n| |$sz|) (|shoeLeafLispExp| |exp|))) - (#0# - (PROGN (SETQ |$n| |n|) (|shoeLeafLispExp| |exp|))))))))))))) + (|SoftShoeError| (CONS |$linepos| |$n|) + "lisp escape error") + (|shoeLeafError| (ELT |$ln| |$n|))) + (#0='T (SETQ |exp| (CAR |a|)) (SETQ |n| (CADR |a|)) + (COND + ((NULL |n|) (SETQ |$n| |$sz|) + (|shoeLeafLispExp| |exp|)) + (#0# (SETQ |$n| |n|) (|shoeLeafLispExp| |exp|))))))))))) (DEFUN |shoeEscape| () (PROG (|a|) |