nightshade

scope.adb (5620B)

---

with Parser;      use Parser;
with Ada.Containers.Indefinite_Vectors;
with Ada.Text_IO; use Ada.Text_IO;

package body Scope is

   procedure Load_STD_Symbols (S : in out Scoper);

   --  Int_Type    : constant AST_Type_Info_Ref := new AST_Type_Info'(Kind => TY_INT);
   --  String_Type : constant AST_Type_Info_Ref := new AST_Type_Info'(Kind => TY_STRING);
   --  Bool_Type   : constant AST_Type_Info_Ref := new AST_Type_Info'(Kind => TY_BOOL);
   --  Void_Type   : constant AST_Type_Info_Ref := new AST_Type_Info'(Kind => TY_VOID);
   --  Error_Type  : constant AST_Type_Info_Ref := new AST_Type_Info'(Kind => TY_ERROR);

   ----------
   -- init --
   ----------

   function Init (AST : Declaration_Vectors.Vector) return Scoper is
      Symbols : Symbols_Map.Map;
      Sc      : AST_Scope_Ref;
      S       : Scoper;
   begin
      Sc := new AST_Scope'(Parent => null, Symbols => Symbols);
      S := (Scope => Sc, Scoped_AST => AST);
      Load_STD_Symbols (S);
      return S;
   end Init;

   -----------------------
   -- load std in scope --
   -----------------------

   procedure Load_STD_Symbols (S : in out Scoper) is
      Info       : AST_Symbol_Info;
      Print_Type : constant AST_Type_Info_Ref :=
        new AST_Type_Info'
          (Kind => TY_FUNC,
           Func => (Return_Type => Void_Type, Params => new AST_Type_List'(1 => String_Type)));
   begin
      Put_Line ("load std symbols");
      Info := (Name => To_Unbounded_String ("print"), Kind => SYM_FUNC, Entity_Type => Print_Type);
      S.Scope.Symbols.Include ("print", Info);
   end;

   --------------------------
   -- new scope from scope --
   --------------------------

   procedure New_Scope_From_Scope (S : in out Scoper) is
      Symbols : Symbols_Map.Map;
      Sc      : AST_Scope_Ref;
   begin
      Sc := new AST_Scope'(Parent => S.Scope, Symbols => Symbols);
      S.Scope := Sc;
   end;

   -----------------------------
   -- scope contains or error --
   -----------------------------

   -- recursive
   function Scope_Contains_Or_Error
     (Sc : AST_Scope_Ref; Name : Unbounded_String; Kind : AST_Symbol_Kind_Enum) return AST_Type_Info_Ref
   is
      Info : AST_Symbol_Info;
   begin
      if Sc.Symbols.Contains (To_String (Name)) then
         Info := Sc.Symbols.Element (To_String (Name));
         if Info.Kind = Kind then
            Put_Line
              ("Found " & To_String (Name) & " of kind " & AST_Symbol_Kind_Enum'Image (Kind) & " in scope.");
            return Info.Entity_Type;
         else
            raise Program_Error
              with
                "Symbol found in scope was not of expected type "
                & AST_Symbol_Kind_Enum'Image (Kind)
                & " but is in fact "
                & AST_Symbol_Kind_Enum'Image (Info.Kind);
         end if;
      elsif Sc.Parent /= null then
         Put_Line ("Not found in current scope, looking in parent...");
         return Scope_Contains_Or_Error (Sc.Parent, Name, Kind);
      else
         raise Program_Error with "Could not find symbol " & To_String (Name) & " in scope.";
      end if;
   end;

   ----------------------
   -- scope call param --
   ----------------------

   procedure Scope_Call (S : in out Scoper; Func_Call : in out Call_Expr);

   procedure Scope_Expr_Ref (S : in out Scoper; Expr : Expr_Ref) is
   begin
      case Expr.Kind is
         when String_Literal =>
            Expr.Entity_Type := String_Type;
            Put_Line ("scoping string literal has no effect");
            null; -- no need to scope literals

         when Expr_Call      =>
            Scope_Call (S, Expr.Call);

         when others         =>
            raise Program_Error with "scoping expr unknown TODO?";
      end case;
   end;

   ---------------------
   -- scope func call --
   ---------------------

   procedure Scope_Call (S : in out Scoper; Func_Call : in out Call_Expr) is
      Found_Entity_Type : AST_Type_Info_Ref;
   begin
      -- determine whether the callee exist in scope or bail with error
      Put_Line ("scoping call");
      Found_Entity_Type := Scope_Contains_Or_Error (S.Scope, Func_Call.Name, SYM_FUNC);
      Func_Call.Entity_Type := Found_Entity_Type;

      for Param of Func_Call.Params loop
         Scope_Expr_Ref (S, Param);
      end loop;
   end;

   --------------------
   -- scope var decl --
   --------------------

   procedure Scope_Var_Decl (S : in out Scoper) is
   begin

      -- TODO we do not yet add to scope, but we do not currently have
      --      variables so this is a waste of time for now

      null;
   end;

   ----------------
   -- scope func --
   ----------------

   -- TODO parameters must be put in this scope
   procedure Scope_Func (S : in out Scoper; Fn : in out Func_Decl) is
      Found_Scope : AST_Scope_Ref;
   begin
      -- entering function block scope
      New_Scope_From_Scope (S);

      for Statement of Fn.Stmts loop
         if Statement.Kind = Stmt_Call then
            Put_Line ("scoping call");
            Scope_Call (S, Statement.Call);
            Statement.Scope := S.Scope;
         -- TODO when scoping adds a symbol, check whether it exists first: no shadowing.

         end if;
      end loop;
   end;

   --------------
   -- analysis --
   --------------

   procedure Analysis (S : in out Scoper) is
   begin
      for Declaration of S.Scoped_AST loop
         if Declaration.Kind = Function_Kind then
            Declaration.Scope := S.Scope;
            Put_Line ("scoping function");
            Scope_Func (S, Declaration.Func);
         end if;
         null;
      end loop;
   end Analysis;

end Scope;