diff --git a/langkit/compile_context.py b/langkit/compile_context.py index dbed06297..a153312e5 100644 --- a/langkit/compile_context.py +++ b/langkit/compile_context.py @@ -685,7 +685,7 @@ class CompileCtx(): # Unit for initialization primitives ("pkg_init", ["init"], True), # Unit for analysis primitives - ("pkg_analysis_interfaces", ["analysis_interfaces"], False), + ("pkg_analysis_interfaces", ["analysis_interfaces"], True), # Unit for analysis primitives ("pkg_analysis", ["analysis"], True), # Unit for the root AST node diff --git a/langkit/templates/astnode_types_ada.mako b/langkit/templates/astnode_types_ada.mako index f7c39c2be..d94e62194 100644 --- a/langkit/templates/astnode_types_ada.mako +++ b/langkit/templates/astnode_types_ada.mako @@ -422,8 +422,7 @@ % if cls.env_spec._add_env: Ret := AST_Envs.Create (Initial_Env); - Self.Unit.Register_Deallocatable - (Ret.all'Address, Deallocate_Lexical_Env'Access); + Register_Destroyable (Self.Unit, Ret); Self.Self_Env := Ret; % endif diff --git a/langkit/templates/pkg_analysis_body_ada.mako b/langkit/templates/pkg_analysis_body_ada.mako index 0e7d47dc7..0ff549af1 100644 --- a/langkit/templates/pkg_analysis_body_ada.mako +++ b/langkit/templates/pkg_analysis_body_ada.mako @@ -114,17 +114,17 @@ package body ${_self.ada_api_settings.lib_name}.Analysis is if Created then Unit := new Analysis_Unit_Type' - (Context => Context, - Ref_Count => 1, - AST_Root => null, - File_Name => Fname, - Charset => <>, - TDH => <>, - Diagnostics => <>, - With_Trivia => With_Trivia, - Rule => Rule, - AST_Mem_Pool => No_Pool, - Deallocatables => Deallocatable_Vectors.Empty_Vector); + (Context => Context, + Ref_Count => 1, + AST_Root => null, + File_Name => Fname, + Charset => <>, + TDH => <>, + Diagnostics => <>, + With_Trivia => With_Trivia, + Rule => Rule, + AST_Mem_Pool => No_Pool, + Destroyables => Destroyable_Vectors.Empty_Vector); Initialize (Unit.TDH, Context.Symbols); Context.Units_Map.Insert (Fname, Unit); else @@ -378,10 +378,10 @@ package body ${_self.ada_api_settings.lib_name}.Analysis is end if; Free (Unit.TDH); Free (Unit.AST_Mem_Pool); - for D of Unit.Deallocatables loop - D.Deallocate (D.Object); + for D of Unit.Destroyables loop + D.Destroy (D.Object); end loop; - Deallocatable_Vectors.Destroy (Unit.Deallocatables); + Destroyable_Vectors.Destroy (Unit.Destroyables); Free (Unit_Var); end Destroy; @@ -458,18 +458,18 @@ package body ${_self.ada_api_settings.lib_name}.Analysis is Dump_Lexical_Env (Unit.AST_Root, Unit.Context.Root_Scope); end Dump_Lexical_Env; - ---------------------------- - -- Register_Deallocatable -- - ---------------------------- + -------------------------- + -- Register_Destroyable -- + -------------------------- overriding - procedure Register_Deallocatable - (Unit : access Analysis_Unit_Type; - Object : System.Address; - Deallocate : Deallocate_Procedure) + procedure Register_Destroyable_Helper + (Unit : access Analysis_Unit_Type; + Object : System.Address; + Destroy : Destroy_Procedure) is begin - Deallocatable_Vectors.Append (Unit.Deallocatables, (Object, Deallocate)); - end Register_Deallocatable; + Destroyable_Vectors.Append (Unit.Destroyables, (Object, Destroy)); + end Register_Destroyable_Helper; end ${_self.ada_api_settings.lib_name}.Analysis; diff --git a/langkit/templates/pkg_analysis_interfaces_spec_ada.mako b/langkit/templates/pkg_analysis_interfaces_spec_ada.mako index 776a8faca..af986ed10 100644 --- a/langkit/templates/pkg_analysis_interfaces_spec_ada.mako +++ b/langkit/templates/pkg_analysis_interfaces_spec_ada.mako @@ -27,14 +27,26 @@ package ${_self.ada_api_settings.lib_name}.Analysis_Interfaces is -- token data handler is not valid anymore as soon as Unit is destroyed or -- reparsed. - type Deallocate_Procedure is access procedure (Object : System.Address); - -- Type for generic deallocation procedure, to be used with - -- Register_Deallocatable. + type Destroy_Procedure is access procedure (Object : System.Address); - procedure Register_Deallocatable - (Unit : access Analysis_Unit_Interface_Type; - Object : System.Address; - Deallocate : Deallocate_Procedure) + procedure Register_Destroyable_Helper + (Unit : access Analysis_Unit_Interface_Type; + Object : System.Address; + Destroy : Destroy_Procedure) is abstract; + -- Internal implementation helper for Register_Destroyable. This is + -- basically an untyped version of it, using System.Address instead of + -- access types. This is required to we can store these values in the same + -- place. + + generic + type T is private; + type T_Access is access all T; + with procedure Destroy (Object : in out T_Access); + procedure Register_Destroyable + (Unit : access Analysis_Unit_Interface_Type'Class; + Object : T_Access); + -- Generic procedure to register an object so that it is automatically + -- destroyed when Unit is destroyed. end ${_self.ada_api_settings.lib_name}.Analysis_Interfaces; diff --git a/langkit/templates/pkg_analysis_spec_ada.mako b/langkit/templates/pkg_analysis_spec_ada.mako index bf61e2ff3..bc25a1300 100644 --- a/langkit/templates/pkg_analysis_spec_ada.mako +++ b/langkit/templates/pkg_analysis_spec_ada.mako @@ -144,40 +144,39 @@ private -- to resolve cross file references. end record; - type Deallocatable_Type is record - Object : System.Address; - -- Object to deallocate + type Destroyable_Type is record + Object : System.Address; + -- Object to destroy - Deallocate : Deallocate_Procedure; - -- Prodecure to deallocate Object + Destroy : Destroy_Procedure; + -- Procedure to destroy Object end record; - -- Simple holder to associate an object to deallocate and the procedure to - -- perform the deallocation. + -- Simple holder to associate an object to destroy and the procedure to + -- perform the destruction. - package Deallocatable_Vectors is new Langkit_Support.Vectors - (Deallocatable_Type); + package Destroyable_Vectors is new Langkit_Support.Vectors + (Destroyable_Type); type Analysis_Unit_Type is new Analysis_Unit_Interface_Type with record - Context : Analysis_Context; - Ref_Count : Natural; - AST_Root : ${root_node_type_name}; - File_Name : Unbounded_String; - Charset : Unbounded_String; - TDH : aliased Token_Data_Handler; - Diagnostics : Diagnostics_Vectors.Vector; - With_Trivia : Boolean; + Context : Analysis_Context; + Ref_Count : Natural; + AST_Root : ${root_node_type_name}; + File_Name : Unbounded_String; + Charset : Unbounded_String; + TDH : aliased Token_Data_Handler; + Diagnostics : Diagnostics_Vectors.Vector; + With_Trivia : Boolean; - Rule : Grammar_Rule; + Rule : Grammar_Rule; -- The grammar rule used to parse this unit - AST_Mem_Pool : Bump_Ptr_Pool; + AST_Mem_Pool : Bump_Ptr_Pool; -- This memory pool shall only be used for AST parsing. Stored here -- because it is more convenient, but one shall not allocate from it. - Deallocatables : Deallocatable_Vectors.Vector; - -- Collection of objects to deallocate when destroying the analysis - -- unit. + Destroyables : Destroyable_Vectors.Vector; + -- Collection of objects to destroy when destroying the analysis unit end record; overriding @@ -188,10 +187,10 @@ private (Unit.TDH'Access); overriding - procedure Register_Deallocatable - (Unit : access Analysis_Unit_Type; - Object : System.Address; - Deallocate : Deallocate_Procedure); + procedure Register_Destroyable_Helper + (Unit : access Analysis_Unit_Type; + Object : System.Address; + Destroy : Destroy_Procedure); function Root (Unit : Analysis_Unit) return ${root_node_type_name} is (Unit.AST_Root); diff --git a/langkit/templates/pkg_ast_body_ada.mako b/langkit/templates/pkg_ast_body_ada.mako index fb054803c..3218aca33 100644 --- a/langkit/templates/pkg_ast_body_ada.mako +++ b/langkit/templates/pkg_ast_body_ada.mako @@ -7,10 +7,8 @@ with Ada.Containers; use Ada.Containers; with Ada.Containers.Hashed_Maps; with Ada.Containers.Ordered_Maps; with Ada.Text_IO; use Ada.Text_IO; -with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; -with System; with System.Storage_Elements; use System.Storage_Elements; with Langkit_Support.Extensions; use Langkit_Support.Extensions; @@ -24,19 +22,6 @@ with Langkit_Support.Tokens; use Langkit_Support.Tokens; package body ${_self.ada_api_settings.lib_name}.AST is - function To_Lexical_Env is new Ada.Unchecked_Conversion - (System.Address, AST_Envs.Lexical_Env); - - ---------------------------- - -- Deallocate_Lexical_Env -- - ---------------------------- - - procedure Deallocate_Lexical_Env (A : System.Address) is - Env : AST_Envs.Lexical_Env := To_Lexical_Env (A); - begin - AST_Envs.Destroy (Env); - end Deallocate_Lexical_Env; - ${array_types.body(root_node_array)} ----------- diff --git a/langkit/templates/pkg_ast_spec_ada.mako b/langkit/templates/pkg_ast_spec_ada.mako index cc7e4fb8d..5f6ab0e92 100644 --- a/langkit/templates/pkg_ast_spec_ada.mako +++ b/langkit/templates/pkg_ast_spec_ada.mako @@ -595,8 +595,4 @@ private C : Children_Cursor) return Children_Cursor; - procedure Deallocate_Lexical_Env (A : System.Address); - -- Helper to deallocate lexical evnironments along with their owning - -- analysis unit. - end ${_self.ada_api_settings.lib_name}.AST; diff --git a/langkit/templates/pkg_ast_types_body_ada.mako b/langkit/templates/pkg_ast_types_body_ada.mako index b995f23ce..12390f18c 100644 --- a/langkit/templates/pkg_ast_types_body_ada.mako +++ b/langkit/templates/pkg_ast_types_body_ada.mako @@ -21,6 +21,10 @@ pragma Warnings (On, "referenced"); package body ${_self.ada_api_settings.lib_name}.AST.Types is + procedure Register_Destroyable is new + Analysis_Interfaces.Register_Destroyable + (AST_Envs.Lexical_Env_Type, AST_Envs.Lexical_Env, AST_Envs.Destroy); + % for struct_type in no_builtins(_self.struct_types): ${struct_types.body(struct_type)} % endfor