commit 3863be81c14395a5bca359fbe1b49cfeb070fb1e
parent e465c6a9023bf04858c57f80db17a33de60b6c68
Author: citbl <citbl@citbl.org>
Date: Mon, 15 Jun 2026 16:13:43 +1000
refac
Diffstat:
13 files changed, 318 insertions(+), 301 deletions(-)
diff --git a/src/ast_lower.adb b/src/ast_lower.adb
@@ -0,0 +1,10 @@
+
+package body AST_Lower is
+
+ function Init
+ (File_Name : File_Name_Ref; Source : Source_Ref; AST : Declaration_Vectors.Vector) return Lowerer is
+ begin
+ return Lowerer'(File_Name => File_Name, Source => Source, AST => AST);
+ end Init;
+
+end AST_Lower;
diff --git a/src/ast_lower.ads b/src/ast_lower.ads
@@ -0,0 +1,59 @@
+with Ada.Containers.Vectors;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with Types; use Types;
+
+package AST_Lower is
+
+ type Lowerer is record
+ File_Name : File_Name_Ref;
+ Source : Source_Ref;
+ AST : Declaration_Vectors.Vector;
+ end record;
+
+ type IR_Type is (IR_VOID, IR_STR, IR_I64, IR_BOOL);
+
+ type IR_Value is record
+ Id : Positive;
+ Typ : IR_Type;
+ end record;
+
+ type IR_Inst_Kind is (CONST_STR, RET, CALL);
+
+ package IR_Values_Vector is new Ada.Containers.Vectors (Index_Type => Natural, Element_Type => IR_Value);
+
+ type IR_Instruction (Kind : IR_Inst_Kind := CONST_STR) is record
+ case Kind is
+ when CONST_STR =>
+ Const_Str_Value : Unbounded_String;
+
+ when RET =>
+ Ret_Value : IR_Value;
+ Has_Value : Boolean;
+
+ when CALL =>
+ Call_Name : Unbounded_String;
+ Call_Has_Dest : Boolean;
+ Call_Dest : IR_Value;
+ Call_Args : IR_Values_Vector.Vector;
+ end case;
+ end record;
+
+ package Instructions_Vector is new
+ Ada.Containers.Vectors (Index_Type => Natural, Element_Type => IR_Instruction);
+
+ type IR_Function is record
+ Name : Unbounded_String;
+ Instructions : Instructions_Vector.Vector;
+ end record;
+
+ package Functions_Vector is new
+ Ada.Containers.Vectors (Index_Type => Natural, Element_Type => IR_Function);
+
+ type IR_Module is record
+ Functions : Functions_Vector.Vector;
+ end record;
+
+ function Init
+ (File_Name : File_Name_Ref; Source : Source_Ref; AST : Declaration_Vectors.Vector) return Lowerer;
+
+end AST_Lower;
diff --git a/src/ast_scoper.adb b/src/ast_scoper.adb
@@ -0,0 +1,180 @@
+with Parser; use Parser;
+with Ada.Containers.Indefinite_Vectors;
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body AST_Scoper 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 AST_Scoper;
diff --git a/src/ast_scoper.ads b/src/ast_scoper.ads
@@ -0,0 +1,31 @@
+with Ada.Containers.Indefinite_Hashed_Maps;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with Ada.Strings.Hash;
+with Types; use Types;
+
+package AST_Scoper is
+
+ type Scoper is record
+ Scope : AST_Scope_Ref;
+ Scoped_AST : Declaration_Vectors.Vector;
+ end record;
+
+ 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;
+
+ --------------
+ -- analysis --
+ --------------
+
+ procedure Analysis (S : in out Scoper);
+
+end AST_Scoper;
diff --git a/src/ast_typer.adb b/src/ast_typer.adb
@@ -0,0 +1,18 @@
+package body AST_Typer is
+
+ function Init (AST : Declaration_Vectors.Vector) return Typer is
+ begin
+ return Typer'(AST => AST);
+ end;
+
+ procedure Type_Check (TT : in out Typer) is
+ begin
+ for Declaration of TT.AST loop
+ if Declaration.Kind = Function_Kind then
+ null; -- we won't type check just yet because we don't really have anything to type check.
+
+ end if;
+ end loop;
+ end;
+
+end AST_Typer;
diff --git a/src/ast_typer.ads b/src/ast_typer.ads
@@ -0,0 +1,13 @@
+with Types; use Types;
+
+package AST_Typer is
+
+ type Typer is record
+ AST : Declaration_Vectors.Vector;
+ end record;
+
+ function Init (AST : Declaration_Vectors.Vector) return Typer;
+
+ procedure Type_Check (TT : in out Typer);
+
+end AST_Typer;
diff --git a/src/ir.adb b/src/ir.adb
@@ -1,3 +0,0 @@
--- package body IR is
-
--- end IR;
diff --git a/src/ir.ads b/src/ir.ads
@@ -1,49 +0,0 @@
-with Ada.Containers.Vectors;
-with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
-
-package IR is
-
- type IR_Type is (IR_VOID, IR_STR, IR_I64, IR_BOOL);
-
- type IR_Value is record
- Id : Positive;
- Typ : IR_Type;
- end record;
-
- type IR_Inst_Kind is (CONST_STR, RET, CALL);
-
- package IR_Values_Vector is new Ada.Containers.Vectors (Index_Type => Natural, Element_Type => IR_Value);
-
- type IR_Instruction (Kind : IR_Inst_Kind := CONST_STR) is record
- case Kind is
- when CONST_STR =>
- Const_Str_Value : Unbounded_String;
-
- when RET =>
- Ret_Value : IR_Value;
- Has_Value : Boolean;
-
- when CALL =>
- Call_Name : Unbounded_String;
- Call_Has_Dest : Boolean;
- Call_Dest : IR_Value;
- Call_Args : IR_Values_Vector.Vector;
- end case;
- end record;
-
- package Instructions_Vector is new
- Ada.Containers.Vectors (Index_Type => Natural, Element_Type => IR_Instruction);
-
- type IR_Function is record
- Name : Unbounded_String;
- Instructions : Instructions_Vector.Vector;
- end record;
-
- package Functions_Vector is new
- Ada.Containers.Vectors (Index_Type => Natural, Element_Type => IR_Function);
-
- type IR_Module is record
- Functions : Functions_Vector.Vector;
- end record;
-
-end IR;
diff --git a/src/nightshade.adb b/src/nightshade.adb
@@ -4,9 +4,9 @@ with Utils;
with Types;
with Lexer;
with Parser;
-with Scope;
-with Typing;
-with IR;
+with AST_Scoper;
+with AST_Typer;
+with AST_Lower;
procedure Nightshade is
begin
@@ -32,14 +32,14 @@ begin
Utils.Print_AST (P.AST);
declare
- Scoper : Scope.Scoper := Scope.Init (P.AST);
+ Scoper : AST_Scoper.Scoper := AST_Scoper.Init (P.AST);
begin
- Scope.Analysis (Scoper);
+ AST_Scoper.Analysis (Scoper);
Utils.Print_AST (Scoper.Scoped_AST);
declare
- TypedAST : Typing.Typer := Typing.Init (P.AST);
+ TypedAST : AST_Typer.Typer := AST_Typer.Init (P.AST);
begin
- Typing.Type_Check (TypedAST);
+ AST_Typer.Type_Check (TypedAST);
end;
end;
end;
diff --git a/src/scope.adb b/src/scope.adb
@@ -1,180 +0,0 @@
-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;
diff --git a/src/scope.ads b/src/scope.ads
@@ -1,31 +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 Scope is
-
- type Scoper is record
- Scope : AST_Scope_Ref;
- Scoped_AST : Declaration_Vectors.Vector;
- end record;
-
- 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;
-
- --------------
- -- analysis --
- --------------
-
- procedure Analysis (S : in out Scoper);
-
-end Scope;
diff --git a/src/typing.adb b/src/typing.adb
@@ -1,18 +0,0 @@
-package body Typing is
-
- function Init (AST : Declaration_Vectors.Vector) return Typer is
- begin
- return Typer'(AST => AST);
- end;
-
- procedure Type_Check (TT : in out Typer) is
- begin
- for Declaration of TT.AST loop
- if Declaration.Kind = Function_Kind then
- null; -- we won't type check just yet because we don't really have anything to type check.
-
- end if;
- end loop;
- end;
-
-end Typing;
diff --git a/src/typing.ads b/src/typing.ads
@@ -1,13 +0,0 @@
-with Types; use Types;
-
-package Typing is
-
- type Typer is record
- AST : Declaration_Vectors.Vector;
- end record;
-
- function Init (AST : Declaration_Vectors.Vector) return Typer;
-
- procedure Type_Check (TT : in out Typer);
-
-end Typing;
