diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/boot/includer.boot | 136 | ||||
| -rw-r--r-- | src/boot/scanner.boot | 17 | ||||
| -rw-r--r-- | src/boot/strap/includer.clisp | 50 | ||||
| -rw-r--r-- | src/boot/strap/scanner.clisp | 25 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 1 | ||||
| -rw-r--r-- | src/boot/tokens.boot | 1 | ||||
| -rw-r--r-- | src/interp/incl.boot | 499 | ||||
| -rw-r--r-- | src/interp/scan.boot | 7 |
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 |