diff --git a/hosts/ocaml/bin/mcp_tree.ml b/hosts/ocaml/bin/mcp_tree.ml index 1ee4d348..0a20a911 100644 --- a/hosts/ocaml/bin/mcp_tree.ml +++ b/hosts/ocaml/bin/mcp_tree.ml @@ -200,6 +200,38 @@ let setup_env () = | _ -> Nil); (* use — module declaration, no-op at eval time, metadata for static analysis *) bind "use" (fun _args -> Nil); + (* Capability-based evaluation contexts *) + let cap_stack : string list ref = ref [] in + bind "with-capabilities" (fun args -> match args with + | [List caps; body] -> + let cap_set = List.filter_map (fun v -> match v with + | Symbol s | String s -> Some s | _ -> None) caps in + let prev = !cap_stack in + cap_stack := cap_set; + (* body can be a lambda (call it) or an expression (eval it) *) + let result = try + match body with + | Lambda _ -> Sx_ref.cek_call body Nil + | _ -> body + with exn -> cap_stack := prev; raise exn in + cap_stack := prev; + result + | _ -> Nil); + bind "current-capabilities" (fun _args -> + if !cap_stack = [] then Nil + else List (List.map (fun s -> String s) !cap_stack)); + bind "has-capability?" (fun args -> match args with + | [String cap] -> + if !cap_stack = [] then Bool true (* no restriction *) + else Bool (List.mem cap !cap_stack) + | _ -> Bool true); + bind "require-capability!" (fun args -> match args with + | [String cap] -> + if !cap_stack = [] then Nil (* no restriction *) + else if List.mem cap !cap_stack then Nil + else raise (Eval_error (Printf.sprintf + "Capability '%s' not available. Current: %s" cap (String.concat ", " !cap_stack))) + | _ -> Nil); bind "trim" (fun args -> match args with | [String s] -> String (String.trim s) | _ -> String ""); bind "split" (fun args -> match args with