DIRECTORY
Commander USING[CommandProc, Register],
CParser USING [CParseTree, CParseTreeBody, ProductionNames],
IO USING[char, Close, EndOfStream,  GetTokenRope, IDProc, int, PutF, real, RIS, rope, STREAM, TokenKind],
Lexer USING [GetCTokenInit, GetCTokenRope, GetCTokenRopeAndValue],
OneCasabaParser USING[BuildParserTableFromKipperedStream, GetReportStream, Parse, ParserTable],
PFS USING [PathFromRope, StreamOpen],
PFSNames USING [PATH],
Rope USING[Length, ROPE, Substr];

CParserImpl: CEDAR PROGRAM
IMPORTS Commander, IO, Lexer, OneCasabaParser, PFS, Rope
EXPORTS CParser ~ {

ROPE: TYPE ~ Rope.ROPE;



ParseFromFile: Commander.CommandProc ~ {
parseTree: CParser.CParseTree;
filename:PFSNames.PATH;
sourceStream:IO.STREAM;
commandLineStream: IO.STREAM _ IO.RIS[cmd.commandLine];
tableStream: IO.STREAM _ PFS.StreamOpen[PFS.PathFromRope["c.kipperedParseTables"]];
table: OneCasabaParser.ParserTable _ OneCasabaParser.BuildParserTableFromKipperedStream[tableStream];
IO.Close[tableStream];
filename _ PFS.PathFromRope[IO.GetTokenRope[commandLineStream,IO.IDProc].token];
IO.Close[commandLineStream];
sourceStream _ PFS.StreamOpen[filename];
parseTree _ MakeCParseTree[table, sourceStream, cmd.out];
PrintParseTree[cmd.out, parseTree];
};

ProductionNameRopes: ARRAY [0..ORD[LAST[CParser.ProductionNames]]] OF Rope.ROPE = ["Start", "PrintResult", "Expressionone", "Expressionmore", "AssignmentExpressioncond", "AssignmentExpressioneq", "AssignmentExpressionmuleq", "AssignmentExpressiondiveq", "AssignmentExpressionmodeq", "AssignmentExpressionaddeq", "AssignmentExpressionsubeq", "AssignmentExpressionshiftleq", "AssignmentExpressionshiftreq", "AssignmentExpressionandeq", "AssignmentExpressionxoreq", "AssignmentExpressionoreq", "ConditionalExpressionone", "ConditionalExpressionmore", "LogicalOrExpressionone", "LogicalOrExpressionmore", "LogicalAndExpressionone", "LogicalAndExpressionmore", "InclusiveOrExpressionone", "InclusiveOrExpressionmore", "ExclusiveOrExpressionone", "ExclusiveOrExpressionmore", "AndExpressionone", "AndExpressionmore", "EqualityExpressionrel", "EqualityExpressioneq", "EqualityExpressionneq", "RelationalExpressionone", "RelationalExpressionlt", "RelationalExpressiongt", "RelationalExpressionle", "RelationalExpressionge", "ShiftExpressionadd", "ShiftExpressionleft", "ShiftExpressionright", "AdditiveExpressionmul", "AdditiveExpressionadd", "AdditiveExpressionsub", "MultiplicativeExpressioncast", "MultiplicativeExpressionmul", "MultiplicativeExpressiondiv", "MultiplicativeExpressionmod", "CastExpressionunary", "CastExpressioncast", "UnaryExpressionpost", "UnaryExpressioninc", "UnaryExpressiondec", "UnaryExpressionand", "UnaryExpressionptr", "UnaryExpressionadd", "UnaryExpressionsub", "UnaryExpressionbnot", "UnaryExpressionlnot", "UnaryExpressionsizeexpr", "UnaryExpressionsizetype", "PostfixExpressionprimary", "PostfixExpressionarray", "PostfixExpressioncall", "PostfixExpressionrecord", "PostfixExpressionrecptr", "PostfixExpressioninc", "PostfixExpressiondec", "PrimaryExpressionid", "PrimaryExpressionconst", "PrimaryExpressionstring", "PrimaryExpressionparen", "TypeNamevoid", "TypeNamechar", "TypeNameshort", "TypeNameint", "TypeNamelong", "TypeNamefloat", "TypeNamedouble", "TypeNamesigned", "TypeNameunsigned", "ArgumentExpressionListone", "ArgumentExpressionListmore", "Constantint", "Constantchar", "Constantfloat", "Constantenum",

"IntegerConstant", "CharacterConstant", "FloatingConstant", "String", "Identifier"];

MakeCParseTree: PUBLIC PROC[table: OneCasabaParser.ParserTable, source: IO.STREAM, out:IO.STREAM] RETURNS [parseTree: CParser.CParseTree] ~ {
partialValues: LIST OF CParser.CParseTree _ NIL;
textPosition: INT _ 0;
newSource: IO.STREAM _ source;
newOut:IO.STREAM _ out;

SupplySourceToken: PROC RETURNS [tokenKind: IO.TokenKind, tokenText: ROPE, position: INT] ~ {
charsSkipped: INT;
WHILE TRUE DO
[tokenKind, tokenText, charsSkipped] _ Lexer.GetCTokenRope[newSource, FALSE
! IO.EndOfStream => {
tokenKind _ tokenEOF;
tokenText _ "";
charsSkipped _ 0;
CONTINUE}
];
textPosition _ textPosition + charsSkipped;
position _ textPosition;
textPosition _ textPosition + Rope.Length[tokenText];


IF tokenKind # tokenCOMMENT THEN RETURN [tokenKind, tokenText, position];
ENDLOOP

};

SeeGenericShift: PROC [code: CARDINAL, kind: IO.TokenKind, text: ROPE, firstCharPosition: INT] ~ {
temp:CParser.CParseTree;
textStream:IO.STREAM _ IO.RIS[text];
tokenKind:IO.TokenKind;
tokenValue:REF ANY;
charsSkipped:INT;
token:Rope.ROPE;
[tokenKind, token, charsSkipped, tokenValue] _ Lexer.GetCTokenRopeAndValue[textStream, FALSE];
IO.Close[textStream];
SELECT tokenKind FROM
tokenDECIMAL => {
temp _ NEW[CParser.CParseTreeBody[1]] ;
temp^.production _ IntegerConstant;
temp^.children[0] _ tokenValue;
partialValues _ CONS[temp, partialValues];
};
tokenCHAR => {
temp _ NEW[CParser.CParseTreeBody[1]];
temp^.production _ CharacterConstant;
temp^.children[0] _ tokenValue;
partialValues _ CONS[temp, partialValues];
};
tokenREAL => {
temp _ NEW[CParser.CParseTreeBody[1]];
temp^.production _ FloatingConstant;
temp^.children[0] _ tokenValue;
partialValues _ CONS[temp, partialValues];
};
tokenROPE => {
temp _ NEW[CParser.CParseTreeBody[1]];
temp^.production _ String;
temp^.children[0] _ tokenValue;
partialValues _ CONS[temp, partialValues];
};
tokenID => {
temp _ NEW[CParser.CParseTreeBody[1]];
temp^.production _ Identifier;
temp^.children[0] _ text;
partialValues _ CONS[temp, partialValues]
};
ENDCASE => ERROR;
};

SeeReduce: PROC[rule: CARDINAL, firstCharPosition: INT, length: INT] ~ {
temp:CParser.CParseTree;
SELECT CParser.ProductionNames[VAL[rule]] FROM
Expressionmore, AssignmentExpressioneq, AssignmentExpressionmuleq,
AssignmentExpressiondiveq,
AssignmentExpressionmodeq, AssignmentExpressionaddeq, AssignmentExpressionsubeq,
AssignmentExpressionshiftleq, AssignmentExpressionshiftreq,
AssignmentExpressionandeq, AssignmentExpressionxoreq, AssignmentExpressionoreq,
LogicalOrExpressionmore,  LogicalAndExpressionmore, InclusiveOrExpressionmore,
ExclusiveOrExpressionmore, AndExpressionmore, EqualityExpressioneq,
EqualityExpressionneq, RelationalExpressionlt, RelationalExpressiongt,
RelationalExpressionle, RelationalExpressionge, ShiftExpressionleft,
ShiftExpressionright, AdditiveExpressionadd, AdditiveExpressionsub,
MultiplicativeExpressionmul, MultiplicativeExpressiondiv,
MultiplicativeExpressionmod,  CastExpressioncast, 
PostfixExpressionarray, PostfixExpressioncall, PostfixExpressionrecord,
PostfixExpressionrecptr, ArgumentExpressionListmore => {
temp _ NEW[CParser.CParseTreeBody[2]];
temp^.production _ CParser.ProductionNames[VAL[rule]];
temp^.children[1] _ partialValues.first;
temp^.children[0] _ partialValues.rest.first;
partialValues _ CONS[temp, partialValues.rest.rest]
};
UnaryExpressioninc, UnaryExpressiondec, UnaryExpressionand, UnaryExpressionptr,
UnaryExpressionsub, UnaryExpressionbnot, UnaryExpressionlnot,
UnaryExpressionsizeexpr, UnaryExpressionsizetype, PostfixExpressioninc,
PostfixExpressiondec => {
temp _ NEW[CParser.CParseTreeBody[1]];
temp^.production _ CParser.ProductionNames[VAL[rule]];
temp^.children[0] _ partialValues.first;
partialValues _ CONS[temp, partialValues.rest]
};
Start, TypeNamevoid, TypeNamechar, TypeNameshort, TypeNameint, TypeNamelong,
TypeNamefloat, TypeNamedouble, TypeNamesigned, TypeNameunsigned, UnaryExpressionadd => {
temp _ NEW[CParser.CParseTreeBody[0]];
temp^.production _ CParser.ProductionNames[VAL[rule]];
partialValues _ CONS[temp, partialValues]
};
ConditionalExpressionmore => {
temp _ NEW[CParser.CParseTreeBody[3]];
temp^.production _ CParser.ProductionNames[VAL[rule]];
temp^.children[2] _ partialValues.first;
temp^.children[1] _ partialValues.rest.first;
temp^.children[0] _ partialValues.rest.rest.first;
partialValues _ CONS[temp, partialValues.rest.rest.rest]
};
PrintResult, Expressionone, AssignmentExpressioncond, 
ConditionalExpressionone, 
LogicalOrExpressionone, LogicalAndExpressionone,
InclusiveOrExpressionone, ExclusiveOrExpressionone,
AndExpressionone, EqualityExpressionrel, RelationalExpressionone,
ShiftExpressionadd, AdditiveExpressionmul, MultiplicativeExpressioncast,
CastExpressionunary, UnaryExpressionpost, PostfixExpressionprimary,
PrimaryExpressionid, PrimaryExpressionconst, 
PrimaryExpressionstring, PrimaryExpressionparen, ArgumentExpressionListone,
Constantint, Constantchar, Constantfloat, Constantenum => {};
ENDCASE => ERROR;
};

Lexer.GetCTokenInit[];
[] _ OneCasabaParser.Parse[table, SupplySourceToken, SeeReduce, SeeGenericShift, NIL
! OneCasabaParser.GetReportStream => RESUME[out]
];
parseTree _  partialValues.first;
RETURN[parseTree]
};

SpaceRope: PROC [i:INT] RETURNS [r:Rope.ROPE] ~ {
template:Rope.ROPE = "                                                                               ";
RETURN [Rope.Substr[template, 0, i]]
};

PrintParseTree: PUBLIC PROC [outStream:IO.STREAM, parseTree:REF ANY, depth:INT _ 0] RETURNS [] ~ {
IF parseTree # NIL THEN {
IO.PutF[outStream,"%g%g", IO.rope[SpaceRope[depth]], 
IO.rope[ProductionNameRopes[ORD[NARROW[parseTree, CParser.CParseTree]^.production]]]];
SELECT NARROW[parseTree, CParser.CParseTree]^.production FROM
Expressionmore, AssignmentExpressioneq, AssignmentExpressionmuleq,
AssignmentExpressiondiveq,
AssignmentExpressionmodeq, AssignmentExpressionaddeq, AssignmentExpressionsubeq,
AssignmentExpressionshiftleq, AssignmentExpressionshiftreq,
AssignmentExpressionandeq, AssignmentExpressionxoreq, AssignmentExpressionoreq,
LogicalOrExpressionmore,  LogicalAndExpressionmore, InclusiveOrExpressionmore,
ExclusiveOrExpressionmore, AndExpressionmore, EqualityExpressioneq,
EqualityExpressionneq, RelationalExpressionlt, RelationalExpressiongt,
RelationalExpressionle, RelationalExpressionge, ShiftExpressionleft,
ShiftExpressionright, AdditiveExpressionadd, AdditiveExpressionsub,
MultiplicativeExpressionmul, MultiplicativeExpressiondiv,
MultiplicativeExpressionmod,  CastExpressioncast, 
PostfixExpressionarray, PostfixExpressioncall, PostfixExpressionrecord,
PostfixExpressionrecptr, ArgumentExpressionListmore => {
IO.PutF[outStream,"\n"];
PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]^.children[0], depth+2];
PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]^.children[1], depth+2];
};
UnaryExpressioninc, UnaryExpressiondec, UnaryExpressionand, UnaryExpressionptr,
UnaryExpressionsub, UnaryExpressionbnot, UnaryExpressionlnot,
UnaryExpressionsizeexpr, UnaryExpressionsizetype, PostfixExpressioninc,
PostfixExpressiondec, PrimaryExpressionparen => {
IO.PutF[outStream,"\n"];
PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]^.children[0], depth+2]
};
Start, TypeNamevoid, TypeNamechar, TypeNameshort, TypeNameint, TypeNamelong,
TypeNamefloat, TypeNamedouble, TypeNamesigned, TypeNameunsigned => {
IO.PutF[outStream,"\n"]
};
ConditionalExpressionmore => {
IO.PutF[outStream,"\n"];
PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]^.children[0], depth+2];
PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]^.children[1], depth+2];
PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]^.children[2], depth+2]
};
PrintResult, Expressionone, AssignmentExpressioncond, 
ConditionalExpressionmore,
LogicalOrExpressionone, LogicalAndExpressionone,
InclusiveOrExpressionone, ExclusiveOrExpressionone,
AndExpressionone, EqualityExpressionrel, RelationalExpressionone,
ShiftExpressionadd, AdditiveExpressionmul, MultiplicativeExpressioncast,
CastExpressionunary, UnaryExpressionpost, PostfixExpressionprimary,
PrimaryExpressionid, PrimaryExpressionconst, 
PrimaryExpressionstring, PrimaryExpressionparen, ArgumentExpressionListone,
Constantint, Constantchar, Constantfloat, Constantenum => ERROR;
IntegerConstant => 
IO.PutF[outStream," = %g\n", IO.int[NARROW[NARROW[parseTree, CParser.CParseTree]^.children[0], REF INT]^]];
CharacterConstant =>
IO.PutF[outStream," = %g\n", IO.char[NARROW[NARROW[parseTree, CParser.CParseTree]^.children[0], REF CHAR]^]];
FloatingConstant =>
IO.PutF[outStream," = %g\n", IO.real[NARROW[NARROW[parseTree, CParser.CParseTree]^.children[0], REF REAL]^]];
String =>
IO.PutF[outStream," = %g\n", IO.rope[NARROW[NARROW[parseTree, CParser.CParseTree].children[0], Rope.ROPE]]];
Identifier =>
IO.PutF[outStream," = %g\n", IO.rope[NARROW[NARROW[parseTree, CParser.CParseTree].children[0], Rope.ROPE]]]
ENDCASE => ERROR
}
ELSE 
IO.PutF[outStream,"Empty tree\n"]
};

