aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/includer.boot136
-rw-r--r--src/boot/scanner.boot17
-rw-r--r--src/boot/strap/includer.clisp50
-rw-r--r--src/boot/strap/scanner.clisp25
-rw-r--r--src/boot/strap/tokens.clisp1
-rw-r--r--src/boot/tokens.boot1
6 files changed, 107 insertions, 123 deletions
diff --git a/src/boot/includer.boot b/src/boot/includer.boot
index e74542eb..4ea4ef4b 100644
--- a/src/boot/includer.boot
+++ b/src/boot/includer.boot
@@ -77,9 +77,9 @@ shoeNotFound fn ==
shoeReadLispString(s,n) ==
- l:=# s
- n >= l => nil
- READ_-FROM_-STRING strconc ( "(", subString(s,n,l-n) ,")")
+ l := #s
+ n >= l => nil
+ READ_-FROM_-STRING strconc ( "(", subString(s,n,l-n) ,")")
-- read a line from stream
shoeReadLine stream ==
@@ -101,26 +101,28 @@ diagnosticLocation tok ==
toString lineCharacter pos)
SoftShoeError(posn,key)==
- coreError ['"in line ", toString lineNo posn]
- shoeConsole lineString posn
- shoeConsole strconc(shoeSpaces lineCharacter posn,'"|")
- shoeConsole key
+ coreError ['"in line ", toString lineNo posn]
+ shoeConsole lineString posn
+ shoeConsole strconc(shoeSpaces lineCharacter posn,'"|")
+ shoeConsole key
bpSpecificErrorAtToken(tok, key) ==
- a:=shoeTokPosn tok
- SoftShoeError(a,key)
+ a := shoeTokPosn tok
+ SoftShoeError(a,key)
-bpSpecificErrorHere(key) == bpSpecificErrorAtToken($stok, key)
+bpSpecificErrorHere(key) ==
+ bpSpecificErrorAtToken($stok, key)
-bpGeneralErrorHere() == bpSpecificErrorHere('"syntax error")
+bpGeneralErrorHere() ==
+ bpSpecificErrorHere('"syntax error")
bpIgnoredFromTo(pos1, pos2) ==
- shoeConsole strconc('"ignored from line ", toString lineNo pos1)
- shoeConsole lineString pos1
- shoeConsole strconc(shoeSpaces lineCharacter pos1,'"|")
- shoeConsole strconc('"ignored through line ", toString lineNo pos2)
- shoeConsole lineString pos2
- shoeConsole strconc(shoeSpaces lineCharacter pos2,'"|")
+ shoeConsole strconc('"ignored from line ", toString lineNo pos1)
+ shoeConsole lineString pos1
+ shoeConsole strconc(shoeSpaces lineCharacter pos1,'"|")
+ shoeConsole strconc('"ignored through line ", toString lineNo pos2)
+ shoeConsole lineString pos2
+ shoeConsole strconc(shoeSpaces lineCharacter pos2,'"|")
-- Line inclusion support.
@@ -148,8 +150,7 @@ bStreamNull x ==
bMap(f,x) ==
bDelay(function bMap1, [f,x])
-bMap1(:z)==
- [f,x] := z
+bMap1(f,x)==
bStreamNull x => $bStreamNil
[apply(f,[first x]),:bMap(f,rest x)]
@@ -159,40 +160,39 @@ bDelay(f,x) ==
bAppend(x,y) ==
bDelay(function bAppend1,[x,y])
-bAppend1(:z)==
- bStreamNull first z =>
- bStreamNull second z => ["nullstream"]
- second z
- [CAAR z,:bAppend(CDAR z,second z)]
+bAppend1(x,y)==
+ bStreamNull x =>
+ bStreamNull y => ["nullstream"]
+ y
+ [first x,:bAppend(rest x,y)]
bNext(f,s) ==
bDelay(function bNext1,[f,s])
bNext1(f,s)==
- bStreamNull s=> ["nullstream"]
- h:= apply(f, [s])
+ bStreamNull s => ["nullstream"]
+ h := apply(f,[s])
bAppend(first h,bNext(f,rest h))
bRgen s ==
bDelay(function bRgen1,[s])
-bRgen1(:s) ==
- a := shoeReadLine first s
+bRgen1 s ==
+ a := shoeReadLine s
shoePLACEP a => ["nullstream"]
- [a,:bRgen first s]
+ [a,:bRgen s]
bIgen n ==
bDelay(function bIgen1,[n])
-bIgen1(:n)==
- n:=first n+1
+bIgen1 n ==
+ n := n + 1
[n,:bIgen n]
bAddLineNumber(f1,f2) ==
bDelay(function bAddLineNumber1,[f1,f2])
-bAddLineNumber1(:f)==
- [f1,f2] := f
+bAddLineNumber1(f1,f2)==
bStreamNull f1 => ["nullstream"]
bStreamNull f2 => ["nullstream"]
[[first f1,:first f2],:bAddLineNumber(rest f1,rest f2)]
@@ -226,44 +226,44 @@ shoeElseIf? s == shoePrefix?('")elseif", s)
shoeLisp? s == shoePrefix?('")lisp", s)
shoeLine? s == shoePrefix?('")line", s)
-shoeBiteOff x==
- n:=STRPOSL('" ",x,0,true)
+shoeBiteOff x ==
+ n :=STRPOSL('" ",x,0,true)
n = nil => false
- n1:=STRPOSL ('" ",x,n,nil)
+ n1 := STRPOSL ('" ",x,n,nil)
n1 = nil => [subString(x,n),'""]
[subString(x,n,n1-n),subString(x,n1)]
shoeFileName x==
- a:=shoeBiteOff x
+ a := shoeBiteOff x
a = nil => '""
- c:=shoeBiteOff second a
+ c := shoeBiteOff second a
c = nil => first a
strconc(first a,'".",first c)
shoeFnFileName x==
- a:=shoeBiteOff x
+ a := shoeBiteOff x
a = nil => ['"",'""]
- c:=shoeFileName second a
+ c := shoeFileName second a
c = nil => [first a,'""]
[first a, c]
shoeInclude s ==
bDelay(function shoeInclude1,[s])
-shoeInclude1 s==
- bStreamNull s=> s
- [h,:t] :=s
- string :=first h
- command :=shoeFin? string => $bStreamNil
- command :=shoeIf? string => shoeThen([true],[STTOMC command],t)
+shoeInclude1 s ==
+ bStreamNull s => s
+ [h,:t] := s
+ string := first h
+ command := shoeFin? string => $bStreamNil
+ command := shoeIf? string => shoeThen([true],[STTOMC command],t)
bAppend(shoeSimpleLine h,shoeInclude t)
shoeSimpleLine(h) ==
- string :=first h
+ string := first h
shoePlainLine? string=> [h]
- command:=shoeLisp? string => [h]
- command:=shoeLine? string => [h]
- command:=shoeSay? string =>
+ command := shoeLisp? string => [h]
+ command := shoeLine? string => [h]
+ command := shoeSay? string =>
shoeConsole command
nil
command:=shoeEval? string =>
@@ -277,17 +277,17 @@ shoeThen(keep,b,s) ==
shoeThen1(keep,b,s)==
bPremStreamNull s=> s
- [h,:t] :=s
- string :=first h
- command :=shoeFin? string => bPremStreamNil(h)
- keep1:= first keep
- b1 := first b
- command :=shoeIf? string =>
- keep1 and b1=> shoeThen([true,:keep],[STTOMC command,:b],t)
+ [h,:t] := s
+ string := first h
+ command := shoeFin? string => bPremStreamNil(h)
+ keep1 := first keep
+ b1 := first b
+ command := shoeIf? string =>
+ keep1 and b1 => shoeThen([true,:keep],[STTOMC command,:b],t)
shoeThen([false,:keep],[false,:b],t)
- command :=shoeElseIf? string=>
- keep1 and not b1=>
- shoeThen([true,:rest keep],[STTOMC command,:rest b],t)
+ command := shoeElseIf? string =>
+ keep1 and not b1 =>
+ shoeThen([true,:rest keep],[STTOMC command,:rest b],t)
shoeThen([false,:rest keep],[false,:rest b],t)
command :=shoeElse? string =>
keep1 and not b1=>shoeElse([true,:rest keep],[true,:rest b],t)
@@ -303,15 +303,15 @@ shoeElse(keep,b,s) ==
shoeElse1(keep,b,s)==
bPremStreamNull s=> s
- [h,:t] :=s
- string :=first h
- command :=shoeFin? string => bPremStreamNil(h)
- b1:=first b
- keep1:=first keep
- command :=shoeIf? string=>
- keep1 and b1=> shoeThen([true,:keep],[STTOMC command,:b],t)
+ [h,:t] := s
+ string := first h
+ command := shoeFin? string => bPremStreamNil(h)
+ b1 := first b
+ keep1 := first keep
+ command := shoeIf? string =>
+ keep1 and b1 => shoeThen([true,:keep],[STTOMC command,:b],t)
shoeThen([false,:keep],[false,:b],t)
- command :=shoeEndIf? string =>
+ command := shoeEndIf? string =>
rest b = nil => shoeInclude t
shoeThen(rest keep,rest b,t)
keep1 and b1 => bAppend(shoeSimpleLine h,shoeElse(keep,b,t))
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
index 4522e2b1..b90bd0d5 100644
--- a/src/boot/scanner.boot
+++ b/src/boot/scanner.boot
@@ -64,7 +64,7 @@ dqToList s ==
s = nil => nil
first s
-shoeConstructToken(ln,lp,b,n) ==
+shoeConstructToken(lp,b,n) ==
[b.0,b.1,:[lp,:n]]
shoeTokType x ==
@@ -108,8 +108,7 @@ shoeLineToks(s)==
$n = nil => shoeLineToks $r
stringChar($ln,0) = char ")" =>
command:=shoeLine? $ln=>
- dq:=dqUnit shoeConstructToken
- ($ln,$linepos,shoeLeafLine command,0)
+ dq := dqUnit shoeConstructToken($linepos,shoeLeafLine command,0)
[[dq],:$r]
command:=shoeLisp? $ln=> shoeLispToken($r,command)
shoeLineToks $r
@@ -119,13 +118,12 @@ shoeLineToks(s)==
[[toks],:$r]
shoeLispToken(s,string)==
- string:=
- #string = 0 or stringChar(string,0) = char ";" => '""
- string
- ln:=$ln
+ if #string = 0 or stringChar(string,0) = char ";" then
+ string := '""
+ ln := $ln
linepos:=$linepos
[r,:st]:=shoeAccumulateLines(s,string)
- dq:=dqUnit shoeConstructToken(ln,linepos,shoeLeafLisp st,0)
+ dq := dqUnit shoeConstructToken(linepos,shoeLeafLisp st,0)
[[dq],:r]
shoeAccumulateLines(s,string)==
@@ -150,7 +148,6 @@ shoeCloser t ==
shoeKeyWord t in '(CPAREN CBRACK)
shoeToken () ==
- ln := $ln
linepos := $linepos
n := $n
ch := stringChar($ln,$n)
@@ -175,7 +172,7 @@ shoeToken () ==
[]
shoeError()
b = nil => nil
- dqUnit shoeConstructToken(ln,linepos,b,n)
+ dqUnit shoeConstructToken(linepos,b,n)
-- to pair badge and badgee
shoeLeafId x ==
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)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 671439c5..ad662ce7 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -285,6 +285,7 @@ for i in [ _
["readByte", "READ-BYTE"], _
["readInteger", "PARSE-INTEGER"], _
["readLine", "READ-LINE"], _
+ ["readLispFromString", "READ-FROM-STRING"] , _
["readOnly?","CONSTANTP"], _
["removeDuplicates", "REMDUP"] , _
["rest", "CDR"] , _
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-16 21:56:59 +0000