defmodule PresentationChip8.Literal do
  @moduledoc "Lecture ASCII équivalente à MiniLiteral, sans moteur d’expressions régulières."

  def read(<<first, _::binary>> = text) when first >= ?0 and first <= ?9,
    do: number(text)

  def read(<<first, _::binary>> = text)
      when (first >= ?a and first <= ?z) or (first >= ?A and first <= ?Z) or first == ?_,
      do: name(text)

  def read(_text), do: {:error, :unknown_symbol}

  defp number(text) do
    {integer_size, rest} = digits(text, 0)

    case rest do
      <<?., first, _::binary>> when first >= ?0 and first <= ?9 ->
        <<?., fraction::binary>> = rest
        {fraction_size, rest} = digits(fraction, 0)

        if number_continues?(rest) do
          {:error, :expected_decimal}
        else
          literal = binary_part(text, 0, integer_size + 1 + fraction_size)
          decimal(literal, rest)
        end

      _ ->
        {:error, :expected_decimal}
    end
  end

  defp digits(<<byte, rest::binary>>, size) when byte >= ?0 and byte <= ?9,
    do: digits(rest, size + 1)

  defp digits(rest, size), do: {size, rest}

  defp number_continues?(<<byte, _::binary>>)
       when (byte >= ?a and byte <= ?z) or (byte >= ?A and byte <= ?Z) or
              (byte >= ?0 and byte <= ?9) or byte == ?_ or byte == ?.,
       do: true

  defp number_continues?(_rest), do: false

  defp decimal(literal, rest) do
    {:ok, {:number, String.to_float(literal)}, rest}
  rescue
    ArgumentError -> {:error, :number_out_of_range}
  end

  defp name(text) do
    {size, rest} = word(text, 0)
    literal = binary_part(text, 0, size)

    case keyword(literal) do
      {:ok, token} ->
        {:ok, token, rest}

      :name ->
        if valid_name?(literal), do: {:ok, {:name, literal}, rest}, else: {:error, :invalid_name}
    end
  end

  defp word(<<byte, rest::binary>>, size)
       when (byte >= ?a and byte <= ?z) or (byte >= ?A and byte <= ?Z) or
              (byte >= ?0 and byte <= ?9) or byte == ?_,
       do: word(rest, size + 1)

  defp word(rest, size), do: {size, rest}

  defp valid_name?(<<first, rest::binary>>) when first >= ?a and first <= ?z,
    do: valid_tail?(rest)

  defp valid_name?(_literal), do: false
  defp valid_tail?(""), do: true

  defp valid_tail?(<<byte, rest::binary>>)
       when (byte >= ?a and byte <= ?z) or (byte >= ?0 and byte <= ?9) or byte == ?_,
       do: valid_tail?(rest)

  defp valid_tail?(_rest), do: false
  defp keyword("let"), do: {:ok, :let}
  defp keyword("case"), do: {:ok, :case}
  defp keyword("fn"), do: {:ok, :fn}
  defp keyword("True"), do: {:ok, {:bool, true}}
  defp keyword("False"), do: {:ok, {:bool, false}}
  defp keyword(_literal), do: :name
end