Commander.Register["Parse", ParseFromFile];

}...
ΒCParserimpl.mesa
Copyright Σ 1987 by Xerox Corporation.  All rights reserved.
Hopcroft June 12, 1989 5:57:12 pm PDT
Coolidge, July 12, 1990 3:52 pm PDT
Laurie Horton, November 8, 1991 4:02 pm PST
Terminal type names must be added after the production type elements
temp:Rope.ROPE;
temp _ SELECT tokenKind FROM
tokenDECIMAL => "tokenDECIMAL",
tokenCHAR => "tokenCHAR",
tokenREAL => "tokenREAL",
tokenROPE => "tokenROPE",
tokenID => "tokenID",
tokenEOF => "tokenEOF",
tokenERROR => "tokenERROR",
tokenSINGLE => "tokenSINGLE",
tokenDOUBLE => "tokenDOUBLE",
tokenCOMMENT => "tokenCOMMENT",
tokenOCTAL => "tokenOCTAL",
tokenHEX => "tokenHEX",
ENDCASE => "Unknown";
IO.PutF[newOut,"token: %g = %g\n",
IO.rope[temp],
IO.rope[tokenText]];
_ [production:IntegerConstant, children:NULL]];
_ [production:CharacterConstant, children:NULL]];
_ [production:FloatingConstant, children:NULL]];
_ [production:String, children:NULL]];
_ [production:Identifier, children:NULL]];
IO.PutF[newOut,"Generic shift %g = %g\n",
IO.rope[ProductionNameRopes[ORD[temp^.production]]],
IO.rope[NARROW[temp^.children[0],Rope.ROPE]]]
Two operand productions:
IO.PutF[newOut,"Two operand\n"];
 _ [production:ProductionNames[VAL[rule]], children:NULL]];
