Prelude now derives its own World so dot notation works for those subprograms

1 files changed, 82 insertions, 122 deletions

diff --git a/src/kompsos.adb b/src/kompsos.adb
index 3981005..b2ff1a2 100644
--- a/src/kompsos.adb
+++ b/src/kompsos.adb
@@ -56,34 +56,34 @@ package body Kompsos is
 
 
 
-    --  Worlds  --
+    --  Mu_Worlds  --
 
-    procedure Free is new Ada.Unchecked_Deallocation (World, World_Access);
+    procedure Free is new Ada.Unchecked_Deallocation (Mu_World'Class, World_Access);
 
 
     procedure Adjust
-           (This : in out World) is
+           (This : in out Mu_World) is
     begin
         case This.Engine.Kind is
         when No_Gen =>
             null;
         when Fresh_Gen =>
-            This.Engine.FrG_World := new World'(This.Engine.FrG_World.all);
+            This.Engine.FrG_World := new Mu_World'Class'(This.Engine.FrG_World.all);
         when Unify_Gen =>
-            This.Engine.UniG_World := new World'(This.Engine.UniG_World.all);
+            This.Engine.UniG_World := new Mu_World'Class'(This.Engine.UniG_World.all);
         when Disjunct1_Gen =>
-            This.Engine.Dis1G_World := new World'(This.Engine.Dis1G_World.all);
+            This.Engine.Dis1G_World := new Mu_World'Class'(This.Engine.Dis1G_World.all);
         when Disjunct2_Gen =>
-            This.Engine.Dis2G_World1 := new World'(This.Engine.Dis2G_World1.all);
-            This.Engine.Dis2G_World2 := new World'(This.Engine.Dis2G_World2.all);
+            This.Engine.Dis2G_World1 := new Mu_World'Class'(This.Engine.Dis2G_World1.all);
+            This.Engine.Dis2G_World2 := new Mu_World'Class'(This.Engine.Dis2G_World2.all);
         when Recurse_Gen =>
-            This.Engine.RecG_World := new World'(This.Engine.RecG_World.all);
+            This.Engine.RecG_World := new Mu_World'Class'(This.Engine.RecG_World.all);
         end case;
     end Adjust;
 
 
     procedure Finalize
-           (This : in out World) is
+           (This : in out Mu_World) is
     begin
         case This.Engine.Kind is
         when No_Gen =>
@@ -160,15 +160,15 @@ package body Kompsos is
 
 
     function T
-           (Item1, Item2 : in Term)
+           (Item1, Item2 : in Term'Class)
         return Term is
     begin
         return My_Term : Term do
             My_Term.Actual := new Term_Component'(
                 Kind  => Pair_Term,
                 Count => 1,
-                Left  => Item1,
-                Right => Item2);
+                Left  => Term (Item1),
+                Right => Term (Item2));
         end return;
     end T;
 
@@ -348,7 +348,7 @@ package body Kompsos is
     --  Lazy World Generation --
 
     function Has_State
