Step 7d complete: exhaustive match checking + evaluator cleanup

Match exhaustiveness analysis:
- check-match-exhaustiveness function in evaluator.sx
- lint-node in tree-tools.sx checks match forms during format-check
- Warns on: no wildcard/catch-all, boolean missing true/false case
- (match x (true "yes")) → "match may be non-exhaustive"

Evaluator cleanup:
- Added missing step-sf-callcc definition (was in old transpiled output)
- Added missing step-sf-case definition (was in old transpiled output)
- Removed protocol functions from bootstrap skip set (they transpile fine)
- Retranspiled VM (bootstrap_vm.py) for compatibility

2650 tests pass (+5 from new features).

All Step 7 features complete:
  7a: ->> |> as-> pipe operators
  7b: Dict patterns, &rest, let-match destructuring
  7c: define-protocol, implement, satisfies?
  7d: Exhaustive match checking

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>

hosts/ocaml/bootstrap.py

@@ -53,6 +53,7 @@ let trampoline v = !trampoline_fn v
 let _strict_ref = ref (Bool false)
 let _prim_param_types_ref = ref Nil
 let _last_error_kont_ref = ref Nil
+let _protocol_registry_ = Dict (Hashtbl.create 0)
 
 """
 
@@ -209,6 +210,15 @@ def compile_spec_to_ml(spec_dir: str | None = None) -> str:
     # the transpiler directly — it emits !_ref for reads, _ref := for writes.
     import re
 
+    # Remove `and _protocol_registry_ = (Dict ...)` from the let rec block —
+    # it's defined in the preamble as a top-level let, and Hashtbl.create
+    # is not allowed as a let rec right-hand side.
+    output = re.sub(
+        r'\n\(\* \*protocol-registry\*.*?\nand _protocol_registry_ =\n  \(Dict \(Hashtbl\.create 0\)\)\n',
+        '\n',
+        output
+    )
+
     return output
 
 

hosts/ocaml/lib/sx_ref.ml

@@ -510,6 +510,10 @@ and step_sf_raise args env kont =
 and step_sf_guard args env kont =
   (let var_clauses = (first (args)) in let body = (rest (args)) in let var = (first (var_clauses)) in let clauses = (rest (var_clauses)) in let sentinel = (make_symbol ((String "__guard-reraise__"))) in (step_eval_list ((List [(Symbol "let"); (List [(List [(Symbol "__guard-result"); (cons ((Symbol "call/cc")) ((List [(cons ((Symbol "fn")) ((cons ((List [(Symbol "__guard-k")])) ((List [(cons ((Symbol "handler-bind")) ((cons ((List [(List [(cons ((Symbol "fn")) ((cons ((List [(Symbol "_")])) ((List [(Bool true)]))))); (cons ((Symbol "fn")) ((cons ((List [var])) ((List [(List [(Symbol "__guard-k"); (cons ((Symbol "cond")) ((prim_call "append" [clauses; (List [(List [(Symbol "else"); (List [(Symbol "list"); (List [(Symbol "quote"); sentinel]); var])])])])))])])))))])])) ((List [(List [(Symbol "__guard-k"); (cons ((Symbol "begin")) (body))])])))))])))))])))])]); (List [(Symbol "if"); (List [(Symbol "and"); (List [(Symbol "list?"); (Symbol "__guard-result")]); (List [(Symbol "="); (List [(Symbol "len"); (Symbol "__guard-result")]); (Number 2.0)]); (List [(Symbol "="); (List [(Symbol "first"); (Symbol "__guard-result")]); (List [(Symbol "quote"); sentinel])])]); (List [(Symbol "raise"); (List [(Symbol "nth"); (Symbol "__guard-result"); (Number 1.0)])]); (Symbol "__guard-result")])])) (env) (kont)))
 
+(* step-sf-callcc *)
+and step_sf_callcc args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_callcc_frame (env))) (kont))))
+
 (* step-sf-case *)
 and step_sf_case args env kont =
   (make_cek_state ((first (args))) (env) ((kont_push ((make_case_frame (Nil) ((rest (args))) (env))) (kont))))
@@ -578,6 +582,7 @@ and step_sf_import args env kont =
 and step_sf_perform args env kont =
   (if sx_truthy ((empty_p (args))) then (raise (Eval_error (value_to_str (String "perform requires an IO request argument")))) else (make_cek_state ((first (args))) (env) ((kont_push ((make_perform_frame (env))) (kont)))))
 
+
 (* sf-define-record-type *)
 and sf_define_record_type args env =
   (let type_sym = (first (args)) in let ctor_spec = (nth (args) ((Number 1.0))) in let pred_sym = (nth (args) ((Number 2.0))) in let field_specs = (prim_call "slice" [args; (Number 3.0)]) in (let raw_name = (symbol_name (type_sym)) in (let type_name = (if sx_truthy ((let _and = (prim_call "starts-with?" [raw_name; (String "<")]) in if not (sx_truthy _and) then _and else (prim_call "ends-with?" [raw_name; (String ">")]))) then (prim_call "slice" [raw_name; (Number 1.0); (prim_call "-" [(len (raw_name)); (Number 1.0)])]) else raw_name) in let ctor_name = (symbol_name ((first (ctor_spec)))) in let ctor_params = (List (List.map (fun s -> (symbol_name (s))) (sx_to_list (rest (ctor_spec))))) in let pred_name = (symbol_name (pred_sym)) in let field_names = (List (List.map (fun fs -> (symbol_name ((first (fs))))) (sx_to_list field_specs))) in (let rtd_uid = (make_rtd (type_name) (field_names) (ctor_params)) in (let () = ignore ((env_bind env (sx_to_string ctor_name) (make_record_constructor (rtd_uid)))) in (let () = ignore ((env_bind env (sx_to_string pred_name) (make_record_predicate (rtd_uid)))) in (let () = ignore ((for_each_indexed ((NativeFn ("\206\187", fun _args -> match _args with [idx; fs] -> (fun idx fs -> (let accessor_name = (symbol_name ((nth (fs) ((Number 1.0))))) in (let () = ignore ((env_bind env (sx_to_string accessor_name) (make_record_accessor (idx)))) in (if sx_truthy ((prim_call ">=" [(len (fs)); (Number 3.0)])) then (let mutator_name = (symbol_name ((nth (fs) ((Number 2.0))))) in (env_bind env (sx_to_string mutator_name) (make_record_mutator (idx)))) else Nil)))) idx fs | _ -> Nil))) (field_specs))) in Nil)))))))
@@ -594,9 +599,9 @@ and sf_implement args env =
 and satisfies_p proto_name value =
   (if sx_truthy ((Bool (not (sx_truthy ((record_p (value))))))) then (Bool false) else (let proto = (get (_protocol_registry_) ((if sx_truthy ((symbol_p (proto_name))) then (symbol_name (proto_name)) else proto_name))) in (if sx_truthy ((is_nil (proto))) then (Bool false) else (Bool (not (sx_truthy ((is_nil ((get ((get (proto) ((String "impls")))) ((type_of (value)))))))))))))
 
-(* step-sf-callcc *)
-and step_sf_callcc args env kont =
-  (make_cek_state ((first (args))) (env) ((kont_push ((make_callcc_frame (env))) (kont))))
+(* check-match-exhaustiveness *)
+and check_match_exhaustiveness clauses =
+  (let warnings = ref ((List [])) in let patterns = (List (List.map (fun c -> (first (c))) (sx_to_list clauses))) in let has_wildcard = (Bool (List.exists (fun p -> sx_truthy ((let _and = (symbol_p (p)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((prim_call "=" [p; (Bool true)]))))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((prim_call "=" [p; (Bool false)]))))))))) (sx_to_list patterns))) in let has_else = (Bool (List.exists (fun p -> sx_truthy ((prim_call "=" [p; (String "else")]))) (sx_to_list patterns))) in let has_true = (Bool (List.exists (fun p -> sx_truthy ((prim_call "=" [p; (Bool true)]))) (sx_to_list patterns))) in let has_false = (Bool (List.exists (fun p -> sx_truthy ((prim_call "=" [p; (Bool false)]))) (sx_to_list patterns))) in (let () = ignore ((if sx_truthy ((let _and = (Bool (not (sx_truthy (has_wildcard)))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy (has_else)))))) then (warnings := (prim_call "append" [!warnings; (List [(String "match may be non-exhaustive (no wildcard or :else pattern)")])]); Nil) else Nil)) in (let () = ignore ((if sx_truthy ((let _and = (let _or = has_true in if sx_truthy _or then _or else has_false) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((let _and = has_true in if not (sx_truthy _and) then _and else has_false))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy (has_wildcard)))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy (has_else)))))))) then (warnings := (prim_call "append" [!warnings; (List [(if sx_truthy (has_true) then (String "match on boolean missing false case") else (String "match on boolean missing true case"))])]); Nil) else Nil)) in !warnings)))
 
 (* match-find-clause *)
 and match_find_clause val' clauses env =