diff options
Diffstat (limited to 'discocaml')
| -rw-r--r-- | discocaml/ast.ml | 7 | ||||
| -rw-r--r-- | discocaml/discocaml.ml | 30 | ||||
| -rw-r--r-- | discocaml/eval.ml | 13 |
3 files changed, 37 insertions, 13 deletions
diff --git a/discocaml/ast.ml b/discocaml/ast.ml index 63893fa..92ac32d 100644 --- a/discocaml/ast.ml +++ b/discocaml/ast.ml @@ -161,3 +161,10 @@ let parsetree_of_subexpr (ast : 'a ast) : expr -> Parsetree.expression = let parsetree_of_expr (ast : expr ast) : Parsetree.expression = parsetree_of_subexpr ast (get_subexpr ast ast.root) + +let show_expr (expr : expr ast) : string = + let buf = Buffer.create 16 in + let fmt = Format.formatter_of_buffer buf in + Pprintast.expression fmt (parsetree_of_expr expr); + Format.pp_print_flush fmt (); + Buffer.contents buf diff --git a/discocaml/discocaml.ml b/discocaml/discocaml.ml index df5cef3..e244e26 100644 --- a/discocaml/discocaml.ml +++ b/discocaml/discocaml.ml @@ -14,7 +14,7 @@ let command_of_yojson = function type request = { expr : string; command : command } [@@deriving of_yojson { exn = true }] -type response_expr = { expr : string; has_redex : bool } +type response_expr = { expr : string; has_redex : bool; note : string option } [@@deriving to_yojson { exn = true }] type response = @@ -27,8 +27,9 @@ let%expect_test _ = let%expect_test _ = Yojson.Safe.to_channel stdout - (response_to_yojson (`Expr { expr = "foo"; has_redex = false })); - [%expect {| ["Expr",{"expr":"foo","has_redex":false}] |}] + (response_to_yojson + (`Expr { expr = "foo"; has_redex = false; note = None })); + [%expect {| ["Expr",{"expr":"foo","has_redex":false,"note":null}] |}] let handle_request { expr; command } : response = try @@ -36,13 +37,13 @@ let handle_request { expr; command } : response = let expr = Parse.expression buf in let expr = expr_of_parsetree expr in - let expr_response (expr : expr ast) : response = - let buf = Buffer.create 16 in - (let fmt = Format.formatter_of_buffer buf in - Pprintast.expression fmt (parsetree_of_expr expr); - Format.pp_print_flush fmt ()); - let has_redex = Option.is_some (Eval.find_redex_cbn expr) in - `Expr { expr = Buffer.contents buf; has_redex } + 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) @@ -54,10 +55,15 @@ let handle_request { expr; command } : response = match command with | `Parse -> expr_response expr - | `StepCBN -> expr_response (step_with Eval.find_redex_cbn expr) - | `StepCBV -> expr_response (step_with Eval.find_redex_cbv 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 | `RunCBV -> failwith "not implemented" with + | Eval.NotARedex expr -> `Error ("not a redex: " ^ show_expr expr) | Failure msg -> `Error msg | exn -> `Error ("uncaught exception: " ^ Printexc.to_string exn) diff --git a/discocaml/eval.ml b/discocaml/eval.ml index 9c12003..f8f7dc2 100644 --- a/discocaml/eval.ml +++ b/discocaml/eval.ml @@ -38,6 +38,17 @@ let find_redex_cbv (ast : expr ast) : expr index option = let find_redex_cbn (ast : expr ast) : expr index option = find_redex_cbn_in ast ast.root -let reduce (ast : expr ast) (_i : expr index) : expr ast = +exception NotARedex of expr ast + +let reduce (ast : expr ast) (i : expr index) : expr ast = + let fail () = raise (NotARedex { ast with root = i }) in let ast = copy ast in + let must_int j = match get_subexpr ast j with Int n -> n | _ -> fail () in + Arraylist.set ast.subexprs i.index + (match get_subexpr ast i with + | App (_f, _x) -> failwith "TODO" + | Prim (Add, (l, r)) -> Int (must_int l + must_int r) + | Prim (Sub, (l, r)) -> Int (must_int l - must_int r) + | Prim (Mul, (l, r)) -> Int (must_int l * must_int r) + | _ -> fail ()); ast |