HeroLISP.livemd

HeroLisp Testing.livemd

NimbleParsec Playground

Mix.install([
  {:nimble_parsec, "~> 1.0"}
])

My first ever try to make a LISP with

I've tried to make a LISP by try parsing like it has a more complex AST.

defmodule LispParser1 do
  import NimbleParsec

  def as_identifier(value), do: {:identifier, value}
  def as_fun_def(value), do: {:function, value}
  def as_apply(value), do: {:apply, value}
  def as_args(value), do: {:args, value}
  def as_block(value), do: {:block, value}

  def fn_to_map(function: value) do
    defun =
      value
      |> Enum.filter(&(&1 != :defn))
      |> Enum.into(%{})

    defun =
      defun
      |> Map.put(:arity, Enum.count(defun.args))

    {:defn, defun}
  end

  defcombinatorp(
    :identifier_tail,
    ascii_string(~c"-", 1)
    |> concat(ascii_string([?a..?z], min: 1))
  )

  defcombinatorp(
    :identifier,
    [?a..?z]
    |> ascii_string(min: 1)
    |> concat(times(parsec(:identifier_tail), min: 0))
    |> reduce({Enum, :join, []})
    |> map(:as_identifier)
  )

  defcombinatorp(
    :multi_identifier,
    optional(
      concat(parsec(:identifier), times(concat(ignore(string(" ")), parsec(:identifier)), min: 0))
    )
  )

  defcombinatorp(
    :defn,
    [?(]
    |> ascii_char()
    |> ignore()
    |> concat(string("defn") |> replace(:defn))
    |> concat(ignore(string(" ")))
    |> concat(parsec(:identifier))
    |> concat(ignore(string(" ")))
    |> concat(ignore(ascii_char([?[])))
    |> concat(parsec(:multi_identifier) |> reduce(:as_args))
    |> concat(ignore(ascii_char([?]])))
    |> concat(ignore(string(" ")))
    |> lookahead_not(ascii_char([?a..?z, ?A..?Z, ?0..?9]))
    |> concat(parsec(:expr) |> reduce(:as_block))
    |> concat(ignore(ascii_char([?)])))
    |> reduce(:as_fun_def)
    |> reduce(:fn_to_map)
  )

  defcombinatorp(
    :expr_separated_by_space,
    [?a..?z, ?A..?Z, ?0..?9]
    |> ascii_char()
    |> lookahead_not()
    |> concat(parsec(:expr))
    |> times(min: 0)
  )

  defcombinatorp(
    :apply,
    [?(]
    |> ascii_char()
    |> ignore()
    |> concat(parsec(:identifier))
    |> concat(parsec(:expr_separated_by_space) |> reduce(:as_args))
    |> concat(ignore(ascii_char([?)])))
    |> reduce(:as_apply)
  )

  defparsec(
    :expr,
    choice([
      integer(min: 1),
      parsec(:apply)
    ])
  )

  defparsec(
    :test,
    parsec(:defn)
  )

  # ascii_char([?(])
  # |> ignore()
  # |> concat(parsec(:identifier))
  # |> ignore(ascii_char([?)]))
end

Testing the parser

LispParser1.test("(defn add-abc-kleber [x y z] (abc))")

After some testing, and talking to people that know more about lisp than me, I decided to rewrite the parser to be closer to what a LISP.

New Parser

I decided to break up the responsabilities into separated modules so it's not a pain to expand.

