aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap/scanner.clisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/strap/scanner.clisp')
-rw-r--r--src/boot/strap/scanner.clisp652
1 files changed, 316 insertions, 336 deletions
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index b48125fc..958f768b 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -10,7 +10,8 @@
(DEFCONSTANT |shoeTAB| (CODE-CHAR 9))
(DEFUN |dqUnit| (|s|)
- (PROG (|a|) (RETURN (PROGN (SETQ |a| (LIST |s|)) (CONS |a| |a|)))))
+ (LET* (|a|)
+ (PROGN (SETQ |a| (LIST |s|)) (CONS |a| |a|))))
(DEFUN |dqAppend| (|x| |y|)
(COND ((NULL |x|) |y|) ((NULL |y|) |x|)
@@ -32,123 +33,121 @@
(DEFUN |shoeTokPart| (|x|) (CADR |x|))
(DEFUN |shoeTokPosn| (|x|)
- (PROG (|p|) (RETURN (PROGN (SETQ |p| (CDDR |x|)) |p|))))
+ (LET* (|p|)
+ (PROGN (SETQ |p| (CDDR |x|)) |p|)))
(DEFUN |shoeNextLine| (|s|)
- (PROG (|s1| |a|)
+ (LET* (|s1| |a|)
(DECLARE (SPECIAL |$sz| |$n| |$ln| |$r| |$f| |$linepos|))
- (RETURN
- (COND ((|bStreamNull| |s|) NIL)
- (T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|)) (SETQ |$r| (CDR |s|))
- (SETQ |$ln| (CAR |$f|))
- (SETQ |$n| (|firstNonblankPosition| |$ln| 0))
- (SETQ |$sz| (LENGTH |$ln|))
- (COND ((NULL |$n|) T)
- ((CHAR= (SCHAR |$ln| |$n|) |shoeTAB|)
- (SETQ |a| (|makeString| (- 7 (REM |$n| 8)) (|char| '| |)))
- (SETF (SCHAR |$ln| |$n|) (|char| '| |))
- (SETQ |$ln| (CONCAT |a| |$ln|))
- (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|))
- (|shoeNextLine| |s1|))
- (T T)))))))
+ (COND ((|bStreamNull| |s|) NIL)
+ (T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|)) (SETQ |$r| (CDR |s|))
+ (SETQ |$ln| (CAR |$f|))
+ (SETQ |$n| (|firstNonblankPosition| |$ln| 0))
+ (SETQ |$sz| (LENGTH |$ln|))
+ (COND ((NULL |$n|) T)
+ ((CHAR= (SCHAR |$ln| |$n|) |shoeTAB|)
+ (SETQ |a| (|makeString| (- 7 (REM |$n| 8)) (|char| '| |)))
+ (SETF (SCHAR |$ln| |$n|) (|char| '| |))
+ (SETQ |$ln| (CONCAT |a| |$ln|))
+ (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|))
+ (|shoeNextLine| |s1|))
+ (T T))))))
(DEFUN |shoeLineToks| (|s|)
- (PROG (|toks| |dq| |command|)
- (RETURN
- (LET* ((|$f| NIL)
- (|$r| NIL)
- (|$ln| NIL)
- (|$n| NIL)
- (|$sz| NIL)
- (|$floatok| T)
- (|$linepos| |s|))
- (DECLARE (SPECIAL |$f| |$r| |$ln| |$n| |$sz| |$floatok| |$linepos|))
- (COND ((NOT (|shoeNextLine| |s|)) (CONS NIL NIL))
- ((NULL |$n|) (|shoeLineToks| |$r|))
- ((CHAR= (SCHAR |$ln| 0) (|char| '|)|))
- (COND
- ((SETQ |command| (|shoeLine?| |$ln|))
- (SETQ |dq|
- (|dqUnit|
- (|shoeConstructToken| |$linepos|
- (|shoeLeafLine| |command|) 0)))
- (CONS (LIST |dq|) |$r|))
- ((SETQ |command| (|shoeLisp?| |$ln|))
- (|shoeLispToken| |$r| |command|))
- (T (|shoeLineToks| |$r|))))
- (T (SETQ |toks| NIL)
- (LOOP
- (COND ((NOT (< |$n| |$sz|)) (RETURN NIL))
- (T (SETQ |toks| (|dqAppend| |toks| (|shoeToken|))))))
- (COND ((NULL |toks|) (|shoeLineToks| |$r|))
- (T (CONS (LIST |toks|) |$r|)))))))))
+ (LET* ((|$f| NIL)
+ (|$r| NIL)
+ (|$ln| NIL)
+ (|$n| NIL)
+ (|$sz| NIL)
+ (|$floatok| T)
+ (|$linepos| |s|)
+ |toks|
+ |dq|
+ |command|)
+ (DECLARE (SPECIAL |$f| |$r| |$ln| |$n| |$sz| |$floatok| |$linepos|))
+ (COND ((NOT (|shoeNextLine| |s|)) (CONS NIL NIL))
+ ((NULL |$n|) (|shoeLineToks| |$r|))
+ ((CHAR= (SCHAR |$ln| 0) (|char| '|)|))
+ (COND
+ ((SETQ |command| (|shoeLine?| |$ln|))
+ (SETQ |dq|
+ (|dqUnit|
+ (|shoeConstructToken| |$linepos|
+ (|shoeLeafLine| |command|) 0)))
+ (CONS (LIST |dq|) |$r|))
+ ((SETQ |command| (|shoeLisp?| |$ln|))
+ (|shoeLispToken| |$r| |command|))
+ (T (|shoeLineToks| |$r|))))
+ (T (SETQ |toks| NIL)
+ (LOOP
+ (COND ((NOT (< |$n| |$sz|)) (RETURN NIL))
+ (T (SETQ |toks| (|dqAppend| |toks| (|shoeToken|))))))
+ (COND ((NULL |toks|) (|shoeLineToks| |$r|))
+ (T (CONS (LIST |toks|) |$r|)))))))
(DEFUN |shoeLispToken| (|s| |string|)
- (PROG (|dq| |st| |r| |LETTMP#1| |linepos| |ln|)
+ (LET* (|dq| |st| |r| |LETTMP#1| |linepos| |ln|)
(DECLARE (SPECIAL |$linepos| |$ln|))
- (RETURN
- (PROGN
- (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|))
- (SETQ |r| (CAR |LETTMP#1|))
- (SETQ |st| (CDR |LETTMP#1|))
- (SETQ |dq|
- (|dqUnit|
- (|shoeConstructToken| |linepos| (|shoeLeafLisp| |st|) 0)))
- (CONS (LIST |dq|) |r|)))))
+ (PROGN
+ (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|))
+ (SETQ |r| (CAR |LETTMP#1|))
+ (SETQ |st| (CDR |LETTMP#1|))
+ (SETQ |dq|
+ (|dqUnit|
+ (|shoeConstructToken| |linepos| (|shoeLeafLisp| |st|) 0)))
+ (CONS (LIST |dq|) |r|))))
(DEFUN |shoeAccumulateLines| (|s| |string|)
- (PROG (|a| |command|)
+ (LET* (|a| |command|)
(DECLARE (SPECIAL |$ln| |$r| |$n|))
- (RETURN
- (COND ((NOT (|shoeNextLine| |s|)) (CONS |s| |string|))
- ((NULL |$n|) (|shoeAccumulateLines| |$r| |string|))
- ((EQL (LENGTH |$ln|) 0) (|shoeAccumulateLines| |$r| |string|))
- ((CHAR= (SCHAR |$ln| 0) (|char| '|)|))
- (SETQ |command| (|shoeLisp?| |$ln|))
- (COND
- ((AND |command| (PLUSP (LENGTH |command|)))
- (COND
- ((CHAR= (SCHAR |command| 0) (|char| '|;|))
- (|shoeAccumulateLines| |$r| |string|))
- ((SETQ |a| (|charPosition| (|char| '|;|) |command| 0))
- (|shoeAccumulateLines| |$r|
- (CONCAT |string|
- (|subString| |command| 0
- (- |a| 1)))))
- (T (|shoeAccumulateLines| |$r| (CONCAT |string| |command|)))))
- (T (|shoeAccumulateLines| |$r| |string|))))
- (T (CONS |s| |string|))))))
+ (COND ((NOT (|shoeNextLine| |s|)) (CONS |s| |string|))
+ ((NULL |$n|) (|shoeAccumulateLines| |$r| |string|))
+ ((EQL (LENGTH |$ln|) 0) (|shoeAccumulateLines| |$r| |string|))
+ ((CHAR= (SCHAR |$ln| 0) (|char| '|)|))
+ (SETQ |command| (|shoeLisp?| |$ln|))
+ (COND
+ ((AND |command| (PLUSP (LENGTH |command|)))
+ (COND
+ ((CHAR= (SCHAR |command| 0) (|char| '|;|))
+ (|shoeAccumulateLines| |$r| |string|))
+ ((SETQ |a| (|charPosition| (|char| '|;|) |command| 0))
+ (|shoeAccumulateLines| |$r|
+ (CONCAT |string|
+ (|subString| |command| 0
+ (- |a| 1)))))
+ (T (|shoeAccumulateLines| |$r| (CONCAT |string| |command|)))))
+ (T (|shoeAccumulateLines| |$r| |string|))))
+ (T (CONS |s| |string|)))))
(DEFUN |shoeCloser| (|t|)
(|symbolMember?| (|shoeKeyWord| |t|) '(CPAREN CBRACK)))
(DEFUN |shoeToken| ()
- (PROG (|b| |ch| |n| |linepos|)
+ (LET* (|b| |ch| |n| |linepos|)
(DECLARE (SPECIAL |$ln| |$n| |$linepos|))
- (RETURN
- (PROGN
- (SETQ |linepos| |$linepos|)
- (SETQ |n| |$n|)
- (SETQ |ch| (SCHAR |$ln| |$n|))
- (SETQ |b|
- (COND ((|shoeStartsComment|) (|shoeComment|) NIL)
- ((|shoeStartsNegComment|) (|shoeNegComment|) NIL)
- ((CHAR= |ch| (|char| '!)) (|shoeLispEscape|))
- ((|shoePunctuation| (CHAR-CODE |ch|)) (|shoePunct|))
- ((|shoeStartsId| |ch|) (|shoeWord| NIL))
- ((CHAR= |ch| (|char| '| |)) (|shoeSpace|) NIL)
- ((CHAR= |ch| (|char| '|"|)) (|shoeString|))
- ((DIGIT-CHAR-P |ch|) (|shoeNumber|))
- ((CHAR= |ch| (|char| '_)) (|shoeEscape|))
- ((EQUAL |ch| |shoeTAB|) (SETQ |$n| (+ |$n| 1)) NIL)
- (T (|shoeError|))))
- (COND ((NULL |b|) NIL)
- (T (|dqUnit| (|shoeConstructToken| |linepos| |b| |n|))))))))
+ (PROGN
+ (SETQ |linepos| |$linepos|)
+ (SETQ |n| |$n|)
+ (SETQ |ch| (SCHAR |$ln| |$n|))
+ (SETQ |b|
+ (COND ((|shoeStartsComment|) (|shoeComment|) NIL)
+ ((|shoeStartsNegComment|) (|shoeNegComment|) NIL)
+ ((CHAR= |ch| (|char| '!)) (|shoeLispEscape|))
+ ((|shoePunctuation| (CHAR-CODE |ch|)) (|shoePunct|))
+ ((|shoeStartsId| |ch|) (|shoeWord| NIL))
+ ((CHAR= |ch| (|char| '| |)) (|shoeSpace|) NIL)
+ ((CHAR= |ch| (|char| '|"|)) (|shoeString|))
+ ((DIGIT-CHAR-P |ch|) (|shoeNumber|))
+ ((CHAR= |ch| (|char| '_)) (|shoeEscape|))
+ ((EQUAL |ch| |shoeTAB|) (SETQ |$n| (+ |$n| 1)) NIL)
+ (T (|shoeError|))))
+ (COND ((NULL |b|) NIL)
+ (T (|dqUnit| (|shoeConstructToken| |linepos| |b| |n|)))))))
(DEFUN |shoeLeafId| (|x|) (LIST 'ID (INTERN |x|)))
@@ -157,12 +156,11 @@
(DEFUN |shoeLeafInteger| (|x|) (LIST 'INTEGER (|shoeIntValue| |x|)))
(DEFUN |shoeLeafFloat| (|a| |w| |e|)
- (PROG (|c| |b|)
- (RETURN
- (PROGN
- (SETQ |b| (|shoeIntValue| (CONCAT |a| |w|)))
- (SETQ |c| (* (|double| |b|) (EXPT (|double| 10) (- |e| (LENGTH |w|)))))
- (LIST 'FLOAT |c|)))))
+ (LET* (|c| |b|)
+ (PROGN
+ (SETQ |b| (|shoeIntValue| (CONCAT |a| |w|)))
+ (SETQ |c| (* (|double| |b|) (EXPT (|double| 10) (- |e| (LENGTH |w|)))))
+ (LIST 'FLOAT |c|))))
(DEFUN |shoeLeafString| (|x|) (LIST 'STRING |x|))
@@ -181,98 +179,91 @@
(DEFUN |shoeLeafSpaces| (|x|) (LIST 'SPACES |x|))
(DEFUN |shoeLispEscape| ()
- (PROG (|n| |exp| |a|)
+ (LET* (|n| |exp| |a|)
(DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|))
- (RETURN
- (PROGN
- (SETQ |$n| (+ |$n| 1))
- (COND
- ((NOT (< |$n| |$sz|))
- (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error")
- (|shoeLeafError| (SCHAR |$ln| |$n|)))
- (T (SETQ |a| (|shoeReadLispString| |$ln| |$n|))
- (COND
- ((NULL |a|)
- (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error")
- (|shoeLeafError| (SCHAR |$ln| |$n|)))
- (T (SETQ |exp| (CAR |a|)) (SETQ |n| (CADR |a|))
- (COND ((NULL |n|) (SETQ |$n| |$sz|) (|shoeLeafLispExp| |exp|))
- (T (SETQ |$n| |n|) (|shoeLeafLispExp| |exp|)))))))))))
+ (PROGN
+ (SETQ |$n| (+ |$n| 1))
+ (COND
+ ((NOT (< |$n| |$sz|))
+ (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error")
+ (|shoeLeafError| (SCHAR |$ln| |$n|)))
+ (T (SETQ |a| (|shoeReadLispString| |$ln| |$n|))
+ (COND
+ ((NULL |a|)
+ (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error")
+ (|shoeLeafError| (SCHAR |$ln| |$n|)))
+ (T (SETQ |exp| (CAR |a|)) (SETQ |n| (CADR |a|))
+ (COND ((NULL |n|) (SETQ |$n| |$sz|) (|shoeLeafLispExp| |exp|))
+ (T (SETQ |$n| |n|) (|shoeLeafLispExp| |exp|))))))))))
(DEFUN |shoeEscape| ()
(DECLARE (SPECIAL |$n|))
(PROGN (SETQ |$n| (+ |$n| 1)) (COND ((|shoeEsc|) (|shoeWord| T)) (T NIL))))
(DEFUN |shoeEsc| ()
- (PROG (|n1|)
+ (LET* (|n1|)
(DECLARE (SPECIAL |$ln| |$r| |$sz| |$n|))
- (RETURN
- (COND
- ((NOT (< |$n| |$sz|))
- (COND
- ((|shoeNextLine| |$r|)
- (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |$r|))))
- (|shoeEsc|) NIL)
- (T NIL)))
- (T (SETQ |n1| (|firstNonblankPosition| |$ln| |$n|))
- (COND
- ((NULL |n1|) (|shoeNextLine| |$r|)
- (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |$r|))))
- (|shoeEsc|) NIL)
- (T T)))))))
+ (COND
+ ((NOT (< |$n| |$sz|))
+ (COND
+ ((|shoeNextLine| |$r|)
+ (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |$r|)))) (|shoeEsc|)
+ NIL)
+ (T NIL)))
+ (T (SETQ |n1| (|firstNonblankPosition| |$ln| |$n|))
+ (COND
+ ((NULL |n1|) (|shoeNextLine| |$r|)
+ (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |$r|)))) (|shoeEsc|)
+ NIL)
+ (T T))))))
(DEFUN |shoeStartsComment| ()
- (PROG (|www|)
+ (LET* (|www|)
(DECLARE (SPECIAL |$ln| |$sz| |$n|))
- (RETURN
- (COND
- ((< |$n| |$sz|)
- (COND
- ((CHAR= (SCHAR |$ln| |$n|) (|char| '+)) (SETQ |www| (+ |$n| 1))
- (COND ((NOT (< |www| |$sz|)) NIL)
- (T (CHAR= (SCHAR |$ln| |www|) (|char| '+)))))
- (T NIL)))
- (T NIL)))))
+ (COND
+ ((< |$n| |$sz|)
+ (COND
+ ((CHAR= (SCHAR |$ln| |$n|) (|char| '+)) (SETQ |www| (+ |$n| 1))
+ (COND ((NOT (< |www| |$sz|)) NIL)
+ (T (CHAR= (SCHAR |$ln| |www|) (|char| '+)))))
+ (T NIL)))
+ (T NIL))))
(DEFUN |shoeStartsNegComment| ()
- (PROG (|www|)
+ (LET* (|www|)
(DECLARE (SPECIAL |$ln| |$sz| |$n|))
- (RETURN
- (COND
- ((< |$n| |$sz|)
- (COND
- ((CHAR= (SCHAR |$ln| |$n|) (|char| '-)) (SETQ |www| (+ |$n| 1))
- (COND ((NOT (< |www| |$sz|)) NIL)
- (T (CHAR= (SCHAR |$ln| |www|) (|char| '-)))))
- (T NIL)))
- (T NIL)))))
+ (COND
+ ((< |$n| |$sz|)
+ (COND
+ ((CHAR= (SCHAR |$ln| |$n|) (|char| '-)) (SETQ |www| (+ |$n| 1))
+ (COND ((NOT (< |www| |$sz|)) NIL)
+ (T (CHAR= (SCHAR |$ln| |www|) (|char| '-)))))
+ (T NIL)))
+ (T NIL))))
(DEFUN |shoeNegComment| ()
- (PROG (|n|)
+ (LET* (|n|)
(DECLARE (SPECIAL |$ln| |$sz| |$n|))
- (RETURN
- (PROGN
- (SETQ |n| |$n|)
- (SETQ |$n| |$sz|)
- (|shoeLeafNegComment| (|subString| |$ln| |n|))))))
+ (PROGN
+ (SETQ |n| |$n|)
+ (SETQ |$n| |$sz|)
+ (|shoeLeafNegComment| (|subString| |$ln| |n|)))))
(DEFUN |shoeComment| ()
- (PROG (|n|)
+ (LET* (|n|)
(DECLARE (SPECIAL |$ln| |$sz| |$n|))
- (RETURN
- (PROGN
- (SETQ |n| |$n|)
- (SETQ |$n| |$sz|)
- (|shoeLeafComment| (|subString| |$ln| |n|))))))
+ (PROGN
+ (SETQ |n| |$n|)
+ (SETQ |$n| |$sz|)
+ (|shoeLeafComment| (|subString| |$ln| |n|)))))
(DEFUN |shoePunct| ()
- (PROG (|sss|)
+ (LET* (|sss|)
(DECLARE (SPECIAL |$n| |$ln|))
- (RETURN
- (PROGN
- (SETQ |sss| (|shoeMatch| |$ln| |$n|))
- (SETQ |$n| (+ |$n| (LENGTH |sss|)))
- (|shoeKeyTr| |sss|)))))
+ (PROGN
+ (SETQ |sss| (|shoeMatch| |$ln| |$n|))
+ (SETQ |$n| (+ |$n| (LENGTH |sss|)))
+ (|shoeKeyTr| |sss|))))
(DEFUN |shoeKeyTr| (|w|)
(DECLARE (SPECIAL |$floatok|))
@@ -289,15 +280,14 @@
(T (SETQ |w| (|shoeInteger|)) (|shoeExponent| "0" |w|))))
(DEFUN |shoeSpace| ()
- (PROG (|n|)
+ (LET* (|n|)
(DECLARE (SPECIAL |$floatok| |$ln| |$n|))
- (RETURN
- (PROGN
- (SETQ |n| |$n|)
- (SETQ |$n| (|firstNonblankPosition| |$ln| |$n|))
- (SETQ |$floatok| T)
- (COND ((NULL |$n|) (|shoeLeafSpaces| 0) (SETQ |$n| (LENGTH |$ln|)))
- (T (|shoeLeafSpaces| (- |$n| |n|))))))))
+ (PROGN
+ (SETQ |n| |$n|)
+ (SETQ |$n| (|firstNonblankPosition| |$ln| |$n|))
+ (SETQ |$floatok| T)
+ (COND ((NULL |$n|) (|shoeLeafSpaces| 0) (SETQ |$n| (LENGTH |$ln|)))
+ (T (|shoeLeafSpaces| (- |$n| |n|)))))))
(DEFUN |shoeString| ()
(DECLARE (SPECIAL |$floatok| |$n|))
@@ -307,30 +297,29 @@
(|shoeLeafString| (|shoeS|))))
(DEFUN |shoeS| ()
- (PROG (|b| |a| |str| |mn| |escsym| |strsym| |n|)
+ (LET* (|b| |a| |str| |mn| |escsym| |strsym| |n|)
(DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|))
- (RETURN
- (COND
- ((NOT (< |$n| |$sz|))
- (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") "")
- (T (SETQ |n| |$n|)
- (SETQ |strsym| (OR (|charPosition| (|char| '|"|) |$ln| |$n|) |$sz|))
- (SETQ |escsym| (OR (|charPosition| (|char| '_) |$ln| |$n|) |$sz|))
- (SETQ |mn| (MIN |strsym| |escsym|))
- (COND
- ((EQUAL |mn| |$sz|) (SETQ |$n| |$sz|)
- (|SoftShoeError| (CONS |$linepos| |$n|) "quote added")
- (|subString| |$ln| |n|))
- ((EQUAL |mn| |strsym|) (SETQ |$n| (+ |mn| 1))
- (|subString| |$ln| |n| (- |mn| |n|)))
- (T (SETQ |str| (|subString| |$ln| |n| (- |mn| |n|)))
- (SETQ |$n| (+ |mn| 1)) (SETQ |a| (|shoeEsc|))
- (SETQ |b|
- (COND
- (|a| (SETQ |str| (CONCAT |str| (STRING (SCHAR |$ln| |$n|))))
- (SETQ |$n| (+ |$n| 1)) (|shoeS|))
- (T (|shoeS|))))
- (CONCAT |str| |b|))))))))
+ (COND
+ ((NOT (< |$n| |$sz|))
+ (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") "")
+ (T (SETQ |n| |$n|)
+ (SETQ |strsym| (OR (|charPosition| (|char| '|"|) |$ln| |$n|) |$sz|))
+ (SETQ |escsym| (OR (|charPosition| (|char| '_) |$ln| |$n|) |$sz|))
+ (SETQ |mn| (MIN |strsym| |escsym|))
+ (COND
+ ((EQUAL |mn| |$sz|) (SETQ |$n| |$sz|)
+ (|SoftShoeError| (CONS |$linepos| |$n|) "quote added")
+ (|subString| |$ln| |n|))
+ ((EQUAL |mn| |strsym|) (SETQ |$n| (+ |mn| 1))
+ (|subString| |$ln| |n| (- |mn| |n|)))
+ (T (SETQ |str| (|subString| |$ln| |n| (- |mn| |n|)))
+ (SETQ |$n| (+ |mn| 1)) (SETQ |a| (|shoeEsc|))
+ (SETQ |b|
+ (COND
+ (|a| (SETQ |str| (CONCAT |str| (STRING (SCHAR |$ln| |$n|))))
+ (SETQ |$n| (+ |$n| 1)) (|shoeS|))
+ (T (|shoeS|))))
+ (CONCAT |str| |b|)))))))
(DEFUN |shoeIdEnd| (|line| |n|)
(PROGN
@@ -342,128 +331,120 @@
|n|))
(DEFUN |shoeW| (|b|)
- (PROG (|bb| |a| |str| |endid| |l| |n1|)
+ (LET* (|bb| |a| |str| |endid| |l| |n1|)
(DECLARE (SPECIAL |$ln| |$sz| |$n|))
- (RETURN
- (PROGN
- (SETQ |n1| |$n|)
- (SETQ |$n| (+ |$n| 1))
- (SETQ |l| |$sz|)
- (SETQ |endid| (|shoeIdEnd| |$ln| |$n|))
- (COND
- ((OR (EQUAL |endid| |l|)
- (NOT (CHAR= (SCHAR |$ln| |endid|) (|char| '_))))
- (SETQ |$n| |endid|)
- (LIST |b| (|subString| |$ln| |n1| (- |endid| |n1|))))
- (T (SETQ |str| (|subString| |$ln| |n1| (- |endid| |n1|)))
- (SETQ |$n| (+ |endid| 1)) (SETQ |a| (|shoeEsc|))
- (SETQ |bb| (COND (|a| (|shoeW| T)) (T (LIST |b| ""))))
- (LIST (OR (ELT |bb| 0) |b|) (CONCAT |str| (ELT |bb| 1)))))))))
+ (PROGN
+ (SETQ |n1| |$n|)
+ (SETQ |$n| (+ |$n| 1))
+ (SETQ |l| |$sz|)
+ (SETQ |endid| (|shoeIdEnd| |$ln| |$n|))
+ (COND
+ ((OR (EQUAL |endid| |l|) (NOT (CHAR= (SCHAR |$ln| |endid|) (|char| '_))))
+ (SETQ |$n| |endid|)
+ (LIST |b| (|subString| |$ln| |n1| (- |endid| |n1|))))
+ (T (SETQ |str| (|subString| |$ln| |n1| (- |endid| |n1|)))
+ (SETQ |$n| (+ |endid| 1)) (SETQ |a| (|shoeEsc|))
+ (SETQ |bb| (COND (|a| (|shoeW| T)) (T (LIST |b| ""))))
+ (LIST (OR (ELT |bb| 0) |b|) (CONCAT |str| (ELT |bb| 1))))))))
(DEFUN |shoeWord| (|esp|)
- (PROG (|w| |aaa|)
+ (LET* (|w| |aaa|)
(DECLARE (SPECIAL |$floatok|))
- (RETURN
- (PROGN
- (SETQ |aaa| (|shoeW| NIL))
- (SETQ |w| (ELT |aaa| 1))
- (SETQ |$floatok| NIL)
- (COND ((OR |esp| (ELT |aaa| 0)) (|shoeLeafId| |w|))
- ((|shoeKeyWordP| |w|) (SETQ |$floatok| T) (|shoeLeafKey| |w|))
- (T (|shoeLeafId| |w|)))))))
+ (PROGN
+ (SETQ |aaa| (|shoeW| NIL))
+ (SETQ |w| (ELT |aaa| 1))
+ (SETQ |$floatok| NIL)
+ (COND ((OR |esp| (ELT |aaa| 0)) (|shoeLeafId| |w|))
+ ((|shoeKeyWordP| |w|) (SETQ |$floatok| T) (|shoeLeafKey| |w|))
+ (T (|shoeLeafId| |w|))))))
(DEFUN |shoeInteger| () (|shoeInteger1| NIL))
(DEFUN |shoeInteger1| (|zro|)
- (PROG (|bb| |a| |str| |l| |n|)
+ (LET* (|bb| |a| |str| |l| |n|)
(DECLARE (SPECIAL |$ln| |$sz| |$n|))
- (RETURN
- (PROGN
- (SETQ |n| |$n|)
- (SETQ |l| |$sz|)
- (LOOP
- (COND
- ((NOT (AND (< |$n| |l|) (DIGIT-CHAR-P (SCHAR |$ln| |$n|))))
- (RETURN NIL))
- (T (SETQ |$n| (+ |$n| 1)))))
+ (PROGN
+ (SETQ |n| |$n|)
+ (SETQ |l| |$sz|)
+ (LOOP
(COND
- ((OR (EQUAL |$n| |l|) (NOT (CHAR= (SCHAR |$ln| |$n|) (|char| '_))))
- (COND ((AND (EQUAL |n| |$n|) |zro|) "0")
- (T (|subString| |$ln| |n| (- |$n| |n|)))))
- (T (SETQ |str| (|subString| |$ln| |n| (- |$n| |n|)))
- (SETQ |$n| (+ |$n| 1)) (SETQ |a| (|shoeEsc|))
- (SETQ |bb| (|shoeInteger1| |zro|)) (CONCAT |str| |bb|)))))))
+ ((NOT (AND (< |$n| |l|) (DIGIT-CHAR-P (SCHAR |$ln| |$n|))))
+ (RETURN NIL))
+ (T (SETQ |$n| (+ |$n| 1)))))
+ (COND
+ ((OR (EQUAL |$n| |l|) (NOT (CHAR= (SCHAR |$ln| |$n|) (|char| '_))))
+ (COND ((AND (EQUAL |n| |$n|) |zro|) "0")
+ (T (|subString| |$ln| |n| (- |$n| |n|)))))
+ (T (SETQ |str| (|subString| |$ln| |n| (- |$n| |n|)))
+ (SETQ |$n| (+ |$n| 1)) (SETQ |a| (|shoeEsc|))
+ (SETQ |bb| (|shoeInteger1| |zro|)) (CONCAT |str| |bb|))))))
(DEFUN |shoeIntValue| (|s|)
- (PROG (|d| |ival| |ns|)
- (RETURN
- (PROGN
- (SETQ |ns| (LENGTH |s|))
- (SETQ |ival| 0)
- (LET ((|bfVar#1| (- |ns| 1)) (|i| 0))
- (LOOP
- (COND ((> |i| |bfVar#1|) (RETURN NIL))
- (T (SETQ |d| (DIGIT-CHAR-P (SCHAR |s| |i|)))
- (SETQ |ival| (+ (* 10 |ival|) |d|))))
- (SETQ |i| (+ |i| 1))))
- |ival|))))
+ (LET* (|d| |ival| |ns|)
+ (PROGN
+ (SETQ |ns| (LENGTH |s|))
+ (SETQ |ival| 0)
+ (LET ((|bfVar#1| (- |ns| 1)) (|i| 0))
+ (LOOP
+ (COND ((> |i| |bfVar#1|) (RETURN NIL))
+ (T (SETQ |d| (DIGIT-CHAR-P (SCHAR |s| |i|)))
+ (SETQ |ival| (+ (* 10 |ival|) |d|))))
+ (SETQ |i| (+ |i| 1))))
+ |ival|)))
(DEFUN |shoeNumber| ()
- (PROG (|w| |n| |a|)
+ (LET* (|w| |n| |a|)
(DECLARE (SPECIAL |$ln| |$floatok| |$sz| |$n|))
- (RETURN
- (PROGN
- (SETQ |a| (|shoeInteger|))
- (COND ((NOT (< |$n| |$sz|)) (|shoeLeafInteger| |a|))
- ((AND |$floatok| (CHAR= (SCHAR |$ln| |$n|) (|char| '|.|)))
- (SETQ |n| |$n|) (SETQ |$n| (+ |$n| 1))
- (COND
- ((AND (< |$n| |$sz|) (CHAR= (SCHAR |$ln| |$n|) (|char| '|.|)))
- (SETQ |$n| |n|) (|shoeLeafInteger| |a|))
- (T (SETQ |w| (|shoeInteger1| T)) (|shoeExponent| |a| |w|))))
- (T (|shoeLeafInteger| |a|)))))))
+ (PROGN
+ (SETQ |a| (|shoeInteger|))
+ (COND ((NOT (< |$n| |$sz|)) (|shoeLeafInteger| |a|))
+ ((AND |$floatok| (CHAR= (SCHAR |$ln| |$n|) (|char| '|.|)))
+ (SETQ |n| |$n|) (SETQ |$n| (+ |$n| 1))
+ (COND
+ ((AND (< |$n| |$sz|) (CHAR= (SCHAR |$ln| |$n|) (|char| '|.|)))
+ (SETQ |$n| |n|) (|shoeLeafInteger| |a|))
+ (T (SETQ |w| (|shoeInteger1| T)) (|shoeExponent| |a| |w|))))
+ (T (|shoeLeafInteger| |a|))))))
(DEFUN |shoeExponent| (|a| |w|)
- (PROG (|c1| |e| |c| |n|)
+ (LET* (|c1| |e| |c| |n|)
(DECLARE (SPECIAL |$ln| |$sz| |$n|))
- (RETURN
- (COND ((NOT (< |$n| |$sz|)) (|shoeLeafFloat| |a| |w| 0))
- (T (SETQ |n| |$n|) (SETQ |c| (SCHAR |$ln| |$n|))
- (COND
- ((OR (CHAR= |c| (|char| 'E)) (CHAR= |c| (|char| '|e|)))
- (SETQ |$n| (+ |$n| 1))
- (COND
- ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|)
- (|shoeLeafFloat| |a| |w| 0))
- ((DIGIT-CHAR-P (SCHAR |$ln| |$n|)) (SETQ |e| (|shoeInteger|))
- (SETQ |e| (|shoeIntValue| |e|)) (|shoeLeafFloat| |a| |w| |e|))
- (T (SETQ |c1| (SCHAR |$ln| |$n|))
- (COND
- ((OR (CHAR= |c1| (|char| '+)) (CHAR= |c1| (|char| '-)))
- (SETQ |$n| (+ |$n| 1))
- (COND
- ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|)
- (|shoeLeafFloat| |a| |w| 0))
- ((DIGIT-CHAR-P (SCHAR |$ln| |$n|))
- (SETQ |e| (|shoeInteger|)) (SETQ |e| (|shoeIntValue| |e|))
- (|shoeLeafFloat| |a| |w|
- (COND ((CHAR= |c1| (|char| '-)) (- |e|))
- (T |e|))))
- (T (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0))))))))
- (T (|shoeLeafFloat| |a| |w| 0))))))))
+ (COND ((NOT (< |$n| |$sz|)) (|shoeLeafFloat| |a| |w| 0))
+ (T (SETQ |n| |$n|) (SETQ |c| (SCHAR |$ln| |$n|))
+ (COND
+ ((OR (CHAR= |c| (|char| 'E)) (CHAR= |c| (|char| '|e|)))
+ (SETQ |$n| (+ |$n| 1))
+ (COND
+ ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|)
+ (|shoeLeafFloat| |a| |w| 0))
+ ((DIGIT-CHAR-P (SCHAR |$ln| |$n|)) (SETQ |e| (|shoeInteger|))
+ (SETQ |e| (|shoeIntValue| |e|)) (|shoeLeafFloat| |a| |w| |e|))
+ (T (SETQ |c1| (SCHAR |$ln| |$n|))
+ (COND
+ ((OR (CHAR= |c1| (|char| '+)) (CHAR= |c1| (|char| '-)))
+ (SETQ |$n| (+ |$n| 1))
+ (COND
+ ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|)
+ (|shoeLeafFloat| |a| |w| 0))
+ ((DIGIT-CHAR-P (SCHAR |$ln| |$n|)) (SETQ |e| (|shoeInteger|))
+ (SETQ |e| (|shoeIntValue| |e|))
+ (|shoeLeafFloat| |a| |w|
+ (COND ((CHAR= |c1| (|char| '-)) (- |e|))
+ (T |e|))))
+ (T (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0))))))))
+ (T (|shoeLeafFloat| |a| |w| 0)))))))
(DEFUN |shoeError| ()
- (PROG (|n|)
+ (LET* (|n|)
(DECLARE (SPECIAL |$ln| |$linepos| |$n|))
- (RETURN
- (PROGN
- (SETQ |n| |$n|)
- (SETQ |$n| (+ |$n| 1))
- (|SoftShoeError| (CONS |$linepos| |n|)
- (CONCAT "The character whose number is "
- (WRITE-TO-STRING (CHAR-CODE (SCHAR |$ln| |n|)))
- " is not a Boot character"))
- (|shoeLeafError| (SCHAR |$ln| |n|))))))
+ (PROGN
+ (SETQ |n| |$n|)
+ (SETQ |$n| (+ |$n| 1))
+ (|SoftShoeError| (CONS |$linepos| |n|)
+ (CONCAT "The character whose number is "
+ (WRITE-TO-STRING (CHAR-CODE (SCHAR |$ln| |n|)))
+ " is not a Boot character"))
+ (|shoeLeafError| (SCHAR |$ln| |n|)))))
(DEFUN |shoeKeyWord| (|st|) (|tableValue| |shoeKeyTable| |st|))
@@ -472,34 +453,33 @@
(DEFUN |shoeMatch| (|l| |i|) (|shoeSubStringMatch| |l| |shoeDict| |i|))
(DEFUN |shoeSubStringMatch| (|l| |d| |i|)
- (PROG (|eql| |ls| |s| |s1| |done| |ll| |u| |h|)
- (RETURN
- (PROGN
- (SETQ |h| (CHAR-CODE (SCHAR |l| |i|)))
- (SETQ |u| (ELT |d| |h|))
- (SETQ |ll| (LENGTH |l|))
- (SETQ |done| NIL)
- (SETQ |s1| "")
- (LET ((|bfVar#1| (- (LENGTH |u|) 1)) (|j| 0))
- (LOOP
- (COND ((OR (> |j| |bfVar#1|) |done|) (RETURN NIL))
- (T (SETQ |s| (ELT |u| |j|)) (SETQ |ls| (LENGTH |s|))
- (SETQ |done|
- (COND ((< |ll| (+ |ls| |i|)) NIL)
- (T (SETQ |eql| T)
- (LET ((|bfVar#2| (- |ls| 1)) (|k| 1))
- (LOOP
- (COND
- ((OR (> |k| |bfVar#2|) (NOT |eql|))
- (RETURN NIL))
- (T
- (SETQ |eql|
- (CHAR= (SCHAR |s| |k|)
- (SCHAR |l| (+ |k| |i|))))))
- (SETQ |k| (+ |k| 1))))
- (COND (|eql| (SETQ |s1| |s|) T) (T NIL)))))))
- (SETQ |j| (+ |j| 1))))
- |s1|))))
+ (LET* (|eql| |ls| |s| |s1| |done| |ll| |u| |h|)
+ (PROGN
+ (SETQ |h| (CHAR-CODE (SCHAR |l| |i|)))
+ (SETQ |u| (ELT |d| |h|))
+ (SETQ |ll| (LENGTH |l|))
+ (SETQ |done| NIL)
+ (SETQ |s1| "")
+ (LET ((|bfVar#1| (- (LENGTH |u|) 1)) (|j| 0))
+ (LOOP
+ (COND ((OR (> |j| |bfVar#1|) |done|) (RETURN NIL))
+ (T (SETQ |s| (ELT |u| |j|)) (SETQ |ls| (LENGTH |s|))
+ (SETQ |done|
+ (COND ((< |ll| (+ |ls| |i|)) NIL)
+ (T (SETQ |eql| T)
+ (LET ((|bfVar#2| (- |ls| 1)) (|k| 1))
+ (LOOP
+ (COND
+ ((OR (> |k| |bfVar#2|) (NOT |eql|))
+ (RETURN NIL))
+ (T
+ (SETQ |eql|
+ (CHAR= (SCHAR |s| |k|)
+ (SCHAR |l| (+ |k| |i|))))))
+ (SETQ |k| (+ |k| 1))))
+ (COND (|eql| (SETQ |s1| |s|) T) (T NIL)))))))
+ (SETQ |j| (+ |j| 1))))
+ |s1|)))
(DEFUN |shoePunctuation| (|c|) (EQL (ELT |shoePun| |c|) 1))
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-01 09:21:29 +0000