One operand productions:
 _ [production:ProductionNames[VAL[rule]], children:NULL]];
No operand productions:
 _ [production:ProductionNames[VAL[rule]], children:NULL]];
Three operand productions:
 _ [production:ProductionNames[VAL[rule]], children:NULL]];
No operation productions:
IO.PutF[newOut,"Reduce rule %g\n",IO.rope[ProductionNameRopes[ORD[rule]]]]
Two operand productions:
One operand productions:
No operand productions:
Three operand productions:
No operation productions:
Terminals
main code
Κλ–

"cedar" style˜
code™K™<Kš
œ%™%K™#K™+—K˜š
Οk	˜	Kšœ
œ˜'K˜<Kšœ
œ=	œœ
˜iK˜BKšœœJ˜_Kšœ
œ˜%Kšœ	œœ˜Kšœœ	œ
˜!—K˜šΠbnΟbœœ
˜Kšœœœ˜8Kš
œ˜K˜Kšœœœ
˜K˜K˜K˜šΟn
œ˜(K˜K˜K˜Kš	œœ
œœ
œ˜7Kšœ
œ
œœ7˜SKš
œe˜eKšœ˜K˜PK˜K˜(K˜9K˜#Kš
œ˜—K˜Kš
œί˜ί˜Kšœ!Οi
Πbiœ™DK˜T——˜š œœ-œ
œ<˜
Kš	œœ
œ	
œœ
˜0Kšœœ˜K˜K˜K˜š œœ
œ
œœœ˜]Kšœœ
˜K™šœ
œ
˜
šœ'œ˜Kšœœ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœ
˜	—Kš
œ˜—Kš
œ+˜+K˜K˜5K˜™K™K™K™K™K™K™K™K™K™K™K™K™K™—™"K™K™—K˜Kšœœ
œ"˜IKš
˜—K˜Kš
œ˜—K˜š œœœœœœ˜bKš
œ˜K˜$K˜K˜K˜K˜K˜^K˜˜˜Kš
œ'˜'K™/K˜#K˜K˜*K˜—˜Kš
œ&˜&K™1K˜%K˜K˜*K˜—˜Kš
œ&˜&K™0K˜$K˜K˜*K˜—˜Kš
œ&˜&K™&K˜K˜K˜*K˜—˜Kš
œ&˜&K™*K˜K˜K˜)K˜—K˜—K™Œ
Kš
œ˜—K˜š
 	œœœœ
