// AST Support code shared by TreeParser and Parser.
// We use delegation to share code (and have only one
// bit of code to maintain) rather than subclassing
// or superclassing (forces AST support code to be
// loaded even when you don't want to do AST stuff).
//
// Typically, setASTNodeType is used to specify the
// homogeneous type of node to create, but you can override
// create to make heterogeneous nodes etc...

unit dpgrtl.astFactory;

interface
uses
   Generics.Collections,
   dpgrtl.types,
   dpgrtl.astBase,
   dpgrtl.astPair;

type
   TTokenToASTMap = TDictionary<integer,TASTClass>;

   TASTFactory = class
      protected
         // How to specify the classname to create for a particular
         // token type. Note that DPG allows you to say, for example,
         //
         //    tokens
         //    {
         //       PLUS<AST=PLUSNode>;
         //       ...
         //    }
         //
         // and it tracks everything statically. #[PLUS] will make you
         // a PLUSNode w/o use of this table.
         //
         // For tokens that DPG cannot track statically like #[i],
         // you can use this table to map PLUS (Integer) -> PLUSNode (Class)
         // etc... DPG sets the class map from the tokens {...} section
         // via the ASTFactory(Hashtable) ctor in antlr.Parser.

         fASTNodeTypeName  : AnsiString;
         fASTNodeTypeClass : TASTClass;

         fTokenToASTMap    : TTokenToASTMap;

      protected
         function    GetASTClass( TokenType: integer): TASTClass;
         procedure   SetASTClass( TokenType: integer; ASTClass: TASTClass);

      public
         function    CreateAST(  TokenType: integer=TT_INVALID;
                                 TokenText: string = ''): TAST; overload;

         function    CreateAST(  TokenType: integer;
                                 TokenText: string;
                                 ASTName  : string)   : TAST; overload;

         function    CreateAST(  ASTName : string)    : TAST; overload;

         function    CreateAST(  AST      : TAST)     : TAST; overload;
         function    CreateAST(  Token    : IToken)   : TAST; overload;

         function    Clone(      AST      : TAST)     : TAST;
         function    CloneList(  AST      : TAST)     : TAST;
         function    CloneTree(  AST      : TAST)     : TAST;

         function    Make(       Nodes    : array of TAST)  : TAST;
         procedure   MakeRoot(   ASTPair  : TASTPair;
                                 Root     : TAST);


      public
         constructor Create( map: TTokenToASTMap);
         destructor  Destroy; override;

      public
         property    ASTClass[t: integer] : TASTClass   read  GetASTClass
                                                        write SetASTClass;

   end;


implementation
uses
   System.RTTI,
   dpgrtl.astCommon,
   System.SysUtils;

{ TASTFactory }

// ================================================================================================
// Constructor
// ================================================================================================
constructor TASTFactory.Create(map: TTokenToASTMap);
begin
   inherited Create;
   fTokenToASTMap := TTokenToASTMap.Create;

//   SetTokenToASTMap(map);
end;

// ================================================================================================
// Destructor
// ================================================================================================
destructor TASTFactory.Destroy;
begin
   FreeAndNil(fTokenToASTMap);
   inherited;
end;


// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                           Interface
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Create AST (TokenType,TokenText)
//
//    Create a new empty AST node. If the user did not specify an AST node type, then create a
//    default one: *TastCommon*
// ================================================================================================
function TASTFactory.CreateAST(TokenType: integer; TokenText: string): TAST;
begin
   result := ASTClass[TokenType].Create;

   if Assigned(result) then
      result.Initialize( TokenType, AnsiString(TokenText));
end;

// ================================================================================================
// Create AST (AST Class Name)
// ================================================================================================
function TASTFactory.CreateAST(ASTName: string): TAST;
var
   ctx   : TRttiContext;
   typ   : TRttiType;

begin
   result := nil;
   ctx    := TRttiContext.Create;
   typ    := ctx.FindType(ASTName);

   if Assigned(typ) then
      result := TASTClass(typ).Create;
end;

// ================================================================================================
// Create AST
// ================================================================================================
function TASTFactory.CreateAST(TokenType: integer; TokenText, ASTName: string): TAST;
begin
   result := CreateAST( ASTName);

   if Assigned(result) then
      result.Initialize( TokenType, AnsiString(TokenText))
