open Noun

(** Nock interpreter

    Based on the reference implementation from vere/pkg/noun/nock.c

    The Nock spec has 12 opcodes (0-11):
    - 0: slot/fragment lookup
    - 1: constant
    - 2: nock (recursion)
    - 3: is-cell test
    - 4: increment
    - 5: equality test
    - 6: if-then-else
    - 7: composition
    - 8: push
    - 9: call with axis
    - 10: hint (ignored in reference implementation)
    - 11: scry (errors in reference implementation)
*)

(** Main nock evaluation function: nock(subject, formula)

    In Nock notation: *[subject formula]

    This is a direct port of _n_nock_on from nock.c:157-396
*)
let rec nock_on bus fol =
  match fol with
  | Cell (hib, gal) when is_cell hib ->
      (* [a b] -> compute both sides and cons *)
      let poz = nock_on bus hib in
      let riv = nock_on bus gal in
      cell poz riv

  | Cell (Atom op, gal) ->
      (match Z.to_int op with
      | 0 ->
          (* /[axis subject] - slot/fragment lookup *)
          if not (is_atom gal) then raise Exit
          else slot (match gal with Atom n -> n | _ -> raise Exit) bus

      | 1 ->
          (* =[constant subject] - return constant *)
          gal

      | 2 ->
          (* *[subject formula new_subject] - evaluate with new subject *)
          if not (is_cell gal) then raise Exit;
          let b_gal = head gal in
          let c_gal = tail gal in
          let seb = nock_on bus b_gal in
          let nex = nock_on bus c_gal in
          nock_on seb nex

      | 3 ->
          (* ?[subject formula] - is-cell test *)
          let gof = nock_on bus gal in
          if is_cell gof then atom 0 else atom 1

      | 4 ->
          (* +[subject formula] - increment *)
          let gof = nock_on bus gal in
          inc gof

      | 5 ->
          (* =[subject formula] - equality test *)
          let wim = nock_on bus gal in
          if not (is_cell wim) then raise Exit;
          let a = head wim in
          let b = tail wim in
          if equal a b then atom 0 else atom 1

      | 6 ->
          (* if-then-else *)
          if not (is_cell gal) then raise Exit;
          let b_gal = head gal in
          let cd_gal = tail gal in
          if not (is_cell cd_gal) then raise Exit;
          let c_gal = head cd_gal in
          let d_gal = tail cd_gal in

          let tys = nock_on bus b_gal in
          let nex = match tys with
            | Atom n when Z.equal n Z.zero -> c_gal
            | Atom n when Z.equal n Z.one -> d_gal
            | _ -> raise Exit
          in
          nock_on bus nex

      | 7 ->
          (* composition: *[*[subject b] c] *)
          if not (is_cell gal) then raise Exit;
          let b_gal = head gal in
          let c_gal = tail gal in
          let bod = nock_on bus b_gal in
          nock_on bod c_gal

      | 8 ->
          (* push: *[[*[subject b] subject] c] *)
          if not (is_cell gal) then raise Exit;
          let b_gal = head gal in
          let c_gal = tail gal in
          let heb = nock_on bus b_gal in
          let bod = cell heb bus in
          nock_on bod c_gal

      | 9 ->
          (* call: *[*[subject c] axis] *)
          if not (is_cell gal) then raise Exit;
          let b_gal = head gal in
          let c_gal = tail gal in
          if not (is_atom b_gal) then raise Exit;

          let seb = nock_on bus c_gal in
          let nex = slot (match b_gal with Atom n -> n | _ -> raise Exit) seb in
          nock_on seb nex

      | 10 ->
          (* hint - in reference implementation, hints are mostly ignored *)
          (* gal must be a cell: [hint-spec formula] *)
          if not (is_cell gal) then raise Exit;
          let nex = tail gal in
          nock_on bus nex

      | 11 ->
          (* scry - not implemented in reference nock, raises error *)
          raise Exit

      | _ ->
          (* Invalid opcode *)
          raise Exit
      )

  | _ ->
      (* Invalid formula structure *)
      raise Exit

(** Convenience function: nock(subject, formula) *)
let nock subject formula =
  nock_on subject formula

(** slam: apply gate to sample
    slam(gate, sample) = *[gate [9 2 [0 1] [0 6] [1 sample] [0 7]]]

    In practice this evaluates the gate (which is a core with a formula at axis 2)
    with a modified sample (at axis 6).
*)
let slam gat sam =
  let cor = cell (head gat) (cell sam (tail (tail gat))) in
  let formula = slot (Z.of_int 2) cor in
  nock_on cor formula

(** kick: fire gate without changing sample
    kick(gate) = *[gate 9 2 0 1]
*)
let kick gat =
  let formula = slot (Z.of_int 2) gat in
  nock_on gat formula