Jam/feature/constraints

lib/AL.ex

@@ -70,9 +70,13 @@ defmodule AL do
           | {:retract_super, AL.Var.t(), AL.Var.t()}
           | {:retract_method, AL.Var.t(), AL.Var.t(), AL.Var.t()}
           | {:retract_oapply, AL.Var.t(), AL.Var.t()}
-          | {:spawn_process, AL.Var.t(), AL.Var.t(), [goal()]}
+          | {:send_async, AL.Var.t(), AL.Var.t(), AL.Var.t()}
+          | {:send_elixir, AL.Var.t(), AL.Var.t()}
           | {:gensym, AL.Var.t()}
           | {:print, AL.Var.t()}
+          | {:not, [goal()]}
+          | {:unify, AL.Var.t(), AL.Var.t()}
+          | {:call, [AL.Var.t()], [goal()], [AL.Var.t()]}
           | :fail
 
   @type stack_entry() :: AL.Choicepoint.t() | {:mark, scope()} | :implies_mark
@@ -174,8 +178,20 @@ defmodule AL do
 
   def ast_to_pattern({:findall, _, [template, condition, result]}),
     do: {:findall, ast_to_pattern(template), ast_to_pattern(condition), ast_to_pattern(result)}
-  def ast_to_pattern({:spawn_process, _, [object, head, body]}),
-    do: {:spawn_process, ast_to_pattern(object), ast_to_pattern(head), ast_to_pattern(body)}
+
+  def ast_to_pattern({:not, _, [goals]}),
+    do: {:not, ast_to_pattern(goals)}
+
+  def ast_to_pattern({:unify, _, [a, b]}),
+    do: {:unify, ast_to_pattern(a), ast_to_pattern(b)}
+
+  def ast_to_pattern({:call, _, [head, body, args]}),
+    do: {:call, ast_to_pattern(head), ast_to_pattern(body), ast_to_pattern(args)}
+  def ast_to_pattern({:send_async, _, [object, method, args]}),
+    do: {:send_async, ast_to_pattern(object), ast_to_pattern(method), ast_to_pattern(args)}
+
+  def ast_to_pattern({:send_elixir, _, [pid, message]}),
+    do: {:send_elixir, ast_to_pattern(pid), ast_to_pattern(message)}
 
   def ast_to_pattern({:defmethod, _, [class, method_name, head, body]}) do
     {:oapply, :defmethod, [
@@ -191,6 +207,8 @@ defmodule AL do
 
   def ast_to_pattern({name, _, _module}), do: AL.Var.var(name)
 
+  def ast_to_pattern({a, b}), do: {ast_to_pattern(a), ast_to_pattern(b)}
+
   def ast_to_pattern(x), do: x
 
   @doc """
@@ -275,7 +293,7 @@ defmodule AL do
           tx_id: tx_id,
           trace: [],
           program: program
-        })
+                 })
 
       if result.active_choicepoint.bindings == nil do
         :mnesia.abort(format_failure(result.trace))
@@ -355,7 +373,7 @@ defmodule AL do
   @spec continue(t()) :: t() | nil
   def continue(nil), do: nil
 
-  def continue(state) do
+  def continue(state) do    
     cond do
       state.active_choicepoint.bindings == nil ->
         backtrack(state)
@@ -394,7 +412,6 @@ defmodule AL do
         }
 
         result = interp(goal, next_frame)
-
         continue(result)
     end
   end
@@ -422,6 +439,14 @@ defmodule AL do
               }
           }
       end
+    else if is_list(object_pattern) do
+      %AL{
+        state
+        | active_choicepoint: %AL.Choicepoint{
+            state.active_choicepoint
+            | bindings: AL.Var.unify(:list, class_pattern, state.active_choicepoint.bindings)
+          }
+      }
     else
       case AL.Objects.scan_class(object_pattern, class_pattern) do
         [] ->
@@ -454,6 +479,7 @@ defmodule AL do
           }
       end
     end
+    end
   end
 
   def interp({:get_super, object_pattern, super_pattern}, state) do
@@ -583,9 +609,7 @@ defmodule AL do
            AL.Var.unify({k_pattern, v_pattern}, pair, state.active_choicepoint.bindings)
          end)
          |> Enum.filter(fn t -> t end) do
-      [] ->
-        backtrack(state)
-
+      [] -> backtrack(state)
       [choice | next_choices] ->
         %AL{
           state
@@ -652,19 +676,19 @@ defmodule AL do
         %AL{
           state
           | active_choicepoint: %AL.Choicepoint{
-              goals: body_pattern,
-              bindings:
-                AL.Var.unify(
-                  {head_pattern, id},
-                  {bind_head_pattern, method_id_pattern},
-                  state.active_choicepoint.bindings
-                ),
-              continuations: [continuation | state.active_choicepoint.continuations],
-              goal_pointer: 0,
-              scope_pointer: freshener
-            },
-            choicepoint_stack:
-              alternative_choicepoints ++ [{:mark, freshener} | state.choicepoint_stack]
+            goals: body_pattern,
+            bindings:
+            AL.Var.unify(
+              {head_pattern, id},
+              {bind_head_pattern, method_id_pattern},
+              state.active_choicepoint.bindings
+            ),
+            continuations: [continuation | state.active_choicepoint.continuations],
+            goal_pointer: 0,
+            scope_pointer: freshener
+          },
+          choicepoint_stack:
+          alternative_choicepoints ++ [{:mark, freshener} | state.choicepoint_stack]
         }
     end
   end
@@ -673,11 +697,12 @@ defmodule AL do
     %AL{
       state
       | active_choicepoint: state.active_choicepoint,
-        choicepoint_stack:
-          Enum.drop_while(state.choicepoint_stack, fn choice ->
-            case choice do
-              {:mark, f} -> f != state.active_choicepoint.scope_pointer
-              _choice -> true
+      choicepoint_stack:
+      Enum.drop_while(state.choicepoint_stack, fn choice ->
+        case choice do
+          {:mark, f} ->
+            f != state.active_choicepoint.scope_pointer
+          _choice -> true
             end
           end)
     }
@@ -849,12 +874,16 @@ defmodule AL do
     state
   end
 
-  def interp({:spawn_process, object, head, body}, state) do
-    AL.Command.spawn_process(state.tx_id, object, head, body)
-
+  def interp({:send_async, object, method, args}, state) do
+    AL.Command.send_async(state.tx_id, object, method, args)
     state
   end
 
+  def interp({:send_elixir, pid, message}, state) do
+    AL.Command.send_elixir(state.tx_id, pid, message)
+    state
+  end
+
   def interp({:gensym, var}, state) do
     sym = :crypto.strong_rand_bytes(16) |> Base.encode16(case: :lower) |> String.to_atom()
 
@@ -903,6 +932,49 @@ defmodule AL do
     }
   end
 
+  def interp({:call, head, body, args}, state) do
+    freshener = AL.Command.fresh_scope()
+    fresh_head = AL.Var.freshen(head, freshener)
+    fresh_body = AL.Var.freshen(body, freshener)
+
+    bindings = AL.Var.unify(fresh_head, args, state.active_choicepoint.bindings)
+
+    if bindings == nil do
+      backtrack(state)
+    else
+      continuation = %AL.Continuation{
+        goals: state.active_choicepoint.goals,
+        goal_pointer: state.active_choicepoint.goal_pointer,
+        scope_pointer: state.active_choicepoint.scope_pointer
+      }
+
+      %AL{state |
+        active_choicepoint: %AL.Choicepoint{
+          goals: fresh_body,
+          bindings: bindings,
+          continuations: [continuation | state.active_choicepoint.continuations],
+          goal_pointer: 0,
+          scope_pointer: freshener
+        },
+        choicepoint_stack: [{:mark, freshener} | state.choicepoint_stack]
+      }
+    end
+  end
+
+  def interp({:unify, a, b}, state) do
+    case AL.Var.unify(a, b, state.active_choicepoint.bindings) do
+      nil -> backtrack(state)
+      bindings -> %AL{state | active_choicepoint: %AL.Choicepoint{state.active_choicepoint | bindings: bindings}}
+    end
+  end
+
+  def interp({:not, condition}, state) do
+    case collect_all_solutions(condition, state.active_choicepoint.bindings, state.tx_id) do
+      [] -> state
+      _ -> backtrack(state)
+    end
+  end
+
   def interp(:fail, state) do
     backtrack(state)
   end

lib/AL/application.ex

@@ -5,7 +5,6 @@ defmodule AL.Application do
   """
 
   use Application
-  use AL
 
   @impl true
   def start(_type, _args) do
@@ -22,126 +21,14 @@ defmodule AL.Application do
 
   def bootstrap() do
     case :mnesia.table_info(:command, :size) do
-      0 -> do_bootstrap()
-      _ -> :ok
-    end
-  end
-
-  defp do_bootstrap() do
-    run do
-      set_class(:class, :class)
-      set_class(:object, :class)
-      set_class(:behaviour, :class)
-
-      set_super(:class, :object)
-      set_super(:behaviour, :object)
-
-      set_method(:object, :lookup, :lookup)
-      set_method(:object, :send, :send)
-      set_method(:object, :meta, :metaclass)
-      set_method(:object, :defmethod, :defmethod)
-
-      set_class(:metaclass, :behaviour)
-
-      set_oapply(:metaclass, [self, class, meta]) do
-        class(self, class)
-        class(class, meta)
-      end
-
-      set_class(:lookup, :behaviour)
-      set_oapply(
-        :lookup,
-        [self, name, id]
-      ) do
-        alternative([method(self, name, id)],
-          [super(self, super),
-           lookup(super, name, id)])
-      end
-
-      set_class(:send, :behaviour)
-
-      set_oapply(
-        :send,
-        [self, method, args]
-      ) do
-        class(self, class)
-        implies(
-          [lookup(class, method, id)],
-          [
-            print(["calling", id, "from", class, "with args", [self | args]]),
-            oapply(id, [self | args])
-          ],
-          [:fail]
-        )
-      end
-
-      set_class(:defmethod, :behaviour)
-      set_oapply(:defmethod, [self, method_name, head, body]) do
-        fresh_id(impl)
-        set_method(self, method_name, impl)
-        set_class(impl, :behaviour)
-        set_oapply(impl, head, body)
-      end
-
-      set_class(:map_get, :behaviour)
-      set_method(:map, :map_get, :map_get)
-
-      defmethod(:class, :construct, [self, %{class: self}]) do
-      end
-
-      set_method(:class, :allocate, :allocate_class)
-      set_class(:allocate_class, :behaviour)
-
-      set_oapply(
-        :allocate_class,
-        [self, args, name]
-      ) do
-        map_get(args, :name, name)
-        map_get(args, :super, super)
-        map_get(args, :slots, slots)
-
-        class(self, meta)
-
-        set_class(name, meta)
-        set_super(name, super)
-        set_slots(name, slots)
-      end
-
-      defmethod(:object, :allocate, [self, _, self]) do
-        print(["allocate", self])
-      end
-
-      defmethod(:object, :init, [self, _, self]) do
-        print(["initialise", self])
-      end
-
-      defmethod(:class, :new, [self, args, new]) do
-        send(self, :construct, [construct])
-        send(construct, :allocate, [args, alloc])
-        send(alloc, :init, [args, new])
-      end
-
-      defmethod(:object, :examine, [self, %{classes: classes,
-                                            objects: objects,
-                                            supers: supers,
-                                            subs: subs,
-                                            methods: methods,
-                                            clauses: clauses}]) do
-        findall(c, [class(self, c)], classes)
-        findall(c, [class(c, self)], objects)
-        findall(s, [super(self, s)], supers)
-        findall(sub, [super(sub, self)], subs)
-        findall([n, id], [method(self, n, id)], methods)
-        findall([head, body], [clause(self, head, body)], clauses)
-      end
-
-      send(:class, :new, [%{name: :process, super: :object, slots: []}, _])      
-      defmethod(:process, :init, [self, args, new_obj]) do
-        map_get(args, :head, head)
-        map_get(args, :body, body)
-        gensym(new_obj)
-        spawn_process(new_obj, head, body)
-      end
+      0 ->
+        AL.Bootstrap.Core.setup()
+        AL.Bootstrap.Lists.setup()
+        AL.Bootstrap.ElixirProcess.setup()
+        AL.Bootstrap.Process.setup()
+        AL.Bootstrap.Constraints.setup()
+      _ ->
+        :ok
     end
   end
 end