unit dpglib.PrettyPrinter; interface uses System.Classes, System.SysUtils, dpgrtl.types, dpglib.Utils, dpglib.Types, dpglib.CodeGenerator, dpglib.DelphiCharFormatter, dpglib.DelphiBlockFinishingInfo; type TPrettyPrinter = class( TCodeGenerator) protected fIsLexer : boolean; fIsParser : boolean; fIsTreeWalker : boolean; fLexerGrammar : ILexerGrammar; fParserGrammar : IParserGrammar; fTreeWalkerGrammar: ITreeWalkerGrammar; protected procedure genGrammar; procedure genUses; procedure genClassDecl; procedure genClassOptions; procedure genClassTokens; procedure genClassMemberDecl; procedure genClassRules; procedure genClassMemberDef; procedure genRuleOptions( blk: IRuleBlock); procedure genRuleLocals( blk: IRuleBlock); procedure genRuleInit( blk: IRuleBlock); procedure genRuleBlock( blk: IRuleBlock); public destructor Destroy; override; public procedure gen( pGrammar: IGrammar); end; implementation // ============================================================================ // Destructor // ============================================================================ destructor TPrettyPrinter.Destroy; begin fLexerGrammar := nil; fParserGrammar := nil; fTreeWalkerGrammar := nil; inherited; end; // ============================================================================ // gen // ============================================================================ procedure TPrettyPrinter.gen(pGrammar: IGrammar); begin if pGrammar <> nil then begin fIsLexer := false; fIsParser := false; fIsTreeWalker := false; pGrammar.QueryInterface( ILexerGrammar, fLexerGrammar); pGrammar.QueryInterface( IParserGrammar, fParserGrammar); pGrammar.QueryInterface( ITreeWalkerGrammar, fTreeWalkerGrammar); if fLexerGrammar <> nil then fIsLexer := true; if fParserGrammar <> nil then fIsParser := true; if fTreeWalkerGrammar <> nil then fIsTreeWalker := true; fGrammar := pGrammar; genGrammar; end; end; // ============================================================================ // genGrammar // ============================================================================ procedure TPrettyPrinter.genGrammar; begin // --------------------------------------------------------------- // Calculate the output file name, and open it. // --------------------------------------------------------------- fFile := fOutDir + fGrammar.UnitName + '.pg'; fOutput := TFileStream.Create( fFile, fmCreate); // --------------------------------------------------------------- // Generate red tape // --------------------------------------------------------------- println('// ----------------------------------------------------------------------------'); println('// This is a generated file. Do not modify it by hand!'); println('// ----------------------------------------------------------------------------'); println('unit ' + fGrammar.UnitName + ';'); println(''); genUses; genClassDecl; fOutput.Free; end; // ============================================================================ // genUses // ============================================================================ procedure TPrettyPrinter.genUses; var i: integer; begin if fGrammar.UsesList.Count > 0 then begin println('uses'); println('{'); INC(fTabs); for i:=0 to fGrammar.UsesList.Count -1 do println(fGrammar.UsesList.Strings[i] + ';'); DEC(fTabs); println('}'); println(''); end; end; // ============================================================================ // genClassDecl // ============================================================================ procedure TPrettyPrinter.genClassDecl; begin // --------------------------------------------------------------- // print class header // --------------------------------------------------------------- if fIsLexer then print('lexer '); if fIsParser then print('parser '); if fIsTreeWalker then print('treewalker '); // --------------------------------------------------------------- // print class name // --------------------------------------------------------------- _print( fGrammar.GetClassName); // --------------------------------------------------------------- // print superclass (later) // --------------------------------------------------------------- // --------------------------------------------------------------- // Close class header // --------------------------------------------------------------- _println(';'); // --------------------------------------------------------------- // Generate the rest // --------------------------------------------------------------- genClassOptions; genClassTokens; genClassMemberDecl; genClassRules; genClassMemberDef; end; // ============================================================================ // genClassOptions // ============================================================================ procedure TPrettyPrinter.genClassOptions; begin println('options'); println('{'); println('}'); println(''); end; // ============================================================================ // genClassTokens // ============================================================================ procedure TPrettyPrinter.genClassTokens; begin println('tokens'); println('{'); println('}'); println(''); end; // ============================================================================ // genClassMemberDecl // ============================================================================ procedure TPrettyPrinter.genClassMemberDecl; begin println('memberdecl'); println('{'); println('}'); println(''); end; // ============================================================================ // genClassMemberDef // ============================================================================ procedure TPrettyPrinter.genClassMemberDef; begin println('memberdef'); println('{'); println('}'); println(''); end; // ============================================================================ // genClassRules // ============================================================================ procedure TPrettyPrinter.genClassRules; var i : integer; rs : IRuleSymbol; rb : IRuleBlock; begin for i:=0 to fGrammar.Rules.Count -1 do begin rs := fGrammar.Rules[i] as IRuleSymbol; rb := rs.Block; if (rb = nil) or (rs.ID = 'mNextToken') then continue; println('// ============================================================================'); println('// ' + rb.RuleName); println('// ============================================================================'); // ------------------------------------------------------------ // Print rule scope. // ------------------------------------------------------------ if rs.Access = 'public' then print('public ') else if rs.Access = 'protected' then print('protected ') else if rs.Access = 'private' then print('private ') else print(' INVALID SCOPE '); // ------------------------------------------------------------ // Print rule ID. // ------------------------------------------------------------ _print( rb.RuleName); // ------------------------------------------------------------ // Print rule arguments // ------------------------------------------------------------ if rb.Arguments <> '' then _print(' ' + rb.Arguments); // ------------------------------------------------------------ // Print rule returns // ------------------------------------------------------------ if rb.ReturnAction <> '' then _print(' returns ' + rb.ReturnAction); _println(';'); // ------------------------------------------------------------ // print rule things // ------------------------------------------------------------ genRuleOptions(rb); genRuleLocals(rb); genRuleInit(rb); INC(fTabs); println(':'); INC(fTabs); genRuleBlock(rb); DEC(fTabs); println(';'); DEC(fTabs); println(''); end; end; // ============================================================================ // genRuleOptions // ============================================================================ procedure TPrettyPrinter.genRuleOptions(blk: IRuleBlock); begin println('options'); println('{'); println('}'); println(''); end; // ============================================================================ // genRuleLocals // ============================================================================ procedure TPrettyPrinter.genRuleLocals(blk: IRuleBlock); begin println('locals'); println('{'); println('}'); println(''); end; // ============================================================================ // genRuleInit // ============================================================================ procedure TPrettyPrinter.genRuleInit(blk: IRuleBlock); begin println('{'); println('}'); end; // ============================================================================ // genRuleBlock // ============================================================================ procedure TPrettyPrinter.genRuleBlock(blk: IRuleBlock); begin end; end.