diff options
Diffstat (limited to 'ocaml')
| -rw-r--r-- | ocaml/lib/boot.ml | 92 | ||||
| -rw-r--r-- | ocaml/lib/nock.ml | 316 |
2 files changed, 288 insertions, 120 deletions
diff --git a/ocaml/lib/boot.ml b/ocaml/lib/boot.ml index 9e3f17c..61bb202 100644 --- a/ocaml/lib/boot.ml +++ b/ocaml/lib/boot.ml @@ -174,9 +174,29 @@ let life eve = Printf.printf "[Boot] About to execute: *[eve [2 [0 3] [0 2]]]\n%!"; Printf.printf "[Boot] This expands to: *[*[eve [0 3]] *[eve [0 2]]]\n%!"; + (* Log eve structure before nock - matching C vortex.c:43-59 *) + Printf.printf "[Boot] eve is %s\n%!" (if Noun.is_cell eve then "cell" else "atom"); + (match eve with + | Noun.Cell (eve_h, eve_t) -> + Printf.printf "[Boot] eve head is %s\n%!" (if Noun.is_cell eve_h then "cell" else "atom"); + Printf.printf "[Boot] eve tail is %s\n%!" (if Noun.is_cell eve_t then "cell" else "atom"); + (match eve_h with + | Noun.Cell (eve_hh, eve_ht) -> + Printf.printf "[Boot] eve head.head is %s\n%!" + (if Noun.is_atom eve_hh then + let z = match eve_hh with Noun.Atom z -> z | _ -> Z.zero in + "atom(" ^ Z.to_string z ^ ")" + else "cell"); + Printf.printf "[Boot] eve head.tail is %s\n%!" + (if Noun.is_cell eve_ht then "cell" else "atom") + | _ -> ()) + | _ -> ()); + (* First, manually compute the two parts to see where it fails *) let gat = try + Printf.printf "[Boot] calling Nock.nock_on(eve, [2 [0 3] [0 2]])...\n%!"; + (* Step 1: Compute *[eve [0 3]] = slot 3 of eve *) Printf.printf "[Boot] Step 1: Computing *[eve [0 3]] (slot 3 of subject)...\n%!"; let slot3_result = Nock.nock_on eve (Noun.cell (Noun.atom 0) (Noun.atom 3)) in @@ -189,9 +209,24 @@ let life eve = Printf.printf "[Boot] ✓ Slot 2 computed: %s\n%!" (if Noun.is_cell slot2_result then "cell" else "atom"); + (* Debug: check if slot2 looks like a valid Nock formula *) + Printf.printf "[Boot] Checking slot2 structure (should be a formula):\n%!"; + (match slot2_result with + | Noun.Cell (h, t) -> + Printf.printf "[Boot] slot2 = [%s %s]\n%!" + (if Noun.is_atom h then + let z = match h with Noun.Atom z -> z | _ -> Z.zero in + "atom(" ^ Z.to_string z ^ ")" + else "cell") + (if Noun.is_atom t then "atom" else "cell") + | Noun.Atom z -> + Printf.printf "[Boot] slot2 = atom(%s)\n%!" (Z.to_string z)); + (* Step 3: Compute *[slot3_result slot2_result] *) Printf.printf "[Boot] Step 3: Computing *[slot3 slot2] (nock slot-2 formula on slot-3 subject)...\n%!"; - Nock.nock_on slot3_result slot2_result + let result = Nock.nock_on slot3_result slot2_result in + Printf.printf "[Boot] ✓ Nock.nock_on returned successfully\n%!"; + result with e -> Printf.printf "[Boot] ✗ Nock failed during lifecycle: %s\n%!" (Printexc.to_string e); @@ -443,9 +478,6 @@ let build_event_list bot mod_ use_ = | _ -> acc in - (* Start with flipped bot events (NO timestamp) *) - let eve = flip (Noun.Atom Z.zero) bot in - (* Weld mod and use lists *) let rec weld l1 l2 = match l1 with @@ -456,7 +488,16 @@ let build_event_list bot mod_ use_ = let lit = weld mod_ use_ in - (* Add timestamped events *) + (* Start with flipped bot events (NO timestamp) *) + let eve = flip (Noun.Atom Z.zero) bot in + + (* Add timestamped mod/use events by consing to FRONT + * This matches C Vere: eve = u3nc(u3nc(now, i), eve) + * After all events are added, eve looks like: + * [[time use_last] ... [time mod1] bot3 bot2 bot1 ~] + * Then we flip to get: + * [bot1 bot2 bot3 [time mod1] ... [time use_last]] + *) let rec add_timestamped acc now_ref noun = match noun with | Noun.Atom z when Z.equal z Z.zero -> acc @@ -468,10 +509,8 @@ let build_event_list bot mod_ use_ = in now_ref := new_now; - (* Create [timestamp event] pair *) + (* Create [timestamp event] pair and cons to FRONT *) let stamped = Noun.Cell (new_now, event) in - - (* Cons onto accumulator *) let new_acc = Noun.Cell (stamped, acc) in add_timestamped new_acc now_ref rest @@ -481,10 +520,29 @@ let build_event_list bot mod_ use_ = let now_ref = ref now in let eve_with_stamped = add_timestamped eve now_ref lit in - (* Flip final list *) + (* Flip final list to get: [bot1 bot2 bot3 [time mod1] ...] *) let ova = flip (Noun.Atom Z.zero) eve_with_stamped in Printf.printf "[Boot] ✓ Event list built: %d events\n%!" (count_list ova); + + (* Debug: Check first few events *) + Printf.printf "[Boot] First event structure:\n%!"; + (match ova with + | Noun.Cell (first, _) -> + Printf.printf "[Boot] first = %s\n%!" + (if Noun.is_cell first then "cell" else "atom"); + (match first with + | Noun.Cell (h, t) -> + Printf.printf "[Boot] head = %s\n%!" + (if Noun.is_atom h then + let z = match h with Noun.Atom z -> z | _ -> Z.zero in + "atom(" ^ Z.to_string z ^ ")" + else "cell"); + Printf.printf "[Boot] tail = %s\n%!" + (if Noun.is_cell t then "cell" else "atom") + | _ -> ()) + | _ -> ()); + ova (* Boot lite - bootstrap ivory pill @@ -608,6 +666,22 @@ let boot_solid ~fs state ivory_path solid_path = (* Step 3.5: Synthesize events (C Vere mars.c:1763-1789) *) Printf.printf "[3.5] Synthesizing events (like C Vere)...\n%!"; + (* Debug: Check what's in first BOT event *) + Printf.printf " [Debug] Checking first BOT event structure:\n%!"; + (match bot with + | Noun.Cell (first_bot, _) -> + Printf.printf " first_bot is %s\n%!" + (if Noun.is_cell first_bot then "cell" else "atom"); + (match first_bot with + | Noun.Cell (h, _) -> + Printf.printf " first_bot head is %s\n%!" + (if Noun.is_atom h then + let z = match h with Noun.Atom z -> z | _ -> Z.zero in + "atom(" ^ Z.to_string z ^ ")" + else "cell") + | _ -> ()) + | _ -> ()); + (* Generate 4 synthetic MOD events *) let synth_mod = synthesize_mod_events () in Printf.printf " ✓ Generated 4 synthetic MOD events\n%!"; diff --git a/ocaml/lib/nock.ml b/ocaml/lib/nock.ml index 34065b8..670b12b 100644 --- a/ocaml/lib/nock.ml +++ b/ocaml/lib/nock.ml @@ -19,6 +19,10 @@ open Noun - 11: scry (errors in reference implementation) *) +(* Trace depth counter - only log first 20 levels *) +let trace_depth = ref 0 +let max_trace_depth = 20 + (** Main nock evaluation function: nock(subject, formula) In Nock notation: *[subject formula] @@ -26,120 +30,210 @@ open Noun 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 *) - let nex = - if is_cell gal then - (* [[hint-tag hint-value] formula] *) - tail gal - else - (* [hint-tag formula] where hint-value is implicit *) - gal - in - nock_on bus nex - - | 11 -> - (* scry - not implemented in reference nock, raises error *) - raise Exit + let should_trace = !trace_depth < max_trace_depth in + if should_trace then incr trace_depth; + try + let result = match fol with + | Cell (hib, gal) when is_cell hib -> + (* [a b] -> compute both sides and cons *) + if should_trace then Printf.eprintf "[Nock:%d] Cell-cell formula\n%!" !trace_depth; + let poz = nock_on bus hib in + let riv = nock_on bus gal in + cell poz riv - | _ -> - (* Invalid opcode *) + | Cell (Atom op, gal) -> + (* Check if opcode fits in int *) + if Z.compare op (Z.of_int max_int) > 0 then ( + if should_trace then Printf.eprintf "[Nock:%d] Opcode too large: %s\n%!" !trace_depth (Z.to_string op); raise Exit - ) + ); + let opcode = Z.to_int op in + if should_trace then Printf.eprintf "[Nock:%d] Opcode %d\n%!" !trace_depth opcode; + (match opcode with + | 0 -> + (* /[axis subject] - slot/fragment lookup *) + if not (is_atom gal) then ( + if should_trace then Printf.eprintf "[Nock:%d] Op0: gal not atom\n%!" !trace_depth; + 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 ( + if should_trace then Printf.eprintf "[Nock:%d] Op2: gal not cell\n%!" !trace_depth; + 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 ( + if should_trace then Printf.eprintf "[Nock:%d] Op5: wim not cell\n%!" !trace_depth; + 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 ( + if should_trace then Printf.eprintf "[Nock:%d] Op6: gal not cell\n%!" !trace_depth; + raise Exit + ); + let b_gal = head gal in + let cd_gal = tail gal in + if not (is_cell cd_gal) then ( + if should_trace then Printf.eprintf "[Nock:%d] Op6: cd_gal not cell\n%!" !trace_depth; + 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 + | _ -> + if should_trace then Printf.eprintf "[Nock:%d] Op6: tys not 0 or 1\n%!" !trace_depth; + raise Exit + in + nock_on bus nex + + | 7 -> + (* composition: *[*[subject b] c] *) + if not (is_cell gal) then ( + if should_trace then Printf.eprintf "[Nock:%d] Op7: gal not cell\n%!" !trace_depth; + 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 ( + if should_trace then Printf.eprintf "[Nock:%d] Op8: gal not cell\n%!" !trace_depth; + raise Exit + ); + let b_gal = head gal in + let c_gal = tail gal in + if should_trace then Printf.eprintf "[Nock:%d] Op8: computing b_gal...\n%!" !trace_depth; + let heb = nock_on bus b_gal in + if should_trace then Printf.eprintf "[Nock:%d] Op8: creating new subject [heb bus]...\n%!" !trace_depth; + let bod = cell heb bus in + if should_trace then Printf.eprintf "[Nock:%d] Op8: computing c_gal on new subject...\n%!" !trace_depth; + nock_on bod c_gal + + | 9 -> + (* call: *[*[subject c] axis] *) + if not (is_cell gal) then ( + if should_trace then Printf.eprintf "[Nock:%d] Op9: gal not cell\n%!" !trace_depth; + raise Exit + ); + let b_gal = head gal in + let c_gal = tail gal in + if not (is_atom b_gal) then ( + if should_trace then Printf.eprintf "[Nock:%d] Op9: b_gal not atom\n%!" !trace_depth; + 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 *) + if should_trace then Printf.eprintf "[Nock:%d] Op10: hint (gal is %s)\n%!" !trace_depth + (if is_cell gal then "cell" else "atom"); + let nex = + if is_cell gal then begin + (* [[hint-tag hint-value] formula] *) + let hint_part = head gal in + let formula = tail gal in + if should_trace then Printf.eprintf "[Nock:%d] Op10: hint_part is %s, formula is %s\n%!" !trace_depth + (if is_cell hint_part then "cell" else "atom") + (if is_cell formula then "cell" else "atom"); + formula + end else begin + (* [hint-tag formula] where hint-value is implicit *) + if should_trace then Printf.eprintf "[Nock:%d] Op10: implicit hint\n%!" !trace_depth; + gal + end + in + nock_on bus nex + + | 11 -> + (* scry - static scry *) + if should_trace then Printf.eprintf "[Nock:%d] Op11: scry (gal is %s)\n%!" !trace_depth + (if is_cell gal then "cell" else "atom"); + if not (is_cell gal) then ( + if should_trace then Printf.eprintf "[Nock:%d] Op11: gal not cell\n%!" !trace_depth; + raise Exit + ); + let ref_formula = head gal in + let gof_formula = tail gal in + + if should_trace then Printf.eprintf "[Nock:%d] Op11: ref_formula is %s, gof_formula is %s\n%!" !trace_depth + (if is_cell ref_formula then "cell" else "atom") + (if is_cell gof_formula then "cell" else "atom"); + + (* Check if ref_formula looks valid *) + (match ref_formula with + | Cell (Atom op, _) when Z.to_int op > 11 -> + if should_trace then Printf.eprintf "[Nock:%d] Op11: WARNING ref_formula has invalid opcode %d\n%!" !trace_depth (Z.to_int op) + | _ -> ()); + + (* Evaluate both formulas *) + if should_trace then Printf.eprintf "[Nock:%d] Op11: evaluating ref...\n%!" !trace_depth; + let _ref = nock_on bus ref_formula in + if should_trace then Printf.eprintf "[Nock:%d] Op11: evaluating gof...\n%!" !trace_depth; + let _gof = nock_on bus gof_formula in + + (* For now, scry always fails (returns block) + * In real Urbit, this would call into the scry handler + * C Vere calls u3m_soft_esc which can fail + * We'll return a crash for now *) + if should_trace then Printf.eprintf "[Nock:%d] Op11: scry not supported, crashing\n%!" !trace_depth; + raise Exit + + | n -> + (* Invalid opcode *) + if should_trace then Printf.eprintf "[Nock:%d] Invalid opcode: %d\n%!" !trace_depth n; + raise Exit + ) - | _ -> - (* Invalid formula structure *) - raise Exit + | _ -> + (* Invalid formula structure *) + if should_trace then Printf.eprintf "[Nock:%d] Invalid formula (not [atom cell] or [cell cell])\n%!" !trace_depth; + raise Exit + in + if should_trace then decr trace_depth; + result + with e -> + if should_trace then decr trace_depth; + raise e (** Convenience function: nock(subject, formula) *) let nock subject formula = |