bds.mr.dpg/src.lib/dpglib.PrettyPrinter.pas

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.