SParseImpl.mesa
Don Curry September 6, 1987 2:40:45 pm PDT
DIRECTORY
Convert, IO, Rope, SParse;
SParseImpl: CEDAR PROGRAM
IMPORTS Convert, IO, Rope
EXPORTS SParse =
BEGIN
BadRope: PUBLIC SIGNAL = CODE; -- From ToTree
BadTree: PUBLIC SIGNAL = CODE; -- From ToRope
ToTree: PUBLIC PROC[rope: IO.ROPE] RETURNS[SParse.Tree] = {
GetFunc: PROC[op: IO.ROPE] RETURNS[exp: REF] = {
exps: LIST OF REF ← NIL;
DO
expr: REF ← GetSum[];
IF expr#NIL THEN exps ← CONS[expr, exps];
IF lastChar # ', THEN EXIT ENDLOOP;
RETURN[IF exps=NIL THEN op ELSE CONS[op, Reverse[exps]]]};
GetSum: PROC RETURNS[exp: REF] = {
exps: LIST OF REF ← NIL;
DO
expr: REF ← GetProd[];
IF expr#NIL THEN exps ← CONS[expr, exps];
IF lastChar # '+ THEN EXIT ENDLOOP;
RETURN[IF exps.rest=NIL THEN exps.first ELSE CONS[plus, Reverse[exps]]]};
GetProd: PROC RETURNS[exp: REF] = {
exps: LIST OF REF ← NIL;
DO
expr: REF ← GetFact[];
IF expr#NIL THEN exps ← CONS[expr, exps];
IF lastChar # '* THEN EXIT ENDLOOP;
RETURN[IF exps.rest=NIL THEN exps.first ELSE CONS[star, Reverse[exps]]]};
GetFact: PROC RETURNS[exp: REF] = {
tKind, bKind:  Kind;
token, break:   IO.ROPE;
[tKind, token] ← Get[];
SELECT tKind FROM
brk   => SELECT token.Fetch[] FROM
'~   => {exps: LIST OF REF ← LIST[not, GetFact[]]; RETURN[exps]};
'(   => {exp ← GetSum[]; IF lastChar#') THEN SIGNAL BadRope};
ENDCASE => SIGNAL BadRope;
int   => {int: REF INT ← NEW[INT ← Convert.IntFromRope[token]]; exp ← int};
id    => {exp ← token};
ENDCASE  => {lastChar ← IO.NUL; RETURN[NIL]};
[bKind, break] ← Get[];
IF break.Equal["("] THEN {
exp ← GetFunc[token];
IF lastChar#') THEN SIGNAL BadRope;
[bKind, break] ← Get[]};
SELECT bKind FROM
brk    => SELECT break.Fetch[] FROM
'*, '+, ',, ') => {lastChar ← break.Fetch[]};
ENDCASE  => SIGNAL BadRope;
end    => {lastChar ← IO.NUL};
ENDCASE   => SIGNAL BadRope};
Get: PROC RETURNS[kind: Kind, tok: IO.ROPE] = {
breakProc: IO.BreakProc = {RETURN[SELECT char FROM
IN [IO.NUL .. IO.SP]  => sepr,
'(, '), '+, '~, '*, ',  => break,
ENDCASE     => other]};
IF in.EndOf[] THEN RETURN[end, NIL];
tok ← IO.GetTokenRope[in, breakProc].token;
kind ← SELECT tok.Fetch[] FROM
'(, '), '+, '~, '*, ', => brk,
IN['0..'9]    => int,
ENDCASE    => id};
Kind:  TYPE = {brk, int, id, end};
plus:  IO.ROPE = "+";
star:  IO.ROPE = "*";
not:  IO.ROPE = "~";
in:   IO.STREAM ← IO.RIS[rope];
lastChar: CHAR ← IO.NUL;
RETURN[GetSum[]]};
ToRope: PUBLIC PROC[ref: SParse.Tree, indentedLevs: INT ← 2] RETURNS[IO.ROPE] = {
ToRopeBasic: PROC[tree: REF, top: BOOL] RETURNS[rope: IO.ROPE] = {
rope ← NIL;
IF tree = NIL THEN RETURN[NIL];
WITH tree SELECT FROM
int: REF INT  => RETURN[Convert.RopeFromInt[int^]];
rp: IO.ROPE  => RETURN[rp];
list: LIST OF REF => {
op:  IO.ROPE ← NARROW[list.first];
wiggle: BOOL  ← op.Equal["~"]; -- highest
infix:  BOOL  ← op.Equal["*"] OR op.Equal["+"] OR wiggle;
args: LIST OF IO.ROPE ← NIL;
FOR list ← list.rest, list.rest WHILE list#NIL DO
args ← CONS[ToRopeBasic[list.first, ~infix], args] ENDLOOP;
IF wiggle THEN {IF args.rest#NIL THEN SIGNAL BadTree; RETURN[Rope.Cat["~", args.first]]};
IF ~(top AND infix) THEN rope ← ")"; -- cross or function
FOR args ← args, args.rest WHILE args#NIL DO
rope ← Rope.Cat[args.first, rope];
IF args.rest#NIL THEN {IF infix
THEN rope ← Rope.Cat[" ", op, " ", rope]
ELSE rope ← Rope.Cat[", ", rope]} ENDLOOP;
IF ~(top AND infix) THEN rope ← Rope.Cat["(", rope];
IF ~infix THEN rope ← Rope.Cat[op, rope]};
ENDCASE => SIGNAL BadTree};
RETURN[ToRopeBasic[ref, TRUE]]};
Reverse: PROC[list: LIST OF REF] RETURNS[res: LIST OF REF] =
{FOR list ← list, list.rest WHILE list#NIL DO res ← CONS[list.first, res] ENDLOOP};
END.