ISScanImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
edit by Ayers 17-Jun-85 14:14:31
Rick Beach, August 1, 1985 2:13:30 pm PDT
MKaplan, September 13, 1985 3:14:03 pm PDT
DIRECTORY
Basics,
Atom USING [MakeAtom--, GetPName--],
ISMessage,
ISBinding,
ISNode,
ISScan,
ISToken,
ISTiogaIntern,
Rope USING [ROPE--, Fetch, Length, Concat, Substr--],
IO USING [STREAM, RIS, ROS, EndOfStream, RopeFromROS, CR, GetChar, PeekChar, PutChar, GetIndex, SetIndex--, atom--];
ISScanImpl: CEDAR PROGRAM
IMPORTS Atom, ISBinding, ISNode, IO, --Rope, --ISTiogaIntern
EXPORTS ISBinding, ISScan
= BEGIN OPEN ISToken, ISScan;
ParseFailure: PUBLIC SIGNAL [s: ISScan.ScanHandle, r: ISScan.ParseFailureReason] = CODE;
BindingFailure: PUBLIC SIGNAL [r: ISBinding.BindingFailureReason] = CODE;
currentEnvironment: ISBinding.EnvironmentHandle ← NIL;
environmentAnchor: ISBinding.Handle ← NIL;
notACharacter: CARDINAL = LAST[CARDINAL];
bufferWords: CARDINAL = ISScan.bufferBytes / 2; -- all must be power of two --
CreateScan: PUBLIC PROCEDURE [
base: Rope.ROPE,
index: INT,
allocateWith: ISNode.Handle,
bindingStack: ISBinding.StackHandle ← NIL,
family: ATOM ← NIL ]
RETURNS [ScanHandle] = BEGIN
newScanner: CharactersScanner ← NEW[ScanStream.characters];
new: ScanHandle ← NEW[ScanObject];
newScanner^ ← [name: NIL, body: characters [cstream: IO.RIS[base]]];
IO.SetIndex[newScanner.cstream, index];
new^ ← [
stream: newScanner,
family: family--,--
--allocateWith: allocateWith--];
IF bindingStack#NIL THEN {new.bindingStack ← bindingStack; new.stackIsScans ← FALSE}
ELSE {new.bindingStack ← ISBinding.CreateStack[]; new.stackIsScans ← TRUE};
RETURN [new];
END;
InitializeScan: PUBLIC PROCEDURE [s: ScanHandle] = BEGIN
WITH s.stream SELECT FROM
ss: CharactersScanner => IF ss.cstream=NIL THEN ERROR;
ENDCASE => ERROR;
RETURN;
END;
InitializeScanThroughCurly: PUBLIC PROCEDURE [s: ScanHandle] = BEGIN
InitializeScan [s];
WITH s.stream SELECT FROM
ss: CharactersScanner =>
BEGIN
THROUGH [0..100) DO
IF IO.PeekChar[ss.cstream]='{ THEN {[] ← AdvanceScan[s]; RETURN};
[] ← IO.GetChar[ss.cstream];
ENDLOOP;
END;
ENDCASE => ERROR;
SIGNAL ParseFailure [s, spare];
RETURN;
END;
The publication encoding is ISO-646, which is eight bit characters. --
Although we extend this to allow for sixteen bit characters, via 377B --
shifts, within "<>" strings, the regular scanner does not have to deal with --
this, since the bytes inside the "<>" are gobbled up by special routines. --
Get: PROCEDURE [s: CharactersScanner] RETURNS [e: Basics.Byte] = INLINE
{e ← Peek[s]; s.nextCharacter ← notACharacter};
GetGoodPeek: PROCEDURE [s: CharactersScanner] RETURNS [e: Basics.Byte] = INLINE
{e ← s.nextCharacter; s.nextCharacter ← notACharacter};
UseUpPeek: PROCEDURE [s: CharactersScanner] = INLINE {s.nextCharacter ← notACharacter};
Peek: PROCEDURE [s: CharactersScanner] RETURNS [e: Basics.Byte] = INLINE BEGIN
IF s.nextCharacter#notACharacter THEN RETURN [s.nextCharacter];
e ← s.nextCharacter ← GetByteAtOffset[s];
BumpStreamOffset[s];
RETURN;
END;
BumpStreamOffset: PROCEDURE [s: CharactersScanner] = INLINE BEGIN
s.byteInBuffer ← s.byteInBuffer + 1;
END;
GetByteAtOffset: PROCEDURE [s: CharactersScanner] RETURNS [Basics.Byte] = INLINE BEGIN
IF s.byteInBuffer>=ISScan.bufferBytes THEN
BEGIN
IF (s.runningAddress ← s.runningAddress + ISScan.bufferBytes/2)
>= s.lastAddressPlusOne THEN SIGNAL ParseFailure [NIL, hitEndOfScript];
s.buffer ← s.runningAddress^;
s.byteInBuffer ← 0;
END;
RETURN [s.buffer[s.byteInBuffer] ];
END;
UseUpPeek: PROC [s: IO.STREAM] ~ { [] ← IO.GetChar[s]; };
PeelInteger: PROCEDURE [stream: IO.STREAM, startCharacter: CHAR ← '0] RETURNS [LONG INTEGER] = BEGIN
li: LONG INTEGER ← startCharacter - '0;
a: ARRAY [0..10] OF NAT;
count: NAT ← 0;
radix: NAT ← 10;
peek: CHAR;
WHILE (peek←IO.PeekChar[stream]) IN ['0..'9] DO
a[count] ← IO.GetChar[stream] - '0;
count ← MIN[count+1,10];
ENDLOOP;
IF peek='B OR peek='b THEN { radix ← 8; UseUpPeek[stream] };
FOR z: NAT IN [0..count) DO li ← li*radix + a[z]; ENDLOOP;
RETURN [li];
END;
AdvanceScan: PUBLIC PROCEDURE [s: ScanHandle] = BEGIN
DO -- so we can repeatedly pop --
WITH s.stream SELECT FROM
ss: TokensScanner => s.stream.token ← TokenFromTokensScanner [ss];
ss: CharactersScanner => s.stream.token ← TokenFromCharactersScanner [ss];
ENDCASE => ERROR; -- not tokens or characters --
BEGIN
type: TVType ← s.stream.token.type;
IF (type = endOfString OR type = endOfStream)
AND s.stream.pushed#NIL THEN BEGIN -- pop the scan --
old: REF ScanStream ← s.stream.pushed;
s.stream ← old;
If the token in the stream that was just popped is not 'null' or eos then we assert that it has not been processed and return it.
type ← s.stream.token.type;
IF type#endOfStream AND type#endOfString AND type3null THEN RETURN;
END
ELSE RETURN;
END;
ENDLOOP;
END;
TokenFromTokensScanner: PROCEDURE [ts: TokensSca~ner] RETURNS [obj: TVHandle] = BEGIN
IF ts.tokenList=NIL THEN obj ← NEW[TVObject.endOfStream]
ELSE {obj ← ts.tokenList; 43.tokenList ← ts.tokenList.next};
obj.streamName ← ts.name; --<<used to hurt tests 22may85 rma>>--
RETURN;
END;
TokenFromCharactersScanner: PROCEDURE [cs: CharactersScanner] RETURNS [tr: TVHandle] = BEGIN
byte: CHAR;
inComment: BOOLEAN ← FALSE;
ios: IO.STREAM ← cs.cstream;
DO -- skip noise bytes and comments --
byte ← IO.GetChar[ios !
IO.EndOfStream => GOTO PopInputScanner];
IF inComment THEN
SELECT byte FROM
'- => IF IO.PeekChar[ios]='- THEN {UseUpPeek[ios]; inComment ← FALSE};
IO.CR => inComment ← FALSE; -- comment ended by cr or eos --
ENDCASE => NULL
ELSE
SELECT VAL[byte] FROM
IN [1B..40B] => LOOP;
VAL['-] => IF IO.PeekChar[ios]='- THEN -- comment --
{UseUpPeek[ios]; inComment ← TRUE} ELSE EXIT;
ENDCASE => EXIT;
REPEAT
PopInputScanner => RETURN[NEW[TVObject.endOfStream]];
ENDLOOP;
SELECT byte FROM --<<trying to get a jump table from the compiler .. rma 13feb84>>--
IN ['A..'Z],
IN ['a..'z] => BEGIN -- atom or dollar --
--<<This code assumes that everything is in characterset zero>>--
rope: IO.STREAM ← IO.ROS[];
peek: CHAR;
IO.PutChar[rope, byte];
WHILE (peek←IO.PeekChar[ios]) IN ['A..'Z] OR peek IN ['a..'z]
OR peek IN ['0..'9] -- Allow non-leading digits --
OR peek='. DO -- current (feb85) separator, e.g. 'FONT.Points' --
IO.PutChar[rope, IO.GetChar[ios]];
ENDLOOP;
IF peek='$ OR VAL[peek]=244B THEN BEGIN
-- the dollar used to be in the atom .. but no more .. rma feb85 --
UseUpPeek[ios];
tr ← NEW[TVObject ← [body: dollar[value: Atom.MakeAtom[IO.RopeFromROS[rope, TRUE]]]] ];
END
ELSE tr ← NEW[TVObject ← [body: atom[value: Atom.MakeAtom[IO.RopeFromROS[rope, TRUE]]]] ];
END;
'< => BEGIN -- characters --
t: characters TVObject ← [
body: characters [ value: [
offset: cs.byteInBuffer,
limit: cs.byteInBuffer,
bytes: LOOPHOLE[cs.runningAddress],
context: XString.vanillaContext ] ] -- font supplied later -- ];
<<vanillaContext is correct because '< is in characterset zero>>--
startIndex: INT = IO.GetIndex[ios];
cs0: BOOLEAN ← TRUE;
DO --<< See comment above 'Get' >>--
char: CHAR ← IO.GetChar[ios];
IF cs0 AND char='> THEN
IF IO.PeekChar[ios]#'> THEN EXIT ELSE [] ← IO.GetChar[ios];
IF VAL[char]=377B THEN cs0 ← VAL[IO.GetChar[ios]]=0;
ENDLOOP;
tr ← NEW[TVObject ← [body: characters [stream: ios, startIndex: startIndex, length: IO.GetIndex[ios]-startIndex-1]] ];
END;
IN ['0..'9] => BEGIN -- number --
t: integer TVObject ← [body: integer[value: 0]];
t.value ← PeelInteger [stream: ios, startCharacter: byte];
tr ← NEW[TVObject ← t ];
END;
'← => {tr ← NEW[TVObject ← [body: gets[]] ]};
VAL[254B] => {tr ← NEW[TVObject ← [body: gets[]] ]};
'= => {tr ← NEW[TVObject ← [body: gets[]] ]};
'{ => {tr ← NEW[TVObject ← [body: leftCurly[]] ]};
'} => {tr ← NEW[TVObject ← [body: rightCurly[]] ]};
'+ => {tr ← NEW[TVObject ← [body: plus[]] ]};
'- => {tr ← NEW[TVObject ← [body: minus[]] ]};
'* => {tr ← NEW[TVObject ← [body: times[]] ]};
'^ => {tr ← NEW[TVObject ← [body: open[]] ]};
VAL[255B] => {tr ← NEW[TVObject ← [body: open[]] ]};
'! => {tr ← NEW[TVObject ← [body: open[]] ]};
'| => {tr ← NEW[TVObject ← [body: open[]] ]};
'" => -- string .. Interscript string-constant --
BEGIN
IF cs.inString THEN {tr ← NEW[TVObject ← [body: endOfString[]] ]; cs.inString ← FALSE}
ELSE
BEGIN
stringToken: StringTVHandle ← NEW[string TVObject ← [body: string[]]];
stringToken.tail ← stringToken;
cs.inString ← TRUE;
DO
to: TVHandle ← TokenFromCharactersScanner [cs];
IF to.type=endOfString THEN
{tr ← NEW[TVObject ← stringToken^ ]; GOTO FoundEndOfString}
ELSE
BEGIN
new: TVHandle ← CopyOneTV [to];
new.next ← NIL; stringToken.tail.next ← new; stringToken.tail ← new;
END;
ENDLOOP;
END; -- of else --
EXITS FoundEndOfString => NULL;
END; -- of Interscript string-constant --
'/ => {tr ← NEW[TVObject ← [body: divide[]] ]};
'[ => {tr ← NEW[TVObject ← [body: push[]] ]};
'] => {tr ← NEW[TVObject ← [body: pop[]] ]};
ENDCASE => SIGNAL ParseFailure [NIL, unsupportedConstruct];
always get here .. no RETURNs above --
tr.streamName ← cs.name;
RETURN;
END;
CreateStack: PUBLIC PROCEDURE [useEnvironment: BOOLEAN ← TRUE]
RETURNS [ISBinding.StackHandle] = BEGIN
sh: ISBinding.StackHandle ← NEW [ISBinding.StackObject];
sh^ ← [top: IF useEnvironment THEN environmentAnchor ELSE NIL];
RETURN [sh];
END;
DestroyStack: PUBLIC PROCEDURE [atStack: REF ISBinding.StackHandle] = BEGIN
atStack^ ← NIL;
END;
AnchorBindings: PUBLIC PROCEDURE [stack: ISBinding.StackHandle]
RETURNS [ISBinding.Anchor] = {RETURN [stack^]};
CreateEnvironment: PUBLIC PROCEDURE [stack: ISBinding.StackHandle]
RETURNS [ISBinding.EnvironmentHandle] = BEGIN
eh: ISBinding.EnvironmentHandle ← NEW[ISBinding.EnvironmentObject];
eh^ ← [stack: stack];
environmentAnchor ← stack.top;
RETURN [eh];
END;
UseEnvironment: PUBLIC PROCEDURE [environment: ISBinding.EnvironmentHandle] = BEGIN
currentEnvironment ← environment;
environmentAnchor ← environment.stack.top; --<<compatibility>>--
END;
UnuseEnvironment: PUBLIC PROCEDURE RETURNS [ISBinding.EnvironmentHandle] = BEGIN
eh: ISBinding.EnvironmentHandle ← currentEnvironment;
currentEnvironment ← NIL;
environmentAnchor ← NIL; --<<compatibility>>--
RETURN [eh];
END;
DestroyEnvironment: PUBLIC PROCEDURE [at: REF ISBinding.EnvironmentHandle] = BEGIN
at.stack.zone.FREE[at];
garbage collect the other stuff when clinet destroys bindings --
END;
PruneBindings: PUBLIC PROCEDURE [
stack: ISBinding.StackHandle,
anchor: ISBinding.Anchor] = BEGIN
stack^ ← anchor; --<<no garbage collecting for now>>--
RETURN;
END;
AugmentBindings: PUBLIC PROCEDURE [
name: ATOM,
value: TVHandle,
stack: ISBinding.StackHandle] = BEGIN
temp: ISBinding.Handle ← NEW[ISBinding.Object];
temp^ ← [ previous: stack.top, name: name, value: value ];
stack.top ← temp;
RETURN;
END;
ObtainBinding: PUBLIC PROCEDURE [name: ATOM, stack: ISBinding.StackHandle] RETURNS [TVHandle] = BEGIN
FOR temp: ISBinding.Handle ← stack.top, temp.previous UNTIL temp=NIL DO
IF temp.name=name THEN RETURN [temp.value];
ENDLOOP;
RETURN [NIL];
END;
CopyScanStream: PROCEDURE [old: REF ScanStream] RETURNS [new: REF ScanStream] = BEGIN
WITH old SELECT FROM
s: CharactersScanner => new ← NEW[characters ScanStream ← s^];
s: TokensScanner => new ← NEW[tokens ScanStream ← s^];
ENDCASE => NULL;
RETURN;
END;
CopyOneTV: PROCEDURE [tv: TVHandle] RETURNS [r: TVHandle] = BEGIN
WITH tv^ SELECT FROM
o: null TVObject => r ← NEW[null TVObject ← o];
o: endOfString TVObject => r ← NEW[endOfString TVObject ← o];
o: endOfStream TVObject => r ← NEW[endOfStream TVObject ← o];
o: endOfScript TVObject => r ← NEW[endOfScript TVObject ← o];
o: integer TVObject => r ← NEW[integer TVObject ← o];
o: atom TVObject => r ← NEW[atom TVObject ← o];
o: string TVObject => r ← NEW[string TVObject ← o];
o: dollar TVObject => r ← NEW[dollar TVObject ← o];
o: characters TVObject => r ← NEW[characters TVObject ← o];
o: plus TVObject => r ← NEW[plus TVObject ← o];
o: minus TVObject => r ← NEW[minus TVObject ← o];
o: times TVObject => r ← NEW[times TVObject ← o];
o: divide TVObject => r ← NEW[divide TVObject ← o];
o: gets TVObject => r ← NEW[gets TVObject ← o];
o: open TVObject => r ← NEW[open TVObject ← o];
o: leftCurly TVObject => r ← NEW[leftCurly TVObject ← o];
o: rightCurly TVObject => r ← NEW[rightCurly TVObject ← o];
o: push TVObject => r ← NEW[push TVObject ← o];
o: pop TVObject => r ← NEW[pop TVObject ← o];
o: node TVObject => r ← NEW[node TVObject ← o];
o: specialChars TVObject => r ← NEW[specialChars TVObject ← o];
o: styleOpen TVObject => r ← NEW[styleOpen TVObject ← o];
o: styleDefinition TVObject => r ← NEW[styleDefinition TVObject ← o];
ENDCASE;
RETURN;
END;
CollectRHS: PROCEDURE [scan: ScanHandle] RETURNS [TVObject] = BEGIN
uniaryMinus: BOOLEAN ← FALSE;
SELECT scan.stream.token.type FROM
gets => AdvanceScan [scan];
ENDCASE => NULL;
in case caller didn't
SELECT scan.stream.token.type FROM
plus => AdvanceScan [scan]; -- kill leading uniary plus --
minus => {uniaryMinus ← TRUE; AdvanceScan [scan]};
ENDCASE => NULL;
WITH scan.stream.token SELECT FROM
t: LeftCurlyTVHandle => BEGIN
child: NodeTVHandle;
return: NodeTVHandle ← NEW[node TVObject];
AdvanceScan [scan];
child ← CollectNode [scan: scan, bound: TRUE];
DO
WITH scan.stream.token SELECT FROM
n: NullTVHandle => AdvanceScan[scan];
o: OpenTVHandle => --Remove outer {} and splice innerds into input stream (macro expansion)--
BEGIN
AdvanceScan[scan]; --Get rid of open--
scan.stream ← NEW[characters ScanStream ← [
name: NIL,
pushed: CopyScanStream[scan.stream],
body: characters [cstream: IO.RIS[ISTiogaIntern.PrintNodeContents[NARROW[child.isnode], FALSE]]]]];
AdvanceScan [scan]; -- prime the pump --
EXIT;
END;
ENDCASE => {
return^ ← [body: node[isnode: child.isnode]];
EXIT;
};
ENDLOOP;
RETURN [return^];
END;
t: AtomTVHandle => BEGIN
rhsAtom: atom TVObject ← t^;
AdvanceScan [scan];
SELECT scan.stream.token.type FROM
open => BEGIN
b: TVHandle ← ObtainBinding [RemoveDot[rhsAtom.value], scan.bindingStack];
AdvanceScan [scan];
WITH b SELECT FROM
n: NodeTVHandle => { --Do "macro expansion" of node--
scan.stream ← NEW[characters ScanStream ← [
name: t.value,
pushed: CopyScanStream[scan.stream],
body: characters [cstream: IO.RIS[ISTiogaIntern.PrintNodeContents[NARROW[n.isnode]]]]]];
AdvanceScan [scan]; -- prime the pump --
RETURN[CollectRHS[scan]];
};
ENDCASE => RETURN [IF b=NIL THEN rhsAtom ELSE b^];
END;
ENDCASE => RETURN [rhsAtom];
END;
t: IntegerTVHandle => BEGIN
int: integer TVObject ← t^;
operator: TVType;
IF uniaryMinus THEN int.value ← -int.value;
AdvanceScan [scan];
operator ← scan.stream.token.type;
SELECT operator FROM
times, minus, plus => NULL;
ENDCASE => RETURN [int];
AdvanceScan [scan];
BEGIN
right: TVObject ← CollectRHS [scan];
WITH right SELECT FROM
far: integer TVObject => BEGIN
SELECT operator FROM
times => int.value ← int.value * far.value;
minus => int.value ← int.value - far.value;
plus => int.value ← int.value + far.value;
ENDCASE => ERROR;
RETURN [int];
END;
ENDCASE => ERROR ParseFailure [scan, unexpectedDelimiter];
END;
END;
ENDCASE => {rhs: TVObject ← scan.stream.token^; AdvanceScan [scan]; RETURN [rhs]};
END;
This can be uncommented if you want to look at properties with the EditTool (warning: a couple of other places have to be changed... look for Rope.Concat's or Cat's having "." as an argument).
RemoveDot: PROC [a: ATOM] RETURNS [ATOM] ~ {
n: Rope.ROPE = Atom.GetPName[a];
FOR k: INT IN [0..Rope.Length[n]-1] DO
IF Rope.Fetch[n, k]='. THEN RETURN[Atom.MakeAtom[Rope.Concat[Rope.Substr[n, 0, k], Rope.Substr[n, k+1]]]];
ENDLOOP;
RETURN[a];
};
CollectNode: PUBLIC PROCEDURE [
scan: ScanHandle,
parent: ISNode.Handle ← NIL,
bound: BOOL ← FALSE ]
RETURNS [NodeTVHandle] = BEGIN
node: NodeTVHandle ← NEW[node TVObject];
primaryImpl: ISNode.Implementation ← NIL;
primaryTag: ATOM ← NIL;
oldLocalLimit: ISBinding.Anchor;
anchor: ISBinding.Anchor;
square: ISBinding.Anchor; -- bad usage: no nesting and little syntactic checking of '[]' --
contentBuffer: TVHandle ← NIL;
lastBufferedContent: TVHandle ← NIL;
BufferOrCall: --LOCAL-- PROCEDURE [con: TVHandle] = BEGIN
IF primaryImpl#NIL THEN BEGIN
WITH con SELECT FROM
cc: NodeTVHandle =>
BEGIN
ie: ISToken.InterscriptContext ← NEW[ISToken.InterscriptContextObject ← [ body: embedded[content: cc] ] ];
[] ← primaryImpl.internalize [ NARROW[node.isnode], ie ];
END;
cc: StyleOpenTVHandle =>
BEGIN
ie: ISToken.InterscriptContext ← NEW[ ISToken.InterscriptContextObject ← [ body: styleOpen[identifier: cc] ] ];
[] ← primaryImpl.internalize [ NARROW[node.isnode], ie ];
END;
cc: StyleDefinitionTVHandle =>
BEGIN
ie: ISToken.InterscriptContext ← NEW[ ISToken.InterscriptContextObject ← [ body: styleDefinition[definition: cc] ] ];
[] ← primaryImpl.internalize [ NARROW[node.isnode], ie ];
END;
ENDCASE =>
BEGIN
ic: ISToken.InterscriptContext ← NEW[ ISToken.InterscriptContextObject ← [ body: content[content: con] ] ];
[] ← primaryImpl.internalize [ NARROW[node.isnode], ic ];
END;
END
ELSE
BEGIN
copy: TVHandle ← CopyOneTV[con];
IF lastBufferedContent#NIL THEN
{lastBufferedContent.next ← copy; lastBufferedContent ← copy}
ELSE contentBuffer ← lastBufferedContent ← copy;
END;
END;
node^ ← [body: node[]];
node.isnode ← ISNode.Create [--scan.allocateWith--];
^^ knowing that the only difference between ISNode.Create[x] and --
ISNode.Create[y] is the atom stored into the type field --
anchor ← AnchorBindings [scan.bindingStack];
oldLocalLimit ← ISTiogaIntern.localBindingLimit;
ISTiogaIntern.localBindingLimit ← anchor; --hack hack--
DO
WITH scan.stream.token SELECT FROM
t: NullTVHandle => AdvanceScan [scan];
-- lets us not AdvanceScan .. see at rightCurly --
t: EOScTVHandle => SIGNAL ParseFailure [scan,hitEndOfScript];
t: IntegerTVHandle =>
BEGIN
tvo: TVHandle ← NEW[TVObject ← CollectRHS [scan]]; -- to pick up integer expressions as content --
BufferOrCall [tvo];
scan advanced by CollectRHS: AdvanceScan [scan];
END;
t: MinusTVHandle =>
BEGIN
tvo: TVHandle ← NEW[TVObject ← CollectRHS [scan]]; -- to pick up integer expressions as content --
BufferOrCall [tvo];
scan advanced by CollectRHS: AdvanceScan [scan];
END;
t: PlusTVHandle =>
BEGIN
tvo: TVHandle ← NEW[TVObject ← CollectRHS [scan]]; -- to pick up integer expressions as content --
BufferOrCall [tvo];
scan advanced by CollectRHS: AdvanceScan [scan];
END;
t: AtomTVHandle =>
BEGIN
theAtomicTV: TVObject ← scan.stream.token^;
theAtom: ATOM ← t.value;
AdvanceScan [scan];
WITH scan.stream.token SELECT FROM
x: GetsTVHandle => BEGIN
rhs: TVHandle ← NEW[TVObject ← CollectRHS [scan]];
AugmentBindings [RemoveDot[theAtom], CopyOneTV[rhs], scan.bindingStack];
Look to see if the lhs is non-qualified (no '.'). If so, assume that this is a style definition and pass it to the node-impl.
BEGIN
dotTest: Rope.ROPE ← Atom.GetPName[theAtom];
FOR k: INT IN [0..Rope.Length[dotTest]-1] DO
IF Rope.Fetch[dotTest, k]='. THEN EXIT
REPEAT
FINISHED => GOTO Dotless;
ENDLOOP;
EXITS Dotless => BEGIN
sd: TVHandle ← NEW[styleDefinition TVObject ← [body: styleDefinition [
name: theAtom,
value: CopyOneTV[rhs]]]];
BufferOrCall [sd];
END;
END;
END;
x: OpenTVHandle => BEGIN
original: ATOM;
tvo: TVHandle ← NEW[TVObject ← theAtomicTV]; -- may be altered below --
WITH tvo SELECT FROM t0: AtomTVHandle => original ← t0.value; ENDCASE;
DO -- handling multiple opens ala Atom^^ --
WITH tvo SELECT FROM -- will surely be atom the first time --
t2: AtomTVHandle =>
WITH scan.stream.token SELECT FROM
t3: OpenTVHandle => BEGIN
b: TVHandle ← ObtainBinding [RemoveDot[t2.value], scan.bindingStack];
AdvanceScan [scan]; -- past the open --
IF b#NIL THEN tvo ← b ELSE GOTO EndOfOpenings;
END; -- and loop to handle atom bound to atom bound to ... --
ENDCASE => GOTO EndOfOpenings;
ENDCASE => GOTO EndOfOpenings;
REPEAT
EndOfOpenings => NULL;
ENDLOOP;
fall through having done opens until 'tvo' not an atom or no more opens --
WITH tvo SELECT FROM
tt: NodeTVHandle => --Splice external node rep into input stream--
BEGIN
scan.stream ← NEW[characters ScanStream ← [
name: theAtom,
pushed: CopyScanStream[scan.stream],
body: characters [cstream: IO.RIS[ISTiogaIntern.PrintNodeContents[NARROW[tt.isnode]]]]]];
AdvanceScan [scan]; -- prime the pump --
END;
tt: StringTVHandle =>
BEGIN
scan.stream ← NEW[tokens ScanStream ← [
name: theAtom,
pushed: CopyScanStream[scan.stream],
body: tokens [tokenList: tt.list] ]];
BEGIN -- warn node impl about the styleOpen --
zz: TVHandle ← NEW[styleOpen TVObject ← [body: styleOpen[name: original]]];
BufferOrCall [zz];
END;
AdvanceScan [scan]; -- prime the pump --
END;
tt: AtomTVHandle => BufferOrCall [tvo]; -- opens finally got just another atom --
ENDCASE => ERROR;
END; -- of open --
ENDCASE => -- just the atom was there --
{a: AtomTVHandle ← NEW[atom TVObject ← [body: atom[value: theAtom]]];
BufferOrCall [a]};
END; -- of atom --
t: CharactersTVHandle => BEGIN
BufferOrCall [scan.stream.token];
AdvanceScan [scan];
END;
t: StringTVHandle => {BufferOrCall [scan.stream.token]; AdvanceScan [scan]};
t: DollarTVHandle =>
BEGIN
IF primaryImpl=NIL THEN
BEGIN -- test this tag for being the primary impl --
im: ISNode.Implementation ← ISNode.GetImplementation [t.value, scan.family];
IF im#NIL AND im.implementationClass=primary THEN BEGIN
-- have the primary impl --
ii: ISToken.InterscriptContext ← NEW[ ISToken.InterscriptContextObject ← [ body: initial [parent] ] ];
primaryImpl ← im; primaryTag ← t.value;
NARROW[node.isnode, ISNode.Handle].tag ← primaryTag;
^^ not NARROW[node.isnode] ← ISNode.Create [aa]; --
we know that the only difference between ISNode.Create[x] and --
ISNode.Create[y] is the atom stored into the type field --
NARROW[node.isnode, ISNode.Handle].printProc ← primaryImpl.printTioga;
primaryImpl.internalize [ NARROW[node.isnode], ii ];
feed to node-impl the content we had to remember while --
we didn't know what the impl was --
WHILE contentBuffer#NIL DO
temp: TVHandle;
WITH contentBuffer SELECT FROM
cb: NodeTVHandle => BEGIN
ie: ISToken.InterscriptContext ← NEW[ ISToken.InterscriptContextObject ← [ body: embedded[content: cb] ] ];
[] ← primaryImpl.internalize [ NARROW[node.isnode], ie ];
END;
cb: StyleOpenTVHandle => BEGIN
ie: ISToken.InterscriptContext ← NEW[ ISToken.InterscriptContextObject ← [ body: styleOpen[identifier: cb] ] ];
[] ← primaryImpl.internalize [ NARROW[NARROW[node.isnode]], ie ];
END;
ENDCASE => BEGIN
ic: ISToken.InterscriptContext ← NEW[ ISToken.InterscriptContextObject ← [ body: content[content: contentBuffer] ] ];
[] ← primaryImpl.internalize [ NARROW[NARROW[node.isnode]], ic ];
END;
temp ← contentBuffer; contentBuffer ← contentBuffer.next;
ENDLOOP;
END;
END;
ISNode.SetTag [NARROW[node.isnode], t.value]; AdvanceScan [scan];
ISMessage.PutF["CollectNode: %g\n", IO.atom[t.value]];
END;
t: PushTVHandle => {square ← AnchorBindings[scan.bindingStack]; AdvanceScan [scan]};
t: PopTVHandle => {PruneBindings[scan.bindingStack, square]; AdvanceScan [scan]};
t: LeftCurlyTVHandle => BEGIN
child: NodeTVHandle;
AdvanceScan [scan];
child ← CollectNode [scan, NARROW[node.isnode]];
--<<Make PourImpl do this: child.isnode.parent ← NARROW[node.isnode];>>--
DO
WITH scan.stream.token SELECT FROM
n: NullTVHandle => AdvanceScan[scan];
o: OpenTVHandle => --Remove outer {} and splice innerds into input stream (macro expansion)--
BEGIN
AdvanceScan[scan]; --Get rid of open--
scan.stream ← NEW[characters ScanStream ← [
name: NIL,
pushed: CopyScanStream[scan.stream],
body: characters [cstream: IO.RIS[ISTiogaIntern.PrintNodeContents[NARROW[child.isnode], FALSE]]]]];
AdvanceScan [scan]; -- prime the pump --
EXIT;
END;
ENDCASE => {
BufferOrCall [child];
EXIT;
};
ENDLOOP;
END;
t: RightCurlyTVHandle => BEGIN
IF primaryImpl=NIL OR primaryImpl.internalize=NIL THEN BEGIN
-- was no dollar that was a primary impl --
ii: ISToken.InterscriptContext ← NEW[InterscriptContextObject ← [body: initial [parent] ] ];
primaryImpl ← ISNode.GetImplementation [( primaryTag←NIL), scan.family];
IF primaryImpl=NIL OR primaryImpl.internalize=NIL THEN ERROR;
--<<defaults not set>>--
NARROW[node.isnode, ISNode.Handle].printProc ← primaryImpl.printTioga;
primaryImpl.internalize [NARROW[node.isnode], ii];
WHILE contentBuffer#NIL DO
temp: TVHandle;
WITH contentBuffer SELECT FROM
cb: NodeTVHandle => BEGIN
ie: ISToken.InterscriptContext ← NEW[ ISToken.InterscriptContextObject ← [ body: embedded[content: cb] ] ];
[] ← primaryImpl.internalize [ NARROW[node.isnode], ie ];
END;
cb: StyleOpenTVHandle => BEGIN
ie: ISToken.InterscriptContext ← NEW[ ISToken.InterscriptContextObject ← [ body: styleOpen[identifier: cb] ] ];
[] ← primaryImpl.internalize [ NARROW[node.isnode], ie ];
END;
ENDCASE => BEGIN
ic: ISToken.InterscriptContext ← NEW[ ISToken.InterscriptContextObject ← [ body: content[content: contentBuffer] ] ];
[] ← primaryImpl.internalize [ NARROW[node.isnode], ic ];
END;
temp ← contentBuffer; contentBuffer ← contentBuffer.next;
ENDLOOP;
END;
IF contentBuffer#NIL THEN ERROR; --<<cleared just above or at dollar>>--
FOR c: ISNode.TagHandle ← NARROW[node.isnode, ISNode.Handle].tagThread, c.next UNTIL c=NIL DO
ib: ISToken.InterscriptContext ← NEW[ ISToken.InterscriptContextObject ← [ body: bindings[scan.bindingStack] ] ];
dimpl: ISNode.Implementation ← ISNode.GetImplementation [c.tag, scan.family];
NARROW[node.isnode, ISNode.Handle].tag ← c.tag;
IF dimpl#NIL AND dimpl.internalize#NIL THEN dimpl.internalize [ NARROW[node.isnode], ib ];
ENDLOOP;
BEGIN
ie: ISToken.InterscriptContext ← NEW[ ISToken.InterscriptContextObject ← [ body: end[] ] ];
[] ← primaryImpl.internalize [ NARROW[node.isnode], ie ];
END;
PruneBindings [scan.bindingStack, anchor];
ISTiogaIntern.localBindingLimit ← oldLocalLimit;
scan.stream.token ← NEW[null TVObject ← [body: null[]]];
-- not AdvanceScan [scan]: might be last node --
RETURN [node];
END;
ENDCASE => ERROR ParseFailure [scan, outOfPlaceConstruct];
ENDLOOP;
END;
SHORTINTEGER: PROC [p: LONG INTEGER] RETURNS [INTEGER] ~ INLINE {
IF p < FIRST[INTEGER] OR p > LAST[INTEGER] THEN ERROR;
RETURN[INTEGER[p]];
};
ObtainBindingIntegerOrZero: PUBLIC PROCEDURE [
name: ATOM,
stack: ISBinding.StackHandle]
RETURNS [INTEGER] = BEGIN
tv: TVHandle ← ObtainBinding [name, stack];
IF tv=NIL THEN RETURN [0];
WITH tv SELECT FROM
tt: IntegerTVHandle => RETURN [SHORTINTEGER [tt.value]];
ENDCASE => RETURN [0];
END;
END.