
<<DispImpl.Mesa>>
<<Copyright Xerox Corporation, 1982.  All rights reserved.>>
<<Last Modified by JHM>>
<<Schmidt, August 21, 1982 2:59 pm>>
<<last edit by Satterthwaite, April 18, 1986 4:46:36 pm PST>>

DIRECTORY
Disp: TYPE USING [],
IO: TYPE USING [char, GetChar, Put, PutChar, 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 PL;
ROPE: TYPE = Rope.ROPE;
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: BOOL = PL.cdebug;
WP: TYPE = PROC[CHAR];
<<>>
WC: WP;
charCount: CARDINAL _ 0;
DispCnt: INTEGER _ 0;
AskEnd: BOOL _ TRUE;
ConfirmChar: CHAR _ '\n;
LineLength: CARDINAL = 60;
MoreFlag: BOOL;

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: BOOL, indent: [0..128), c: CHAR];
<<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 [BOOL] = {
ConfirmChar _ P.IS.GetChar[]; RETURN[ ConfirmChar= '\n]};

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

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

MyWriteProc: PROC[c: CHAR] = {
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[IO.char['\n], IO.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: CHAR] = {
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
DO -- to eliminate tail recursion
{W: PROC[left, right: Node] RETURNS [loop: BOOL]=
{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: CHAR;
[c, ns1] _ S.Item[ns1];
IF c NOT IN ['0..'9] THEN GOTO NonNum;
REPEAT
NonNum =>
{
PC['"];
WHILE ~S.EmptyS[ns] DO
{
c: CHAR;
[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: CHAR;
[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:CHAR; [c, ns] _ S.Item[ns]; WC[c]; ENDLOOP;
};

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

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

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

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

FOR t: NodeType 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] _ "?";

}.


