elipl/tpl_prolog.exs

Code.require_file("tpl.exs")

defmodule TplProlog do
  # Prolog comparison/arithmetic operators not in the TPL precedence table.
  # These remain in natural order [lhs, op, rhs] in the AST.
  @infix_ops ["\\=", ">=", "=<", ">", "<", "is", "==", "\\==", "=:=", "=\\="]

  # --- Public API ---

  def to_prolog(ast_nodes) do
    ast_nodes
    |> Enum.reject(&skip?/1)
    |> Enum.map(&emit(&1, :top))
    |> Enum.reject(&is_nil/1)
    |> Enum.join("\n")
  end

  # --- Node emitters ---

  # emit/2: convert one AST node to a Prolog string in the given context.
  # context is :top (clause level), :body (goal), or :arg (term inside a call).

  defp emit(%{t: :sexp, list: list}, ctx), do: sexp(clean(list), ctx)
  defp emit(%{t: :brace, list: list}, _ctx), do: body(list)
  defp emit(%{t: :token, str: s}, _ctx), do: s
  defp emit(%{t: :string, chunks: chunks, values: []}, _ctx), do: ~s("#{Enum.join(chunks)}")
  defp emit(%{t: :string, chunks: chunks, values: values}, _ctx) do
    # Best-effort: interleave chunks and values
    max = max(length(chunks), length(values))

    Enum.flat_map(0..(max - 1), fn i ->
      chunk = if i < length(chunks), do: [Enum.at(chunks, i)], else: []
      value = if i < length(values), do: ["#{emit(Enum.at(values, i), :arg)}"], else: []
      chunk ++ value
    end)
    |> Enum.join()
    |> then(&~s("#{&1}"))
  end
  defp emit(%{t: t}, _ctx) when t in [:newline, :comment, :dot, :comma], do: nil

  # --- Helpers ---

  defp skip?(%{t: t}) when t in [:newline, :comment], do: true
  defp skip?(_), do: false

  defp clean(list), do: Enum.reject(list, &skip?/1)

  defp dot(s), do: s <> "."
  defp maybe_dot(s, :top), do: dot(s)
  defp maybe_dot(s, _), do: s

  # term/1: list of head nodes -> Prolog term (functor with args, or atom)
  defp term([%{t: :token, str: f}]), do: f
  defp term([%{t: :token, str: f} | args]) do
    args_s = args |> Enum.map(&emit(&1, :arg)) |> Enum.reject(&is_nil/1) |> Enum.join(", ")
    if args_s == "", do: f, else: "#{f}(#{args_s})"
  end
  defp term([single]), do: emit(single, :arg)
  defp term(nodes), do: nodes |> Enum.map(&emit(&1, :arg)) |> Enum.reject(&is_nil/1) |> Enum.join(", ")

  # body/1: goal list from a brace block -> comma-joined conjunction string
  defp body(list) do
    goals =
      list
      |> Enum.reject(&skip?/1)
      |> Enum.map(&emit(&1, :body))
      |> Enum.reject(&is_nil/1)

    case goals do
      [] -> "true"
      _ -> Enum.join(goals, ",\n    ")
    end
  end

  # findall_body: inline conjunction with parens for multi-goal bodies.
  # Avoids findall(T, goal1,\n    goal2, R) misparse.
  defp findall_body(list) do
    goals = list |> Enum.reject(&skip?/1) |> Enum.map(&emit(&1, :body)) |> Enum.reject(&is_nil/1)
    case goals do
      [] -> "true"
      [single] -> single
      multiple -> "(#{Enum.join(multiple, ", ")})"
    end
  end

  defp brace?(%{t: :brace}), do: true
  defp brace?(_), do: false

  # --- S-expression dispatch ---

  # Any sexp whose last element is a brace is a rule (or DCG rule).
  # e.g.  ancestor X Y { parent X Z, ancestor Z Y }
  #       dcg command (cmd A T) { verb A, noun T }
  defp sexp(list, ctx) when length(list) >= 2 do
    head = Enum.drop(list, -1)
    last = List.last(list)

    # A rule has exactly one trailing brace (the body) and no braces in the head.
    # This excludes `or { A } { B }` where the head itself contains braces.
    if brace?(last) and not Enum.any?(head, &brace?/1) do
      body_s = body(last.list)

      case head do
        [%{t: :token, str: "dcg"} | rest] ->
          "#{term(rest)} --> #{body_s}" |> maybe_dot(ctx)

        _ ->
          "#{term(head)} :- #{body_s}" |> maybe_dot(ctx)
      end
    else
      sexp_no_rule(list, ctx)
    end
  end

  defp sexp(list, ctx), do: sexp_no_rule(list, ctx)

  defp sexp_no_rule(list, ctx) do
    case list do
      # ── Findall ──────────────────────────────────────────────────────────────
      # Var = find Template { Goals }
      # AST (after precedence pass): [token:=, token:Var, sexp:[find, Template, brace:Goals]]
      [%{t: :token, str: "="}, %{t: :token, str: var}, %{t: :sexp, list: rhs}] ->
        rhs_clean = clean(rhs)

        if match?([%{t: :token, str: "find"} | _], rhs_clean) and
             length(rhs_clean) >= 3 and brace?(List.last(rhs_clean)) do
          [_ | rest] = rhs_clean
          {tmpl_nodes, [brace]} = Enum.split(rest, length(rest) - 1)
          tmpl_s = term(tmpl_nodes)
          goal_s = findall_body(brace.list)
          "findall(#{tmpl_s}, #{goal_s}, #{var})" |> maybe_dot(ctx)
        else
          rhs_s = sexp(rhs_clean, :arg)
          "#{var} = #{rhs_s}" |> maybe_dot(ctx)
        end

      # ── Assignment / unification ─────────────────────────────────────────────
      # = lhs rhs  (operator-first because = is in the TPL precedence table)
      [%{t: :token, str: "="}, lhs, rhs] ->
        "#{emit(lhs, :body)} = #{emit(rhs, :body)}" |> maybe_dot(ctx)

      # ── Infix comparison operators (not in TPL table, stay in natural order) ──
      # e.g.  A >= 18  ,  X \= Y
      [lhs, %{t: :token, str: op}, rhs] when op in @infix_ops ->
        "#{emit(lhs, :body)} #{op} #{emit(rhs, :body)}"

      # ── Disjunction ──────────────────────────────────────────────────────────
      # or { goalA } { goalB } ...
      [%{t: :token, str: "or"} | branches] ->
        branches
        |> Enum.filter(&match?(%{t: :brace}, &1))
        |> Enum.map(&emit(&1, :body))
        |> Enum.join(" ; ")
        |> then(&"(#{&1})")

      # ── Negation ─────────────────────────────────────────────────────────────
      # not goal...
      [%{t: :token, str: "not"} | goals] ->
        "\\+ #{term(goals)}"

      # ── General functor call / fact ──────────────────────────────────────────
      [%{t: :token, str: f} | args] ->
        args_s = args |> Enum.map(&emit(&1, :arg)) |> Enum.reject(&is_nil/1) |> Enum.join(", ")
        (if args_s == "", do: f, else: "#{f}(#{args_s})") |> maybe_dot(ctx)

      # ── Fallback ─────────────────────────────────────────────────────────────
      _ ->
        list
        |> Enum.map(&emit(&1, :body))
        |> Enum.reject(&is_nil/1)
        |> Enum.join(" ")
        |> maybe_dot(ctx)
    end
  end
end


# ── Demo ──────────────────────────────────────────────────────────────────────

prolog_code =
  """
  parent elizabeth charles
  parent charles william
  parent charles harry

  male charles
  male william
  male harry
  female elizabeth

  age charles 75
  age william 42
  age harry 40

  person X {
    male X
  }

  grandparent G C {
    parent G P
    parent P C
    (G \= C)
  }

  is_adult Person {
    age Person A
    A >= 18
  }

  ancestor X Y {
    parent X Z
    ancestor Z Y
  }

  child_or_pet_owner X {
    or {
      parent X _
    } {
      owns_pet X _
    }
  }

  is_childless X {
    person X
    not parent X _
  }

  Adults = find P {
    person P
    is_adult P
  }

  dcg command (cmd Action Target) {
    verb Action
    noun Target
  }

  dcg verb (action find) { "find" }
  dcg noun (obj harry)   { "harry" }

  dcg sentence {
    noun_phrase
    verb_phrase
  }
  """
  |> Tpl.to_ast()
  |> TplProlog.to_prolog()

IO.puts("\n--- Generated Prolog ---")
IO.puts(prolog_code)
IO.puts("------------------------\n")