œ˜HKš
œ˜šœœ˜.K™Kš
œB˜BKš
œ˜Kš
œP˜PKš
œ;˜;Kš
œO˜OKš
œN˜NKš
œC˜CKš
œF˜FKš
œD˜DKš
œC˜CKš
œ9˜9Kš
œ2˜2Kš
œG˜Gš
œ8˜8K™ Kš
œ&˜&K™;K˜6K˜(K˜-K˜3K˜—K™Kš
œO˜OKš
œ=˜=Kš
œG˜Gš
œ˜Kš
œ&˜&K™;K˜6K˜(K˜.K˜—K™Kš
œL˜Lš
œX˜XKš
œ&˜&K™;K˜6K˜)K˜—K™˜Kš
œ&˜&K™;K˜6K˜(K˜-K˜2K˜8K˜—K™K˜6K˜K˜0K˜3K˜AK˜HK˜CKš
œ-˜-Kš
œK˜KKš
œ=˜=Kšœœ
˜K™J—Kš
œ˜——˜K˜šœQ˜TKšœ%œ˜0Kš
œ˜—K˜!K˜Kš
œ˜——˜š 	œœ	œ˜1K˜gK˜$K˜——˜š œœ9œ˜b˜Kš
œŒ
˜Œ
šœ3˜=K™Kš
œB˜BKš
œ˜Kš
œP˜PKš
œ;˜;Kš
œO˜OKš
œN˜NKš
œC˜CKš
œF˜FKš
œD˜DKš
œC˜CKš
œ9˜9Kš
œ2˜2Kš
œG˜Gš
œ8˜8K˜Kš
œW˜WKš
œW˜WK˜—K™Kš
œO˜OKš
œ=˜=Kš
œG˜Gš
œ1˜1K˜Kš
œV˜VK˜—K™Kš
œL˜Lš
œD˜DK˜K˜—K™˜K˜Kš
œW˜WKš
œW˜WKš
œV˜VK˜—K™K˜6K˜K˜0K˜3K˜AK˜HK˜CKš
œ-˜-Kš
œK˜KKš
œ@˜@K™	˜Kš
œk˜k—˜Kš
œm˜m—˜Kš
œm˜m—˜	Kš
œl˜l—˜
Kš
œk˜k—Kšœ˜K˜
——˜K˜!——K˜—Kš
œ	™	K˜Kš
œ+˜+K˜Kš
œ˜—…—0¬>Y