diff options
Diffstat (limited to 'discocaml/eval.ml')
| -rw-r--r-- | discocaml/eval.ml | 30 |
1 files changed, 30 insertions, 0 deletions
diff --git a/discocaml/eval.ml b/discocaml/eval.ml index f1e5a2b..cdcb727 100644 --- a/discocaml/eval.ml +++ b/discocaml/eval.ml @@ -30,6 +30,9 @@ let has_free_var (ast : expr ast) (i : expr index) (name : string) : bool = | Prim (Mul, (l, r)) -> loop l; loop r + | Prim (RelOp, (_, l, r)) -> + loop l; + loop r | Var x -> if String.equal name x then raise FoundIt in try @@ -75,6 +78,11 @@ let check_redex (ast : expr ast) (i : expr index) : unit = match (get_subexpr ast l, get_subexpr ast r) with | Int _, Int _ -> raise (FoundRedex i) | _ -> ()) + | Prim (RelOp, (_, l, r)) -> ( + match (get_subexpr ast l, get_subexpr ast r) with + | Bool _, Bool _ -> raise (FoundRedex i) + | Int _, Int _ -> raise (FoundRedex i) + | _ -> ()) | Var _ -> () | Bool _ | Cons _ | Int _ | Lam _ | Nil -> () @@ -89,6 +97,9 @@ let find_redex_cbv_in (ast : expr ast) : expr index -> unit = | Prim (Add, (l, r)) | Prim (Sub, (l, r)) | Prim (Mul, (l, r)) -> loop l; loop r + | Prim (RelOp, (_, l, r)) -> + loop l; + loop r | Var _ -> () | Bool _ | Cons _ | Int _ | Lam _ | Nil -> ()); check_redex ast i @@ -107,6 +118,9 @@ let find_redex_cbn_in (ast : expr ast) : expr index -> unit = | Prim (Add, (l, r)) | Prim (Sub, (l, r)) | Prim (Mul, (l, r)) -> loop l; loop r + | Prim (RelOp, (_, l, r)) -> + loop l; + loop r | Var _ -> () | Bool _ | Cons _ | Int _ | Lam _ | Nil -> () in @@ -151,6 +165,7 @@ let subst (ast : expr ast) (from : string) (to_ : expr index) : | Prim (Add, (l, r)) -> add (Prim (Add, (loop l, loop r))) | Prim (Sub, (l, r)) -> add (Prim (Sub, (loop l, loop r))) | Prim (Mul, (l, r)) -> add (Prim (Mul, (loop l, loop r))) + | Prim (RelOp, (op, l, r)) -> add (Prim (RelOp, (op, loop l, loop r))) | Var x -> if String.equal from x then to_ else i in loop @@ -177,5 +192,20 @@ let reduce (ast : expr ast) (i : expr index) : expr ast = | 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) + | Prim (RelOp, (op, l, r)) -> + let l, r = + match (get_subexpr ast l, get_subexpr ast r) with + | Bool l, Bool r -> (Obj.repr l, Obj.repr r) + | Int l, Int r -> (Obj.repr l, Obj.repr r) + | _ -> fail () + in + Bool + (match op with + | `LT -> l < r + | `LTE -> l <= r + | `GT -> l > r + | `GTE -> l >= r + | `EQ -> l = r + | `NE -> l <> r) | _ -> fail ()); ast |