patrick.sirref.org
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 n when Option.is_some (int_of_string_opt n) -> int_of_string n
31 | _ -> 0
32 in
33 let update state s i =
34 match S.update state ~param:s (string_of_int i) with
35 | Ok s -> s
36 | Error m -> failwith m
37 in
38 let rec calc state = function
39 | Int i -> (state, i)
40 | Var v -> (state, lookup state v)
41 | Binop (op, e1, e2) ->
42 let state, v1 = calc state e1 in
43 let state, v2 = calc state e2 in
44 (state, exec_op op v1 v2)
45 | Neg n ->
46 let state, v1 = calc state n in
47 (state, Int.neg v1)
48 | Assign (op, var, e) ->
49 let current_v = lookup state var in
50 let state, v1 = calc state e in
51 let nv = exec_op op current_v v1 in
52 (update state var nv, nv)
53 | Ternary (e1, e2, e3) ->
54 let state, v1 = calc state e1 in
55 if Int.equal v1 Int.zero then calc state e3 else calc state e2
56 in
57 calc initial_state expr
58end