defmodule PresentationChip8.Lexer do
  def lex(text), do: scan(text, [])

  defp scan("", acc) do
    # EXERCISE AP2-E1a BEGIN
    {:ok, Enum.reverse(acc)}
    # EXERCISE AP2-E1a END
  end

  defp scan(" " <> rest, acc), do: scan(rest, acc)
  defp scan("\t" <> rest, acc), do: scan(rest, acc)
  defp scan("\r" <> rest, acc), do: scan(rest, acc)
  defp scan("\n" <> rest, acc), do: scan(rest, acc)
  defp scan("==" <> rest, acc), do: scan(rest, [:eq | acc])
  defp scan("->" <> rest, acc), do: scan(rest, [:arrow | acc])

  defp scan("+" <> rest, acc) do
    # EXERCISE AP2-E1b BEGIN
    scan(rest, [:plus | acc])
    # EXERCISE AP2-E1b END
  end

  defp scan("-" <> rest, acc), do: scan(rest, [:minus | acc])
  defp scan("*" <> rest, acc), do: scan(rest, [:multiply | acc])
  defp scan("/" <> rest, acc), do: scan(rest, [:divide | acc])
  defp scan("<" <> rest, acc), do: scan(rest, [:lt | acc])
  defp scan("=" <> rest, acc), do: scan(rest, [:assign | acc])
  defp scan("(" <> rest, acc), do: scan(rest, [:lparen | acc])
  defp scan(")" <> rest, acc), do: scan(rest, [:rparen | acc])
  defp scan("{" <> rest, acc), do: scan(rest, [:lbrace | acc])
  defp scan("}" <> rest, acc), do: scan(rest, [:rbrace | acc])
  defp scan("," <> rest, acc), do: scan(rest, [:comma | acc])

  defp scan(text, acc) do
    case PresentationChip8.Literal.read(text) do
      {:ok, token, rest} -> scan(rest, [token | acc])
      {:error, reason} -> {:error, {:lex, reason, text}}
    end
  end
end

defmodule PresentationChip8.Parser do
  def parse(tokens) do
    case sequence(tokens) do
      {:ok, tree, []} -> {:ok, tree}
      {:ok, _tree, rest} -> error(:unexpected_tokens, rest)
      error -> error
    end
  end

  defp sequence([:let, {:name, name}, :assign | rest]) do
    with {:ok, value, rest} <- expression(rest),
         {:ok, body, rest} <- sequence(rest) do
      {:ok, {:let, name, value, body}, rest}
    end
  end

  defp sequence(tokens), do: expression(tokens)
  defp expression(tokens), do: binary(tokens, &comparison/1, [:eq])
  defp comparison(tokens), do: binary(tokens, &sum/1, [:lt])
  defp sum(tokens), do: binary(tokens, &product/1, [:plus, :minus])
  defp product(tokens), do: binary(tokens, &unary/1, [:multiply, :divide])

  defp binary(tokens, read, operators) do
    with {:ok, left, rest} <- read.(tokens) do
      continue_binary(left, rest, read, operators)
    end
  end

  defp continue_binary(left, [op | rest] = tokens, read, operators) do
    if op in operators do
      with {:ok, right, rest} <- read.(rest) do
        # EXERCISE AP2-E3b BEGIN
        tree = {:binary, op, left, right}
        # EXERCISE AP2-E3b END
        continue_binary(tree, rest, read, operators)
      end
    else
      {:ok, left, tokens}
    end
  end

  defp continue_binary(left, [], _read, _operators), do: {:ok, left, []}

  defp unary([:minus | rest]) do
    with {:ok, tree, rest} <- unary(rest), do: {:ok, {:neg, tree}, rest}
  end

  defp unary(tokens) do
    with {:ok, tree, rest} <- primary(tokens), do: calls(tree, rest)
  end

  defp calls(tree, [:lparen | rest]) do
    with {:ok, arguments, rest} <- arguments(rest) do
      calls({:call, tree, arguments}, rest)
    end
  end

  defp calls(tree, rest), do: {:ok, tree, rest}
  defp arguments([:rparen | rest]), do: {:ok, [], rest}
  defp arguments(tokens), do: argument_list(tokens, [])

  defp argument_list(tokens, acc) do
    with {:ok, argument, rest} <- expression(tokens) do
      case rest do
        [:comma | rest] -> argument_list(rest, [argument | acc])
        [:rparen | rest] -> {:ok, Enum.reverse([argument | acc]), rest}
        _ -> error(:expected_argument_separator, rest)
      end
    end
  end

  defp primary([{:number, number} | rest]) do
    # EXERCISE AP2-E3a BEGIN
    {:ok, {:number, number}, rest}
    # EXERCISE AP2-E3a END
  end

  defp primary([{:bool, value} | rest]), do: {:ok, {:bool, value}, rest}
  defp primary([{:name, name} | rest]), do: {:ok, {:name, name}, rest}

  defp primary([:lparen | rest]) do
    with {:ok, tree, rest} <- expression(rest),
         {:ok, rest} <- expect(rest, :rparen) do
      {:ok, tree, rest}
    end
  end

  defp primary([:lbrace | rest]), do: block(rest)

  defp primary([:case | rest]) do
    with {:ok, condition, rest} <- expression(rest),
         {:ok, rest} <- expect(rest, :lbrace),
         {:ok, rest} <- expect(rest, {:bool, true}),
         {:ok, rest} <- expect(rest, :arrow),
         {:ok, yes, rest} <- expression(rest),
         {:ok, rest} <- expect(rest, {:bool, false}),
         {:ok, rest} <- expect(rest, :arrow),
         {:ok, no, rest} <- expression(rest),
         {:ok, rest} <- expect(rest, :rbrace) do
      {:ok, {:case, condition, yes, no}, rest}
    end
  end

  defp primary([:fn, :lparen | rest]) do
    with {:ok, parameters, rest} <- parameters(rest),
         {:ok, rest} <- expect(rest, :lbrace),
         {:ok, body, rest} <- block(rest) do
      {:ok, {:fn, parameters, body}, rest}
    end
  end

  defp primary(tokens), do: error(:expected_expression, tokens)

  defp block(tokens) do
    with {:ok, tree, rest} <- sequence(tokens),
         {:ok, rest} <- expect(rest, :rbrace) do
      {:ok, tree, rest}
    end
  end

  defp parameters([:rparen | rest]), do: {:ok, [], rest}
  defp parameters(tokens), do: parameter_list(tokens, [])

  defp parameter_list([{:name, name} | rest] = tokens, acc) do
    if name in acc do
      error(:duplicate_parameter, tokens)
    else
      case rest do
        [:comma | rest] -> parameter_list(rest, [name | acc])
        [:rparen | rest] -> {:ok, Enum.reverse([name | acc]), rest}
        _ -> error(:expected_parameter_separator, rest)
      end
    end
  end

  defp parameter_list(tokens, _acc), do: error(:expected_parameter, tokens)
  defp expect([token | rest], token), do: {:ok, rest}
  defp expect(tokens, token), do: error({:expected, token}, tokens)
  defp error(reason, tokens), do: {:error, {:parse, reason, tokens}}
