ryan.freumh.org
forked from
patrick.sirref.org/merry
Shells in OCaml
1(* We handle _very_ simple arithmetic expressions.
2 Really nothing crazy yet, hopefully enough to handle
3 most [while x < 10 do x = x + 1 done] loops! *)
4type operator = Add | Sub | Mul | Div | Mod | Lt | Gt | Eq
5[@@deriving to_yojson]
6
7let exec_op = function
8 | Add -> Int.add
9 | Sub -> Int.sub
10 | Mul -> Int.mul
11 | Div -> Int.div
12 | Mod -> ( mod )
13 | Lt -> fun a b -> if a < b then 1 else 0
14 | Gt -> fun a b -> if a > b then 1 else 0
15 | Eq -> fun a b -> if Int.equal a b then 1 else 0
16
17type expr =
18 | Int of int
19 | Var of string
20 | Binop of operator * expr * expr
21 | Neg of expr
22 | Assign of operator * string * expr
23 | Ternary of (expr * expr * expr)
24[@@deriving to_yojson]
25
26module Make (S : Types.State) = struct
27 let eval initial_state expr =
28 let lookup state s =
29 match S.lookup state ~param:s with
30 | Some [ Ast.WordLiteral n ] when Option.is_some (int_of_string_opt n) ->
31 int_of_string n
32 | _ -> 0
33 in
34 let update state s i =
35 match S.update state ~param:s [ Ast.WordLiteral (string_of_int i) ] with
36 | Ok s -> s
37 | Error m -> failwith m
38 in
39 let rec calc state = function
40 | Int i -> (state, i)
41 | Var v -> (state, lookup state v)
42 | Binop (op, e1, e2) ->
43 let state, v1 = calc state e1 in
44 let state, v2 = calc state e2 in
45 (state, exec_op op v1 v2)
46 | Neg n ->
47 let state, v1 = calc state n in
48 (state, Int.neg v1)
49 | Assign (op, var, e) ->
50 let current_v = lookup state var in
51 let state, v1 = calc state e in
52 let nv = exec_op op current_v v1 in
53 (update state var nv, nv)
54 | Ternary (e1, e2, e3) ->
55 let state, v1 = calc state e1 in
56 if Int.equal v1 Int.zero then calc state e3 else calc state e2
57 in
58 calc initial_state expr
59end