-- 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