end;

// ================================================================================================
// Create AST
// ================================================================================================
function TASTFactory.CreateAST(AST: TAST): TAST;
begin
   result := nil;

   if Assigned(AST) then
      result := CreateAST(AST.ClassName);

   if Assigned(result) then
      result.Initialize( AST.AstType, AST.AstText);
end;

// ================================================================================================
// Create AST
// ================================================================================================
function TASTFactory.CreateAST(Token: IToken): TAST;
begin
   result := nil;

   if Assigned(Token) then
      result := CreateAST( Token.TokenType, string(Token.TokenText))
end;

// ================================================================================================
// Clone
// ================================================================================================
function TASTFactory.Clone( AST: TAST) : TAST;
begin
   result := nil;

   if Assigned(AST) then
      result := CreateAST(AST);
end;

// ================================================================================================
// Clone List
//
//    Duplicate a tree including siblings of root.
// ================================================================================================
function TASTFactory.CloneList( AST: TAST): TAST;
var
   nt: TAST;

begin
   result := CloneTree(AST);
   nt     := result;

   while Assigned(AST) do
   begin
      AST := AST.NextSibling;

      nt.NextSibling := CloneTree(AST);
      nt             := nt.NextSibling;
   end;
end;

// ================================================================================================
// Clone Tree
//
//    Duplicate a tree, assuming this is a root node of a tree.
//    Duplicate that node and what's below; ignore siblings of a root node.
// ================================================================================================
function TASTFactory.CloneTree( AST: TAST): TAST;
begin
   result := Clone(AST);

   if Assigned(result) then
      result.FirstChild := CloneList( AST.FirstChild)
end;

// ================================================================================================
// Make
//
//    Make a tree from a list of nodes. The first element in the array is the root.
//    If the root is null, then the tree is a simple list not a tree.
//    Handles null children nodes correctly.
//
//       For example, build(a, b, null, c) yields tree (a b c).
//       build(null,a,b) yields tree (nil a b).
// ================================================================================================
function TASTFactory.Make(Nodes: array of TAST): TAST;
var
   i     : integer;
   root  : TAST;
   tail  : TAST;

begin
   result := nil;

   if Length(Nodes) > 0 then
   begin
      root  := Nodes[Low(Nodes)];
      tail  := nil;

      if Assigned(root) then
         root.FirstChild := nil;

      // link in children
      for i:=Low(Nodes)+1 to High(Nodes) do
      begin
         // ignore nil nodes
         if Nodes[i] = nil then
            continue;

         if not Assigned(root) then
         begin
            root := nodes[i];
            tail := nodes[i];
         end

         else if not Assigned(tail) then
         begin
            root.FirstChild := Nodes[i];
            tail            := root.FirstChild;
         end

         else begin
            tail.NextSibling:= Nodes[i];
            tail            := tail.NextSibling;
         end;

         while Assigned(tail.NextSibling) do
            tail := tail.NextSibling;
      end
   end
end;

// ================================================================================================
// Make root
// ================================================================================================
procedure TASTFactory.MakeRoot(ASTPair: TASTPair; Root: TAST);
begin
   if Assigned(Root) then
   begin
      Root.AddChild(ASTPair.Root);

      ASTPair.Child  := ASTPair.Root;
      ASTPair.AdvanceChildToEnd;
      ASTPair.Root   := Root;
   end
end;

// @@@: Property handlers +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                       Property handlers
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get the AST class that assigned to a token type
// ================================================================================================
function TASTFactory.GetASTClass(TokenType: integer): TASTClass;
begin
   result := nil;

   if Assigned( fTokenToASTMap) then
      fTokenToASTMap.TryGetValue( TokenType, result);

   if not Assigned(result) then
      result := fASTNodeTypeClass;

   if not Assigned(result) then
      result := TastCommon;
end;

// ================================================================================================
// Assign an AST class to a token type
// ================================================================================================
procedure TASTFactory.SetASTClass(TokenType: integer; ASTClass: TASTClass);
begin
   if Assigned( fTokenToASTMap) then
   begin
      if fTokenToASTMap.ContainsKey(TokenType) then
         fTokenToASTMap.Remove(TokenType);

      if Assigned(ASTClass) then
         fTokenToASTMap.Add(TokenType,ASTClass)
   end
end;

end.