diff options
Diffstat (limited to 'src/boot/strap')
| -rw-r--r-- | src/boot/strap/includer.clisp | 37 | ||||
| -rw-r--r-- | src/boot/strap/pile.clisp | 10 | ||||
| -rw-r--r-- | src/boot/strap/scanner.clisp | 7 |
3 files changed, 35 insertions, 19 deletions
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp index 7dce3190..02d2408b 100644 --- a/src/boot/strap/includer.clisp +++ b/src/boot/strap/includer.clisp @@ -59,9 +59,22 @@ (|shoeConsole| (|lineString| |pos2|)) (|shoeConsole| (CONCAT (|shoeSpaces| (|lineCharacter| |pos2|)) "|")))) -(DEFUN |lineNo| (|p|) (CDAAR |p|)) +(DEFSTRUCT (|%SourceLine| (:COPIER |copy%SourceLine|)) |str| |num|) -(DEFUN |lineString| (|p|) (CAAAR |p|)) +(DEFMACRO |mk%SourceLine| (|str| |num|) + (LIST '|MAKE-%SourceLine| :|str| |str| :|num| |num|)) + +(DEFMACRO |sourceLineString| (|bfVar#1|) (LIST '|%SourceLine-str| |bfVar#1|)) + +(DEFMACRO |sourceLineNumber| (|bfVar#1|) (LIST '|%SourceLine-num| |bfVar#1|)) + +(DEFMACRO |makeSourceLine| (|bfVar#2| |bfVar#1|) + (|applySubst| (LIST (CONS '|bfVar#2| |bfVar#2|) (CONS '|bfVar#1| |bfVar#1|)) + '(|mk%SourceLine| |bfVar#2| |bfVar#1|))) + +(DEFUN |lineNo| (|p|) (|sourceLineNumber| (CAAR |p|))) + +(DEFUN |lineString| (|p|) (|sourceLineString| (CAAR |p|))) (DEFUN |lineCharacter| (|p|) (CDR |p|)) @@ -131,7 +144,7 @@ (COND ((|bStreamNull| |f1|) (LIST '|nullstream|)) ((|bStreamNull| |f2|) (LIST '|nullstream|)) (T - (CONS (CONS (CAR |f1|) (CAR |f2|)) + (CONS (|makeSourceLine| (CAR |f1|) (CAR |f2|)) (|bAddLineNumber| (CDR |f1|) (CDR |f2|)))))) (DEFUN |shoePrefixLisp| (|x|) (CONCAT ")lisp" |x|)) @@ -181,7 +194,7 @@ (LET* (|command| |string| |t| |h|) (COND ((|bStreamNull| |s|) |s|) (T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|)) - (SETQ |string| (CAR |h|)) + (SETQ |string| (|sourceLineString| |h|)) (COND ((SETQ |command| (|shoeFin?| |string|)) |$bStreamNil|) ((SETQ |command| (|shoeIf?| |string|)) (|shoeThen| (LIST T) (LIST (STTOMC |command|)) |t|)) @@ -190,7 +203,7 @@ (DEFUN |shoeSimpleLine| (|h|) (LET* (|command| |string|) (PROGN - (SETQ |string| (CAR |h|)) + (SETQ |string| (|sourceLineString| |h|)) (COND ((|shoePlainLine?| |string|) (LIST |h|)) ((SETQ |command| (|shoeLisp?| |string|)) (LIST |h|)) ((SETQ |command| (|shoeLine?| |string|)) (LIST |h|)) @@ -206,7 +219,7 @@ (LET* (|b1| |keep1| |command| |string| |t| |h|) (COND ((|bPremStreamNull| |s|) |s|) (T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|)) - (SETQ |string| (CAR |h|)) + (SETQ |string| (|sourceLineString| |h|)) (COND ((SETQ |command| (|shoeFin?| |string|)) (|bPremStreamNil| |h|)) (T (SETQ |keep1| (CAR |keep|)) (SETQ |b1| (CAR |b|)) @@ -246,7 +259,7 @@ (LET* (|keep1| |b1| |command| |string| |t| |h|) (COND ((|bPremStreamNull| |s|) |s|) (T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|)) - (SETQ |string| (CAR |h|)) + (SETQ |string| (|sourceLineString| |h|)) (COND ((SETQ |command| (|shoeFin?| |string|)) (|bPremStreamNil| |h|)) (T (SETQ |b1| (CAR |b|)) (SETQ |keep1| (CAR |keep|)) @@ -267,15 +280,17 @@ (DEFUN |shoeLineSyntaxError| (|h|) (PROGN (|shoeConsole| - (CONCAT "INCLUSION SYNTAX ERROR IN LINE " (WRITE-TO-STRING (CDR |h|)))) - (|shoeConsole| (CAR |h|)) + (CONCAT "INCLUSION SYNTAX ERROR IN LINE " + (WRITE-TO-STRING (|sourceLineNumber| |h|)))) + (|shoeConsole| (|sourceLineString| |h|)) (|shoeConsole| "LINE IGNORED"))) (DEFUN |bPremStreamNil| (|h|) (PROGN (|shoeConsole| - (CONCAT "UNEXPECTED )fin IN LINE " (WRITE-TO-STRING (CDR |h|)))) - (|shoeConsole| (CAR |h|)) + (CONCAT "UNEXPECTED )fin IN LINE " + (WRITE-TO-STRING (|sourceLineNumber| |h|)))) + (|shoeConsole| (|sourceLineString| |h|)) (|shoeConsole| "REST OF FILE IGNORED") |$bStreamNil|)) diff --git a/src/boot/strap/pile.clisp b/src/boot/strap/pile.clisp index 6eb0c938..fb2da17f 100644 --- a/src/boot/strap/pile.clisp +++ b/src/boot/strap/pile.clisp @@ -24,19 +24,17 @@ (CONS (LIST (ELT |a| 2)) (ELT |a| 3)))))))) (DEFUN |shoePileTree| (|n| |s|) - (LET* (|hh| |t| |h| |LETTMP#1|) + (LET* (|hh| |t| |h|) (COND ((|bStreamNull| |s|) (LIST NIL |n| NIL |s|)) - (T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|))) - (SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|)) + (T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|)) (SETQ |hh| (|shoePileColumn| |h|)) (COND ((< |n| |hh|) (|shoePileForests| |h| |hh| |t|)) (T (LIST NIL |n| NIL |s|))))))) (DEFUN |eqshoePileTree| (|n| |s|) - (LET* (|hh| |t| |h| |LETTMP#1|) + (LET* (|hh| |t| |h|) (COND ((|bStreamNull| |s|) (LIST NIL |n| NIL |s|)) - (T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|))) - (SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|)) + (T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|)) (SETQ |hh| (|shoePileColumn| |h|)) (COND ((EQUAL |hh| |n|) (|shoePileForests| |h| |hh| |t|)) (T (LIST NIL |n| NIL |s|))))))) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 3c056e11..070235e3 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -28,7 +28,7 @@ (DECLARE (SPECIAL |$sz| |$n| |$ln| |$r| |$f| |$linepos|)) (COND ((|bStreamNull| |s|) NIL) (T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|)) (SETQ |$r| (CDR |s|)) - (SETQ |$ln| (CAR |$f|)) + (SETQ |$ln| (|sourceLineString| |$f|)) (SETQ |$n| (|firstNonblankPosition| |$ln| 0)) (SETQ |$sz| (LENGTH |$ln|)) (COND ((NULL |$n|) T) @@ -36,7 +36,10 @@ (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|)) + (SETQ |s1| + (CONS + (|makeSourceLine| |$ln| (|sourceLineNumber| |$f|)) + |$r|)) (|shoeNextLine| |s1|)) (T T)))))) |