aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/includer.boot33
-rw-r--r--src/boot/pile.boot4
-rw-r--r--src/boot/scanner.boot4
-rw-r--r--src/boot/strap/includer.clisp37
-rw-r--r--src/boot/strap/pile.clisp10
-rw-r--r--src/boot/strap/scanner.clisp7
6 files changed, 60 insertions, 35 deletions
diff --git a/src/boot/includer.boot b/src/boot/includer.boot
index d36932d5..9b09f02b 100644
--- a/src/boot/includer.boot
+++ b/src/boot/includer.boot
@@ -116,13 +116,22 @@ bpIgnoredFromTo(pos1, pos2) ==
shoeConsole lineString pos2
shoeConsole strconc(shoeSpaces lineCharacter pos2,'"|")
+--%
+structure %SourceLine ==
+ Record(str: %String, num: %Short) with
+ sourceLineString == (.str)
+ sourceLineNumber == (.num)
+
+macro makeSourceLine(s,n) ==
+ mk%SourceLine(s,n)
+
-- Line inclusion support.
lineNo p ==
- CDAAR p
+ sourceLineNumber CAAR p
lineString p ==
- CAAAR p
+ sourceLineString CAAR p
lineCharacter p ==
rest p
@@ -147,7 +156,7 @@ bMap1(f,x)==
[apply(f,[first x]),:bMap(f,rest x)]
bDelay(f,x) ==
- ["nonnullstream",:[f,:x]]
+ ["nonnullstream",f,:x]
bAppend(x,y) ==
bDelay(function bAppend1,[x,y])
@@ -187,7 +196,7 @@ bAddLineNumber(f1,f2) ==
bAddLineNumber1(f1,f2)==
bStreamNull f1 => ["nullstream"]
bStreamNull f2 => ["nullstream"]
- [[first f1,:first f2],:bAddLineNumber(rest f1,rest f2)]
+ [makeSourceLine(first f1,first f2),:bAddLineNumber(rest f1,rest f2)]
shoePrefixLisp x ==
@@ -224,13 +233,13 @@ shoeInclude s ==
shoeInclude1 s ==
bStreamNull s => s
[h,:t] := s
- string := first h
+ string := sourceLineString h
command := shoeFin? string => $bStreamNil
command := shoeIf? string => shoeThen([true],[STTOMC command],t)
bAppend(shoeSimpleLine h,shoeInclude t)
shoeSimpleLine(h) ==
- string := first h
+ string := sourceLineString h
shoePlainLine? string=> [h]
command := shoeLisp? string => [h]
command := shoeLine? string => [h]
@@ -249,7 +258,7 @@ shoeThen(keep,b,s) ==
shoeThen1(keep,b,s)==
bPremStreamNull s=> s
[h,:t] := s
- string := first h
+ string := sourceLineString h
command := shoeFin? string => bPremStreamNil(h)
keep1 := first keep
b1 := first b
@@ -275,7 +284,7 @@ shoeElse(keep,b,s) ==
shoeElse1(keep,b,s)==
bPremStreamNull s=> s
[h,:t] := s
- string := first h
+ string := sourceLineString h
command := shoeFin? string => bPremStreamNil(h)
b1 := first b
keep1 := first keep
@@ -290,13 +299,13 @@ shoeElse1(keep,b,s)==
shoeLineSyntaxError(h)==
shoeConsole strconc('"INCLUSION SYNTAX ERROR IN LINE ",
- toString rest h)
- shoeConsole first h
+ toString sourceLineNumber h)
+ shoeConsole sourceLineString h
shoeConsole '"LINE IGNORED"
bPremStreamNil(h)==
- shoeConsole strconc('"UNEXPECTED )fin IN LINE ",toString rest h)
- shoeConsole first h
+ shoeConsole strconc('"UNEXPECTED )fin IN LINE ",toString sourceLineNumber h)
+ shoeConsole sourceLineString h
shoeConsole '"REST OF FILE IGNORED"
$bStreamNil
diff --git a/src/boot/pile.boot b/src/boot/pile.boot
index f789067d..f374fee9 100644
--- a/src/boot/pile.boot
+++ b/src/boot/pile.boot
@@ -57,14 +57,14 @@ shoePileInsert (s)==
shoePileTree(n,s)==
bStreamNull s => [false,n,[],s]
- [h,t] := [first s,rest s]
+ [h,:t] := s
hh := shoePileColumn h
hh > n => shoePileForests(h,hh,t)
[false,n,[],s]
eqshoePileTree(n,s)==
bStreamNull s => [false,n,[],s]
- [h,t] := [first s,rest s]
+ [h,:t] := s
hh := shoePileColumn h
hh = n => shoePileForests(h,hh,t)
[false,n,[],s]
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
index f283d08a..91298559 100644
--- a/src/boot/scanner.boot
+++ b/src/boot/scanner.boot
@@ -64,7 +64,7 @@ shoeNextLine s==
bStreamNull s => false
$linepos := s
[$f,:$r] := s
- $ln := first $f
+ $ln := sourceLineString $f
$n := firstNonblankPosition($ln,0)
$sz := #$ln
$n = nil => true
@@ -72,7 +72,7 @@ shoeNextLine s==
a := makeString(7-($n rem 8),char " ")
stringChar($ln,$n) := char " "
$ln := strconc(a,$ln)
- s1 := [[$ln,:rest $f],:$r]
+ s1 := [makeSourceLine($ln,sourceLineNumber $f),:$r]
shoeNextLine s1
true
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))))))
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 05:01:32 +0000