diff options
Diffstat (limited to 'ocaml/lib/nock.ml')
| -rw-r--r-- | ocaml/lib/nock.ml | 93 |
1 files changed, 93 insertions, 0 deletions
diff --git a/ocaml/lib/nock.ml b/ocaml/lib/nock.ml new file mode 100644 index 0000000..5a51a92 --- /dev/null +++ b/ocaml/lib/nock.ml @@ -0,0 +1,93 @@ +open Noun + +let rec nock subject formula = + match formula with + | Atom _ -> raise Exit + | Cell (head_node, tail_node) -> ( + match head_node with + | Atom op when Z.fits_int op -> + let opcode = Z.to_int op in + begin match opcode with + | 0 -> + let axis = match tail_node with + | Atom z -> z + | _ -> raise Exit + in + slot axis subject + | 1 -> + tail_node + | 2 -> + if not (is_cell tail_node) then raise Exit; + let b = head tail_node in + let c = tail tail_node in + let new_subject = nock subject b in + let new_formula = nock subject c in + nock new_subject new_formula + | 3 -> + let res = nock subject tail_node in + if is_cell res then zero else one + | 4 -> + let res = nock subject tail_node in + inc res + | 5 -> + let res = nock subject tail_node in + if not (is_cell res) then raise Exit; + let a = head res in + let b = tail res in + if equal a b then zero else one + | 6 -> + if not (is_cell tail_node) then raise Exit; + let b = head tail_node in + let rest = tail tail_node in + if not (is_cell rest) then raise Exit; + let c = head rest in + let d = tail rest in + let test = nock subject b in + begin match test with + | Atom z when Z.equal z Z.zero -> nock subject c + | Atom z when Z.equal z Z.one -> nock subject d + | _ -> raise Exit + end + | 7 -> + if not (is_cell tail_node) then raise Exit; + let b = head tail_node in + let c = tail tail_node in + let new_subject = nock subject b in + nock new_subject c + | 8 -> + if not (is_cell tail_node) then raise Exit; + let b = head tail_node in + let c = tail tail_node in + let value = nock subject b in + let new_subject = cell value subject in + nock new_subject c + | 9 -> + if not (is_cell tail_node) then raise Exit; + let b = head tail_node in + let c = tail tail_node in + let axis = match b with + | Atom z -> z + | _ -> raise Exit + in + let core = nock subject c in + let target = slot axis core in + nock core target + | 10 -> + if not (is_cell tail_node) then raise Exit; + let _p = head tail_node in + let q = tail tail_node in + nock subject q + | 11 -> + if not (is_cell tail_node) then raise Exit; + let _p = head tail_node in + let q = tail tail_node in + nock subject q + | _ -> + raise Exit + end + | _ -> + let left = nock subject head_node in + let right = nock subject tail_node in + cell left right) + +let nock_on subject formula = nock subject formula |
