-- Last Modified by JHM
--  Schmidt, August 21, 1982 2:59 pm

DIRECTORY
  Disp: TYPE USING [],
  IO: TYPE USING [char, GetChar, Put, PutChar, rope, ROPE],
  PL: TYPE USING [cdebug, EndDisplay, Environment, Insert, IS, LSTNode, Node,
  	NodeType, OS, rASS, rCAT, rCATL, rCLOSURE, rCOMB, rDELETE, rEQUAL,
  	RErr, rFAIL, rFCN, rGOBBLE, rGTR, rHOLE, rID, rITER, rLST, rMAPPLY,
  	rMINUS, rNUM, rOPT, rPALT, rPAPPLY, rPATTERN, rPLUS, rPROG, rSEQ,
  	rSEQOF, rSEQOFC, rSTR, rTILDE, rWILD, SN, Symbol],
  PString: TYPE USING [EmptyS, Item, MakeNUM, NewStream, Stream],
  Rope: TYPE USING [Fetch, Length, ROPE],
  SafeStorage: TYPE USING [NarrowRefFault];

DispImpl: CEDAR PROGRAM IMPORTS P:PL, S: PString, Rope, IO, SafeStorage EXPORTS Disp  = {
OPEN Rope, IO, PL;
NumLines: INTEGER = 10;
Environment: TYPE = PL.Environment;
LSTNode: TYPE = PL.LSTNode;
NodeType: TYPE = PL.NodeType;
Node: TYPE = PL.Node;
Symbol: TYPE = PL.Symbol;
Stream: TYPE = PString.Stream;
cdebug: BOOLEAN = PL.cdebug;
WP: TYPE = PROC[CHARACTER];
--
WC: WP;
charCount: CARDINAL _ 0;
DispCnt: INTEGER _ 0;
AskEnd: BOOLEAN _ TRUE;
ConfirmChar: CHARACTER _ '\n;
LineLength: CARDINAL = 60;
MoreFlag: BOOLEAN;

Precedence: TYPE = [0..256);
Operator: ARRAY NodeType OF ROPE; 

CharsPerLine: CARDINAL = 72;
cIn: CARDINAL; -- current indentation of the line to be printed;
cPos: CARDINAL; -- current character position;
broken: [0..1]; -- 1 iff lines at current indentation should be put on multiple lines
Line: ARRAY [0..CharsPerLine) OF RECORD[break: BOOLEAN, indent: [0..128), c: CHARACTER];
-- Invariant:
      -- Line[0...cIn).c = SP
      -- For i in [cIn...cPos)Line[i].c contains characters
      -- If Line[i].break then we can start a new line there indented by Line[i].indent.  This indent value us always greater than cIn.
      -- cPos < CharsPerLine (i.e. we empty immediately when full)

-- this routine is necessary only until compiler is fixed (5/23/80)

ClearLine: PUBLIC PROC = {};

ClearScreen: PUBLIC PROC = {charCount _ DispCnt _ 0};

Confirm: PUBLIC PROC RETURNS [BOOLEAN] =
   {ConfirmChar _ P.IS.GetChar[]; RETURN[ ConfirmChar= '\n]};

DispReset: PUBLIC PROC = {
DispCnt _ 0;
AskEnd _ TRUE;
MoreFlag _ TRUE;
WC _ MyWriteProcedure;
};

DispSetup: PUBLIC PROC = {
DispReset[];
[] _ P.Insert["print",[,,ZARY[PrintRoutine]]];
};

MyWriteProcedure: PUBLIC PROC[c: CHARACTER] = {
P.OS.PutChar[c];
charCount _ IF c='\n THEN 0 ELSE charCount+1;
IF ~(charCount>CharsPerLine OR c = '\n) OR ~AskEnd THEN RETURN;
charCount _ 0;
DispCnt _ DispCnt + 1;
IF DispCnt >= NumLines AND ~MoreFlag THEN {
	   P.OS.Put[char['\n], rope[" ......\n"]];
	   P.EndDisplay;
      };
};

Print: PUBLIC PROC[n: Node] = {
{ ENABLE P.EndDisplay => CONTINUE;
i: CARDINAL;
      cIn _ cPos _ broken _ 0;
      FOR i IN [0..CharsPerLine) DO
	   Line[i].break _ FALSE;
	   ENDLOOP;
PrintExp[n,0,0,0];broken _ 1;NL[0];
};
};

NL: PROC[i: CARDINAL] =
      {
      IF i<cIn+broken THEN -- flush out line
	   { j: CARDINAL;
	   FOR j IN [0..cPos)
		 DO
		 WC[Line[j].c];
		 Line[j]_[FALSE,,' ];
		 ENDLOOP;
	   WC['\n];
	   IF i<cIn THEN broken _ 0;
	   cIn  _ cPos _ i;
	   }
      ELSE {
	   Line[cPos].break _ TRUE;
	   Line[cPos].indent _ i;
	   };
      };

PC: PROC[c: CHARACTER] = {
      Line[cPos].c _ c;
      cPos _ cPos + 1;
      IF cPos=CharsPerLine THEN -- Time to flush line
	   {
	   i, j, k, l: CARDINAL;
	   mindent: CARDINAL _ 77777B;
	   FOR i IN [cIn+1 ..CharsPerLine) DO
		 IF Line[i].break AND Line[i].indent<mindent THEN
		 mindent _ Line[i].indent;
		 ENDLOOP;
	   FOR i _ 0, i+1 UNTIL i=CharsPerLine OR 
                       i>cIn AND Line[i].break AND
                        Line[i].indent=mindent
		 DO
		 WC[Line[i].c]
		 ENDLOOP;
	   WC['\n];
	   IF mindent=77777B THEN cPos _ cIn
	   ELSE {
		 -- We're now at greater indentation than before
		 --Add blanks
		 FOR j IN [cIn..mindent) DO
		       Line[j] _ [FALSE,,' ]; ENDLOOP;
		 j _ cIn _ mindent;
		 -- shift characters to the left
		 k _ i;
		       DO
		       Line[j] _ Line[k];
		       j _ j+1;
		       k _ k+1;
		       IF k=CharsPerLine THEN EXIT;
		       IF Line[k].break AND Line[k].indent=cIn THEN
			     { -- flush again
			     FOR l IN [0..j)
				  DO
				  WC[Line[l].c]
				  ENDLOOP;
			     WC['\n];
			     j _ cIn;
			     };
		       ENDLOOP;
		 cPos _ j;
		 broken _ 1;
		 };
	   FOR i IN [cPos..CharsPerLine) DO
		 Line[i].break _ FALSE ENDLOOP;
	   };
      };

PrintExp: PROC[n: Node,in: CARDINAL,lp,rp: Precedence] = {
-- This routine never calls Alloc
DO -- to eliminate tail recursion
IF n = NIL THEN PS["NIL(error)"]
ELSE IF ISTYPE[n, rFAIL] OR ISTYPE[n, rWILD] OR ISTYPE[n, rHOLE] THEN PS[Operator[n.Type]]
ELSE
{W: PROC[left, right: Node] RETURNS [loop: BOOLEAN]=
     {lprec, rprec: Precedence;
      SELECT n.Type FROM
       PROG => {lprec _2; rprec _ 2};
       ASS => {lprec _ 16; rprec _ 4};
       PALT => {lprec _ 6; rprec _ 6};
       GTR => {lprec _ 8; rprec _ 8};
       ENDCASE => {lprec _ 10; rprec _ 11};
      IF lp>lprec OR rprec<rp THEN
	   {
	   PC['(];
	   PrintExp[left,in+1,0,lprec];
	   NL[in+1];
	   PS[Operator[n.Type]];
	   PrintExp[right,in+1,rprec, 0];
	   PC[')];
	   RETURN[FALSE]}
      ELSE {
	   PrintExp[left,in,lp,lprec];
	   NL[in];
	   PS[Operator[n.Type]];
	   n _ right;
	   lp _ rprec;
	   RETURN[TRUE];
	   };
      };
WITH n SELECT FROM
m: rNUM => PrintExp[P.SN[S.MakeNUM[m.num]],in,lp,rp];
m: rSTR =>
      {
      -- No Allocs done in here, by called procedures either!
      ns, ns1: Stream;
      ns _ S.NewStream[m.str];
      ns1 _ S.NewStream[m.str];
      WHILE ~S.EmptyS[ns1] DO
	   c: CHARACTER;
	   [c, ns1] _ S.Item[ns1];
	   IF c NOT IN ['0..'9] THEN GOTO NonNum;
	   REPEAT
	   NonNum =>
		 {
		 PC['"];
		 WHILE ~S.EmptyS[ns] DO
		       {
		       c: CHARACTER;
			[c, ns] _ S.Item[ns];
		       SELECT c FROM
		       '", '^ => { PC['^]; PC[c] };
		       36C => PS["^036"];
		       '\177 => PS["^177"];
		       IN [' ..'\177) => PC[c];
		       ENDCASE => {
			     PC['^]; PC[c+100B];
			     };
		       };
		       ENDLOOP;
		 PC['"];
		 };
	   FINISHED =>
		 IF S.EmptyS[ns] THEN
		       { PC['"]; PC['"] }
		 ELSE WHILE ~S.EmptyS[ns] DO
		       c: CHARACTER;
			[c,ns] _ S.Item[ns];
			PC[c];
		       ENDLOOP;
	   ENDLOOP;
      };
m: rCLOSURE => 
      {
      e: Environment;
      IF m.env=NIL THEN { n_m.exp; LOOP };
      PC['(];
      in _ in+1;
      PrintExp[m.exp,in,0,0];
      NL[in];
      PS[" where "];
      e _ m.env;
      UNTIL e=NIL DO
	   PrintString1[e.name.name];
	   PC['=];
	   PrintExp[e.val,in,0,0]; NL[in];
	   e _ e.next;
	   IF e#NIL THEN PS[" and "]
	   ENDLOOP;
      PC[')];
      };
m: rID => PrintString1[m.name.name];
m: rPATTERN => {
      PC['{]; PrintExp[m.pattern,in+1,0,0]; PC['}]
      };
m: rLST => 
      IF m.listhead=NIL THEN PS["[]"]
      ELSE 
	   {l: rLST _ m;
	   PC['[];
	   DO
		 PrintExp[l.listhead,in+1,0,0];
		 l _ l.listtail;
		 IF l.Type ~= LST THEN
		       {PS["TRASHED LST TAIL!!!"];
		       EXIT};
		 IF l.listhead = NIL THEN EXIT;
		 PC[',]; NL[in+1];
		 ENDLOOP;
	   PC[']];
	   };
m: rCOMB =>
      IF rp>12 THEN
	   {
	   PC['(];
	   PrintString1[m.proc.name];
	   PC[' ];
	   NL[in+1];
	   PrintExp[m.parm,in+1,12, 0];
	   PC[')];
	   }
      ELSE
	   {
	   PrintString1[m.proc.name];
	   PC[' ];
	   NL[in];
	   n_m.parm;
	   lp _ 12;
	   LOOP;
	   };
m: rTILDE =>
      IF rp>12 THEN
	   {
	   PS["(~"];NL[in+1];
	   PrintExp[m.not,in+1,12, 0];
	   PC[')];
	   }
      ELSE
	   {
	   PC['~];NL[in];
	   n_m.not;
	   lp _ 12;
	   LOOP;
	   };
m: rFCN =>
      {
      IF lp>16 OR 0<rp THEN
	   {
	   PC['(];
	   PrintExp[m.parms,in+1,0,16];
	   PS[": "];
	   NL[in+1];
	   PrintExp[m.fcn,in+1,0, 0];
	   PC[')];
	   }
      ELSE {
	   PrintExp[m.parms,in,lp,16];
	   PS[": "];
	   NL[in];
	   n _ m.fcn;
	   lp _ 0;
	   LOOP;
	   };
      };
m: rCAT => IF W[m.left, m.right] THEN LOOP;
m: rCATL => IF W[m.left, m.right] THEN LOOP;
m: rEQUAL => IF W[m.left, m.right] THEN LOOP;
m: rGTR => IF W[m.left, m.right] THEN LOOP;
m: rPALT => IF W[m.left, m.right] THEN LOOP;
m: rPAPPLY => IF W[m.left, m.right] THEN LOOP;
m: rMAPPLY => IF W[m.left, m.right] THEN LOOP;
m: rGOBBLE => IF W[m.left, m.right] THEN LOOP;
m: rITER => IF W[m.left, m.right] THEN LOOP;
m: rPROG => IF W[m.left, m.right] THEN LOOP;
m: rPLUS => IF W[m.left, m.right] THEN LOOP;
m: rMINUS => IF W[m.left, m.right] THEN LOOP;
m: rSEQ => IF W[m.left, m.right] THEN LOOP;
m: rASS =>
      {
      IF lp>16 OR 4<rp THEN
	   {
	   PC['(];
	   PrintString1[m.lhs.name];
	   NL[in+1];
	   PS["_"];
	   PrintExp[m.rhs,in+1,4, 0];
	   PC[')];
	   }
      ELSE {
	   PrintString1[m.lhs.name];
	   NL[in];
	   PS["_"];
	   n _ m.rhs;
	   lp _ 4;
	   LOOP;
	   };
      };
m: rOPT => {PrintExp[m.pat,in,lp, 14]; PS[Operator[n.Type]]};
m: rDELETE => {PrintExp[m.pat,in,lp, 14]; PS[Operator[n.Type]]};
m: rSEQOF => {PrintExp[m.pat,in,lp, 14]; PS[Operator[n.Type]]};
m: rSEQOFC => {PrintExp[m.pat,in,lp, 14]; PS[Operator[n.Type]]};
ENDCASE => {PS["TRASHED NODE!!! Type= "];PC[LOOPHOLE[n.Type]]};
RETURN;
}ENDLOOP;
};

PrintRoutine: PROC[n1: Node] RETURNS[Node] = {
-- zary
-- print on terminal the entire incoming string, as is
-- must be string coming in
PrintString[NARROW[n1, rSTR ! SafeStorage.NarrowRefFault =>
P.RErr["print requires a string as input"]].str] ;
RETURN[n1];
};

PrintString: PUBLIC PROC[s: ROPE] = {
      ns: Stream;
      ns _ S.NewStream[s];
      WHILE ~S.EmptyS[ns] DO c:CHARACTER; [c, ns] _ S.Item[ns]; WC[c]; ENDLOOP;
};

PrintString1: PROC[s: ROPE] = {
      ns: Stream;
      ns _ S.NewStream[s];
      WHILE ~S.EmptyS[ns] DO c:CHARACTER; [c, ns] _ S.Item[ns]; PC[c]; ENDLOOP;
};

PS: PROC[s: ROPE] = {
FOR i: LONG INTEGER IN [0..Length[s]) DO PC[Fetch[s,i]] ENDLOOP;
};

ToggleAllPrint: PUBLIC PROC RETURNS[BOOLEAN] = {
RETURN[TRUE];
};

ToggleMore: PUBLIC PROC RETURNS[BOOLEAN] = {
RETURN[MoreFlag _ ~MoreFlag];
};

t: NodeType;
FOR t IN NodeType DO Operator[t] _ "???" ENDLOOP;
Operator[HOLE] _ "...";
Operator[CAT] _ "  ";
Operator[FAIL] _ "fail";
Operator[WILD] _ "#";
Operator[CATL] _ ",,";
Operator[EQUAL] _ "=";
Operator[GTR] _ ">";
Operator[PALT] _ "| ";
Operator[PAPPLY] _ "/";
Operator[MAPPLY] _ "//";
Operator[GOBBLE] _ "///";
Operator[ITER] _ "%";
Operator[FCN] _ ":";
Operator[ASS] _ "_";
Operator[PROG] _ ";";
Operator[SEQOF] _ "!";
Operator[SEQOFC] _ ",!";
Operator[DELETE] _ "*";
Operator[PLUS] _ "+";
Operator[MINUS] _ "-";
Operator[TILDE] _ "~";
Operator[SEQ] _ "--";
Operator[OPT] _ "?";

}.