diff --git a/lib/interp.ml b/lib/interp.ml index 01450b8..70ba0b8 100644 --- a/lib/interp.ml +++ b/lib/interp.ml @@ -214,7 +214,13 @@ let rec eval : type a. a Expr.t -> value = | Seq (e1, e2) -> eval e1 |> ignore; eval e2 - | Bin_op { op; left; right } -> ( + | Uop { op; arg } -> ( + let v = eval arg in + match (op, v) with + | Not, Bool b -> Bool (not b) + | Uminus, Int i -> Int ~-i + | _, _ -> raise Type_error) + | Bop { op; left; right } -> ( let v1 = eval left in let v2 = eval right in match (op, v1, v2) with diff --git a/lib/parser.mly b/lib/parser.mly index 2dd7366..9393709 100644 --- a/lib/parser.mly +++ b/lib/parser.mly @@ -27,6 +27,7 @@ open Expr %right AND %left PLUS MINUS %left TIMES +%nonassoc prec_unary %start prog @@ -39,7 +40,7 @@ comp_lst: comp_expr: | LET; name = var; param = var; EQ; body = expr { { name; param; body = hook_full body } } expr: - | bop_expr { $1 } + | atom { $1 } | FUN; param = var; RARROW; body = expr { Ex (Fn { param; body = hook_free_exn body }) } | LET; id = var; EQ; bound = expr; IN; body = expr { let Ex body = body in @@ -59,11 +60,13 @@ expr: | Some e1, Some e2 -> Ex (Seq (e1, e2)) | _, _ -> Ex (Seq (hook_full e1, hook_full e2)) } -bop_expr: - | atom { $1 } - | left = bop_expr; op = op; right = bop_expr - { Ex (Bin_op { op; left = hook_free_exn left; right = hook_free_exn right }) } -%inline op: + | op = uop; expr = expr %prec prec_unary { Ex (Uop { op; arg = hook_free_exn expr }) } + | left = expr; op = bop; right = expr + { Ex (Bop { op; left = hook_free_exn left; right = hook_free_exn right }) } +%inline uop: + | PLUS { Uplus } + | MINUS { Uminus } +%inline bop: | AND { And } | OR { Or } | PLUS { Plus } diff --git a/lib/syntax.ml b/lib/syntax.ml index 9eb0928..ced0505 100644 --- a/lib/syntax.ml +++ b/lib/syntax.ml @@ -40,10 +40,12 @@ module Expr = struct -> hook_full t | Eff : hook_free t -> hook_full t | Seq : 'a t * 'a t -> 'a t - | Bin_op : { op : bin_op; left : hook_free t; right : hook_free t } -> _ t + | Uop : { op : uop; arg : hook_free t } -> _ t + | Bop : { op : bop; left : hook_free t; right : hook_free t } -> _ t and const = Unit | Bool of bool | Int of int - and bin_op = And | Or | Plus | Minus | Times + and uop = Not | Uplus | Uminus + and bop = And | Or | Plus | Minus | Times type some_expr = Ex : 'a t -> some_expr [@@unboxed] @@ -51,46 +53,51 @@ module Expr = struct let (Ex expr) = expr in let ( let* ) = Stdlib.Option.bind in match expr with - | Const _ as e -> Some e - | Var _ as e -> Some e - | View _ as e -> Some e - | Cond _ as e -> Some e - | Fn _ as e -> Some e - | App _ as e -> Some e | Let ({ body; _ } as e) -> let* body = hook_free (Ex body) in Some (Let { e with body }) - | Stt _ -> None - | Eff _ -> None + | Stt _ | Eff _ -> None | Seq (e1, e2) -> let* e1 = hook_free (Ex e1) in let* e2 = hook_free (Ex e2) in Some (Seq (e1, e2)) - | Bin_op _ as e -> Some e + | (Const _ as e) + | (Var _ as e) + | (View _ as e) + | (Cond _ as e) + | (Fn _ as e) + | (App _ as e) + | (Bop _ as e) + | (Uop _ as e) -> + Some e let hook_free_exn e = Option.value_exn (hook_free e) let rec hook_full (expr : some_expr) : hook_full t = let (Ex expr) = expr in match expr with - | Const _ as e -> e - | Var _ as e -> e - | View _ as e -> e - | Cond _ as e -> e - | Fn _ as e -> e - | App _ as e -> e | Let ({ body; _ } as e) -> let body = hook_full (Ex body) in Let { e with body } - | Stt _ as e -> e - | Eff _ as e -> e | Seq (e1, e2) -> let e1 = hook_full (Ex e1) in let e2 = hook_full (Ex e2) in Seq (e1, e2) - | Bin_op _ as e -> e - - let string_of_bin_op = function + | (Const _ as e) + | (Var _ as e) + | (View _ as e) + | (Cond _ as e) + | (Fn _ as e) + | (App _ as e) + | (Stt _ as e) + | (Eff _ as e) + | (Uop _ as e) + | (Bop _ as e) -> + e + + let string_of_uop = function Not -> "not" | Uplus -> "+" | Uminus -> "-" + + let string_of_bop = function | And -> "&&" | Or -> "||" | Plus -> "+" @@ -123,11 +130,9 @@ module Expr = struct ] | Eff e -> l [ a "Eff"; sexp_of_t e ] | Seq (e1, e2) -> l [ a "Seq"; sexp_of_t e1; sexp_of_t e2 ] - | Bin_op { op; left; right } -> - l - [ - a "Bin_op"; a (string_of_bin_op op); sexp_of_t left; sexp_of_t right; - ] + | Uop { op; arg } -> l [ a "Uop"; a (string_of_uop op); sexp_of_t arg ] + | Bop { op; left; right } -> + l [ a "Bop"; a (string_of_bop op); sexp_of_t left; sexp_of_t right ] end module Prog = struct diff --git a/samples/simple.ml b/samples/simple.ml index 7958474..ac3202c 100644 --- a/samples/simple.ml +++ b/samples/simple.ml @@ -1,6 +1,6 @@ let C x = stt s, setS = 42 in - eff (setS (fun s -> 43)); + eff (setS (fun s -> -43)); view [()] ;; view [C ()] diff --git a/test/test_react_trace.ml b/test/test_react_trace.ml index ebe142f..9abdb7c 100644 --- a/test/test_react_trace.ml +++ b/test/test_react_trace.ml @@ -95,7 +95,7 @@ let set_in_effect_step_indefinitely () = { param = "s"; body = - Bin_op + Bop { op = Plus; left = Var "s";