ada/langkit
0
0
Fork 0
mirror of https://github.com/AdaCore/langkit.git synced 2026-02-12 12:28:12 -08:00
Code Issues Packages Projects Releases Wiki Activity

Analysis_Interfaces: rename Deallocatable into Destroyable...

Browse Source 
... and enhance the destroyable mechanism to expose a typed interface.

Before this change, this required clients to deal with System.Address
values and conversion wrappers in order to register objects.

This business has now been wrapped into a generic that
Analysis_Interfaces provides so that clients only have to instantiate it
and call the resulting procedure. As a result, the "untyped" interface
is now used in a very localized place while clients can deal with
properly typed access to objects and the corresponding destroy
procedures.

Change-Id: I069ddb1fb8475f43baf3ffe0755bcf439e89059d
TN: P308-027
This commit is contained in:
Pierre-Marie de Rodat
2016-03-21 12:33:19 +01:00
committed by Raphaël Amiard
parent 0647b8dcd8
commit 100e5db868
8 changed files with 73 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
langkit/compile_context.py
View File

@@ -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

3
langkit/templates/astnode_types_ada.mako
View File

@@ -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

46
langkit/templates/pkg_analysis_body_ada.mako
View File

@@ -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;

26
langkit/templates/pkg_analysis_interfaces_spec_ada.mako
View File

@@ -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;

51
langkit/templates/pkg_analysis_spec_ada.mako
View File

@@ -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);

15
langkit/templates/pkg_ast_body_ada.mako
View File

@@ -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)}
-----------

4
langkit/templates/pkg_ast_spec_ada.mako
View File

@@ -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;

4
langkit/templates/pkg_ast_types_body_ada.mako
View File

@@ -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