-- File: ScriptShowImpl.mesa - last edit by
-- Karlton:	 2-Sep-82 14:21:31

DIRECTORY
  Ascii USING [CR, NUL, SP],
  Environment USING [Byte],
  Real USING [AppendReal],
  ScriptHash USING [AppendId, Handle, Hash],
  ScriptNode USING [Operator, QualifiedID, String],
  ScriptParse USING [Error],
  ScriptTree USING [Handle, RootNode, TreeHandle, Walk],
  Stream USING [Handle, PutBlock, PutChar],
  String USING [AppendLongDecimal];
  
ScriptShowImpl: PROGRAM
  IMPORTS Real, ScriptHash, ScriptParse, ScriptTree, Stream, String
  EXPORTS ScriptParse = {
  
  indentPerDepth: CARDINAL = 4;
  
  Nibble: TYPE = [0..15];
  HexChar: TYPE = MACHINE DEPENDENT RECORD [
    pad(0:0..7): Environment.Byte,
    left(0:8..11): Nibble,
    right(0:12..15): Nibble];

  Handle: TYPE = ScriptTree.Handle;
  Format: TYPE = {tree, script};
  Frame: TYPE = POINTER TO FrameObject;
  FrameObject: TYPE = RECORD [
    out: Stream.Handle,
    univ, id: ScriptHash.Handle,
    lastChar: CHARACTER,
    format: Format _ tree];
  
  ShowTree: PUBLIC PROCEDURE [
    out: Stream.Handle,
    univ, id: ScriptHash.Handle,
    tree: ScriptTree.TreeHandle] = {
    f: FrameObject _ [out, univ, id, Ascii.NUL, tree];
    ShowNode[@f, ScriptTree.RootNode[tree], 0]};
      
  Externalize: PUBLIC PROCEDURE [
    out: Stream.Handle,
    univ, id: ScriptHash.Handle,
    tree: ScriptTree.TreeHandle] = {
    f: FrameObject _ [out, univ, id, Ascii.NUL,  script];
    ShowString[@f, "Interscript/Reference/83 "L];
    ShowChar[@f, Ascii.CR];
    ShowNode[@f, ScriptTree.RootNode[tree], 0];
    ShowString[@f, "ENDSCRIPT"L];
    ShowChar[@f, Ascii.CR]};
      
  ShowSons: PROCEDURE [f: Frame, r: Handle, d: CARDINAL] = {
    son: Handle;
    son _ ScriptTree.Walk[r, down];
    WHILE son # NIL DO
      ShowNode[f, son, d + 1];
      son _ ScriptTree.Walk[son, right]
      ENDLOOP};
      
  NoSons: PROCEDURE [f: Frame, r: Handle] = {
    IF ScriptTree.Walk[r, down] # NIL THEN
      ERROR ScriptParse.Error[invalidTree, 0];
    ShowBreak[f]};
    
  GetSons: PROCEDURE [n: Handle, min, max: [0..3]]
    RETURNS [Handle, Handle, Handle] = {
    sons: ARRAY [0..4) OF Handle _ ALL[NIL];
    sons[0] _ ScriptTree.Walk[n, down];
    FOR i: CARDINAL IN [1..4) DO
      IF sons[i-1] = NIL THEN EXIT;
      sons[i] _ ScriptTree.Walk[sons[i-1], right];
      ENDLOOP;
    IF sons[max] # NIL THEN ERROR ScriptParse.Error[invalidTree, 0];
    IF sons[min - 1] = NIL THEN ERROR ScriptParse.Error[invalidTree, 0];
    RETURN[sons[0], sons[1], sons[2]]};
    
  ShowNode: PROCEDURE [f: Frame, n: Handle, d: CARDINAL] = {
    IF f.format = tree THEN
      THROUGH [0..d*indentPerDepth) DO ShowChar[f, Ascii.SP] ENDLOOP;
    ShowNodeContent[f, n, d]};
    
  ShowNodeContent: PROCEDURE [f: Frame, n: Handle, d: CARDINAL] = {
    first, second, third: Handle;
    WITH node: n.node SELECT FROM
      atom => {ShowId[f, node.atom, f.univ]; NoSons[f, n]};
      application => {
        ShowIds[f, node.ids, f.id];
	SELECT f.format FROM
	  script => {
	    ShowChar[f, '[]; ShowSons[f, n, d]; ShowChar[f, ']]; ShowBreak[f]};
	  tree => {ShowString[f, "[]"]; ShowBreak[f]; ShowSons[f, n, d]};
	  ENDCASE};
      boolean => {ShowBoolean[f, node.boolean]; NoSons[f, n]};
      choice => {
        [first, second, third] _ GetSons[n, 3, 3];
	SELECT f.format FROM
	  script => {
	    ShowChar[f, '(];
	    ShowNode[f, first, d + 1];
	    ShowChar[f, '|];
	    ShowNode[f, second, d + 1];
	    ShowChar[f, '|];
	    ShowNode[f, third, d + 1];
	    ShowChar[f, ')];
	    ShowBreak[f]};
	  tree => {
	    ShowString[f, "Selection"L];
	    ShowBreak[f];
	    ShowNode[f, first, d + 1];
	    ShowBreak[f];
	    ShowNode[f, second, d + 1];
	    ShowBreak[f];
	    ShowNode[f, third, d + 1];
	    ShowBreak[f]};
	  ENDCASE};
      dollar => {ShowIdLabel[f, node.label, f.univ, "$"L]; NoSons[f, n]};
      environment => {
        [first, second, ] _ GetSons[n, 2, 2];
	SELECT f.format FROM
	  script => {
	    ShowChar[f, '[];
	    ShowNode[f, first, d];
	    ShowChar[f, '|];
	    ShowNode[f, second, d];
	    ShowChar[f, ']];
	    ShowBreak[f]};
	  tree => {
	    ShowString[f, "Environment"L];
	    ShowBreak[f];
	    ShowNode[f, first, d];
	    ShowBreak[f];
	    ShowNode[f, second, d];
	    ShowBreak[f]};
	  ENDCASE};
      expression => {
        [first, second, ] _ GetSons[n, 1, 2];
        SELECT f.format FROM
	  script => {
	    IF second # NIL THEN ShowNode[f, first, d + 1];
	    ShowOperator[f, node.expression];
	    ShowNode[f, IF second = NIL THEN first ELSE second, d + 1];
	    ShowBreak[f]};
	  tree => {
	    ShowOperator[f, node.expression];
	    ShowBreak[f];
	    ShowNode[f, first, d + 1];
	    ShowBreak[f];
	    IF second # NIL THEN {ShowNode[f, second, d + 1]; ShowBreak[f]}};
	  ENDCASE};
      globalBind => {
	[first, , ] _ GetSons[n, 1, 1];
	ShowIds[f, node.lhs, IF node.univ THEN f.univ ELSE f.id];
	ShowString[f, " := "L];
	ShowNodeContent[f, first, d]};
      integer => {ShowInteger[f, node.integer]; NoSons[f, n]};
      links => {
        ShowString[f, "LINKS "L]; ShowId[f, node.label, f.id]; NoSons[f, n]};
      localBind => {
	[first, , ] _ GetSons[n, 1, 1];
	ShowIds[f, node.lhs, f.id];
	ShowString[f, " _ "L];
	ShowNodeContent[f, first, d]};
      node => {
        SELECT f.format FROM
	  script => {
	    ShowChar[f, '{];
	    ShowSons[f, n, d];
	    ShowChar[f, '}];
	    ShowChar[f, Ascii.CR]};
	  tree => {ShowString[f, "Node"L]; ShowBreak[f]; ShowSons[f, n, d]};
	  ENDCASE};
      percent => {ShowIdsLabel[f, node.ids, f.id, "%"L]; NoSons[f, n]};
      placeHolder => {
        IF f.format = tree THEN {ShowString[f, "Place Holder"L]; ShowBreak[f]};
	ShowSons[f, n, d]};
      qualifiedID => {ShowIds[f, node.ids, f.id]; NoSons[f, n]};
      quotedExpression => {
        SELECT f.format FROM
	  script => {
	    ShowChar[f, ''];
	    ShowSons[f, n, d];
	    ShowChar[f, ''];
	    ShowChar[f, Ascii.CR]};
	  tree => {
	    ShowString[f, "Quoted Expression"L]; ShowBreak[f]; ShowSons[f, n, d]};
	  ENDCASE};
      real => {ShowReal[f, node.real]; NoSons[f, n]};
      source => {
        ShowIds[f, node.ids, f.id]; ShowChar[f, '^]; ShowBreak[f]; NoSons[f, n]};
      string => {ShowText[f, node.string]; NoSons[f, n]};
      target => {
        ShowIds[f, node.ids, f.id]; ShowChar[f, ':]; ShowBreak[f]; NoSons[f, n]};
      univApplication => {
        ShowId[f, node.atom, f.univ];
	SELECT f.format FROM
	  script => {
	    ShowChar[f, '[]; ShowSons[f, n, d]; ShowChar[f, ']]; ShowBreak[f]};
	  tree => {ShowString[f, "[]"]; ShowBreak[f]; ShowSons[f, n, d]};
	  ENDCASE};
      vector => {
        SELECT f.format FROM
	  script => {
	    ShowChar[f, '(]; ShowSons[f, n, d]; ShowChar[f, ')]; ShowBreak[f]};
	  tree => {ShowString[f, "Vector"L]; ShowBreak[f]; ShowSons[f, n, d]};
	  ENDCASE};
      ENDCASE => ERROR};
  
  ShowString: PROC [f: Frame, v: LONG STRING] = {
    f.out.PutBlock[[LOOPHOLE[@v.text], 0, v.length]];
    f.lastChar _ Ascii.NUL};
        
  ShowChar: PROC [f: Frame, v: CHARACTER] = INLINE {
    f.out.PutChar[v]; f.lastChar _ v};
        
  ShowBreak: PROC [f: Frame] = {
    char: CHARACTER = IF f.format = tree THEN Ascii.CR ELSE Ascii.SP;
    IF f.lastChar # char THEN ShowChar[f, char]};
      
  ShowHex: PROC [f: Frame, v: HexChar] = INLINE {
    ShowChar[f, 'A + v.left]; ShowChar[f, 'A + v.right]};
        
  ShowText: PROC [f: Frame, string: ScriptNode.String] = {
    ShowChar[f, '<];
    SELECT f.format FROM
      script => {
        IF string.allSimple THEN ShowString[f, string.string]
	ELSE {
	  OpenEscape: PROC = INLINE {
	    IF ~inEscape THEN {ShowChar[f, '=]; inEscape _ TRUE}};
	  CloseEscape: PROC = INLINE {
	    IF inEscape THEN {ShowChar[f, '=]; inEscape _ FALSE}};
	  set: CHARACTER _ 0C;
	  char: CHARACTER;
	  pos: CARDINAL;
	  inEscape: BOOLEAN _ FALSE;
	  WHILE pos < string.string.length DO
            SELECT (char _ string.string[pos]) FROM
              377C => {pos _ pos + 1; set _ string.string[pos]};
              ENDCASE => {
	        IF set # 0C THEN {
		  OpenEscape[];
		  ShowInteger[f, (set - 0C)*256 + (char - 0C)];
		  ShowChar[f, Ascii.SP]}
		ELSE SELECT char FROM
		  '=, '> => {OpenEscape[]; ShowHex[f, LOOPHOLE[char]]};
		  IN [40C..176C] => {CloseEscape[]; ShowChar[f, char]};
		  ENDCASE => {OpenEscape[]; ShowHex[f, LOOPHOLE[char]]}};
	    pos _ pos + 1;
	    ENDLOOP;
	    CloseEscape[]}};
      tree => {
        IF string.allSet0 THEN ShowString[f, string.string]
        ELSE {
          set: CHARACTER _ 0C;
          c: CHARACTER;
          pos: CARDINAL _ 0;
          WHILE pos < string.string.length DO
            SELECT (c _ string.string[pos]) FROM
              377C => {pos _ pos + 1; set _ string.string[pos]};
              ENDCASE => ShowChar[f, IF set = 0C THEN c ELSE 377C];
	    pos _ pos + 1;
	    ENDLOOP}};
      ENDCASE;
    ShowChar[f, '>]};
        
  ShowOperator: PROC [f: Frame, v: ScriptNode.Operator] = {
    ShowString[f, SELECT v FROM
      plus => "+ "L, minus => "- "L, divide => "/ "L, multiply => "* "L,
      ENDCASE => ERROR ScriptParse.Error[invalidTree, 0]]};
        
  ShowBoolean: PROC [f: Frame, v: BOOLEAN] = {
    SELECT v FROM
      TRUE => ShowString[f, IF f.format = script THEN "T"L ELSE "TRUE"L];
      FALSE => ShowString[f, IF f.format = script THEN "F"L ELSE "FALSE"L];
      ENDCASE};
        
  ShowInteger: PROC [f: Frame, v: LONG INTEGER] = {
    string: STRING = [20];
    String.AppendLongDecimal[string, v];
    ShowString[f, string]};
        
  ShowReal: PROC [f: Frame, v: REAL] = {
    string: STRING = [20];
    Real.AppendReal[s: string, r: v, forceE: TRUE];
    ShowString[f, string]};
        
  ShowId: PROC [f: Frame, hash: ScriptHash.Hash, table: ScriptHash.Handle] = {
    val: LONG STRING = [40];
    ScriptHash.AppendId[table, val, hash];
    ShowString[f, val]};
        
  ShowIdLabel: PROC [
    f: Frame, hash: ScriptHash.Hash, table: ScriptHash.Handle, label: STRING] = {
    IF f.format = tree THEN {ShowString[f, label]; ShowChar[f, Ascii.SP]};
    ShowId[f, hash, table];
    IF f.format = script THEN ShowString[f, label]};
        
  ShowIds: PROC [
    f: Frame, ids: ScriptNode.QualifiedID, table: ScriptHash.Handle] = {
    FOR i: CARDINAL IN [0..ids.length) DO
      IF i > 0 THEN ShowChar[f, '.]; ShowId[f, ids[i], table] ENDLOOP};
        
  ShowIdsLabel: PROC [
    f: Frame, ids: ScriptNode.QualifiedID, table: ScriptHash.Handle,
    label: STRING] = {
    IF f.format = tree THEN {ShowString[f, label]; ShowChar[f, Ascii.SP]};
    ShowIds[f, ids, table];
    IF f.format = script THEN ShowString[f, label]};
        
  }. -- of ScriptShowImpl