diff options
Diffstat (limited to 'src/interp/incl.boot')
| -rw-r--r-- | src/interp/incl.boot | 499 |
1 files changed, 241 insertions, 258 deletions
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, []] |