end


defmodule PresentationChip8.Sprites do
  @moduledoc "Les sept tuiles 4 × 4 fournies ; les quatre bits de poids faible restent éteints."
  @rows [
    <<0xF0, 0x90, 0x90, 0xF0>>,
    <<0, 0, 0, 0>>,
    <<0, 0x60, 0x60, 0>>,
    <<0xF0, 0xB0, 0xD0, 0xF0>>,
    <<0xF0, 0xD0, 0xB0, 0xF0>>,
    <<0x60, 0x60, 0xF0, 0x90>>,
    <<0x60, 0x60, 0xF0, 0xF0>>
  ]
  def rows(index), do: Enum.at(@rows, index)
  def data, do: Enum.with_index(@rows, fn bytes, index -> {:data, {:sprite, index}, bytes} end)
end

defmodule PresentationChip8.Source do
  @moduledoc "Fonctions fermées de premier ordre : paramètres u8, résultat u8 ou booléen."
  @primitives %{
    "clear" => {[], :u8},
    "read_key" => {[], :u8},
    "tile" => {[:u8, :u8, :u8], :u8},
    "load" => {[:u8], :u8},
    "store" => {[:u8, :u8], :u8},
    "rem" => {[:u8, :u8], :u8}
  }
  @powers [1, 2, 4, 8, 16, 32, 64, 128]

  def validate(ast) do
    try do
      {functions, entry} = collect(ast, [])

      {definitions, signatures} =
        Enum.map_reduce(functions, %{}, fn {name, parameters, body}, signatures ->
          if Map.has_key?(signatures, name) or Map.has_key?(@primitives, name),
            do: fail("fonction définie deux fois ou nom réservé : #{name}")

          if length(parameters) > 8, do: fail("une fonction accepte au plus huit paramètres")

          if Enum.any?(
               parameters,
               &(Map.has_key?(@primitives, &1) or Map.has_key?(signatures, &1) or &1 == name)
             ),
             do: fail("un paramètre ne peut pas masquer un nom de fonction")

          current = %{name: name, parameters: parameters}
          local = Map.new(parameters, &{&1, :u8})
          result = type(body, local, signatures, current, true)
          result = if result == :recursive, do: :u8, else: result
          depth = 1 + call_depth(body, signatures, name)
          if depth > 16, do: fail("plus de seize appels imbriqués : pile CHIP-8 insuffisante")

          definition = %{
            name: name,
            parameters: parameters,
            body: body,
            result: result,
            depth: depth
          }

          {definition,
           Map.put(signatures, name, {List.duplicate(:u8, length(parameters)), result, depth})}
        end)

      result = type(entry, %{}, signatures, nil, false)
      {:ok, %{functions: definitions, entry: entry, type: result}}
    catch
      {:source_error, reason} -> {:error, reason}
    end
  end

  defp collect({:let, name, {:fn, parameters, body}, rest}, acc),
    do: collect(rest, [{name, parameters, body} | acc])

  defp collect(entry, acc), do: {Enum.reverse(acc), entry}
  defp fail(reason), do: throw({:source_error, reason})
  defp expect(type, type), do: type
  defp expect(actual, expected), do: fail("type attendu : #{expected}, reçu : #{actual}")
  defp same(:recursive, type), do: type
  defp same(type, :recursive), do: type
  defp same(left, right), do: expect(right, left)

  defp type({:number, value}, _, _, _, _) when is_number(value) and value >= 0 and value <= 255 do
    if trunc(value) != value, do: fail("le profil u8 exige un littéral entier")
    :u8
  end

  defp type({:number, _}, _, _, _, _),
    do: fail("littéral hors du profil u8 : entier de 0 à 255 attendu")

  defp type({:bool, _}, _, _, _, _), do: :bool

  defp type({:name, name}, local, _, _, _) do
    case Map.fetch(local, name) do
      {:ok, type} -> type
      :error -> fail("nom inconnu ou variable capturée : #{name}")
    end
  end

  defp type({:neg, value}, local, signatures, current, _) do
    expect(type(value, local, signatures, current, false), :u8)
  end

  defp type({:binary, op, left, right}, local, signatures, current, _)
       when op in [:+, :-, :<, :==, :*, :/] do
    expect(type(left, local, signatures, current, false), :u8)
    expect(type(right, local, signatures, current, false), :u8)
    if op in [:*, :/], do: power(right)
    if op in [:<, :==], do: :bool, else: :u8
  end

  defp type({:let, name, value, body}, local, signatures, current, tail) do
    if Map.has_key?(@primitives, name) or Map.has_key?(signatures, name) or
         (current != nil and name == current.name),
       do: fail("nom de fonction réservé : #{name}")

    value_type = type(value, local, signatures, current, false)
    type(body, Map.put(local, name, value_type), signatures, current, tail)
  end

  defp type({:case, condition, yes, no}, local, signatures, current, tail) do
    expect(type(condition, local, signatures, current, false), :bool)
    same(type(yes, local, signatures, current, tail), type(no, local, signatures, current, tail))
  end

  defp type({:call, {:name, name}, arguments}, local, signatures, current, tail) do
    cond do
      current != nil and name == current.name ->
        if not tail, do: fail("l'appel récursif à #{name} doit être en position terminale")

        arguments(
          arguments,
          List.duplicate(:u8, length(current.parameters)),
          local,
          signatures,
          current
        )

        :recursive

      Map.has_key?(@primitives, name) ->
        {expected, result} = Map.fetch!(@primitives, name)
        arguments(arguments, expected, local, signatures, current)
        if name == "rem", do: power(Enum.at(arguments, 1))
        result

      Map.has_key?(signatures, name) ->
        {expected, result, _} = Map.fetch!(signatures, name)
        arguments(arguments, expected, local, signatures, current)
        result

      true ->
        fail("fonction inconnue ou définie plus loin : #{name}")
    end
  end

  defp type(_, _, _, _, _),
    do:
      fail(
        "forme hors du profil : fonctions fermées au début du programme, sans fonction comme valeur"
      )

  defp arguments(values, expected, local, signatures, current) do
    if length(values) != length(expected),
      do: fail("nombre d'arguments attendu : #{length(expected)}, reçu : #{length(values)}")

    Enum.zip(values, expected)
    |> Enum.each(fn {value, expected} ->
      expect(type(value, local, signatures, current, false), expected)
    end)
  end

  defp power({:number, value}) when value in @powers, do: :ok

  defp power(_),
    do: fail("*, / et rem attendent à droite une puissance de deux littérale entre 1 et 128")

  defp call_depth({:call, {:name, name}, arguments}, signatures, current) do
    own =
      if name == current do
        0
      else
        case Map.get(signatures, name) do
          {_, _, depth} -> depth
          nil -> 0
        end
      end

    max(own, max_depth(arguments, signatures, current))
  end

  defp call_depth(tuple, signatures, current) when is_tuple(tuple),
    do: max_depth(Tuple.to_list(tuple), signatures, current)

  defp call_depth(list, signatures, current) when is_list(list),
    do: max_depth(list, signatures, current)

  defp call_depth(_, _, _), do: 0

  defp max_depth(items, signatures, current),
    do:
      Enum.reduce(items, 0, fn item, maximum ->
        max(maximum, call_depth(item, signatures, current))
      end)