-           (This  : in out World;
+           (This  : in out Mu_World;
             Index : in     Positive)
         return Boolean is
     begin
@@ -358,7 +358,7 @@ package body Kompsos is
 
 
     procedure Roll_Fresh_Gen
-           (This : in out World) is
+           (This : in out Mu_World) is
     begin
         This.Engine.FrG_World.Rollover;
         if This.Engine.FrG_World.Possibles.Last_Index < This.Engine.FrG_Index then
@@ -376,7 +376,7 @@ package body Kompsos is
 
 
     procedure Roll_Unify_Gen
-           (This : in out World)
+           (This : in out Mu_World)
     is
         Extended : State;
     begin
@@ -402,7 +402,7 @@ package body Kompsos is
 
 
     procedure Roll_Disjunct1_Gen
-           (This : in out World) is
+           (This : in out Mu_World) is
     begin
         This.Engine.Dis1G_World.Rollover;
         if This.Engine.Dis1G_World.Possibles.Last_Index < This.Engine.Dis1G_Index then
@@ -417,7 +417,7 @@ package body Kompsos is
 
 
     procedure Roll_Disjunct2_Gen
-           (This : in out World)
+           (This : in out Mu_World)
     is
         Temp_World : World_Access;
         Temp_Index : Positive;
@@ -445,7 +445,7 @@ package body Kompsos is
 
 
     procedure Roll_Recurse_Gen
-           (This : in out World) is
+           (This : in out Mu_World) is
     begin
         This.Engine.RecG_World.Rollover;
         if This.Engine.RecG_World.Possibles.Last_Index < This.Engine.RecG_Index then
@@ -467,7 +467,7 @@ package body Kompsos is
     --  This is intentional to get better behaviour with infinite Worlds.
 
     procedure Rollover
-           (This : in out World) is
+           (This : in out Mu_World) is
     begin
         case This.Engine.Kind is
         when No_Gen        => null;
@@ -481,7 +481,7 @@ package body Kompsos is
 
 
     procedure Roll_Until
-           (This  : in out World;
+           (This  : in out Mu_World;
             Index : in     Positive) is
     begin
         while This.Possibles.Last_Index < Index and This.Engine.Kind /= No_Gen loop
@@ -496,51 +496,38 @@ package body Kompsos is
     --  Public API Operations  --
     -----------------------------
 
-    --  Query  --
-
-    function Failed
-           (This : in out World)
-        return Boolean is
-    begin
-        return not This.Has_State (1);
-    end Failed;
-
-
-
-
     --  Fresh  --
 
     function Fresh
-           (This : in out World)
-        return Variable is
+           (This : in out Mu_World'Class)
+        return Term is
     begin
         return This.Fresh (+"");
     end Fresh;
 
 
     function Fresh
-           (This : in out World;
+           (This : in out Mu_World'Class;
             Name : in     String)
-        return Variable is
+        return Term is
     begin
         return This.Fresh (+Name);
     end Fresh;
 
 
     function Fresh
-           (This : in out World;
+           (This : in out Mu_World'Class;
             Name : in     Ada.Strings.Unbounded.Unbounded_String)
-        return Variable is
+        return Term is
     begin
-        return My_Var : constant Variable := (Ident => This.Next_Ident, Name => Name) do
-            This := (Ada.Finalization.Controlled with
-                Possibles  => State_Vectors.Empty_Vector,
-                Next_Ident => This.Next_Ident + 1,
-                Engine     =>
-                   (Kind      => Fresh_Gen,
-                    FrG_World => new World'(This),
-                    FrG_Index => 1,
-                    FrG_Name  => Name));
+        return My_Term : constant Term := T (Variable'(Ident => This.Next_Ident, Name => Name)) do
+            This.Engine :=
+               (Kind      => Fresh_Gen,
+                FrG_World => new Mu_World'Class'(This),
+                FrG_Index => 1,
+                FrG_Name  => Name);
+            This.Next_Ident := This.Next_Ident + 1;
+            This.Possibles := State_Vectors.Empty_Vector;
         end return;
     end Fresh;
 
@@ -550,71 +537,35 @@ package body Kompsos is
     --  Unify  --
 
     function Unify
-           (This  : in World;
-            Left  : in Variable;
+           (This  : in Mu_World;
+            Left  : in Term'Class;
             Right : in Element_Type)
-        return World is
+        return Mu_World is
     begin
-        return This.Unify (T (Left), T (Right));
+        return This.Unify (Left, T (Right));
     end Unify;
 
 
     procedure Unify
-           (This  : in out World;
-            Left  : in     Variable;
+           (This  : in out Mu_World;
+            Left  : in     Term'Class;
             Right : in     Element_Type) is
     begin
-        This := This.Unify (T (Left), T (Right));
-    end Unify;
-
-
-    function Unify
-           (This        : in World;
-            Left, Right : in Variable)
-        return World is
-    begin
-        return This.Unify (T (Left), T (Right));
-    end Unify;
-
-
-    procedure Unify
-           (This        : in out World;
-            Left, Right : in     Variable) is
-    begin
-        This := This.Unify (T (Left), T (Right));
+        This := This.Unify (Left, T (Right));
     end Unify;
 
 
     function Unify
-           (This  : in World;
-            Left  : in Variable;
-            Right : in Term'Class)
-        return World is
-    begin
-        return This.Unify (T (Left), Right);
-    end Unify;
-
-
-    procedure Unify
-           (This  : in out World;
-            Left  : in     Variable;
-            Right : in     Term'Class) is
-    begin
-        This := This.Unify (T (Left), Right);
-    end Unify;
-
-
-    function Unify
-           (This        : in World;
+           (This        : in Mu_World;
             Left, Right : in Term'Class)
-        return World is
+        return Mu_World is
     begin
-        return Result : constant World := (Ada.Finalization.Controlled with
+        return Result : constant Mu_World := (Ada.Finalization.Controlled with
             Possibles  => State_Vectors.Empty_Vector,
             Next_Ident => This.Next_Ident,
             Engine     =>
                (Kind       => Unify_Gen,
-                UniG_World => new World'(This),
+                UniG_World => new Mu_World'(This),
                 UniG_Index => 1,
                 UniG_Term1 => Term (Left),
                 UniG_Term2 => Term (Right)));
@@ -622,7 +573,7 @@ package body Kompsos is
 
 
     procedure Unify
-           (This        : in out World;
+           (This        : in out Mu_World;
             Left, Right : in     Term'Class) is
     begin
         This := This.Unify (Left, Right);
@@ -634,49 +585,50 @@ package body Kompsos is
     --  Disjunct  --
 
     function Disjunct
-           (Left, Right : in World)
-        return World is
+           (Left, Right : in Mu_World)
+        return Mu_World is
     begin
-        return Result : constant World := (Ada.Finalization.Controlled with
+        return Result : constant Mu_World := (Ada.Finalization.Controlled with
             Possibles  => State_Vectors.Empty_Vector,
             Next_Ident => ID_Number'Max (Left.Next_Ident, Right.Next_Ident),
             Engine     =>
                (Kind         => Disjunct2_Gen,
-                Dis2G_World1 => new World'(Left),
+                Dis2G_World1 => new Mu_World'(Left),
                 Dis2G_Index1 => 1,
-                Dis2G_World2 => new World'(Right),
+                Dis2G_World2 => new Mu_World'(Right),
                 Dis2G_Index2 => 1));
     end Disjunct;
 
 
     procedure Disjunct
-           (This  : in out World;
-            Right : in     World) is
+           (This  : in out Mu_World;
+            Right : in     Mu_World) is
     begin
         This := Disjunct (This, Right);
     end Disjunct;
 
 
     function Disjunct
-           (Inputs : in World_Array)
-        return World is
+           (Inputs : in Mu_World_Array)
+        return Mu_World is
     begin
         if Inputs'Length = 0 then
-            return Failed : constant World := (Ada.Finalization.Controlled with
+            return Failed : constant Mu_World := (Ada.Finalization.Controlled with
                 Possibles  => State_Vectors.Empty_Vector,
                 Next_Ident => 0,
                 Engine     => (Kind => No_Gen));
         elsif Inputs'Length = 1 then
             return Inputs (Inputs'First);
         else
-            return Result : World := (Ada.Finalization.Controlled with
+            return Result : Mu_World := (Ada.Finalization.Controlled with
                 Possibles  => State_Vectors.Empty_Vector,
                 Next_Ident => 0,  --  dummy
                 Engine     =>
                    (Kind         => Disjunct2_Gen,
-                    Dis2G_World1 => new World'(Inputs (Inputs'First)),
+                    Dis2G_World1 => new Mu_World'(Inputs (Inputs'First)),
                     Dis2G_Index1 => 1,
-                    Dis2G_World2 => new World'(Disjunct (Inputs (Inputs'First + 1 .. Inputs'Last))),
+                    Dis2G_World2 =>
+                        new Mu_World'(Disjunct (Inputs (Inputs'First + 1 .. Inputs'Last))),
                     Dis2G_Index2 => 1))
             do
                 Result.Next_Ident := ID_Number'Max
@@ -688,8 +640,8 @@ package body Kompsos is
 
 
     procedure Disjunct
-           (This   : in out World;
-            Inputs : in     World_Array) is
+           (This   : in out Mu_World;
+            Inputs : in     Mu_World_Array) is
     begin
         This := Disjunct (This & Inputs);
     end Disjunct;
@@ -700,21 +652,21 @@ package body Kompsos is
     --  Recurse  --
 
     function Recurse
-           (This : in World)
-        return World is
+           (This : in Mu_World)
+        return Mu_World is
     begin
-        return Result : constant World := (Ada.Finalization.Controlled with
+        return Result : constant Mu_World := (Ada.Finalization.Controlled with
             Possibles  => State_Vectors.Empty_Vector,
             Next_Ident => This.Next_Ident,
             Engine     =>
                (Kind       => Recurse_Gen,
-                RecG_World => new World'(This),
+                RecG_World => new Mu_World'(This),
                 RecG_Index => 1));
     end Recurse;
 
 
     procedure Recurse
-           (This : in out World) is
+           (This : in out Mu_World) is
     begin
         This := This.Recurse;
     end Recurse;
@@ -725,9 +677,9 @@ package body Kompsos is
     --  Forced Evaluation  --
 
     function Take
-           (This  : in World;
+           (This  : in Mu_World;
             Count : in Natural)
-        return World is
+        return Mu_World is
     begin
         if Count = 0 then
             return (Ada.Finalization.Controlled with
@@ -735,7 +687,7 @@ package body Kompsos is
                 Next_Ident => ID_Number'First,
                 Engine     => (Kind => No_Gen));
         end if;
-        return Result : World := This do
+        return Result : Mu_World := This do
             Result.Roll_Until (Count);
             if Result.Possibles.Last_Index > Count then
                 Result.Possibles.Set_Length (Ada.Containers.Count_Type (Count));
@@ -746,7 +698,7 @@ package body Kompsos is
 
 
     procedure Take
-           (This  : in out World;
+           (This  : in out Mu_World;
             Count : in     Natural) is
     begin
         This := This.Take (Count);
@@ -754,7 +706,7 @@ package body Kompsos is
 
 
     procedure Force
-           (This  : in out World;
+           (This  : in out Mu_World;
             Count : in     Positive) is
     begin
         This.Roll_Until (Count);
@@ -762,7 +714,7 @@ package body Kompsos is
 
 
     procedure Force_All
-           (This : in out World) is
+           (This : in out Mu_World) is
     begin
         while This.Engine.Kind /= No_Gen loop
             This.Rollover;
@@ -770,6 +722,14 @@ package body Kompsos is
     end Force_All;
 
 
+    function Failed
+           (This : in out Mu_World)
+        return Boolean is
+    begin
+        return not This.Has_State (1);
+    end Failed;
+
+
 end Kompsos;