Interpreter from Chapter 10 of The Little Typer implemented in Elixir

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...")