Introduce the named environments mechanism

See the "Named environments" comments section in
pkg_implementation_spec.mako for details.

TN: T320-010

langkit/compile_context.py

@@ -1015,9 +1015,11 @@ def compute_types(self):
                               for n in self.grammar.user_defined_rules],
                  is_builtin_type=True)
 
-        # Force the creation of the env assoc type, as required by the
+        # Force the creation of the env assoc type and the
+        # Symbol.array/Symbol.array.array types, as required by the
         # always-emitted PLE helpers.
-        _ = resolve_type(T.env_assoc)
+        for t in (T.env_assoc, T.Symbol.array, T.Symbol.array.array):
+            _ = resolve_type(t)
 
         # Now that all types are known, construct default values for fields
         for st in CompiledTypeRepo.struct_types:

langkit/envs.py

@@ -37,7 +37,8 @@ class MyNode(RootNode):
 # Public API for env actions
 
 def add_env(no_parent: bool = False,
-            transitive_parent: bool = False) -> AddEnv:
+            transitive_parent: bool = False,
+            names: Optional[AbstractExpression] = None) -> AddEnv:
     """
     Add an environment linked to the current node. This env action must be
     called as a pre action. The only actions that can precede this one in pre
@@ -46,8 +47,12 @@ def add_env(no_parent: bool = False,
 
     :param no_parent: If passed, the new env will be created with no parent
         env.
+    :param transitive_parent: TODO.
+    :param names: Optional list of names for the created environment. If not
+        passed or if this is an empty array, the created environment is not
+        named.
     """
-    return AddEnv(no_parent, transitive_parent)
+    return AddEnv(no_parent, transitive_parent, names)
 
 
 class RefKind(Enum):
@@ -178,7 +183,28 @@ def set_initial_env(env_expr: AbstractExpression,
     :param unsound: Whether ``env_expr`` is allowed to return foreign
         environments.
     """
-    return SetInitialEnv(env_expr, unsound)
+    return SetInitialEnv(None, env_expr, unsound)
+
+
+def set_initial_env_by_name(
+    name_expr: AbstractExpression,
+    fallback_env_expr: AbstractExpression
+) -> SetInitialEnv:
+    """
+    Action that sets the initial env in which the rest of the environment
+    actions are evaluated. Except for Do() hooks, this action must be first in
+    the list of action (if present).
+
+    :param name_expr: Expression that returns an array of symbols (an env
+        name). If it evaluates to a non-empty array, look for the environment
+        that has this name (it will be updated every time another environment
+        related to this name takes precedence). If it evaluates to an empty
+        array, use ``fallback_env_expr`` to get the initial environment.
+    :param fallback_env_expr: Expression that returns the initial env if there
+        is no named env lookup. Note that except if it's the empty env or the
+        root scope, this environment must not be foreign to Self.
+    """
+    return SetInitialEnv(name_expr, fallback_env_expr)
 
 
 def do(expr: AbstractExpression) -> Do:
@@ -238,9 +264,14 @@ def count(cls: Type[EnvAction], sequence: List[EnvAction]) -> int:
             while actions and isinstance(actions[0], Do):
                 first_actions.append(actions.pop(0))
 
-        # After that, allow exactly one call to SetInitialEnv
+        # After that, allow at most one call to SetInitialEnv
         self.initial_env = None
         if actions and isinstance(actions[0], SetInitialEnv):
+            check_source_language(
+                isinstance(actions[0], SetInitialEnv),
+                'The initial environment must come first after the potential'
+                ' do()'
+            )
             self.initial_env = cast(SetInitialEnv, actions.pop(0))
             first_actions.append(self.initial_env)
         check_source_language(
@@ -379,13 +410,23 @@ def _render_field_access(self, p: PropertyDef) -> str:
                 Self.construct_nocheck(), p, []
             ).render_expr()
 
+    @property
+    def initial_env_name_expr(self) -> str:
+        """
+        The initial environment name expression.
+        """
+        assert self.initial_env
+        assert self.initial_env.name_expr
+        assert self.initial_env.name_prop
+        return self._render_field_access(self.initial_env.name_prop)
+
     @property
     def initial_env_expr(self) -> str:
         """
         The initial environment expression.
         """
         assert self.initial_env
-        return self._render_field_access(self.initial_env.initial_env_prop)
+        return self._render_field_access(self.initial_env.fallback_env_prop)
 
 
 class EnvAction:
@@ -434,15 +475,20 @@ def rewrite_property_refs(self,
 class AddEnv(EnvAction):
     def __init__(self,
                  no_parent: bool = False,
-                 transitive_parent: bool = False) -> None:
+                 transitive_parent: bool = False,
+                 names: Optional[AbstractExpression] = None) -> None:
         super().__init__()
         self.no_parent = no_parent
         self.transitive_parent = transitive_parent
+        self.names = names
 
     def create_internal_properties(self, env_spec: EnvSpec) -> None:
         self.transitive_parent_prop = env_spec.create_internal_property(
             'Env_Trans_Parent', unsugar(self.transitive_parent), T.Bool
         )
+        self.names_prop = env_spec.create_internal_property(
+            'Env_Names', self.names, T.Symbol.array.array
+        )
 
 
 class AddToEnv(EnvAction):
@@ -619,26 +665,30 @@ class HandleChildren(EnvAction):
     pass
 
 
-class ExprHolderAction(EnvAction):
-    def __init__(self, env_expr: AbstractExpression) -> None:
+class SetInitialEnv(EnvAction):
+    def __init__(self,
+                 name_expr: Optional[AbstractExpression],
+                 fallback_env_expr: AbstractExpression,
+                 unsound: bool = False) -> None:
         super().__init__()
-        self.env_expr = env_expr
-
-
-class SetInitialEnv(ExprHolderAction):
-
-    def __init__(self, env_expr: AbstractExpression, unsound: bool) -> None:
-        super().__init__(env_expr)
+        self.name_expr = name_expr
+        self.fallback_env_expr = fallback_env_expr
         self.unsound = unsound
 
     def create_internal_properties(self, env_spec: EnvSpec) -> None:
-        self.initial_env_prop = env_spec.create_internal_property(
-            'Initial_Env', self.env_expr, T.LexicalEnv
+        self.name_prop = env_spec.create_internal_property(
+            'Initial_Env_Name', self.name_expr, T.Symbol.array
+        )
+        self.fallback_env_prop = env_spec.create_internal_property(
+            'Initial_Env', self.fallback_env_expr, T.LexicalEnv
         )
 
 
-class Do(ExprHolderAction):
-    def create_internal_properties(self, env_spec: EnvSpec) -> None:
-        self.do_property = env_spec.create_internal_property(
-            'Env_Do', self.env_expr, None
+class Do(EnvAction):
+    def __init__(self, expr: AbstractExpression) -> None:
+        self.expr = expr
+
+    def create_internal_properties(self, spec: EnvSpec) -> None:
+        self.do_property = spec.create_internal_property(
+            'Env_Do', self.expr, None
         )

langkit/gdb/printers.py

@@ -6,12 +6,14 @@
 
 import gdb
 import gdb.printing
+from gnatdbg.strings import StringAccess
 
 from langkit.gdb.tdh import TDH
 from langkit.gdb.units import AnalysisUnit
 from langkit.gdb.utils import adaify_name
 from langkit.utils import memoized
 
+
 if TYPE_CHECKING:
     from langkit.gdb.context import Context
 
@@ -333,6 +335,57 @@ def to_string(self):
             return '<LexicalEnv (corrupted)]'
 
 
+class EnvNamePrinter(BasePrinter):
+    """
+    Pretty-printer for env names.
+    """
+    name = 'EnvName'
+
+    matcher = RecordAccessMatcher('env_name_record', 'env_name')
+
+    @classmethod
+    def matches(cls, value, context):
+        return cls.matcher.matches_access(value, context)
+
+    def to_string(self):
+        if not self.value:
+            return 'null'
+
+        # Since GDB's Python API only exposes the low-level details of how Ada
+        # arrays are implemented, we need to do some pointer arithmetic in
+        # order to fetch the sequence of symbols that this EnvName contains::
+        #
+        #    $.Symbols (1 .. $.Size)
+
+        # Lookup the symbol type (array element)
+        symbol_type = gdb.lookup_type(
+            self.context.comname('symbols__symbol_type')
+        )
+        symbol_ptr = symbol_type.pointer()
+
+        # Fetch the size and the address of the first array element
+        size = int(self.value['size'])
+        symbols_addr = int(self.value['symbols'].address)
+
+        # We can now fetch individual symbols
+        result = []
+        for i in range(size):
+            sym_addr = symbols_addr + i * symbol_type.sizeof
+            sym = gdb.Value(sym_addr).cast(symbol_ptr).dereference()
+
+            # Fetch the text corresponding to the current symbol. Symbols are
+            # implemented as wide wide strings, so decode them using the UTF-32
+            # encoding (native endianity). Do not crash on
+            # uninitialized/corrupted symbol: try to be as helpful as possible.
+            try:
+                sym_text = StringAccess(sym).get_string(encoding='utf-32')
+            except gdb.error:
+                sym_text = '???'
+
+            result.append(sym_text)
+        return 'EnvName({})'.format('.'.join(result))
+
+
 class LexicalEnvPrinter(BasePrinter):
     """
     Pretty-printer for lexical environments.

langkit/gdb/setup.py

@@ -30,6 +30,7 @@ def setup(lib_name, astnode_names, astnode_kinds, prefix):
     for printer in [
         printers.AnalysisUnitPrinter,
         printers.ASTNodePrinter,
+        printers.EnvNamePrinter,
         printers.LexicalEnvPrinter,
         printers.EnvGetterPrinter,
         printers.ReferencedEnvPrinter,

langkit/templates/astnode_types_ada.mako

@@ -211,13 +211,13 @@
       % if cls.env_spec.pre_actions:
          procedure ${cls.raw_name}_Pre_Env_Actions
            (Self            : ${cls.name};
-            State           : in out PLE_State;
+            State           : in out PLE_Node_State;
             Add_To_Env_Only : Boolean := False);
       % endif
 
       % if cls.env_spec.post_actions:
          procedure ${cls.raw_name}_Post_Env_Actions
-           (Self : ${cls.name}; State : in out PLE_State);
+           (Self : ${cls.name}; State : in out PLE_Node_State);
       % endif
 
    % endif
@@ -283,9 +283,15 @@
       env_getter = "{}_Initial_Env_Getter_Fn".format(cls.name)
    %>
 
-   <%def name="emit_set_initial_env(do_action)">
-      State.Current_Env := ${env_getter}
-        ((Node => Self, Info => ${T.entity_info.nullexpr}));
+   <%def name="emit_set_initial_env(sie)">
+      declare
+         Name_Result : ${T.Symbol.array.name} :=
+            ${(cls.env_spec.initial_env_name_expr
+               if sie.name_prop
+               else 'null')};
+      begin
+         Set_Initial_Env (Self, State, Name_Result, ${env_getter}'Access);
+      end;
    </%def>
 
    <%def name="emit_add_to_env(exprs)">
@@ -315,7 +321,7 @@
          % endif
 
          Add_To_Env
-           (Self, Mapping, State.Current_Env, Resolver,
+           (Self, Mapping, State, Resolver,
             DSL_Location => ${('""'
                                if exprs.unsound else
                                string_repr(exprs.str_location))});
@@ -377,29 +383,16 @@
       end if;
 
       declare
-         G : Env_Getter :=
-            % if add_env.no_parent:
-               AST_Envs.No_Env_Getter
-            % else:
-               AST_Envs.Simple_Env_Getter (State.Current_Env)
-            % endif
-         ;
+         No_Parent         : constant Boolean :=
+            ${'True' if add_env.no_parent else 'False'};
+         Transitive_Parent : constant Boolean :=
+            ${call_prop(add_env.transitive_parent_prop)};
+         Resolver          : constant Lexical_Env_Resolver :=
+            ${"{}'Access".format(env_getter) if has_dyn_env else 'null'};
+         Names             : ${T.Symbol.array.array.name} :=
+            ${call_prop(add_env.names_prop) if add_env.names_prop else 'null'};
       begin
-         % if has_dyn_env:
-            if State.Current_Env.Env.Node /= null
-               and then State.Current_Env.Env.Node.Unit /= Self.Unit
-            then
-               G := AST_Envs.Dyn_Env_Getter (${env_getter}'Access, Self);
-            end if;
-         % endif
-
-         Self.Self_Env := AST_Envs.Create_Lexical_Env
-           (Parent            => G,
-            Node              => Self,
-            Transitive_Parent => ${call_prop(add_env.transitive_parent_prop)},
-            Owner             => Self.Unit);
-         State.Current_Env := Self.Self_Env;
-         Register_Destroyable (Self.Unit, Self.Self_Env.Env);
+         Add_Env (Self, State, No_Parent, Transitive_Parent, Resolver, Names);
       end;
    </%def>
 
@@ -447,24 +440,23 @@
 
       Initial_Env : Lexical_Env := Bound_Env;
    begin
-      % if cls.env_spec.initial_env:
-         Initial_Env := ${cls.env_spec.initial_env_expr};
+      Initial_Env := ${cls.env_spec.initial_env_expr};
 
-         if Initial_Env.Kind /= Primary then
+      if Initial_Env.Kind /= Primary then
+         raise Property_Error with
+            "Cannot set initial env to non-primary one";
+      end if;
+
+      % if not cls.env_spec.initial_env.unsound:
+         if Initial_Env.Env.Node /= null
+            and then Initial_Env.Env.Node.Unit /= Self.Unit
+         then
             raise Property_Error with
-               "Cannot set initial env to non-primary one";
+               "unsound foreign environment in SetInitialEnv ("
+               & "${cls.env_spec.initial_env.str_location}" & ")";
          end if;
-
-         % if not cls.env_spec.initial_env.unsound:
-            if Initial_Env.Env.Node /= null
-               and then Initial_Env.Env.Node.Unit /= Self.Unit
-            then
-               raise Property_Error with
-                  "unsound foreign environment in SetInitialEnv ("
-                  & "${cls.env_spec.initial_env.str_location}" & ")";
-            end if;
-         % endif
       % endif
+
       return Initial_Env;
    end ${env_getter};
 
@@ -475,7 +467,7 @@
    % if cls.env_spec.pre_actions:
       procedure ${cls.raw_name}_Pre_Env_Actions
         (Self            : ${cls.name};
-         State           : in out PLE_State;
+         State           : in out PLE_Node_State;
          Add_To_Env_Only : Boolean := False) is
       begin
          % for action in cls.env_spec.pre_actions:
@@ -486,7 +478,7 @@
 
    % if cls.env_spec.post_actions:
       procedure ${cls.raw_name}_Post_Env_Actions
-        (Self : ${cls.name}; State : in out PLE_State) is
+        (Self : ${cls.name}; State : in out PLE_Node_State) is
       begin
          % for action in cls.env_spec.post_actions:
             ${emit_env_action (action)}