diff options
Diffstat (limited to 'src/kompsos.adb')
| -rw-r--r-- | src/kompsos.adb | 159 |
1 files changed, 80 insertions, 79 deletions
diff --git a/src/kompsos.adb b/src/kompsos.adb index 080683b..4a34b1b 100644 --- a/src/kompsos.adb +++ b/src/kompsos.adb @@ -55,20 +55,20 @@ package body Kompsos is - -- Goals -- + -- Goal Graphs -- - procedure Free is new Ada.Unchecked_Deallocation (Goal_Component, Goal_Component_Access); + procedure Free is new Ada.Unchecked_Deallocation (Graph_Component, Graph_Component_Access); procedure Initialize - (This : in out Goal) is + (This : in out Goal_Graph) is begin This.Actual := null; end Initialize; procedure Adjust - (This : in out Goal) is + (This : in out Goal_Graph) is begin if This.Actual /= null then This.Actual.Counter := This.Actual.Counter + 1; @@ -77,7 +77,7 @@ package body Kompsos is procedure Finalize - (This : in out Goal) is + (This : in out Goal_Graph) is begin if This.Actual /= null then This.Actual.Counter := This.Actual.Counter - 1; @@ -209,43 +209,24 @@ package body Kompsos is - -- Goals -- + -- Goal Graphs -- - package Goal_Convert is new System.Address_To_Access_Conversions (Goal_Component); + package Graph_Convert is new System.Address_To_Access_Conversions (Graph_Component); function "<" - (Left, Right : in Goal_Component_Access) + (Left, Right : in Graph_Component_Access) return Boolean is use System.Storage_Elements; begin return - To_Integer (Goal_Convert.To_Address (Goal_Convert.Object_Pointer (Left))) < - To_Integer (Goal_Convert.To_Address (Goal_Convert.Object_Pointer (Right))); + To_Integer (Graph_Convert.To_Address (Graph_Convert.Object_Pointer (Left))) < + To_Integer (Graph_Convert.To_Address (Graph_Convert.Object_Pointer (Right))); end "<"; - ------------------------ - -- Internal Helpers -- - ------------------------ - - -- Variables -- - - Next_Variable : Variable := Variable'First; - - function Next_Gen - return Variable is - begin - return Result : constant Variable := Next_Variable do - Next_Variable := Next_Variable + 1; - end return; - end Next_Gen; - - - - ------------------- -- microKanren -- ------------------- @@ -256,7 +237,9 @@ package body Kompsos is (This : in out Goal'Class) return Term is begin - return Term (T (Next_Gen)); + return Result : constant Term := Term (T (This.Next_Var)) do + This.Next_Var := This.Next_Var + 1; + end return; end Fresh; @@ -307,13 +290,15 @@ package body Kompsos is Left, Right : in Term'Class) return Goal is begin - return Result : constant Goal := (Ada.Finalization.Controlled with - Actual => new Goal_Component'( - (Kind => Unify_Node, - Counter => 1, - Uni_Goal => This, - Uni_Term1 => Term (Left), - Uni_Term2 => Term (Right)))); + return Result : constant Goal := + (Graph => (Ada.Finalization.Controlled with + Actual => new Graph_Component'( + (Kind => Unify_Node, + Counter => 1, + Uni_Goal => This.Graph, + Uni_Term1 => Term (Left), + Uni_Term2 => Term (Right)))), + Next_Var => This.Next_Var); end Unify; @@ -332,12 +317,14 @@ package body Kompsos is (Left, Right : in Goal) return Goal is begin - return Result : constant Goal := (Ada.Finalization.Controlled with - Actual => new Goal_Component'( - (Kind => Disjunct_Node, - Counter => 1, - Dis_Goal1 => Left, - Dis_Goal2 => Right))); + return Result : constant Goal := + (Graph => (Ada.Finalization.Controlled with + Actual => new Graph_Component'( + (Kind => Disjunct_Node, + Counter => 1, + Dis_Goal1 => Left.Graph, + Dis_Goal2 => Right.Graph))), + Next_Var => Variable'Max (Left.Next_Var, Right.Next_Var)); end Disjunct; @@ -354,16 +341,22 @@ package body Kompsos is return Goal is begin if Inputs'Length = 0 then - return (Ada.Finalization.Controlled with Actual => null); + return Empty_Goal; elsif Inputs'Length = 1 then return Inputs (Inputs'First); else - return Result : constant Goal := (Ada.Finalization.Controlled with - Actual => new Goal_Component'( - (Kind => Disjunct_Node, - Counter => 1, - Dis_Goal1 => Inputs (Inputs'First), - Dis_Goal2 => Disjunct (Inputs (Inputs'First + 1 .. Inputs'Last))))); + declare + Rest : constant Goal := Disjunct (Inputs (Inputs'First + 1 .. Inputs'Last)); + begin + return Result : constant Goal := + (Graph => (Ada.Finalization.Controlled with + Actual => new Graph_Component'( + (Kind => Disjunct_Node, + Counter => 1, + Dis_Goal1 => Inputs (Inputs'First).Graph, + Dis_Goal2 => Rest.Graph))), + Next_Var => Variable'Max (Inputs (Inputs'First).Next_Var, Rest.Next_Var)); + end; end if; end Disjunct; @@ -384,12 +377,14 @@ package body Kompsos is Func : in Junction_Zero_Func) return Goal is begin - return Result : constant Goal := (Ada.Finalization.Controlled with - Actual => new Goal_Component'( - (Kind => Conjunct_Node, - Counter => 1, - Con_Goal => This, - Con_Data => Lazy_Holders.To_Holder ((Kind => Zero_Arg, ZFunc => Func))))); + return Result : constant Goal := + (Graph => (Ada.Finalization.Controlled with + Actual => new Graph_Component'( + (Kind => Conjunct_Node, + Counter => 1, + Con_Goal => This.Graph, + Con_Data => Lazy_Holders.To_Holder ((Kind => Zero_Arg, ZFunc => Func))))), + Next_Var => This.Next_Var); end Conjunct; @@ -407,15 +402,17 @@ package body Kompsos is Input : in Term'Class) return Goal is begin - return Result : constant Goal := (Ada.Finalization.Controlled with - Actual => new Goal_Component'( - (Kind => Conjunct_Node, - Counter => 1, - Con_Goal => This, - Con_Data => Lazy_Holders.To_Holder - ((Kind => One_Arg, - OFunc => Func, - OInput => Term (Input)))))); + return Result : constant Goal := + (Graph => (Ada.Finalization.Controlled with + Actual => new Graph_Component'( + (Kind => Conjunct_Node, + Counter => 1, + Con_Goal => This.Graph, + Con_Data => Lazy_Holders.To_Holder + ((Kind => One_Arg, + OFunc => Func, + OInput => Term (Input)))))), + Next_Var => This.Next_Var); end Conjunct; @@ -434,15 +431,17 @@ package body Kompsos is Inputs : in Term_Array) return Goal is begin - return Result : constant Goal := (Ada.Finalization.Controlled with - Actual => new Goal_Component'( - (Kind => Conjunct_Node, - Counter => 1, - Con_Goal => This, - Con_Data => Lazy_Holders.To_Holder - ((Kind => Many_Arg, - MFunc => Func, - MInput => Term_Array_Holders.To_Holder (Inputs)))))); + return Result : constant Goal := + (Graph => (Ada.Finalization.Controlled with + Actual => new Graph_Component'( + (Kind => Conjunct_Node, + Counter => 1, + Con_Goal => This.Graph, + Con_Data => Lazy_Holders.To_Holder + ((Kind => Many_Arg, + MFunc => Func, + MInput => Term_Array_Holders.To_Holder (Inputs)))))), + Next_Var => This.Next_Var); end Conjunct; @@ -467,11 +466,13 @@ package body Kompsos is (This : in Goal) return Goal is begin - return Result : constant Goal := (Ada.Finalization.Controlled with - Actual => new Goal_Component'( - (Kind => Recurse_Node, - Counter => 1, - Rec_Goal => This))); + return Result : constant Goal := + (Graph => (Ada.Finalization.Controlled with + Actual => new Graph_Component'( + (Kind => Recurse_Node, + Counter => 1, + Rec_Goal => This.Graph))), + Next_Var => This.Next_Var); end Recurse; |