exo

defmodule Exo do
  @moduledoc """
  Logic programming in elixir.
  """

  defmodule Var do
    defstruct [
      id: 0
    ]
    @type t :: %Var{id: integer}

    @spec c(integer) :: Var.t
    def c(id) do
      %Var{id: id}
    end

    @spec p(any) :: boolean
    def p(x) do
      case x do
        %Var{} -> true
        _ -> false
      end
    end
  end

  @typedoc"""
  We tried to support all unifiable datatype of elixir.
  """
  @type value :: atom | integer | String.t | Var.t | [value]
  @type substitution :: %{required(Var.t) => value}

  @doc"""
  One-step walking

  Walking until the value is not Var.t,
  which does not care about other vars in the result value.
  """
  @spec walk(value, substitution) :: value
  def walk(u, s) do
    case u do
      %Var{} ->
        case Map.fetch(s, u) do
          {:ok, v} -> walk(v, s)
          :error -> u
        end

      _ -> u
    end
  end

  @spec unify(substitution, value, value) :: substitution | false
  def unify(s, u, v) do
    u = walk(u, s)
    v = walk(v, s)
    case {u, v} do
      {%Var{id: id}, %Var{id: id}} -> s

      {%Var{}, _} -> Map.put(s, u, v)

      {_, %Var{}} -> Map.put(s, v, u)

      {[u_head | u_tail], [v_head | v_tail]} ->
        s = unify(s, u_head, v_head)
        s && unify(s, u_tail, v_tail)

      _ -> u === v && s
    end
  end

  defmodule State do
    defstruct [
      id_counter: 0,
      substitution: %{}
    ]
    @type t :: %State{
      id_counter: integer,
      substitution: Exo.substitution
    }

    @spec c(integer, Exo.substitution) :: State.t
    def c(c, s) do
      %State{id_counter: c, substitution: s}
    end
  end

  @spec empty_state() :: State.t
  def empty_state do
    State.c(0, %{})
  end

  @type state_stream ::
          maybe_improper_list(State.t, state_stream)
          | (-> state_stream)

  @type goal :: (State.t -> state_stream)

  @doc"""
  Perform the unification.
  """
  @spec eqo(value, value) :: goal
  def eqo(u, v) do
    fn state ->
      s = unify(Map.get(state, :substitution), u, v)
      if s do
        [%State{state | substitution: s}]
      else
        []
      end
    end
  end

  @doc"""
  Infix version of `eqo/2`.

            The Law of <~>
      v <~> w  is the same as  w <~> v.
  """
  @spec value <~> value :: goal
  def x <~> y do
    eqo(x, y)
  end

  @spec call_with_fresh((Var.t -> goal)) :: goal
  def call_with_fresh(fun) do
    fn state ->
      id = Map.get(state, :id_counter)
      goal = fun.(Var.c(id))
      goal.(%State{state | id_counter: id+1})
    end
  end

  @spec disj(goal, goal) :: goal
  def disj(g1, g2) do
    fn state ->
      s1 = g1.(state)
      s2 = g2.(state)
      mplus(s1, s2)
    end
  end

  @spec conj(goal, goal) :: goal
  def conj(g1, g2) do
    fn state ->
      s1 = g1.(state)
      bind(s1, g2)
    end
  end

  @spec mplus(state_stream, state_stream) :: state_stream
  def mplus(s1, s2) do
    case s1 do
      [] -> s2

      trunk when is_function(trunk) ->
        # - to use interleaving :
        #   to implement a complete search strategy
        #   ><><>< maybe we can use actor model to parallelize this
        # fn -> mplus(s2, trunk.()) end
        # - no interleaving :
        fn -> mplus(trunk.(), s2) end

      [head | tail] -> [head | mplus(tail, s2)]
    end
  end

  @spec bind(state_stream, goal) :: state_stream
  def bind(s, g) do
    case s do
      [] -> []

      trunk when is_function(trunk) ->
        fn -> bind(trunk.(), g) end

      [head | tail] -> mplus(g.(head), bind(tail, g))
    end
  end

  @doc"""
  Invers-η-delay

  The act of performing an inverse-η on a goal
  and then wrapping its body in a lambda
  we refer to as inverse-η-delay.

  Invers-η-delay is an operation that
  takes a goal and returns a goal,
  as the result of doing so on any goal g
  is a function from a state to a stream.
  """
  defmacro zzz(g) do
    quote do
      fn state ->
        fn ->
          unquote(g).(state)
        end
      end
    end
  end

  @doc"""
  A macro for `conj/2` -- the logic and.

  Example macro expanding :

      ando do
        g1
        g2
        g3
      end

      # = expand to =>

      conj(zzz(g1),
        conj(zzz(g2),
          zzz(g3)))
  """
  defmacro ando(exp) do
    case exp do
      [do: {:__block__, _, list}] ->
        quote do
          ando(unquote(list))
        end

      [do: single] ->
        quote do
          ando(unquote([single]))
        end

      [head | []] ->
        quote do
          zzz(unquote(head))
        end

      [head | tail] ->
        quote do
          conj(zzz(unquote(head)), ando(unquote(tail)))
        end
    end
  end

  @doc"""
  A macro for `disj/2` -- the logic or.

  Just like `ando/1`.
  """
  defmacro oro(exp) do
    case exp do
      [do: {:__block__, _, list}] ->
        quote do
          oro(unquote(list))
        end

      [do: single] ->
        quote do
          oro(unquote([single]))
        end

      [head | []] ->
        quote do
          zzz(unquote(head))
        end

      [head | tail] ->
        quote do
          disj(zzz(unquote(head)), oro(unquote(tail)))
        end
    end
  end

  @doc"""
  A macro to create fresh logic variables.

            The Law of Fresh
      If x is fresh, then  v <~> x  succeeds
      and associates x with v.

  Example macro expanding :

      fresh [a, b, c] do
        g1
        g2
        g3
      end

      # = expand to =>

      call_with_fresh fn a ->
        call_with_fresh fn b ->
          call_with_fresh fn c ->
            ando do
              g1
              g2
              g3
            end
          end
        end
      end
  """
  defmacro fresh(var_list, exp) do
    case var_list do
      {_, _, atom} when is_atom(atom) ->
        var_list = [var_list]
        quote do
          fresh(unquote(var_list), unquote(exp))
        end

      [var | []] ->
        quote do
          call_with_fresh fn unquote(var) ->
            ando(unquote(exp))
          end
        end

      [var | tail] ->
        quote do
          call_with_fresh fn unquote(var) ->
            fresh(unquote(tail), unquote(exp))
          end
        end
    end
  end

  @doc"""
  A macro for a list `ando/1` in `oro/1`.

            The Law of conde
      To get more values from conde ,
      pretend that the successful conde
      line has failed, refreshing all variables
      that got an association from that line.

  - conde is written conde and is pronounced “con-dee”.

  - conde is the default control mechanism of Prolog.
    See William F. Clocksin. Clause and Effect. Springer, 1997.
  """
  defmacro conde(exp) do
    case exp do
      [do: {:__block__, _, list}] ->
        quote do
          conde(unquote(list))
        end

      [do: single] ->
        quote do
          conde(unquote([single]))
        end

      [exp_list | []] ->
        quote do
          ando(unquote(exp_list))
        end

      [exp_list | tail] ->
        quote do
          disj(zzz(ando(unquote(exp_list))), conde(unquote(tail)))
        end
    end
  end

  @spec pull(state_stream) :: state_stream
  def pull(state_stream) do
    if is_function(state_stream) do
      pull(state_stream.())
    else
      state_stream
    end
  end

  @spec take_all(state_stream) :: [State.t]
  def take_all(state_stream) do
    state_stream = pull(state_stream)
    case state_stream do
      [] -> []
      [head | tail] -> [head | take_all(tail)]
    end
  end

  @spec take(state_stream, non_neg_integer) :: [State.t]
  def take(state_stream, n) do
    if n === 0 do
      []
    else
      state_stream = pull(state_stream)
      case state_stream do
        [] -> []
        [head | tail] -> [head | take(tail, n-1)]
      end
    end
  end

  @spec mk_reify([State.t]) :: [value]
  def mk_reify(state_list) do
    Enum.map(state_list, &reify_state_with_1st_var/1)
  end

  @spec reify_state_with_1st_var(State.t) :: value
  def reify_state_with_1st_var(state) do
    s = Map.get(state, :substitution)
    v = deep_walk(Var.c(0), s)
    deep_walk(v, reify_s(v, %{}))
  end

  @spec deep_walk(value, substitution) :: value
  def deep_walk(v, s) do
    v = walk(v, s)
    case v do
      %Var{} -> v
      [head | tail] -> [deep_walk(head, s) | deep_walk(tail, s)]
      _ -> v
    end
  end

  @spec reify_s(value, substitution) :: substitution
  def reify_s(v, s) do
    v = walk(v, s)
    case v do
      %Var{} -> Map.put(s, v, reify_name(length(Map.keys(s))))
      [head | tail] -> reify_s(tail, reify_s(head, s))
      _ -> s
    end
  end

  @spec reify_name(integer) :: atom
  def reify_name(n) do
    n
    |> Integer.to_string()
    |> (fn s -> "_" <> s end).()
    |> String.to_atom()
  end

  @spec call_with_empty_state(goal) :: state_stream
  def call_with_empty_state(goal) do
    goal.(empty_state())
  end

  defmacro run(n, var, exp) do
    quote do
      fresh(unquote(var), unquote(exp))
      |> call_with_empty_state()
      |> take(unquote(n))
      |> mk_reify()
    end
  end

  defmacro run(var, exp) do
    quote do
      fresh(unquote(var), unquote(exp))
      |> call_with_empty_state()
      |> take_all()
      |> mk_reify()
    end
  end

  @doc"""
  A goal that succeeds.
  """
  def succeed do
    fn state -> [state] end
  end

  @doc"""
  A goal that fails.
  """
  def fail do
    fn _state -> [] end
  end
end