-- File: ScriptParseImpl.mesa - last edit by
-- Karlton: 2-Sep-82 14:07:38
DIRECTORY
ScriptHash USING [Create, Destroy, Handle, Hash, nullVal, Val],
ScriptNode USING [QualifiedID, QualifiedIDSequence, Type],
ScriptParse USING [
ErrorCode, InitScan, NextSymbol, ScanHandle, Terminal, TerminalType],
ScriptTree USING [AddNode, Create, Destroy, Handle, MoveNode, TreeHandle],
Stream USING [Handle];
ScriptParseImpl: PROGRAM
IMPORTS ScriptHash, ScriptParse, ScriptTree
EXPORTS ScriptParse = {
CantReduce: ERROR = CODE;
Error: PUBLIC ERROR [
code: ScriptParse.ErrorCode, position: LONG CARDINAL] = CODE;
Handle: TYPE = ScriptTree.Handle;
lookAhead: CARDINAL = 2;
CurNext: TYPE = {current, next};
nullVal: ScriptHash.Val = ScriptHash.nullVal;
Frame: TYPE = POINTER TO GlobalData;
GlobalData: TYPE = RECORD [
terminals: ARRAY [0..lookAhead) OF ScriptParse.Terminal,
current: CARDINAL,
scan: ScriptParse.ScanHandle,
idSeq: ScriptNode.QualifiedID ← NIL,
idCount: CARDINAL ← 0,
idTable, univTable: ScriptHash.Handle ← NIL,
tree: ScriptTree.TreeHandle,
z: UNCOUNTED ZONE];
Internalize: PUBLIC PROCEDURE [stream: Stream.Handle, z: UNCOUNTED ZONE]
RETURNS [univ, id: ScriptHash.Handle, tree: ScriptTree.TreeHandle]= {
frame: GlobalData ← [
z: z,
idTable: ScriptHash.Create[z, 50, 3, 20, FALSE],
univTable: ScriptHash.Create[z, 20, 2, 20, TRUE],
idSeq: z.NEW[ScriptNode.QualifiedIDSequence[5]],
scan: NIL,
terminals: ,
current: 0,
tree: ScriptTree.Create[z]];
frame.scan ← ScriptParse.InitScan[
stream, frame.univTable, frame.idTable, frame.z];
FOR i: CARDINAL IN [0..lookAhead) DO
frame.terminals[i] ← ScriptParse.NextSymbol[frame.scan] ENDLOOP;
-- InitUniversalTable[f];
Unit[@frame !
CantReduce => ERROR Error[parse, frame.terminals[frame.current].pos];
UNWIND => {
frame.univTable.Destroy[];
frame.idTable.Destroy[];
ScriptTree.Destroy[frame.tree];
frame.z.FREE[@frame.idSeq]}];
frame.z.FREE[@frame.idSeq];
RETURN[frame.univTable, frame.idTable, frame.tree]};
CheckAndAdvance: PROCEDURE [f: Frame, type: ScriptParse.TerminalType] = {
IF Type[f] # type THEN ERROR CantReduce; Advance[f]};
Advance: PROCEDURE [f: Frame] = {
f.terminals[f.current] ← ScriptParse.NextSymbol[f.scan];
f.current ← (f.current + 1) MOD lookAhead};
Type: PROCEDURE [f: Frame, which: CurNext ← current]
RETURNS [ScriptParse.TerminalType] = {
RETURN[SELECT which FROM
current => f.terminals[f.current].type,
next => f.terminals[1 - f.current].type,
ENDCASE => ERROR]};
CopyIdSequence: PROCEDURE [f: Frame, longer: CARDINAL ← 0]
RETURNS [qid: ScriptNode.QualifiedID] = {
qid ← f.z.NEW[ScriptNode.QualifiedIDSequence[f.idCount + longer]];
FOR i: CARDINAL IN [0..f.idCount) DO qid[i] ← f.idSeq[i] ENDLOOP};
AddIdToSeq: PROC [f: Frame] = {
WITH term: f.terminals[f.current] SELECT FROM
id => {
IF f.idCount = f.idSeq.length THEN {
tempSeq: ScriptNode.QualifiedID ← CopyIdSequence[f, 5];
f.z.FREE[@f.idSeq];
f.idSeq ← tempSeq};
f.idSeq[f.idCount] ← term.hash;
f.idCount ← f.idCount + 1};
ENDCASE => ERROR CantReduce};
TryName: PROCEDURE [f: Frame] = {
IF f.idCount > 0 THEN RETURN;
IF Type[f] # id THEN RETURN;
AddIdToSeq[f];
WHILE Type[f, next] = dot DO
Advance[f]; -- id which is at the front
Advance[f]; -- dot in order to get the next id (hopefully) at the front
AddIdToSeq[f];
ENDLOOP};
GetList: PROCEDURE [
f:Frame,
proc: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle],
node: Handle] = {
last: Handle ← NIL;
DO
SELECT Type[f] FROM
bar, rightParen, rightBrace, rightBracket, quote => EXIT;
-- only things that end lists
ENDCASE => last ← proc[f, node, last];
ENDLOOP};
-- and here are the productions
Unit: PROCEDURE [f: Frame] = {
node: Handle;
CheckAndAdvance[f, start];
CheckAndAdvance[f, versionId];
node ← ScriptTree.AddNode[f.tree, NIL, NIL]; -- define the root
Node[f, node];
CheckAndAdvance[f, stop]};
Node: PROCEDURE [f: Frame, node: Handle] = {
node.node ← [node[NIL, NIL]];
CheckAndAdvance[f, leftBrace];
ItemList[f, node];
CheckAndAdvance[f, rightBrace]};
Name: PROCEDURE [f: Frame] = {
IF f.idCount = 0 THEN ERROR CantReduce; Advance[f]; f.idCount ← 0};
Id: PROCEDURE [f: Frame] = {
IF f.idCount # 1 THEN ERROR CantReduce; Advance[f]; f.idCount ← 0};
ItemList: PROCEDURE [f: Frame, node: Handle] = {GetList[f, Item, node]};
BindingList: PROCEDURE [f: Frame, node: Handle] = {GetList[f, Binding, node]};
Item: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
TryName[f];
SELECT Type[f] FROM
links => new ← Links[f, parent, son];
universal => {
SELECT Type[f, next] FROM
dollar => new ← Label[f, parent, son];
colonEqual => new ← GlobalBinding[f, parent, son];
ENDCASE => new ← Content[f, parent, son]};
id => {
SELECT Type[f, next] FROM
upArrow, colon => new ← Link[f, parent, son];
leftArrow => new ← LocalBinding[f, parent, son];
colonEqual => new ← GlobalBinding[f, parent, son];
ENDCASE => new ← Content[f, parent, son]};
ENDCASE => new ← Content[f, parent, son]};
Content: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
TryName[f];
SELECT Type[f] FROM
leftBrace => {
new ← ScriptTree.AddNode[f.tree, parent, son]; Node[f, new]};
ENDCASE => new ← Term[f, parent, son]};
Term: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
new ← Primary[f, parent, son];
SELECT Type[f] FROM
plus, minus, times, divide => {
left: Handle = new;
new ← Op[f, parent, new];
ScriptTree.MoveNode[
tree: f.tree, node: left, newParent: new, newLeftSibling: NIL];
[] ← Term[f, new, left]};
ENDCASE => NULL};
Primary: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
TryName[f];
SELECT Type[f] FROM
boolean, integer, real, string => new ← Literal[f, parent, son];
universal =>
IF Type[f, next] = leftBracket THEN new ← Application[f, parent, son]
ELSE new ← Literal[f, parent, son];
leftParen => {Advance[f]; new ← SelectionOrVector[f, parent, son]};
id => SELECT Type[f, next] FROM
percent => new ← Indirection[f, parent, son];
leftBracket => new ← Application[f, parent, son];
ENDCASE => new ← Invocation[f, parent, son];
ENDCASE => ERROR CantReduce};
Indirection: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
new ← ScriptTree.AddNode[f.tree, parent, son];
new.node ← [percent[CopyIdSequence[f]]];
Name[f];
CheckAndAdvance[f, percent]};
Invocation: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
new ← ScriptTree.AddNode[f.tree, parent, son];
new.node ← [qualifiedID[ids: CopyIdSequence[f]]];
Name[f]};
SelectionOrVector: PROCEDURE [f: Frame, parent, son: Handle]
RETURNS [new: Handle] = {
IF Type[f] = question THEN {Advance[f]; new ← Selection[f, parent, son]}
ELSE new ← Vector[f, parent, son]};
Vector: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
new ← ScriptTree.AddNode[f.tree, parent, son];
new.node ← [vector[]];
ItemList[f, new]};
Selection: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle]= {
first, second, third: Handle;
new ← ScriptTree.AddNode[f.tree, parent, son];
new.node ← [choice[]];
first ← Term[f, new, NIL];
CheckAndAdvance[f, bar]; -- get the first bar
second ← ScriptTree.AddNode[f.tree, new, first];
third ← ScriptTree.AddNode[f.tree, new, second];
ItemList[f, second];
CheckAndAdvance[f, bar]; -- get the second bar
ItemList[f, third];
CheckAndAdvance[f, rightParen]};
Application: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
new ← ScriptTree.AddNode[f.tree, parent, son];
TryName[f];
WITH term: f.terminals[f.current] SELECT FROM
universal => {
new.node ← [univApplication[term.hash]]; Advance[f]};
id => {
new.node ← [application[CopyIdSequence[f]]]; Name[f]};
ENDCASE => ERROR CantReduce;
CheckAndAdvance[f, leftBracket];
[] ← ItemList[f, new];
CheckAndAdvance[f, rightBracket]};
Literal: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
new ← ScriptTree.AddNode[f.tree, parent, son];
WITH term: f.terminals[f.current] SELECT FROM
boolean => {new.node ← [boolean[term.boolean]]; Advance[f]};
integer => {new.node ← [integer[term.integer]]; Advance[f]};
string => {new.node ← [string[term.string]]; Advance[f]}; -- same heap
real => {new.node ← [real[term.real]]; Advance[f]};
universal => {new.node ← [atom[term.hash]]; Advance[f]};
ENDCASE => ERROR CantReduce};
Op: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
new ← ScriptTree.AddNode[f.tree, parent, son];
SELECT Type[f] FROM
plus => {new.node ← [expression[plus]]; Advance[f]};
times => {new.node ← [expression[multiply]]; Advance[f]};
minus => {new.node ← [expression[minus]]; Advance[f]};
divide => {new.node ← [expression[divide]]; Advance[f]};
ENDCASE => ERROR CantReduce};
Binding: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
SELECT Type[f, next] FROM
leftArrow => new ← LocalBinding[f, parent, son];
colonEqual => new ← GlobalBinding[f, parent, son];
ENDCASE => ERROR CantReduce};
LocalBinding: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
idSeq: ScriptNode.QualifiedID;
TryName[f];
IF Type[f] # id OR Type[f, next] # leftArrow THEN ERROR CantReduce;
new ← ScriptTree.AddNode[f.tree, parent, son];
idSeq ← CopyIdSequence[f];
Name[f];
Advance[f]; -- over leftArrow
new.node ← [localBind[lhs: idSeq]];
RHS[f, new]};
GlobalBinding: PROCEDURE [f: Frame, parent, son: Handle]
RETURNS [new: Handle] = {
TryName[f];
new ← ScriptTree.AddNode[f.tree, parent, son];
IF Type[f, next] # colonEqual THEN ERROR CantReduce;
WITH term: f.terminals[f.current] SELECT FROM
id => {
new.node ← [globalBind[lhs: CopyIdSequence[f], univ: FALSE]]; Name[f]};
universal => {
idSeq: ScriptNode.QualifiedID ← f.z.NEW[ScriptNode.QualifiedIDSequence[1]];
idSeq[0] ← term.hash;
new.node ← [globalBind[lhs: idSeq, univ: TRUE]];
Advance[f]};
ENDCASE => ERROR CantReduce;
Advance[f]; -- over colonEqual
RHS[f, new]};
RHS: PROCEDURE [f: Frame, node: Handle] = {
SELECT Type[f] FROM
plus, minus, times, divide => {
new: Handle = Op[f, node, NIL];
[] ← Term[f, new, NIL]};
quote => {
new: Handle = ScriptTree.AddNode[f.tree, node, NIL];
Advance[f];
new.node ← [quotedExpression[]];
ItemList[f, new];
CheckAndAdvance[f, quote]};
leftBracket => {
new: Handle = ScriptTree.AddNode[f.tree, node, NIL];
left: Handle = ScriptTree.AddNode[f.tree, new, NIL];
right: Handle = ScriptTree.AddNode[f.tree, new, left];
new.node ← [environment[]];
Advance[f];
ItemList[f, left];
CheckAndAdvance[f, bar];
BindingList[f, right];
CheckAndAdvance[f, rightBracket]};
ENDCASE => {
[] ← Content[f, node, NIL]}};
Label: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
TryName[f];
SELECT Type[f] FROM
universal => RETURN[Tag[f, parent, son]];
id => RETURN[Link[f,parent, son]];
ENDCASE => ERROR CantReduce};
Tag: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
new ← ScriptTree.AddNode[f.tree, parent, son];
WITH term: f.terminals[f.current] SELECT FROM
universal => {new.node ← [dollar[term.hash]]; Advance[f]};
ENDCASE => ERROR CantReduce;
CheckAndAdvance[f, dollar]};
Link: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
new ← ScriptTree.AddNode[f.tree, parent, son];
WITH term: f.terminals[f.current] SELECT FROM
colon => {new.node ← [target[CopyIdSequence[f]]]; Name[f]; Advance[f]};
upArrow => {new.node ← [source[CopyIdSequence[f]]]; Name[f]; Advance[f]};
ENDCASE => ERROR CantReduce};
Links: PROCEDURE [f: Frame, parent, son: Handle] RETURNS [new: Handle] = {
Advance[f];
new ← ScriptTree.AddNode[f.tree, parent, son];
TryName[f];
WITH term: f.terminals[f.current] SELECT FROM
id => new.node ← [links[term.hash]];
ENDCASE => ERROR CantReduce;
Id[f]};
-- main line code
}. -- of ScriptParseImpl