···
3
+
(* Set up the formatter for capturing evaluation output *)
4
+
let capture_output f =
5
+
let buffer = Buffer.create 1024 in
6
+
let fmt = Format.formatter_of_buffer buffer in
7
+
let result = f fmt in
8
+
Format.pp_print_flush fmt ();
9
+
(result, Buffer.contents buffer)
11
+
(* Helper for extracting string value from JSON *)
12
+
let get_string_param json name =
15
+
(match List.assoc_opt name fields with
16
+
| Some (`String value) -> value
17
+
| _ -> failwith (Printf.sprintf "Missing or invalid parameter: %s" name))
18
+
| _ -> failwith "Expected JSON object"
20
+
(* Initialize the OCaml toploop with standard libraries *)
21
+
let initialize_toploop () =
22
+
(* Initialize the toplevel environment *)
23
+
Toploop.initialize_toplevel_env ();
25
+
(* Set up the toplevel as if using the standard OCaml REPL *)
26
+
Clflags.nopervasives := false;
27
+
Clflags.real_paths := true;
28
+
Clflags.recursive_types := false;
29
+
Clflags.strict_sequence := false;
30
+
Clflags.applicative_functors := true;
32
+
(* Return success message *)
33
+
"OCaml evaluation environment initialized"
35
+
(* Evaluate an OCaml toplevel phrase *)
36
+
let evaluate_phrase phrase =
37
+
(* Parse the input text as a toplevel phrase *)
38
+
let lexbuf = Lexing.from_string phrase in
40
+
(* Capture both success/failure status and output *)
42
+
let parsed_phrase = !Toploop.parse_toplevel_phrase lexbuf in
43
+
let (success, output) = capture_output (fun fmt ->
44
+
Toploop.execute_phrase true fmt parsed_phrase
47
+
(* Return structured result with status and captured output *)
50
+
("success", `Bool true);
51
+
("output", `String output);
55
+
("success", `Bool false);
56
+
("error", `String "Execution failed");
57
+
("output", `String output);
60
+
(* Handle parsing or other errors with more detailed messages *)
61
+
let error_msg = match e with
62
+
| Syntaxerr.Error err ->
63
+
let msg = match err with
64
+
| Syntaxerr.Unclosed _ -> "Syntax error: Unclosed delimiter"
65
+
| Syntaxerr.Expecting _ -> "Syntax error: Expecting a different token"
66
+
| Syntaxerr.Not_expecting _ -> "Syntax error: Unexpected token"
67
+
| Syntaxerr.Applicative_path _ -> "Syntax error: Invalid applicative path"
68
+
| Syntaxerr.Variable_in_scope _ -> "Syntax error: Variable in scope"
69
+
| Syntaxerr.Other _ -> "Syntax error"
70
+
| _ -> "Syntax error (unknown kind)"
74
+
| Lexer.Error (err, _) ->
75
+
let msg = match err with
76
+
| Lexer.Illegal_character _ -> "Lexer error: Illegal character"
77
+
| Lexer.Illegal_escape _ -> "Lexer error: Illegal escape sequence"
78
+
| Lexer.Unterminated_comment _ -> "Lexer error: Unterminated comment"
79
+
| Lexer.Unterminated_string -> "Lexer error: Unterminated string"
80
+
| Lexer.Unterminated_string_in_comment _ -> "Lexer error: Unterminated string in comment"
81
+
| Lexer.Invalid_literal _ -> "Lexer error: Invalid literal"
82
+
| _ -> "Lexer error (unknown kind)"
85
+
| _ -> Printexc.to_string e
88
+
("success", `Bool false);
89
+
("error", `String error_msg);
92
+
(* Create evaluation server *)
93
+
let server = create_server
94
+
~name:"OCaml Evaluation Server"
95
+
~version:"0.1.0" () |>
97
+
(* Set default capabilities *)
98
+
configure_server server ~with_tools:true ()
100
+
(* Toplevel environment state management *)
101
+
let toplevel_initialized = ref false
103
+
(* Initialize OCaml toplevel on first use *)
104
+
let ensure_toploop_initialized () =
105
+
if not !toplevel_initialized then begin
106
+
let _ = initialize_toploop () in
107
+
toplevel_initialized := true;
110
+
(* Register eval tool *)
111
+
let _ = add_tool server
113
+
~description:"Evaluates OCaml toplevel phrases and returns the result"
114
+
~schema_properties:[
115
+
("code", "string", "OCaml code to evaluate")
117
+
~schema_required:["code"]
119
+
ensure_toploop_initialized ();
122
+
(* Extract code parameter *)
123
+
let code = get_string_param args "code" in
125
+
(* Execute the code *)
126
+
let result = evaluate_phrase code in
128
+
(* Return formatted result *)
129
+
let success = match result with
130
+
| `Assoc fields -> (
131
+
match List.assoc_opt "success" fields with
132
+
| Some (`Bool true) -> true
138
+
let output = match result with
139
+
| `Assoc fields -> (
140
+
match List.assoc_opt "output" fields with
141
+
| Some (`String s) -> s
143
+
match List.assoc_opt "error" fields with
144
+
| Some (`String s) -> s
145
+
| _ -> "Unknown result"
148
+
| _ -> "Unknown result"
151
+
(* Create a tool result with colorized output *)
152
+
create_tool_result [
154
+
] ~is_error:(not success)
158
+
Log.error (Printf.sprintf "Error in OCaml eval tool: %s" msg);
159
+
create_tool_result [TextContent (Printf.sprintf "Error: %s" msg)] ~is_error:true
162
+
(* Run the server with the default scheduler *)
164
+
Eio_main.run @@ fun env->
165
+
Mcp_server.run_server env server
anil.recoil.org