
<<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.