defmodule LispParser do
  @moduledoc """
  Module responsible for parsing my strange lisp
  """
  import NimbleParsec

  def wrap_identifier(value), do: {:identifier, value}

  def parse_hex(["0x" <> rest]) do
    String.to_integer(rest, 16)
  end

  def parse_bin(["0b" <> rest]) do
    String.to_integer(rest, 2)
  end

  def wrap_atom([value]), do: {:atom, value}
  def wrap_string([value]), do: {:string, value}
  def wrap_range([r_start, r_end]), do: {:range, r_start, r_end}
  def wrap_integer([n]), do: {:integer, n}
  def wrap_list(n), do: {:list, n}
  def wrap_boolean(["true"]), do: {:boolean, true}
  def wrap_boolean(["false"]), do: {:boolean, false}

  defcombinatorp(
    :space,
    times(choice([string(" "), string("\n"), string("\t")]), min: 1)
  )

  defcombinatorp(
    :identifier_tail,
    ascii_string(~c"-", 1)
    |> concat(ascii_string([?a..?z], min: 1))
  )

  defcombinatorp(
    :identifier,
    [?a..?z]
    |> ascii_string(min: 1)
    |> concat(times(parsec(:identifier_tail), min: 0))
    |> reduce({Enum, :join, []})
    |> map(:wrap_identifier)
  )

  defcombinatorp(
    :string,
    [?"]
    |> utf8_char()
    |> ignore()
    |> concat(utf8_string([10..33, 35..126], min: 0))
    |> concat(ignore(utf8_char([?"])))
    |> reduce(:wrap_string)
  )

  defcombinatorp(
    :hex_digits,
    times(ascii_string([?a..?f, ?A..?F, ?0..?9], 1), min: 1)
  )

  defcombinatorp(
    :hex,
    string("0x")
    |> concat(parsec(:hex_digits))
    |> reduce({Enum, :join, []})
    |> reduce(:parse_hex)
  )

  defcombinatorp(
    :bin,
    string("0b")
    |> concat(parsec(:hex_digits))
    |> reduce({Enum, :join, []})
    |> reduce(:parse_bin)
  )

  defcombinatorp(
    :atom,
    [11..31, 33, 35..39, 42..126]
    |> ascii_string(min: 1)
    |> reduce(:wrap_atom)
  )

  defcombinatorp(
    :int,
    choice([
      parsec(:hex),
      parsec(:bin),
      integer(min: 1)
    ])
    |> reduce(:wrap_integer)
  )

  defcombinatorp(
    :range,
    parsec(:int)
    |> concat(ignore(string("..")))
    |> concat(parsec(:int))
    |> reduce(:wrap_range)
  )

  defcombinatorp(
    :boolean,
    choice([string("true"), string("false")])
    |> reduce(:wrap_boolean)
  )

  defcombinatorp(
    :primitive,
    choice([
      parsec(:list),
      parsec(:boolean),
      parsec(:range),
      parsec(:string),
      parsec(:int),
      parsec(:atom)
    ])
  )

  defcombinatorp(
    :primitives_separated_by_space,
    :primitive
    |> parsec()
    |> times(min: 0)
    |> concat(times(concat(ignore(parsec(:space)), parsec(:primitive)), min: 0))
  )

  defparsec(
    :test,
    parsec(:list)
  )

  defparsec(
    :list,
    [?(]
    |> ascii_char()
    |> ignore()
    |> concat(parsec(:primitives_separated_by_space))
    |> concat(ignore(ascii_char([?)])))
    |> reduce(:wrap_list)
  )

  defparsec(
    :file,
    :space
    |> parsec()
    |> ignore()
    |> optional()
    |> concat(parsec(:list))
    |> concat(ignore(parsec(:space)))
    |> times(min: 1)
  )
end

This part is the environment for the envrionment for running the language, where the variables and functions are stored.

defmodule LispEval.Env do
  defstruct bindings: %{}, repl_entries: %{}

  @type value ::
          {:string, String.t()}
          | {:atom, String.t()}
          | {:integer, integer()}
          | {:range, integer(), integer()}
          | {:boolean, boolean()}
          | {:list, list()}
          | {:pfun, list()}
          | {:func, params :: list(), vararg :: String.t() | nil, body :: [value()], t()}

  @type t :: %__MODULE__{
          bindings: %{},
          repl_entries: %{}
        }

  @spec new :: t()
  def new do
    %__MODULE__{}
  end

  defp update_bindings(%__MODULE__{} = env, bindings), do: %{env | bindings: bindings}
  defp update_repl_entries(env, repl_entries), do: %{env | repl_entries: repl_entries}

  @spec set_binding(t, {String.t(), value}) :: t
  def set_binding(%__MODULE__{} = env, {atom, value}) do
    env
    |> then(& &1.bindings)
    |> Map.put(atom, value)
    |> then(&update_bindings(env, &1))
  end

  @spec set_binding(t, String.t(), value) :: t
  def set_binding(%__MODULE__{} = env, atom, value) do
    set_binding(env, {atom, value})
  end

  @spec get_binding(t, String.t()) :: value | nil
  def get_binding(%__MODULE__{} = env, atom), do: Map.fetch!(env.bindings, atom)

  @spec set_repl_entry(t, {String.t(), value}) :: t
  def set_repl_entry(%__MODULE__{} = env, {atom, value}) do
    env
    |> then(& &1.repl_entries)
    |> Map.put(atom, value)
    |> then(&update_repl_entries(env, &1))
  end

  @spec set_repl_entry(t, String.t(), value) :: t
  def set_repl_entry(%__MODULE__{} = env, atom, value), do: set_repl_entry(env, {atom, value})

  @spec get_repl_entry(t, String.t()) :: value | nil
  def get_repl_entry(%__MODULE__{} = env, atom) do
    Map.fetch!(env.repl_entries, atom)
  end

  @spec is_bound?(t, String.t()) :: boolean()
  def is_bound?(%__MODULE__{} = env, atom) do
    case get_binding(env, atom) do
      {:ok, _} -> true
      _ -> false
    end
  end

  def merge(env1, env2) do
    update_bindings(env2, Map.merge(env1.bindings, env2.bindings))
  end
end

Here is where we read a string as code and were we start the repl

defmodule Lisp do
  defp filter_fun_def(ast) do
    Enum.filter(ast, fn
      {:list, [{:atom, "define"} | _]} -> true
      _ -> false
    end)
  end

  defp reject_fun_def(ast) do
    Enum.reject(ast, fn
      {:list, [{:atom, "define"} | _]} -> true
      _ -> false
    end)
  end

  defp build_env_from_ast(ast) do
    {env, _} =
      ast
      |> filter_fun_def()
      |> Enum.reduce({LispEval.Env.new(), nil}, fn parsed, {env, _} ->
        LispEval.eval(env, parsed)
      end)

    env
  end

  def sigil_l(src, _opts),
    do: parse_n_eval(src)

  def parse_n_eval(src) do
    {:ok, ast, _, _, _, _} = LispParser.file(src)
    env = build_env_from_ast(ast)

    ast
    |> reject_fun_def()
    |> Enum.reduce({env, nil}, fn parsed, {env, _} ->
      LispEval.eval(env, parsed)
    end)
  end

  def repl, do: repl(LispEval.Env.new(), 1)

  def repl(env, counter) do
    command = IO.gets(:stdio, "HeroLisp(#{counter})> ")
    {:ok, [parsed], _, _, _, _} = LispParser.list(command)
    {env, value} = LispEval.eval(env, parsed)
    env = LispEval.Env.set_repl_entry(env, counter, value)
    IO.puts(value |> LispEval.extract_value() |> LispEval.print_inspect())
    repl(env, counter + 1)
  end
end

Here is where I did the convertion of the lisp's values to elixir values and tried to encode lambdas to with macros and elixir AST but decided that is not worth for this iteration, maybe for a future challenge.

defmodule LispInterop do
  alias LispEval.Env

  defmacrop create_lambda(ast) do
    ast
  end

  def convert_value_to_host(env = %Env{}, {:func, params, _varargs, body, fenv}) do
    args = Enum.map(params, fn {:atom, name} -> {String.to_atom(name), [], Elixir} end)
    new_env = LispEval.Env.merge(env, fenv)

    ast =
      {:fn, [],
       [
         {:->, [],
          [
            args,
            {:__block__, [],
             [
               {:=, [],
                [
                  {{:_env, [], Elixir}, {:value, [], Elixir}},
                  {{:., [], [{:__aliases__, [alias: false], [:LispEval]}, :eval]}, [],
                   [new_env, body]}
                ]},
               {:convert_value_to_host, [], [{:value, [], Elixir}]}
             ]}
          ]}
       ]}

    create_lambda(ast)
  end

  def convert_value_to_host(env = %Env{}, {:list, [{:atom, _} | _]} = value) do
    {env, value} = LispEval.eval(env, value)
    convert_value_to_host(env, value)
  end

  def convert_value_to_host(_env = %Env{}, {:integer, i}),
    do: i

  def convert_value_to_host(_env = %Env{}, {:string, str}),
    do: str

  def convert_value_to_host(_env = %Env{}, {:range, {:integer, i}, {:integer, j}}),
    do: i..j

  def convert_value_to_host(_env = %Env{}, {:boolean, b}),
    do: b

  def convert_value_to_host(env = %Env{}, {:list, list}),
    do: Enum.map(list, &convert_value_to_host(env, &1))

  def convert_value_to_host(env = %Env{}, {:atom, _} = value) do
    {env, value} = LispEval.eval(env, value)
    convert_value_to_host(env, value)
  end
end

Here is where the evaluation is done.

defmodule LispEval do
  alias LispEval.Env

  @type env :: %Env{}

  @primitive_functions %{
    "+" => &Kernel.+/2,
    "-" => &Kernel.-/2,
    "/" => &Kernel.//2,
    "*" => &Kernel.*/2,
    "<" => &Kernel.</2,
    ">" => &Kernel.>/2,
    ">=" => &Kernel.>=/2,
    "<=" => &Kernel.<=/2,
    "=" => &Kernel.==/2,
    "!=" => &Kernel.!=/2,
    "%" => &Kernel.rem/2
  }

  def wrap_value(n) when is_number(n),
    do: {:integer, n}

  def wrap_value(str) when is_bitstring(str),
    do: {:string, str}

  def wrap_value(b) when is_boolean(b),
    do: {:boolean, b}

  def wrap_value(list) when is_list(list),
    do: {:list, Enum.map(list, &wrap_value/1)}

  def wrap_value(:ok) do
    {:boolean, true}
  end

  def extract_value({%Env{} = env, {:atom, value}}) do
    env
    |> Env.get_binding(value)
    |> extract_value()
  end

  def extract_value({%Env{}, value}), do: extract_value(value)
  def extract_value(nil), do: nil
  def extract_value({:string, value}), do: value
  def extract_value({:integer, value}), do: value
  def extract_value({:range, a, b}), do: a..b
  def extract_value({:boolean, value}), do: value
  def extract_value({:list, list}), do: Enum.map(list, &extract_value/1)

  def print_inspect(nil), do: "nil"
  def print_inspect(binary) when is_binary(binary), do: ~s("#{binary}")
  def print_inspect(number) when is_number(number), do: "#{number}"
  def print_inspect(boolean) when is_boolean(boolean), do: "#{boolean}"

  def print_inspect(list) when is_list(list) do
    list
    |> Enum.map(&print_inspect/1)
    |> Enum.join(" ")
    |> then(&"(#{&1})")
  end

  def debug_print({_env, {:func, params, nil, _, _}}),
    do: "<Function/#{length(params)}>"

  def debug_print({_env, {:func, _, _, _, _}}),
    do: "<VariadicFunction>"

  def debug_print({_env, v}), do: v |> extract_value() |> print_inspect()

  def fapply(env, function_name, args) do
    case Env.get_binding(env, function_name) do
      {:func, params, nil, body, fenv} when length(args) == length(params) ->
        environment =
          params
          |> Enum.zip(args)
          |> Enum.reduce(Env.merge(env, fenv), fn {{:atom, n}, {_env, arg}}, env ->
            Env.set_binding(env, n, arg)
          end)

        {_env, result} = eval(environment, body)

        # , label: "#{function_name}'s return with (#{Enum.map_join(args, " ", &debug_print/1)})")
        result

      {:func, params, vararg, body, fenv} when is_binary(vararg) ->
        environment =
          params
          |> Enum.zip(args)
          |> Enum.reduce(Env.merge(env, fenv), fn {{:atom, n}, {_env, arg}}, env ->
            Env.set_binding(env, n, arg)
          end)

        {_env, result} = eval(environment, body)

        result

      {:func, p, nil, _, _} ->
        raise """
        Bad function apply: #{function_name} with args: #{inspect(args)}
        expected #{length(p)} args, received #{length(args)}
        """
    end
  end

  @spec eval(env, Env.value()) :: {env, Env.value()}
  # Eval Function apply
  def eval(%Env{} = env, {:list, [{:atom, fname} | args]}) do
    case {fname, args} do
      {"define", [{:atom, name}, {:list, params}, body]} ->
        {Env.set_binding(env, name, {:func, params, nil, body, env}), nil}

      {"lambda", [{:list, params}, body]} ->
        {env, {:func, params, nil, body, env}}

      {"quote", value} ->
        {env, value}

      {"v", [{:integer, entry_number}]} ->
        {env, Env.get_repl_entry(env, entry_number)}

      {"set", [{:atom, atom}, b]} ->
        {_, value} = eval(env, b)
        {Env.set_binding(env, atom, value), nil}

      {"cons", [a, b]} ->
        with {_, {:list, list}} <- eval(env, b), {_, a} <- eval(env, a) do
          {env, {:list, [a | list]}}
        end

      {"reverse", [expr]} ->
        {env, {:list, list}} = eval(env, expr)
        {env, {:list, Enum.reverse(list)}}

      {"null?", [expr]} ->
        case eval(env, expr) do
          {_env, nil} -> {env, {:boolean, true}}
          {_env, {:list, []}} -> {env, {:boolean, true}}
          _ -> {env, {:boolean, false}}
        end

      {"car", [{:list, []}]} ->
        {env, nil}

      {"car", [value]} ->
        value
        |> then(&eval(env, &1))
        |> then(fn {_, {:list, list}} -> eval(env, hd(list)) end)

      {"cdr", [empty_value]} when empty_value in [[], nil] ->
        {env, {:list, []}}

      {"cdr", [value]} ->
        value
        |> then(&eval(env, &1))
        |> then(fn {env, {:list, list}} ->
          {env, {:list, tl(list)}}
        end)

      {"if", [pred, conseq, alt]} ->
        case eval(env, pred) do
          {env, {:boolean, true}} -> eval(env, conseq)
          {env, _} -> eval(env, alt)
        end

      {func, [a, b]} when func in [">=", "<=", "=", "!=", "<", ">", "%"] ->
        {_, a} = eval(env, a)
        {_, b} = eval(env, b)

        {env,
         {:boolean, @primitive_functions[func].(extract_value({env, a}), extract_value({env, b}))}}

      {func, [head | args]} when func in ["+", "-", "*"] ->
        args
        |> Enum.map(&eval(env, &1))
        |> Enum.reduce(eval(env, head), fn {_, {:integer, n}}, {_, {:integer, acc}} ->
          {env, {:integer, @primitive_functions[func].(acc, n)}}
        end)

      {"inspect", args} ->
        case Enum.count(args) do
          0 ->
            raise "inspect expects at least 1 parameter"

          1 ->
            tap(args, fn args ->
              args
              |> hd()
              |> then(&eval(env, &1))
              |> extract_value()
              |> tap(&IO.puts(print_inspect(&1)))
            end)

            eval(env, hd(args))

          _ ->
            tap(args, fn args ->
              args
              |> Enum.map(fn
                arg ->
                  arg
                  |> then(&eval(env, &1))
                  |> extract_value()
              end)
              |> tap(&IO.puts(print_inspect(&1)))
            end)

            {:list, args}
        end

      {"host!", [{:atom, module_func}, {:list, list}]} ->
        [module, func] = String.split(module_func, "/")
        module_atom = String.to_atom("Elixir.#{module}")
        func_atom = String.to_atom(func)

        params =
          Enum.map(list, fn value ->
            {env, value} = eval(env, value)
            LispInterop.convert_value_to_host(env, value)
          end)

        {env, wrap_value(apply(module_atom, func_atom, params))}

      {fname, args} ->
        {env, fapply(env, fname, Enum.map(args, &eval(env, &1)))}
    end
  end

  def eval(%Env{} = env, {:string, _} = value), do: {env, value}
  def eval(%Env{} = env, {:integer, _} = value), do: {env, value}

  def eval(%Env{} = env, {:range, {:integer, x}, {:integer, y}}),
    do: {env, {:list, Enum.map(x..y, &{:integer, &1})}}

  def eval(%Env{} = env, {:boolean, _} = value), do: {env, value}
  def eval(%Env{} = env, {:atom, key}), do: {env, Env.get_binding(env, key)}

  def eval(%Env{} = env, {:list, list}) do
    {env,
     {:list,
      Enum.map(list, fn value ->
        {_env, v} = eval(env, value)
        v
      end)}}
  end

  def eval(%Env{} = env, nil) do
    {env, {:list, []}}
  end
end

Here is the lisp code with some functions that could be included in it's std library.

require Logger
import Lisp

~l|
(define sum (x y)
  (+ x y))

(define is-odd? (x)
  (!= (% x 2) 0))

(define is-even? (x)
  (= (% x 2) 0))

(define list/foldr (f acc list)
  (if (null? list)
    acc
    (list/foldr f (f (car list) acc) (cdr list))))

(define list/foldl (f acc list)
  (list/foldr f acc (reverse list)))

(define list/filter (f list)
  (list/foldl (lambda (v acc) (if (f v) (cons v acc) acc)) () list))

(define list/filter (pred list)
  (list/foldl (lambda (v acc) (if (pred v) acc (cons v acc))) () list))

(define list/map (f list)
  (list/foldl (lambda (v acc) (cons (f v) acc)) () list))

(define count (n)
  (if (>= n 10)
    (inspect n)
    (count (+ (inspect n) 1))))

(inspect (list/filter is-odd? 0..10))
|

nil
# (count 1)
# 

# (count 1)

Experimenting with Macros hoping to have a practical way to encode lambdas.

quote do
  Enum.map([1, 2, 3], fn x -> x + 1 end)
end

defmodule MacroTest do
  defmacro tests(args) do
    quote do
      fn unquote(do: args) ->
        nil
      end
    end
  end

  defmacro tests2(args) do
    {:fn, [],
     [
       {:->, [],
        [
          args,
          nil
        ]}
     ]}
  end

  defmacro tests3(env, args, body) do
    args = Enum.map(args, fn {:atom, name} -> {String.to_atom(name), [], Elixir} end)

    {:fn, [],
     [
       {:->, [],
        [
          args,
          {:__block__, [],
           [
             {:=, [],
              [
                {{:_env, [], Elixir}, {:value, [], Elixir}},
                {{:., [], [{:__aliases__, [alias: false], [:LispEval]}, :eval]}, [], [env, body]}
              ]},
             {:convert_value_to_host, [], [{:value, [], Elixir}]}
           ]}
        ]}
     ]}
  end
end

require MacroTest
fun = MacroTest.tests3([atom: "x", atom: "y"], [])
fun.(1, 2)

Kernel.rem(2, 2)