end

defmodule PresentationChip8.Assembler do
  @moduledoc "Assembleur fourni : deux passes, labels, encodage big-endian et contrôle des 3,5 Kio."
  import Bitwise
  @origin 0x200
  @limit 0x1000
  def assemble(instructions) do
    try do
      {labels, stop} = Enum.reduce(instructions, {%{}, @origin}, &locate/2)

      if stop > @limit,
        do: fail("ROM trop grande : code, sprites et cases doivent tenir entre 0x200 et 0xFFF")

      rom = instructions |> Enum.map(&encode(&1, labels)) |> IO.iodata_to_binary()
      {:ok, %{rom: rom, labels: labels}}
    catch
      {:assembler_error, message} -> {:error, message}
    end
  end

  defp fail(message), do: throw({:assembler_error, message})

  defp put(labels, name, address) do
    if Map.has_key?(labels, name), do: fail("étiquette définie deux fois : #{inspect(name)}")
    Map.put(labels, name, address)
  end

  defp locate({:label, name}, {labels, address}) do
    if rem(address, 2) != 0, do: fail("instruction à une adresse impaire")
    {put(labels, name, address), address}
  end

  defp locate({:data, name, bytes}, {labels, address}) when is_binary(bytes),
    do: {put(labels, name, address), address + byte_size(bytes)}

  defp locate(_, {labels, address}) do
    if rem(address, 2) != 0, do: fail("instruction à une adresse impaire")
    {labels, address + 2}
  end

  defp address(labels, name) do
    case Map.fetch(labels, name) do
      {:ok, value} when value >= @origin and value < @limit -> value
      _ -> fail("étiquette inconnue ou hors mémoire : #{inspect(name)}")
    end
  end

  defp byte(n) when is_integer(n) and n in 0..255, do: n
  defp byte(_), do: fail("octet invalide")
  defp reg(n) when is_integer(n) and n in 0..15, do: n
  defp reg(_), do: fail("registre invalide")
  defp word(n), do: <<n::unsigned-big-16>>
  defp encode({:label, _}, _), do: <<>>
  defp encode({:data, _, bytes}, _), do: bytes
  defp encode({:raw, opcode}, _), do: word(opcode)
  defp encode(:return, _), do: word(0x00EE)
  defp encode({:call, name}, labels), do: word(0x2000 ||| address(labels, name))
  defp encode(:clear, _), do: word(0x00E0)
  defp encode({:jump, name}, labels), do: word(0x1000 ||| address(labels, name))
  defp encode({:index, name}, labels), do: word(0xA000 ||| address(labels, name))
  defp encode({:load, x, n}, _), do: word(0x6000 ||| reg(x) <<< 8 ||| byte(n))
  defp encode({:skip_eq, x, n}, _), do: word(0x3000 ||| reg(x) <<< 8 ||| byte(n))
  defp encode({:skip_reg_eq, x, y}, _), do: word(0x5000 ||| reg(x) <<< 8 ||| reg(y) <<< 4)

  defp encode({op, x, y}, _) when op in [:copy, :add, :sub] do
    suffix = %{copy: 0, add: 4, sub: 5}[op]
    word(0x8000 ||| reg(x) <<< 8 ||| reg(y) <<< 4 ||| suffix)
  end

  defp encode({:store, x}, _), do: word(0xF055 ||| reg(x) <<< 8)
  defp encode({:fetch, x}, _), do: word(0xF065 ||| reg(x) <<< 8)
  defp encode({:key, x}, _), do: word(0xF00A ||| reg(x) <<< 8)

  defp encode({:draw, x, y, n}, _) when n in 1..15,
    do: word(0xD000 ||| reg(x) <<< 8 ||| reg(y) <<< 4 ||| n)

  defp encode(instruction, _), do: fail("instruction inconnue : #{inspect(instruction)}")
end

defmodule PresentationChip8.Codegen do
  @moduledoc "Expressions en V0, fonctions à cases locales statiques et auto-appels terminaux en sauts."

  def initial(functions) do
    parameters =
      Map.new(functions, fn function ->
        {function.name, Enum.map(function.parameters, &{:parameter, function.name, &1})}
      end)

    slots =
      for function <- functions,
          label <- Map.fetch!(parameters, function.name),
          do: {:data, label, <<0>>}

    %{next: 0, slots: slots, parameters: parameters, current: nil}
  end

  def fresh(state, kind), do: {{kind, state.next}, %{state | next: state.next + 1}}

  def slot(state) do
    {label, state} = fresh(state, :slot)
    {label, %{state | slots: [{:data, label, <<0>>} | state.slots]}}
  end

  def function(definition, state) do
    env = Map.new(Enum.zip(definition.parameters, Map.fetch!(state.parameters, definition.name)))
    {code, state} = emit(definition.body, env, %{state | current: definition.name})
    {[{:label, {:function, definition.name}}] ++ code ++ [:return], %{state | current: nil}}
  end

  def emit({:number, n}, _env, state), do: {[{:load, 0, trunc(n)}], state}
  def emit({:bool, b}, _env, state), do: {[{:load, 0, if(b, do: 1, else: 0)}], state}
  def emit({:name, name}, env, state), do: {read(Map.fetch!(env, name)), state}
  def emit({:neg, value}, env, state), do: emit({:binary, :-, {:number, 0}, value}, env, state)

  def emit({:binary, op, left, {:number, power}}, env, state) when op in [:*, :/] do
    {code, state} = emit(left, env, state)
    shifts = shift_count(trunc(power))
    instruction = if op == :*, do: {:add, 0, 0}, else: {:raw, 0x8006}
    {code ++ List.duplicate(instruction, shifts), state}
  end

  def emit({:binary, op, left, right}, env, state) do
    {left_code, state} = emit(left, env, state)
    {saved, state} = slot(state)
    {right_code, state} = emit(right, env, state)
    {operation, state} = operation(op, state)

    {left_code ++ write(saved) ++ right_code ++ [{:copy, 1, 0}] ++ read(saved) ++ operation,
     state}
  end

  def emit({:let, name, value, body}, env, state) do
    {value_code, state} = emit(value, env, state)
    {saved, state} = slot(state)
    {body_code, state} = emit(body, Map.put(env, name, saved), state)
    {value_code ++ write(saved) ++ body_code, state}
  end

  def emit({:case, condition, yes, no}, env, state) do
    {condition_code, state} = emit(condition, env, state)
    {yes_label, state} = fresh(state, :yes)
    {done, state} = fresh(state, :done)
    {yes_code, state} = emit(yes, env, state)
    {no_code, state} = emit(no, env, state)

    {condition_code ++
       [{:skip_eq, 0, 0}, {:jump, yes_label}] ++
       no_code ++
       [{:jump, done}, {:label, yes_label}] ++ yes_code ++ [{:label, done}], state}
  end

  def emit({:call, {:name, name}, args}, env, state) do
    if Map.has_key?(state.parameters, name) do
      {argument_code, saved, state} = arguments(args, env, state)

      assignment =
        Enum.zip(saved, Map.fetch!(state.parameters, name))
        |> Enum.flat_map(fn {source, target} -> read(source) ++ write(target) end)

      call =
        if name == state.current, do: {:jump, {:function, name}}, else: {:call, {:function, name}}

      {argument_code ++ assignment ++ [call], state}
    else
      primitive(name, args, env, state)
    end
  end

  defp read(label), do: [{:index, label}, {:fetch, 0}]
  defp write(label), do: [{:index, label}, {:store, 0}]
  defp shift_count(1), do: 0
  defp shift_count(n), do: 1 + shift_count(div(n, 2))

  defp arguments(args, env, state) do
    Enum.reduce(args, {[], [], state}, fn arg, {code, saved, state} ->
      {value_code, state} = emit(arg, env, state)
      {slot, state} = slot(state)
      {code ++ value_code ++ write(slot), saved ++ [slot], state}
    end)
  end

  defp operation(:+, state), do: {[{:add, 0, 1}], state}
  defp operation(:-, state), do: {[{:sub, 0, 1}], state}

  defp operation(:<, state),
    do: {[{:sub, 0, 1}, {:copy, 1, 15}, {:load, 0, 1}, {:sub, 0, 1}], state}

  defp operation(:==, state) do
    {done, state} = fresh(state, :equal)

    {[
       {:load, 2, 0},
       {:skip_reg_eq, 0, 1},
       {:jump, done},
       {:load, 2, 1},
       {:label, done},
       {:copy, 0, 2}
     ], state}
  end

  defp primitive("clear", [], _env, state), do: {[:clear, {:load, 0, 0}], state}
  defp primitive("read_key", [], _env, state), do: {[{:key, 0}], state}

  defp primitive("rem", [value, {:number, power}], env, state) do
    {code, state} = emit(value, env, state)
    {code ++ [{:load, 1, trunc(power) - 1}, {:raw, 0x8012}], state}
  end

  defp primitive("load", [address], env, state) do
    {code, state} = emit(address, env, state)
    {code ++ [{:index, :memory}, {:raw, 0xF01E}, {:fetch, 0}], state}
  end

  defp primitive("store", [address, value], env, state) do
    {code, [saved_address, saved_value], state} = arguments([address, value], env, state)

    {code ++
       read(saved_value) ++
       [{:copy, 1, 0}] ++
       read(saved_address) ++
       [{:index, :memory}, {:raw, 0xF01E}, {:copy, 0, 1}, {:store, 0}, {:load, 0, 0}], state}
  end

  defp primitive("tile", [x, y, sprite], env, state) do
    {code, [saved_x, saved_y, saved_sprite], state} = arguments([x, y, sprite], env, state)
    {valid, state} = fresh(state, :tile_valid)
    {done, state} = fresh(state, :tile_done)

    code =
      code ++
        read(saved_sprite) ++
        [
          {:copy, 4, 0},
          {:load, 1, 7},
          {:sub, 0, 1},
          {:skip_eq, 15, 1},
          {:jump, valid},
          {:load, 0, 0},
          {:jump, done},
          {:label, valid},
          {:copy, 0, 4},
          {:add, 0, 0},
          {:add, 0, 0},
          {:copy, 4, 0}
        ] ++
        read(saved_x) ++
        [{:copy, 2, 0}] ++
        read(saved_y) ++
        [
          {:copy, 3, 0},
          {:index, {:sprite, 0}},
          {:raw, 0xF41E},
          {:draw, 2, 3, 4},
          {:load, 0, 0},
          {:label, done}
        ]

    {code, state}
  end
