Begin translation module
[tiger.ml.git] / exercises / ch01 / straight_line_program_interpreter.ml
1 module List = ListLabels
2 module String = StringLabels
3
4 module Spl : sig
5 type id = string
6
7 type binop =
8 | Plus
9 | Minus
10 | Times
11 | Div
12
13 type stm =
14 | CompoundStm of stm * stm
15 | AssignStm of id * exp
16 | PrintStm of exp list
17 and exp =
18 | IdExp of id
19 | NumExp of int
20 | OpExp of exp * binop * exp
21 | EseqExp of stm * exp
22
23 exception Unknown_identifier of string
24
25 val maxargs : stm -> int option
26 (** Option because a program may not have any print statements at all. *)
27
28 val interp : stm -> unit
29 (** raises Unknown_identifier, if such is encountered *)
30 end = struct
31 module Table : sig
32 type ('k, 'v) t
33 val empty : ('k, 'v) t
34 val set : ('k, 'v) t -> k:'k -> v:'v -> ('k, 'v) t
35 val get : ('k, 'v) t -> k:'k -> 'v option
36 end = struct
37 type ('k, 'v) t = ('k * 'v) list
38 let empty = []
39 let set t ~k ~v = (k, v) :: t
40 let get t ~k =
41 let rec search = function
42 | [] -> None
43 | (key, v) :: _ when key = k -> Some v
44 | (_, _) :: rest -> search rest
45 in
46 search t
47 end
48
49 type id = string
50
51 type binop =
52 | Plus
53 | Minus
54 | Times
55 | Div
56
57 type stm =
58 | CompoundStm of stm * stm
59 | AssignStm of id * exp
60 | PrintStm of exp list
61 and exp =
62 | IdExp of id
63 | NumExp of int
64 | OpExp of exp * binop * exp
65 | EseqExp of stm * exp
66
67 exception Unknown_identifier of string
68
69 let interp_binop op v1 v2 =
70 match op with
71 | Plus -> v1 + v2
72 | Minus -> v1 - v2
73 | Times -> v1 * v2
74 | Div -> v1 / v2
75
76 let rec interp_stm tbl_0 stm =
77 begin match stm with
78 | PrintStm exps ->
79 let (tbl_1, val_ints) =
80 List.fold_right exps
81 ~init:(tbl_0, [])
82 ~f:(fun e (tbl0, vs) ->
83 let (tbl1, v) = interp_exp tbl0 e in
84 (tbl1, v :: vs)
85 )
86 in
87 let val_strings = List.map val_ints ~f:string_of_int in
88 print_endline (String.concat val_strings ~sep:" ");
89 tbl_1
90 | AssignStm (id, e) ->
91 let (tbl_1, v) = interp_exp tbl_0 e in
92 Table.set tbl_1 ~k:id ~v
93 | CompoundStm (s1, s2) ->
94 let tbl_1 = interp_stm tbl_0 s1 in
95 interp_stm tbl_1 s2
96 end
97 and interp_exp tbl_0 exp =
98 ( match exp with
99 | IdExp id ->
100 ( match Table.get tbl_0 ~k:id with
101 | Some v -> (tbl_0, v)
102 | None -> raise (Unknown_identifier id)
103 )
104 | NumExp n -> (tbl_0, n)
105 | OpExp (e1, op, e2) ->
106 let (tbl_1, v1) = interp_exp tbl_0 e1 in
107 let (tbl_2, v2) = interp_exp tbl_1 e2 in
108 (tbl_2, interp_binop op v1 v2)
109 | EseqExp (s, e) ->
110 let tbl_1 = interp_stm tbl_0 s in
111 interp_exp tbl_1 e
112 )
113
114 let interp stm : unit =
115 ignore (interp_stm (Table.empty) stm)
116
117 (* 01.p.1: Write ML function (maxargs : stm -> int) that tells the
118 * maximum number of arguments of any print statement within any
119 * subexpression of a given statement. For example, maxargs(prog)
120 * is 2.
121 *)
122 let maxargs stm =
123 let opt_max_update opt n =
124 match opt with
125 | None -> Some n
126 | Some m -> Some (max m n)
127 in
128 let opt_max_merge a b =
129 match a, b with
130 | None , None -> None
131 | None , b -> b
132 | Some _, None -> a
133 | Some _, Some n -> opt_max_update a n
134 in
135 let rec check_stm max_opt stm =
136 match stm with
137 | PrintStm exps ->
138 List.fold_left exps
139 ~init:(opt_max_update max_opt (List.length exps))
140 ~f:check_exp
141 | AssignStm (_, e) ->
142 check_exp max_opt e
143 | CompoundStm (s1, s2) ->
144 opt_max_merge (check_stm max_opt s1) (check_stm max_opt s2)
145 and check_exp max_opt exp =
146 match exp with
147 | IdExp _ | NumExp _ -> max_opt
148 | OpExp (e1, _, e2) ->
149 opt_max_merge (check_exp max_opt e1) (check_exp max_opt e2)
150 | EseqExp (s, e) ->
151 opt_max_merge (check_stm max_opt s) (check_exp max_opt e)
152 in
153 check_stm None stm
154 end
155
156 let spl_prog_orig =
157 (* a := 5 + 3;
158 * b := (print(a, a - 1), 10 * a);
159 * print(b)
160 *)
161 Spl.CompoundStm
162 ( Spl.AssignStm ("a", Spl.OpExp (Spl.NumExp 5, Spl.Plus, Spl.NumExp 3))
163 , Spl.CompoundStm
164 ( Spl.AssignStm
165 ( "b"
166 , Spl.EseqExp
167 ( Spl.PrintStm
168 [ Spl.IdExp "a"
169 ; Spl.OpExp (Spl.IdExp "a", Spl.Minus, Spl.NumExp 1)
170 ]
171 , Spl.OpExp (Spl.NumExp 10, Spl.Times, Spl.IdExp "a")
172 )
173 )
174 , Spl.PrintStm [Spl.IdExp "b"]
175 )
176 )
177
178 let spl_prog_noprint =
179 (* a := 5 + 3;
180 * b := 10 * a
181 *)
182 Spl.CompoundStm
183 ( Spl.AssignStm
184 ("a", Spl.OpExp (Spl.NumExp 5, Spl.Plus, Spl.NumExp 3))
185 , Spl.AssignStm
186 ("b", Spl.OpExp (Spl.NumExp 10, Spl.Times, Spl.IdExp "a"))
187 )
188
189 let () =
190 let string_of_maxargs int_opt =
191 match int_opt with
192 | Some n -> string_of_int n
193 | None -> "N/A"
194 in
195 Printf.printf "maxargs : spl_prog_orig -> %s\n"
196 (string_of_maxargs (Spl.maxargs spl_prog_orig));
197 Printf.printf "maxargs : spl_prog_noprint -> %s\n"
198 (string_of_maxargs (Spl.maxargs spl_prog_noprint));
199 print_endline "BEGIN Spl.interp spl_prog_orig";
200 Spl.interp spl_prog_orig;
201 print_endline "END Spl.interp spl_prog_orig"
This page took 0.07921 seconds and 4 git commands to generate.