-- 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] ← "?";
}.