nightshade

sem.adb (4268B)

---

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

package body Sem is

   procedure Load_STD_Symbols (S : in out Sem);

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

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

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

   procedure Load_STD_Symbols (S : in out Sem) is
      Info        : Symbol_Info;
      Int_Type    : constant Type_Info_Ref := new Type_Info'(Kind => TY_INT);
      String_Type : constant Type_Info_Ref := new Type_Info'(Kind => TY_STRING);
      Bool_Type   : constant Type_Info_Ref := new Type_Info'(Kind => TY_BOOL);
      Void_Type   : constant Type_Info_Ref := new Type_Info'(Kind => TY_VOID);
      Error_Type  : constant Type_Info_Ref := new Type_Info'(Kind => TY_ERROR);
      Print_Type  : constant Type_Info_Ref :=
        new Type_Info'
          (Kind => TY_FUNC,
           Func =>
             (Return_Type => Void_Type, Params => new Type_List'(1 => String_Type)));
   begin
      Put_Line ("load std symbols");
      Info := (Kind => SYM_FUNC, Typ => Print_Type);
      S.Scope.Symbols.Include ("print", Info);
   end;

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

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

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

   procedure Scope_Contains_Or_Error
     (Sc : Scope_Ref; Name : Unbounded_String; Kind : Symbol_Kind_Enum)
   is
      Info : 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 "
               & Symbol_Kind_Enum'Image (Kind)
               & " in scope.");
            return;
         else
            raise Program_Error
              with
                "Symbol found in scope was not of expected type "
                & Symbol_Kind_Enum'Image (Kind)
                & " but is in fact "
                & Symbol_Kind_Enum'Image (Info.Kind);
         end if;
      elsif Sc.Parent /= null then
         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 func call --
   ---------------------

   procedure Scope_Call (S : in out Sem; Callee : in Call_Stmt) is
   begin
      -- determine whether the callee exist in scope or bail with error
      Put_Line ("scoping call wip");
      Scope_Contains_Or_Error (S.Scope, Callee.Name, SYM_FUNC);
      null;
   end;

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

   procedure Scope_Var_Decl (S : in out Sem) 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 --
   ----------------

   procedure Scope_Func (S : in out Sem; Fn : in Func_Decl) is
   begin
      -- go through statements and +scope var_decl and -scope calls
      for Statement of Fn.Stmts loop
         if Statement.Kind = Stmt_Call then
            Put_Line ("scoping call");
            Scope_Call (S, Statement.Call);
         end if;
      end loop;
   end;

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

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

end Sem;