end

defmodule PresentationChip8 do
  @moduledoc "Compiler le langage u8 à fonctions fermées ; aucune règle de jeu dans le compilateur."
  alias PresentationChip8.{Assembler, Codegen, Lexer, Parser, Source, Sprites}

  def compile(text) when is_binary(text) and byte_size(text) <= 16000 do
    with {:ok, tokens} <- Lexer.lex(text),
         {:ok, parsed} <- Parser.parse(tokens),
         {:ok, program} <- Source.validate(normalize(parsed)) do
      state = Codegen.initial(program.functions)
      {entry, state} = Codegen.emit(program.entry, %{}, state)
      {functions, state} = Enum.map_reduce(program.functions, state, &Codegen.function/2)

      instructions =
        entry ++
          [{:label, :halt}, {:jump, :halt}] ++
          List.flatten(functions) ++
          Sprites.data() ++
          Enum.reverse(state.slots) ++ [{:data, :memory, <<0::2048>>}]

      with {:ok, artifact} <- Assembler.assemble(instructions) do
        {:ok, Map.merge(artifact, %{type: program.type, memory: artifact.labels.memory})}
      end
    end
  rescue
    error -> {:error, Exception.message(error)}
  end

  def compile(_), do: {:error, "Le programme doit contenir au plus 16 000 octets."}

  defp normalize({:binary, op, left, right}) do
    mapped = %{plus: :+, minus: :-, multiply: :*, divide: :/, lt: :<, eq: :==}
    {:binary, Map.get(mapped, op, op), normalize(left), normalize(right)}
  end

  defp normalize({:number, number}) when is_number(number) do
    {:number, if(trunc(number) == number, do: trunc(number), else: number)}
  end

  defp normalize(tuple) when is_tuple(tuple),
    do: tuple |> Tuple.to_list() |> Enum.map(&normalize/1) |> List.to_tuple()

  defp normalize(list) when is_list(list), do: Enum.map(list, &normalize/1)
  defp normalize(other), do: other

  @doc "Protocole JSON du runner, sans dépendance à Jason."
  def browser(text) do
    case compile(text) do
      {:ok, artifact} ->
        bytes = artifact.rom |> :binary.bin_to_list() |> Enum.join(",")

        IO.puts(
          "@@CHIP8@@{\"rom\":[" <>
            bytes <>
            "],\"memory\":" <>
            Integer.to_string(artifact.memory) <>
            ",\"type\":\"" <> Atom.to_string(artifact.type) <> "\"}"
        )

        :ok

      {:error, reason} ->
        raise ArgumentError,
              "Compilation refusée : #{if is_binary(reason), do: reason, else: inspect(reason)}"
    end
  end
end