Mix.install([
{:nimble_parsec, "~> 1.0"}
])
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.
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)
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)