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"