blob: 676cd67302d8295a4fea5f9383b5e235d7aed8fb (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
open Ast
type command = [ `Parse | `DrawTree | `RunCBN | `RunCBV | `StepCBN | `StepCBV ]
let command_of_yojson = function
| `String "Parse" -> Ok `Parse
| `String "DrawTree" -> Ok `DrawTree
| `String "RunCBN" -> Ok `RunCBN
| `String "RunCBV" -> Ok `RunCBV
| `String "StepCBN" -> Ok `StepCBN
| `String "StepCBV" -> Ok `StepCBV
| _ -> Error "invalid command"
type request = { expr : string; command : command }
[@@deriving of_yojson { exn = true }]
type response_expr = { expr : string; has_redex : bool; note : string option }
[@@deriving to_yojson { exn = true }]
type response =
[ `Error of string
| `Expr of response_expr
| `Exprs of string option * string array
| `Graphviz of string ]
[@@deriving to_yojson { exn = true }]
let%expect_test _ =
Yojson.Safe.to_channel stdout (response_to_yojson (`Error "foo"));
[%expect {| ["Error","foo"] |}]
let%expect_test _ =
Yojson.Safe.to_channel stdout
(response_to_yojson
(`Expr { expr = "foo"; has_redex = false; note = None }));
[%expect {| ["Expr",{"expr":"foo","has_redex":false,"note":null}] |}]
let%expect_test _ =
Yojson.Safe.to_channel stdout
(response_to_yojson (`Exprs (Some "A", [| "B"; "C" |])));
[%expect {| ["Exprs","A",["B","C"]] |}]
let handle_request { expr; command } : response =
try
let buf = Lexing.from_string expr in
let expr = Parse.expression buf in
let expr = expr_of_parsetree expr in
let expr_response ?(note : string option) (expr : expr ast) : response =
`Expr
{
expr = show_expr expr;
has_redex = Option.is_some (Eval.find_redex_cbn expr);
note;
}
in
let step_with (find_redex : expr ast -> expr index option) (expr : expr ast)
: expr ast =
match find_redex expr with
| Some i -> Eval.reduce expr i
| None -> failwith "no redex"
in
let run_with (find_redex : expr ast -> expr index option) :
expr ast -> expr ast Seq.t =
let rec loop (expr : expr ast) : expr ast Seq.t =
Seq.cons expr (fun () ->
match find_redex expr with
| Some i -> loop (Eval.reduce expr i) ()
| None -> Nil)
in
loop
in
match command with
| `Parse -> expr_response expr
| `StepCBN ->
expr_response ~note:"After one CBN step:"
(step_with Eval.find_redex_cbn expr)
| `StepCBV ->
expr_response ~note:"After one CBV step:"
(step_with Eval.find_redex_cbv expr)
| `DrawTree -> `Graphviz (Draw_tree.draw_tree expr)
| `RunCBN ->
`Exprs
( Some "Evaluating with CBN:",
run_with Eval.find_redex_cbn expr
|> Seq.take 100 |> Seq.map show_expr |> Array.of_seq )
| `RunCBV ->
`Exprs
( Some "Evaluating with CBV:",
run_with Eval.find_redex_cbv expr
|> Seq.take 100 |> Seq.map show_expr |> Array.of_seq )
with
| Eval.NotARedex expr -> `Error ("not a redex: " ^ show_expr expr)
| Failure msg -> `Error msg
| exn -> `Error ("uncaught exception: " ^ Printexc.to_string exn)
|
