Skip to content

Instantly share code, notes, and snippets.

@devstopfix

devstopfix/the_little_typer.exs

Last active January 18, 2019 15:19
Show Gist options
  • Save devstopfix/d6280a3023f5c50e187f751f91f334a2 to your computer and use it in GitHub Desktop.
Save devstopfix/d6280a3023f5c50e187f751f91f334a2 to your computer and use it in GitHub Desktop.
Download ZIP
Interpreter from Chapter 10 of The Little Typer implemented in Elixir
Raw
the_little_typer.exs
#! /usr/local/bin/elixir
defmodule TheLittleSchemer do
defmodule Toys do
@moduledoc "Chapter 1"
@doc """
The Law of Null?
The primitive null? is defined only for lists.
"""
def null?([]), do: true
def null?(_), do: false
def atom?(x), do: not null?(x) and not is_list(x)
end
defmodule Pairs do
@moduledoc "Chapter 7"
def build(s1, s2), do: [s1, s2]
def first(p), do: hd(p)
def second(p), do: hd(tl(p))
def third(p), do: hd(tl(tl(p)))
end
defmodule Interpreter do
@moduledoc """
Chapter 10.
Types are represented as functions, called actions, with suffix ª.
Atoms are used for both symbols and identifiers. In order to differentiate between the two only greek lower case letters can be used as identifiers in lambda definitions:
α β γ δ ε ζ η θ ι κ λ μ ν ξ ο π ρ σ ς τ υ φ χ ψ ω
Example:
[:lambda, [:χ], [:zero?, :χ]]
Run with:
elixir the_little_typer.exs
"""
import TheLittleSchemer.Toys
import TheLittleSchemer.Pairs
def value(e), do: meaning(e, [])
defp meaning(e, table), do: expression_to_action(e).(e, table)
defp expression_to_action(e) do
cond do
atom?(e) -> atom_to_action(e)
true -> list_to_action(e)
end
end
defp list_to_action([:quote | _]), do: &quoteª/2
defp list_to_action([:lambda | _]), do: &lambdaª/2
defp list_to_action([:cond | _]), do: &condª/2
defp list_to_action([_ | _]), do: &applicationª/2
defp list_to_action(_), do: &applicationª/2
def condª([:cond | e], table), do: evcon(e, table)
def constª(e, _table) when is_number(e), do: e
def constª(true, _table), do: true
def constª(false, _table), do: false
def constª(e, _table), do: {:primitive, e}
def identifierª(e, table), do: lookup_in_table(e, table, &initial_table!/1)
def lambdaª([:lambda, formals, body], table),
do: build(:non_primitive, table: table, formals: formals, body: body)
def quoteª([:quote, text], _table), do: text
def atom_to_action(a) when is_number(a), do: &constª/2
def atom_to_action(true), do: &constª/2
def atom_to_action(false), do: &constª/2
def atom_to_action(:cons), do: &constª/2
def atom_to_action(:car), do: &constª/2
def atom_to_action(:cdr), do: &constª/2
def atom_to_action(:null?), do: &constª/2
def atom_to_action(:eq?), do: &constª/2
def atom_to_action(:atom?), do: &constª/2
def atom_to_action(:zero?), do: &constª/2
def atom_to_action(:add1), do: &constª/2
def atom_to_action(:sub1), do: &constª/2
def atom_to_action(:number?), do: &constª/2
def atom_to_action(:α), do: &identifierª/2
def atom_to_action(:β), do: &identifierª/2
def atom_to_action(:γ), do: &identifierª/2
def atom_to_action(:δ), do: &identifierª/2
def atom_to_action(:ε), do: &identifierª/2
def atom_to_action(:ζ), do: &identifierª/2
def atom_to_action(:η), do: &identifierª/2
def atom_to_action(:θ), do: &identifierª/2
def atom_to_action(:ι), do: &identifierª/2
def atom_to_action(:κ), do: &identifierª/2
def atom_to_action(:λ), do: &identifierª/2
def atom_to_action(:μ), do: &identifierª/2
def atom_to_action(:ν), do: &identifierª/2
def atom_to_action(:ξ), do: &identifierª/2
def atom_to_action(:ο), do: &identifierª/2
def atom_to_action(:π), do: &identifierª/2
def atom_to_action(:ρ), do: &identifierª/2
def atom_to_action(:σ), do: &identifierª/2
def atom_to_action(:ς), do: &identifierª/2
def atom_to_action(:τ), do: &identifierª/2
def atom_to_action(:υ), do: &identifierª/2
def atom_to_action(:φ), do: &identifierª/2
def atom_to_action(:χ), do: &identifierª/2
def atom_to_action(:ψ), do: &identifierª/2
def atom_to_action(:ω), do: &identifierª/2
def atom_to_action(e) when is_atom(e), do: &constª/2
def atom_to_action(_), do: &identifierª/2
def applicationª([f | args], table), do: apply_(meaning(f, table), eval_list(args, table))
defp eval_list([], _table), do: []
defp eval_list([arg | tl_arg], table), do: [meaning(arg, table) | eval_list(tl_arg, table)]
defp apply_({:primitive, f}, vals), do: apply_primitive(f, vals)
defp apply_([:non_primitive | closure], vals), do: apply_closure(closure, vals)
def apply_primitive(:cons, [v1, v2 | _]), do: [v1 | v2]
def apply_primitive(:car, vals), do: hd(first(vals))
def apply_primitive(:cdr, vals), do: tl(first(vals))
def apply_primitive(:null?, [val | _]), do: null?(val)
def apply_primitive(:eq?, [v1, v2 | _]), do: v1 == v2
def apply_primitive(:atom?, [val | _]), do: atomic?(val)
def apply_primitive(:zero?, [0 | _]), do: true
def apply_primitive(:zero?, _vals), do: false
def apply_primitive(:add1, [i | _]) when is_number(i), do: i + 1
def apply_primitive(:sub1, [i | _]) when is_number(i), do: i - 1
defp atomic?(x) do
cond do
atom?(x) -> true
null?(x) -> false
hd(x) == :primitive -> true
hd(x) == :non_primitive -> true
true -> false
end
end
defdelegate new_entry(formals, vals), to: Pairs, as: :build
def extend_table(e, t), do: [e | t]
def apply_closure([[table: table, formals: formals, body: body]], vals) do
meaning(
body,
extend_table(new_entry(formals, vals), table)
)
end
defp initial_table!(name), do: raise(ArgumentError, message: inspect(name))
def lookup_in_table(name, [], table_f), do: table_f.(name)
def lookup_in_table(name, table, table_f),
do:
lookup_in_entry(
name,
hd(table),
fn name -> lookup_in_table(name, tl(table), table_f) end
)
defp lookup_in_entry(name, entry, entry_f),
do: lookup_in_entry_help(name, first(entry), second(entry), entry_f)
defp lookup_in_entry_help(name, [], _values, entry_f), do: entry_f.(name)
defp lookup_in_entry_help(name, [name | _], values, _entry_f), do: hd(values)
defp lookup_in_entry_help(name, names, values, entry_f),
do: lookup_in_entry_help(name, tl(names), tl(values), entry_f)
defp evcon([[:else, e] | _], table), do: meaning(e, table)
defp evcon([[question, answer] | lines], table) do
cond do
meaning(question, table) -> meaning(answer, table)
true -> evcon(lines, table)
end
end
end
end
import ExUnit.Assertions
alias TheLittleSchemer.Toys
assert Toys.atom?(1)
assert Toys.atom?(true)
assert Toys.atom?(false)
refute Toys.atom?([])
assert Toys.null?([])
alias TheLittleSchemer.Pairs
assert [1, 2] == Pairs.build(1, 2)
assert 1 == Pairs.first(Pairs.build(1, 2))
assert 2 == Pairs.second(Pairs.build(1, 2))
alias TheLittleSchemer.Interpreter
assert 1 == Interpreter.constª(1, nil)
assert Interpreter.constª(true, nil)
refute Interpreter.constª(false, nil)
assert Interpreter.value(true)
refute Interpreter.value(false)
assert 1 == Interpreter.value(1)
assert {:primitive, :cons} == Interpreter.value(:cons)
assert {:primitive, :car} == Interpreter.value(:car)
assert {:primitive, :cdr} == Interpreter.value(:cdr)
assert {:primitive, :null?} == Interpreter.value(:null?)
assert {:primitive, :eq?} == Interpreter.value(:eq?)
assert {:primitive, :atom?} == Interpreter.value(:atom?)
assert {:primitive, :zero?} == Interpreter.value(:zero?)
assert {:primitive, :add1} == Interpreter.value(:add1)
assert {:primitive, :sub1} == Interpreter.value(:sub1)
assert {:primitive, :number?} == Interpreter.value(:number?)
assert :the_raven == Interpreter.value([:quote, :the_raven])
assert [1, 2] == Interpreter.value([:quote, [1, 2]])
assert [] == Interpreter.value([:quote, []])
assert Interpreter.value([:null?, [:quote, []]])
assert [1, 2, 3] == Interpreter.value([:cons, 1, [:quote, [2, 3]]])
assert [1, 2, 3] == Interpreter.value([:cons, 1, [:cons, 2, [:quote, [3]]]])
assert [1, 2, 3] == Interpreter.value([:cons, 1, [:cons, 2, [:cons, 3, [:quote, []]]]])
assert 1 == Interpreter.value([:car, [:quote, [1, 2, 3]]])
assert [2, 3] == Interpreter.value([:cdr, [:quote, [1, 2, 3]]])
assert 2 == Interpreter.value([:car, [:cdr, [:quote, [1, 2, 3]]]])
assert Interpreter.value([:eq?, 0, 0])
refute Interpreter.value([:eq?, 0, 1])
refute Interpreter.value([:eq?, [:quote, :a], [:quote, :b]])
assert Interpreter.value([:zero?, 0])
refute Interpreter.value([:zero?, 1])
assert Interpreter.value([:zero?, [:sub1, 1]])
assert 3 == Interpreter.value([:add1, 2])
assert 2 == Interpreter.value([:sub1, 3])
assert_raise ArgumentError, fn -> Interpreter.value([:add1, :χ]) end
assert :spaghetti ==
Interpreter.lookup_in_table(
:entrée,
[
[[:entrée, :dessert], [:spaghetti, :spumoni]],
[[:appetizer, :entrée, :beverage], [:food, :tastes, :good]]
],
fn -> nil end
)
assert :campari ==
Interpreter.lookup_in_table(
:beverage,
[
[[:entrée, :dessert], [:spaghetti, :spumoni]],
[[:appetizer, :entrée, :beverage], [:food, :tastes, :campari]]
],
fn _ -> nil end
)
assert 6 ==
Interpreter.value([
[:lambda, [:χ], [:add1, :χ]],
5
])
assert Interpreter.value([
[:lambda, [:χ], [:zero?, :χ]],
0
])
assert false ==
Interpreter.value([
[:lambda, [:χ], [:zero?, :χ]],
65
])
assert 1 == Interpreter.value([:cond, [:else, 1]])
assert Interpreter.value([:cond, [[:zero?, 0], true]])
assert Interpreter.value([:cond, [[:zero?, 0], true], [:else, false]])
assert Interpreter.value([[:lambda, [:χ], [:cond, [[:zero?, :χ], true], [:else, false]]], 0])
assert 4 == Interpreter.value([[:lambda, [:χ], [:cond, [[:eq?, :χ, 2], 4], [:else, 0]]], 2])
assert 2 ==
Interpreter.value([
[
:lambda,
[:χ],
[:cond, [[:eq?, :χ, 1], 1], [[:eq?, :χ, 2], 2], [[:eq?, :χ, 3], 3], [:else, 0]]
],
2
])
assert 4 == Interpreter.value([[:lambda, [:χ], [:cond, [[:eq?, :χ, 2], 4], [:else, 0]]], 2])
assert :yes == Interpreter.value([[:lambda, [:α, :β], [:cond, [[:eq?, :α, :β], [:quote, :yes]]]], :a, :a])
assert 0 == Interpreter.value([[:lambda, [:α, :β], [:cond, [[:eq?, :α, :β], true], [:else, 0]]], 1, 2])
IO.puts("OK. On to The Seasoned Schemer...")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment