DIRECTORY
Commander USING[CommandProc, Register],
CParser USING [CParseTree, CParseTreeBody, ProductionNames],
IO USING[char, Close, EndOfStream,  GetTokenRope, IDProc, int, PutF, PutF1, PutRope, 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.PutRope[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.PutRope[outStream,"\n"];
PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]­.children[0], depth+2]
};
Start, TypeNamevoid, TypeNamechar, TypeNameshort, TypeNameint, TypeNamelong,
TypeNamefloat, TypeNamedouble, TypeNamesigned, TypeNameunsigned => {
IO.PutRope[outStream,"\n"]
};
ConditionalExpressionmore => {
IO.PutRope[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.PutF1[outStream," = %g\n", IO.int[NARROW[NARROW[parseTree, CParser.CParseTree]­.children[0], REF INT]­]];
CharacterConstant =>
IO.PutF1[outStream," = %g\n", IO.char[NARROW[NARROW[parseTree, CParser.CParseTree]­.children[0], REF CHAR]­]];
FloatingConstant =>
IO.PutF1[outStream," = %g\n", IO.real[NARROW[NARROW[parseTree, CParser.CParseTree]­.children[0], REF REAL]­]];
String =>
IO.PutF1[outStream," = %g\n", IO.rope[NARROW[NARROW[parseTree, CParser.CParseTree].children[0], Rope.ROPE]]];
Identifier =>
IO.PutF1[outStream," = %g\n", IO.rope[NARROW[NARROW[parseTree, CParser.CParseTree].children[0], Rope.ROPE]]]
ENDCASE => ERROR
}
ELSE 
IO.PutRope[outStream,"Empty tree\n"]
};

Commander.Register["Parse", ParseFromFile];

}...
μ
CParserimpl.mesa
Copyright Σ 1987, 1992 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
Willie-s, May 14, 1992 1:13 pm PDT
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
Κ	W•NewlineDelimiter

–
(cedarcode) style™
code™Kšœ
Οe
œ7™BKš
œ%™%K™#K™+K™"—K˜š
Οk	˜	Kšœ
žœ˜'Kšœžœ/˜<Kšžœ
žœSžœžœ
˜yKšœžœ7˜BKšœžœJ˜_Kšžœ
žœ˜%Kšœ	žœžœ˜Kšœžœ	žœ
˜!—K˜šΠbnœžœ
ž˜Kšžœžœžœ˜8Kšžœ˜K˜Kšžœžœžœ
˜K˜K˜K˜šΟn
œ˜(K˜Kšœžœ
˜Kšœ
žœ
žœ
˜Kš	œžœ
žœžœ
žœ˜7Kš	œ
žœ
žœžœžœ(˜SK˜eKšžœ˜Kšœžœžœ žœ˜PKšžœ˜Kšœžœ˜(K˜9K˜#Kš
œ˜—K˜Kš œžœžœ
žœžœžœ˜ί˜Kšœ!Οi
Πbiœ™DK˜T——˜š œžœ
žœ-žœ
žœžœ
žœžœ$˜
Kšœžœ
žœžœ
˜0Kšœžœ˜Kšœžœ
žœ
˜Kšœžœ
žœ˜K˜š œžœ
žœ
žœžœžœ˜]Kšœžœ
˜K™šžœ
žœ
ž˜
šœFž˜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šœWžœ˜^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šœžœU˜gKšžœ˜$K˜——˜š œžœ
žœžœ
žœžœ
žœžœžœ˜bšžœ
žœ
žœ˜Kš
žœžœžœžœ
žœ0˜Œ
šžœ
žœ,ž˜=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šœžœ7˜WKšœžœ7˜WK˜—K™Kš
œO˜OKš
œ=˜=Kš
œG˜Gš
œ1˜1Kšžœ˜Kšœžœ6˜VK˜—K™Kš
œL˜Lš
œD˜DKšžœ˜K˜—K™˜Kšžœ˜Kšœžœ7˜WKšœžœ7˜WKšœžœ6˜VK˜—K™K˜6K˜K˜0K˜3K˜AK˜HK˜CKš
œ-˜-Kš
œK˜KKšœ:žœ
˜@K™	˜Kšžœžœžœ
žœ.žœ
žœ˜l—˜Kšžœžœžœ
žœ.žœ
žœ˜n—˜Kšžœžœžœ
žœ.žœ
žœ˜n—˜	Kš
žœžœžœ
žœ2žœ˜m—˜
Kš
žœžœžœ
žœ2žœ˜l—Kšžœž˜K˜
——šžœ
˜Kšžœ"˜$——K˜—Kš
œ	™	K˜Kš
œ+˜+K˜Kš
œ˜—…—0ΞA