commit 33a90a70e24e7c315805416802ce1b1f3beacb46
parent d9e2201d4d3e90264653d79e37d19250c9039adf
Author: citbl <citbl@citbl.org>
Date: Sun, 14 Jun 2026 16:14:11 +1000
refac and undo returning scope
Diffstat:
5 files changed, 187 insertions(+), 191 deletions(-)
diff --git a/src/binder.adb b/src/binder.adb
@@ -1,159 +0,0 @@
-with Parser; use Parser;
-with Ada.Containers.Indefinite_Vectors;
-with Ada.Text_IO; use Ada.Text_IO;
-
-package body Binder is
-
- procedure Load_STD_Symbols (S : in out Sem);
-
- ----------
- -- init --
- ----------
-
- function Init (AST : Declaration_Vectors.Vector) return Sem is
- Symbols : Symbols_Map.Map;
- Sc : AST_Scope_Ref;
- S : Sem;
- begin
- Sc := new AST_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 : AST_Symbol_Info;
- 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);
- 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, 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 : 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_Scope_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 Sc;
- 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 func call --
- ---------------------
-
- function Scope_Call (S : in out Sem; Callee : in Call_Stmt) return AST_Scope_Ref is
- Found_Scope : AST_Scope_Ref;
- begin
- -- determine whether the callee exist in scope or bail with error
- Put_Line ("scoping call");
- Found_Scope := Scope_Contains_Or_Error (S.Scope, Callee.Name, SYM_FUNC);
- return Found_Scope;
- 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 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");
- Found_Scope := Scope_Call (S, Statement.Call);
- Statement.Scope := Found_Scope;
- 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
- Declaration.Scope := S.Scope;
- Put_Line ("scoping function");
- Scope_Func (S, Declaration.Func);
- end if;
- null;
- end loop;
- end Analysis;
-
-end Binder;
-
diff --git a/src/binder.ads b/src/binder.ads
@@ -1,29 +0,0 @@
-with Ada.Containers.Indefinite_Hashed_Maps;
-with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
-with Ada.Strings.Hash;
-with Types; use Types;
-
-package Binder is
-
- ---------
- -- sem --
- ---------
-
- type Sem is record
- Scope : AST_Scope_Ref;
- AST : Declaration_Vectors.Vector;
- end record;
-
- ----------
- -- init --
- ----------
-
- function Init (AST : Declaration_Vectors.Vector) return Sem;
-
- --------------
- -- analysis --
- --------------
-
- procedure Analysis (S : in out Sem);
-
-end Binder;
diff --git a/src/nightshade.adb b/src/nightshade.adb
@@ -4,7 +4,7 @@ with Utils;
with Types;
with Lexer;
with Parser;
-with Binder;
+with Scope;
procedure Nightshade is
begin
@@ -30,9 +30,9 @@ begin
Parser.Print_AST (P.Declarations);
declare
- BoundAST : Binder.Sem := Binder.Init (P.Declarations);
+ BoundAST : Scope.Sem := Scope.Init (P.Declarations);
begin
- Binder.Analysis (BoundAST);
+ Scope.Analysis (BoundAST);
Parser.Print_AST (BoundAST.AST);
end;
end;
diff --git a/src/scope.adb b/src/scope.adb
@@ -0,0 +1,155 @@
+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 Sem);
+
+ ----------
+ -- init --
+ ----------
+
+ function Init (AST : Declaration_Vectors.Vector) return Sem is
+ Symbols : Symbols_Map.Map;
+ Sc : AST_Scope_Ref;
+ S : Sem;
+ begin
+ Sc := new AST_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 : AST_Symbol_Info;
+ 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);
+ 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, 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 : AST_Scope_Ref;
+ begin
+ Sc := new AST_Scope'(Parent => S.Scope, Symbols => Symbols);
+ S.Scope := Sc;
+ end;
+
+ -----------------------------
+ -- scope contains or error --
+ -----------------------------
+
+ -- recursive
+ procedure Scope_Contains_Or_Error
+ (Sc : AST_Scope_Ref; Name : Unbounded_String; Kind : AST_Symbol_Kind_Enum)
+ 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;
+ 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...");
+ 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; Func_Call : in Call_Stmt) is
+ begin
+ -- determine whether the callee exist in scope or bail with error
+ Put_Line ("scoping call");
+ Scope_Contains_Or_Error (S.Scope, Func_Call.Name, SYM_FUNC);
+ 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 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;
+ 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
+ Declaration.Scope := S.Scope;
+ Put_Line ("scoping function");
+ Scope_Func (S, Declaration.Func);
+ end if;
+ null;
+ end loop;
+ end Analysis;
+
+end Scope;
diff --git a/src/scope.ads b/src/scope.ads
@@ -0,0 +1,29 @@
+with Ada.Containers.Indefinite_Hashed_Maps;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with Ada.Strings.Hash;
+with Types; use Types;
+
+package Scope is
+
+ ---------
+ -- sem --
+ ---------
+
+ type Sem is record
+ Scope : AST_Scope_Ref;
+ AST : Declaration_Vectors.Vector;
+ end record;
+
+ ----------
+ -- init --
+ ----------
+
+ function Init (AST : Declaration_Vectors.Vector) return Sem;
+
+ --------------
+ -- analysis --
+ --------------
+
+ procedure Analysis (S : in out Sem);
+
+end Scope;
