aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-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
-rw-r--r--src/interp/incl.boot499
-rw-r--r--src/interp/scan.boot7
8 files changed, 351 insertions, 385 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"] , _
diff --git a/src/interp/incl.boot b/src/interp/incl.boot
index 73f2d5b6..f0eca48e 100644
--- a/src/interp/incl.boot
+++ b/src/interp/incl.boot
@@ -75,362 +75,345 @@ incFileInput fn == incRgen MAKE_-INSTREAM fn
incConsoleInput () == incRgen MAKE_-INSTREAM 0
incLine(eb, str, gno, lno, ufo) ==
- ln := lnCreate(eb,str,gno,lno,ufo)
- [[ln,:1],:str]
+ ln := lnCreate(eb,str,gno,lno,ufo)
+ [[ln,:1],:str]
incPos f == first f
incRenumberItem(f, i) ==
- l := CAAR f
- lnSetGlobalNum(l, i)
- f
+ l := CAAR f
+ lnSetGlobalNum(l, i)
+ f
incRenumberLine(xl, gno) ==
- l := incRenumberItem(xl.0, gno)
- incHandleMessage xl
- l
+ l := incRenumberItem(xl.0, gno)
+ incHandleMessage xl
+ l
-incRenumber ssx == incZip (function incRenumberLine, ssx, incIgen 0)
+incRenumber ssx ==
+ incZip (function incRenumberLine, ssx, incIgen 0)
incPrefix?(prefix, start, whole) ==
- #prefix > #whole-start => false
- good:=true
- for i in 0..#prefix-1 for j in start.. while good repeat
- good:= prefix.i = whole.j
- good
+ #prefix > #whole-start => false
+ good:=true
+ for i in 0..#prefix-1 for j in start.. while good repeat
+ good:= prefix.i = whole.j
+ good
-incCommand?(s) == #s > 0 and s.0 = char ")"
+incCommand?(s) ==
+ #s > 0 and s.0 = char ")"
incCommands :=
- ['"say" , _
- '"include", _
- '"console", _
- '"fin" , _
- '"assert" , _
- '"if" , _
- '"elseif" , _
- '"else" , _
- '"endif" ]
+ ['"say" , _
+ '"include", _
+ '"console", _
+ '"fin" , _
+ '"assert" , _
+ '"if" , _
+ '"elseif" , _
+ '"else" , _
+ '"endif" ]
++ when non-nil, an integer that indicates the current line number.
$inputLineNumber := nil
incClassify(s) ==
- $inputLineNumber = 0 and incPrefix?('"#_!",0,s) =>
- [true,0,'"magicNumber"]
- not incCommand? s => [false,0, '""]
- i := 1; n := #s
- while i < n and s.i = char " " repeat i := i + 1
- i >= n => [true,0,'"other"]
- eb := (i = 1 => 0; i)
- bad:=true
- for p in incCommands while bad repeat
- incPrefix?(p, i, s) =>
- bad:=false
- p1 :=p
- if bad then [true,0,'"other"] else [true,eb,p1]
+ $inputLineNumber = 0 and incPrefix?('"#_!",0,s) =>
+ [true,0,'"magicNumber"]
+ not incCommand? s => [false,0, '""]
+ i := 1; n := #s
+ while i < n and s.i = char " " repeat i := i + 1
+ i >= n => [true,0,'"other"]
+ eb := (i = 1 => 0; i)
+ bad:=true
+ for p in incCommands while bad repeat
+ incPrefix?(p, i, s) =>
+ bad:=false
+ p1 :=p
+ if bad then [true,0,'"other"] else [true,eb,p1]
incCommandTail(s, info) ==
- start := (info.1 = 0 => 1; info.1)
- incDrop(start+#info.2+1, s)
+ start := (info.1 = 0 => 1; info.1)
+ incDrop(start+#info.2+1, s)
incDrop(n, b) ==
- n >= #b => ""
- subString(b,n)
+ n >= #b => ""
+ subString(b,n)
-inclFname(s, info) == incFileName incCommandTail(s, info)
+inclFname(s, info) ==
+ incFileName incCommandTail(s, info)
incBiteOff x ==
- n:=STRPOSL('" ",x,0,true)-- first nonspace
- if null n
- then false -- all spaces
- else
- n1:=STRPOSL ('" ",x,n,nil)
- if null n1 -- all nonspaces
- then [subString(x,n),'""]
- else [subString(x,n,n1-n),subString(x,n1)]
+ n:=STRPOSL('" ",x,0,true)-- first nonspace
+ if null n
+ then false -- all spaces
+ else
+ n1:=STRPOSL ('" ",x,n,nil)
+ if null n1 -- all nonspaces
+ then [subString(x,n),'""]
+ else [subString(x,n,n1-n),subString(x,n1)]
incTrunc (n,x)==
- if #x>n
- then subString(x,0,n)
- else x
+ #x > n => subString(x,0,n)
+ x
-incFileName x == first incBiteOff x
+incFileName x ==
+ first incBiteOff x
-fileNameStrings fn==[PNAME(fn.0),PNAME(fn.1),PNAME(fn.2)]
+fileNameStrings fn==
+ [PNAME(fn.0),PNAME(fn.1),PNAME(fn.2)]
ifCond(s, info) ==
- word := makeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset)
- ListMemberQ?(word, $inclAssertions)
+ word := makeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset)
+ ListMemberQ?(word, $inclAssertions)
assertCond(s, info) ==
- word := makeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset)
- if not ListMemberQ?(word, $inclAssertions) then
- $inclAssertions := [word, :$inclAssertions]
+ word := makeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset)
+ if not ListMemberQ?(word, $inclAssertions) then
+ $inclAssertions := [word, :$inclAssertions]
-incActive?(fn,ufos)==member(fn,ufos)
+incActive?(fn,ufos) ==
+ member(fn,ufos)
incNConsoles ufos==
- a:=member('"console",ufos)
- if a then 1+incNConsoles rest a else 0
+ a:=member('"console",ufos)
+ if a then 1+incNConsoles rest a else 0
--% Message Handling
incHandleMessage(xl) ==
- xl.1.1 = "none" =>
- 0
- xl.1.1 = "error" =>
- inclHandleError(incPos xl.0, xl.1.0)
- xl.1.1 = "warning" =>
- inclHandleWarning(incPos xl.0, xl.1.0)
- xl.1.1 = "say" =>
- inclHandleSay(incPos xl.0, xl.1.0)
- inclHandleBug(incPos xl.0, xl.1.0)
+ xl.1.1 = "none" => 0
+ xl.1.1 = "error" => inclHandleError(incPos xl.0, xl.1.0)
+ xl.1.1 = "warning" => inclHandleWarning(incPos xl.0, xl.1.0)
+ xl.1.1 = "say" => inclHandleSay(incPos xl.0, xl.1.0)
+ inclHandleBug(incPos xl.0, xl.1.0)
xlOK(eb, str, lno, ufo) ==
- [incLine(eb, str, -1, lno, ufo), [NIL, "none"]]
+ [incLine(eb, str, -1, lno, ufo), [NIL, "none"]]
xlOK1(eb, str,str1, lno, ufo) ==
- [incLine1(eb, str,str1, -1, lno, ufo), [NIL, "none"]]
+ [incLine1(eb, str,str1, -1, lno, ufo), [NIL, "none"]]
incLine1(eb, str,str1, gno, lno, ufo) ==
- ln := lnCreate(eb,str,gno,lno,ufo)
- [[ln,:1],:str1]
+ ln := lnCreate(eb,str,gno,lno,ufo)
+ [[ln,:1],:str1]
+
xlSkip(eb, str, lno, ufo) ==
- str := strconc('"-- Omitting:", str)
- [incLine(eb, str, -1, lno, ufo), [NIL, "none"]]
+ str := strconc('"-- Omitting:", str)
+ [incLine(eb, str, -1, lno, ufo), [NIL, "none"]]
xlMsg(eb, str, lno, ufo, mess) ==
- [incLine(eb, str, -1, lno, ufo), mess]
+ [incLine(eb, str, -1, lno, ufo), mess]
xlPrematureEOF(eb, str, lno, ufos) ==
- xlMsg(eb, str, lno,ufos.0,
- [inclmsgPrematureEOF(ufos.0),"error"])
+ xlMsg(eb, str, lno,ufos.0, [inclmsgPrematureEOF(ufos.0),"error"])
xlPrematureFin(eb, str, lno, ufos) ==
- xlMsg(eb, str, lno,ufos.0,
- [inclmsgPrematureFin(ufos.0),"error"])
+ xlMsg(eb, str, lno,ufos.0, [inclmsgPrematureFin(ufos.0),"error"])
xlFileCycle(eb, str, lno, ufos, fn) ==
- xlMsg(eb, str, lno,ufos.0,
- [inclmsgFileCycle(ufos,fn),"error"])
+ xlMsg(eb, str, lno,ufos.0, [inclmsgFileCycle(ufos,fn),"error"])
xlNoSuchFile(eb, str, lno, ufos, fn) ==
- xlMsg(eb, str, lno,ufos.0,
- [inclmsgNoSuchFile(fn), "error"])
+ xlMsg(eb, str, lno,ufos.0, [inclmsgNoSuchFile(fn), "error"])
xlCannotRead(eb, str, lno, ufos, fn) ==
- xlMsg(eb, str, lno,ufos.0,
- [inclmsgCannotRead(fn), "error"])
+ xlMsg(eb, str, lno,ufos.0, [inclmsgCannotRead(fn), "error"])
xlConsole(eb, str, lno, ufos) ==
- xlMsg(eb, str, lno,ufos.0,
- [inclmsgConsole(),"say"])
+ xlMsg(eb, str, lno,ufos.0, [inclmsgConsole(),"say"])
xlConActive(eb, str, lno, ufos, n) ==
- xlMsg(eb, str, lno,ufos.0,
- [inclmsgConActive(n),"warning"])
+ xlMsg(eb, str, lno,ufos.0, [inclmsgConActive(n),"warning"])
xlConStill(eb, str, lno, ufos, n) ==
- xlMsg(eb, str, lno,ufos.0,
- [inclmsgConStill(n), "say"])
+ xlMsg(eb, str, lno,ufos.0, [inclmsgConStill(n), "say"])
xlSkippingFin(eb, str, lno, ufos) ==
- xlMsg(eb, str, lno,ufos.0,
- [inclmsgFinSkipped(),"warning"])
+ xlMsg(eb, str, lno,ufos.0, [inclmsgFinSkipped(),"warning"])
xlIfBug(eb, str, lno, ufos) ==
- xlMsg(eb, str, lno,ufos.0,
- [inclmsgIfBug(), "bug"])
+ xlMsg(eb, str, lno,ufos.0, [inclmsgIfBug(), "bug"])
xlCmdBug(eb, str, lno, ufos) ==
- xlMsg(eb, str, lno,ufos.0,
- [inclmsgCmdBug(), "bug"])
+ xlMsg(eb, str, lno,ufos.0, [inclmsgCmdBug(), "bug"])
xlSay(eb, str, lno, ufos, x) ==
- xlMsg(eb, str, lno,ufos.0,
- [inclmsgSay(x), "say"])
+ xlMsg(eb, str, lno,ufos.0, [inclmsgSay(x), "say"])
xlIfSyntax(eb, str, lno,ufos,info,sts) ==
- st := sts.0
- found := info.2
- context :=
- Top? st => "not in an )if...)endif"
- Else? st => "after an )else"
- "but can't figure out where"
- xlMsg(eb, str, lno, ufos.0,
- [inclmsgIfSyntax(ufos.0,found,context), "error"])
+ st := sts.0
+ found := info.2
+ context :=
+ Top? st => "not in an )if...)endif"
+ Else? st => "after an )else"
+ "but can't figure out where"
+ xlMsg(eb, str, lno, ufos.0,
+ [inclmsgIfSyntax(ufos.0,found,context), "error"])
- --% This is it
+ --% This is it
incLude(eb, ss, ln, ufos, states) ==
- Delay(function incLude1,[eb, ss, ln, ufos, states])
-
-Rest s==>incLude (eb,rest ss,lno,ufos,states)
-
-incLude1 (:z) ==
- [eb, ss, ln, ufos, states]:=z
- $inputLineNumber := ln
- lno := ln+1
- state := states.0
-
- StreamNull ss =>
- not Top? state =>
- [xlPrematureEOF(eb,
- '")--premature end", lno,ufos), :StreamNil]
- StreamNil
-
- str := EXPAND_-TABS first ss
- info := incClassify str
-
- not info.0 =>
- Skipping? state => [xlSkip(eb,str,lno,ufos.0), :Rest s]
- [xlOK(eb, str, lno, ufos.0),:Rest s]
-
- info.2 = '"other" =>
- Skipping? state => [xlSkip(eb,str,lno,ufos.0), :Rest s]
- [xlOK1(eb, str,strconc('")command",str), lno, ufos.0),
- :Rest s]
-
- info.2 = '"say" =>
- Skipping? state => [xlSkip(eb,str,lno,ufos.0), :Rest s]
- str := incCommandTail(str, info)
- [xlSay(eb, str, lno, ufos, str),
- :[xlOK(eb,str,lno,ufos.0), :Rest s]]
-
- info.2 = '"include" =>
- Skipping? state =>
- [xlSkip(eb,str,lno,ufos.0), :Rest s]
- fn1 := inclFname(str, info)
- not fn1 =>
- [xlNoSuchFile(eb, str, lno,ufos,fn1),:Rest s]
- not PROBE_-FILE fn1 =>
- [xlCannotRead(eb, str, lno,ufos,fn1),:Rest s]
- incActive?(fn1,ufos) =>
- [xlFileCycle (eb, str, lno,ufos,fn1),:Rest s]
- Includee :=
- incLude(eb+info.1,incFileInput fn1,0,
- [fn1,:ufos], [Top,:states])
- [xlOK(eb,str,lno,ufos.0), :incAppend(Includee, Rest s)]
-
- info.2 = '"console" =>
- Skipping? state => [xlSkip(eb,str,lno,ufos.0), :Rest s]
- Head :=
- incLude(eb+info.1,incConsoleInput(),0,
- ['"console",:ufos],[Top,:states])
- Tail := Rest s
-
- n := incNConsoles ufos
- if n > 0 then
- Head := [xlConActive(eb, str, lno,ufos,n),:Head]
- Tail :=
- [xlConStill (eb, str, lno,ufos,n),:Tail]
-
- Head := [xlConsole(eb, str, lno,ufos),:Head]
- [xlOK(eb,str,lno,ufos.0),:incAppend(Head,Tail)]
-
- info.2 = '"fin" =>
- Skipping? state =>
- [xlSkippingFin(eb, str, lno,ufos), :Rest s]
- not Top? state =>
- [xlPrematureFin(eb, str, lno,ufos), :StreamNil]
- [xlOK(eb,str,lno,ufos.0), :StreamNil]
-
- info.2 = '"assert" =>
- Skipping? state =>
- [xlSkippingFin(eb, str, lno,ufos), :Rest s]
- assertCond(str, info)
- [xlOK(eb,str,lno,ufos.0), :incAppend(Includee, Rest s)]
-
- info.2 = '"if" =>
- s1 :=
- Skipping? state => IfSkipToEnd
- if ifCond(str,info) then IfKeepPart else IfSkipPart
- [xlOK(eb,str,lno,ufos.0),
- :incLude(eb,rest ss,lno,ufos,[s1,:states])]
- info.2 = '"elseif" =>
- not If? state and not Elseif? state =>
- [xlIfSyntax(eb, str,lno,ufos,info,states), :StreamNil]
-
- if SkipEnd? state or KeepPart? state or SkipPart? state
- then
- s1:=if SkipPart? state
- then
- pred := ifCond(str,info)
- if pred
- then ElseifKeepPart
- else ElseifSkipPart
- else ElseifSkipToEnd
- [xlOK(eb,str,lno,ufos.0),
- :incLude(eb,rest ss,lno,ufos,[s1,:rest states])]
- else
- [xlIfBug(eb, str, lno,ufos), :StreamNil]
-
- info.2 = '"else" =>
- not If? state and not Elseif? state =>
- [xlIfSyntax(eb, str,lno,ufos,info,states),:StreamNil]
- if SkipEnd? state or KeepPart? state or SkipPart? state
- then
- s1 :=if SkipPart? state
- then ElseKeepPart
- else ElseSkipToEnd
- [xlOK(eb,str,lno,ufos.0),
- :incLude(eb,rest ss,lno,ufos,[s1,:rest states])]
- else
- [xlIfBug(eb, str, lno,ufos), :StreamNil]
-
- info.2 = '"endif" =>
- Top? state =>
- [xlIfSyntax(eb, str,lno,ufos,info,states),:StreamNil]
- [xlOK(eb,str,lno,ufos.0),
- :incLude(eb,rest ss,lno,ufos,rest states)]
-
- info.2 = '"magicNumber" =>
- Rest s
-
- [xlCmdBug(eb, str, lno,ufos),:StreamNil]
+ Delay(function incLude1,[eb, ss, ln, ufos, states])
+
+Rest s ==> incLude (eb,rest ss,lno,ufos,states)
+
+incLude1(eb,ss,ln,ufos,states) ==
+ $inputLineNumber := ln
+ lno := ln+1
+ state := states.0
+
+ StreamNull ss =>
+ not Top? state =>
+ [xlPrematureEOF(eb, '")--premature end", lno,ufos), :StreamNil]
+ StreamNil
+
+ str := EXPAND_-TABS first ss
+ info := incClassify str
+
+ not info.0 =>
+ Skipping? state => [xlSkip(eb,str,lno,ufos.0), :Rest s]
+ [xlOK(eb, str, lno, ufos.0),:Rest s]
+
+ info.2 = '"other" =>
+ Skipping? state => [xlSkip(eb,str,lno,ufos.0), :Rest s]
+ [xlOK1(eb, str,strconc('")command",str), lno, ufos.0), :Rest s]
+
+ info.2 = '"say" =>
+ Skipping? state => [xlSkip(eb,str,lno,ufos.0), :Rest s]
+ str := incCommandTail(str, info)
+ [xlSay(eb, str, lno, ufos, str),
+ :[xlOK(eb,str,lno,ufos.0), :Rest s]]
+
+ info.2 = '"include" =>
+ Skipping? state => [xlSkip(eb,str,lno,ufos.0), :Rest s]
+ fn1 := inclFname(str, info)
+ not fn1 => [xlNoSuchFile(eb, str, lno,ufos,fn1),:Rest s]
+ not PROBE_-FILE fn1 => [xlCannotRead(eb, str, lno,ufos,fn1),:Rest s]
+ incActive?(fn1,ufos) => [xlFileCycle (eb, str, lno,ufos,fn1),:Rest s]
+ Includee :=
+ incLude(eb+info.1,incFileInput fn1,0,
+ [fn1,:ufos], [Top,:states])
+ [xlOK(eb,str,lno,ufos.0), :incAppend(Includee, Rest s)]
+
+ info.2 = '"console" =>
+ Skipping? state => [xlSkip(eb,str,lno,ufos.0), :Rest s]
+ Head :=
+ incLude(eb+info.1,incConsoleInput(),0,
+ ['"console",:ufos],[Top,:states])
+ Tail := Rest s
+
+ n := incNConsoles ufos
+ if n > 0 then
+ Head := [xlConActive(eb, str, lno,ufos,n),:Head]
+ Tail := [xlConStill (eb, str, lno,ufos,n),:Tail]
+
+ Head := [xlConsole(eb, str, lno,ufos),:Head]
+ [xlOK(eb,str,lno,ufos.0),:incAppend(Head,Tail)]
+
+ info.2 = '"fin" =>
+ Skipping? state => [xlSkippingFin(eb, str, lno,ufos), :Rest s]
+ not Top? state => [xlPrematureFin(eb, str, lno,ufos), :StreamNil]
+ [xlOK(eb,str,lno,ufos.0), :StreamNil]
+
+ info.2 = '"assert" =>
+ Skipping? state => [xlSkippingFin(eb, str, lno,ufos), :Rest s]
+ assertCond(str, info)
+ [xlOK(eb,str,lno,ufos.0), :incAppend(Includee, Rest s)]
+
+ info.2 = '"if" =>
+ s1 :=
+ Skipping? state => IfSkipToEnd
+ if ifCond(str,info) then IfKeepPart else IfSkipPart
+ [xlOK(eb,str,lno,ufos.0), :incLude(eb,rest ss,lno,ufos,[s1,:states])]
+ info.2 = '"elseif" =>
+ not If? state and not Elseif? state =>
+ [xlIfSyntax(eb, str,lno,ufos,info,states), :StreamNil]
+
+ SkipEnd? state or KeepPart? state or SkipPart? state =>
+ s1 :=
+ SkipPart? state =>
+ ifCond(str,info) => ElseifKeepPart
+ ElseifSkipPart
+ ElseifSkipToEnd
+ [xlOK(eb,str,lno,ufos.0),
+ :incLude(eb,rest ss,lno,ufos,[s1,:rest states])]
+ [xlIfBug(eb, str, lno,ufos), :StreamNil]
+
+ info.2 = '"else" =>
+ not If? state and not Elseif? state =>
+ [xlIfSyntax(eb, str,lno,ufos,info,states),:StreamNil]
+ SkipEnd? state or KeepPart? state or SkipPart? state =>
+ s1 :=
+ SkipPart? state => ElseKeepPart
+ ElseSkipToEnd
+ [xlOK(eb,str,lno,ufos.0),
+ :incLude(eb,rest ss,lno,ufos,[s1,:rest states])]
+ [xlIfBug(eb, str, lno,ufos), :StreamNil]
+
+ info.2 = '"endif" =>
+ Top? state => [xlIfSyntax(eb, str,lno,ufos,info,states),:StreamNil]
+ [xlOK(eb,str,lno,ufos.0), :incLude(eb,rest ss,lno,ufos,rest states)]
+
+ info.2 = '"magicNumber" => Rest s
+ [xlCmdBug(eb, str, lno,ufos),:StreamNil]
--% Message handling for the source includer
-- SMW June 88
inclHandleError(pos, [key, args]) ==
- ncSoftError(pos, key, args)
+ ncSoftError(pos, key, args)
+
inclHandleWarning(pos, [key, args]) ==
- ncSoftError(pos, key,args)
+ ncSoftError(pos, key,args)
+
inclHandleBug(pos, [key, args]) ==
- ncBug(key, args)
+ ncBug(key, args)
+
inclHandleSay(pos, [key, args]) ==
- ncSoftError(pos, key, args)
+ ncSoftError(pos, key, args)
inclmsgSay str ==
- ['S2CI0001, [%id str]]
+ ['S2CI0001, [%id str]]
+
inclmsgPrematureEOF ufo ==
- ['S2CI0002, [%origin ufo]]
+ ['S2CI0002, [%origin ufo]]
+
inclmsgPrematureFin ufo ==
- ['S2CI0003, [%origin ufo]]
+ ['S2CI0003, [%origin ufo]]
+
inclmsgFileCycle(ufos,fn) ==
- flist := [porigin n for n in reverse ufos]
- f1 := porigin fn
- cycle := [:[:[n,'"==>"] for n in flist], f1]
- ['S2CI0004, [%id cycle, %id f1]]
+ flist := [porigin n for n in reverse ufos]
+ f1 := porigin fn
+ cycle := [:[:[n,'"==>"] for n in flist], f1]
+ ['S2CI0004, [%id cycle, %id f1]]
+
inclmsgConsole () ==
- ['S2CI0005, []]
+ ['S2CI0005, []]
+
inclmsgConActive n ==
- ['S2CI0006, [%id n]]
+ ['S2CI0006, [%id n]]
+
inclmsgConStill n ==
- ['S2CI0007, [%id n]]
+ ['S2CI0007, [%id n]]
+
inclmsgFinSkipped() ==
- ['S2CI0008, []]
+ ['S2CI0008, []]
+
inclmsgIfSyntax(ufo,found,context) ==
- found := strconc('")", found)
- ['S2CI0009, [%id found, %id context, %origin ufo]]
+ found := strconc('")", found)
+ ['S2CI0009, [%id found, %id context, %origin ufo]]
+
inclmsgNoSuchFile fn ==
- ['S2CI0010, [%fname fn]]
+ ['S2CI0010, [%fname fn]]
+
inclmsgCannotRead fn ==
- ['S2CI0011, [%fname fn]]
+ ['S2CI0011, [%fname fn]]
+
inclmsgIfBug() ==
- ['S2CB0002, []]
+ ['S2CB0002, []]
+
inclmsgCmdBug() ==
- ['S2CB0003, []]
+ ['S2CB0003, []]
diff --git a/src/interp/scan.boot b/src/interp/scan.boot
index a1a25fb1..7034d2a9 100644
--- a/src/interp/scan.boot
+++ b/src/interp/scan.boot
@@ -275,7 +275,7 @@ lineoftoks(s)==
a := incPrefix?('"command",1,$ln)
a =>
$ln := subString($ln,8)
- b := dqUnit constoken($ln,$linepos,["command",$ln],0)
+ b := dqUnit constoken($linepos,["command",$ln],0)
[[[b,s]],:$r]
while $n<$sz repeat
toks := dqAppend(toks,scanToken())
@@ -284,7 +284,6 @@ lineoftoks(s)==
scanToken() ==
- ln := $ln
linepos := $linepos
n := $n
ch := stringChar($ln,$n)
@@ -308,7 +307,7 @@ scanToken() ==
ch = char "__" => scanEscape()
scanError()
null b => nil
- dqUnit constoken(ln,linepos,b,n+lnExtraBlanks linepos)
+ dqUnit constoken(linepos,b,n+lnExtraBlanks linepos)
-- to pair badge and badgee
@@ -345,7 +344,7 @@ lferror x ==
lfspaces x ==
["spaces",x]
-constoken(ln,lp,b,n)==
+constoken(lp,b,n)==
a := [b.0,:b.1]
ncPutQ(a,"posn",[lp,:n])
a