exercises/ch01/straight_line_program_interpreter.ml

   1 module List = ListLabels
   2
   3 module Spl : sig
   4   type id = string
   5
   6   type binop =
   7     | Plus
   8     | Minus
   9     | Times
  10     | Div
  11
  12   type stm =
  13     | CompoundStm of stm * stm
  14     | AssignStm of id * exp
  15     | PrintStm of exp list
  16   and exp =
  17     | IdExp of id
  18     | NumExp of int
  19     | OpExp of exp * binop * exp
  20     | EseqExp of stm * exp
  21
  22   val maxargs : stm -> int option
  23   (** Option because a program may not have any print statements at all. *)
  24 end = struct
  25   type id = string
  26
  27   type binop =
  28     | Plus
  29     | Minus
  30     | Times
  31     | Div
  32
  33   type stm =
  34     | CompoundStm of stm * stm
  35     | AssignStm of id * exp
  36     | PrintStm of exp list
  37   and exp =
  38     | IdExp of id
  39     | NumExp of int
  40     | OpExp of exp * binop * exp
  41     | EseqExp of stm * exp
  42
  43     (* 01.p.1: Write ML function (maxargs : stm -> int) that tells the
  44      * maximum number of arguments of any print statement within any
  45      * subexpression of a given statement. For example, maxargs(prog)
  46      * is 2.
  47      *)
  48     let maxargs stm =
  49       let opt_max_update opt n =
  50         match opt with
  51         | None   -> Some n
  52         | Some m -> Some (max m n)
  53       in
  54       let opt_max_merge a b =
  55         match a, b with
  56         | None  , None   -> None
  57         | None  , b      -> b
  58         | Some _, None   -> a
  59         | Some _, Some n -> opt_max_update a n
  60       in
  61       let rec check_stm max_opt stm =
  62         match stm with
  63         | PrintStm exps ->
  64             List.fold_left exps
  65               ~init:(opt_max_update max_opt (List.length exps))
  66               ~f:check_exp
  67         | AssignStm (_, e) ->
  68             check_exp max_opt e
  69         | CompoundStm (s1, s2) ->
  70             opt_max_merge (check_stm max_opt s1) (check_stm max_opt s2)
  71       and check_exp max_opt exp =
  72         match exp with
  73         | IdExp _ | NumExp _ -> max_opt
  74         | OpExp (e1, _, e2) ->
  75             opt_max_merge (check_exp max_opt e1) (check_exp max_opt e2)
  76         | EseqExp (s, e) ->
  77             opt_max_merge (check_stm max_opt s) (check_exp max_opt e)
  78       in
  79       check_stm None stm
  80 end
  81
  82 let spl_prog_orig =
  83   (*  a := 5 + 3;
  84    *  b := (print(a, a - 1), 10 * a);
  85    *  print(b)
  86    *)
  87   Spl.CompoundStm
  88     ( Spl.AssignStm ("a", Spl.OpExp (Spl.NumExp 5, Spl.Plus, Spl.NumExp 3))
  89     , Spl.CompoundStm
  90         ( Spl.AssignStm
  91           ( "b"
  92           , Spl.EseqExp
  93               ( Spl.PrintStm
  94                   [ Spl.IdExp "a"
  95                   ; Spl.OpExp (Spl.IdExp "a", Spl.Minus, Spl.NumExp 1)
  96                   ]
  97               , Spl.OpExp (Spl.NumExp 10, Spl.Times, Spl.IdExp "a")
  98               )
  99           )
 100         , Spl.PrintStm [Spl.IdExp "b"]
 101         )
 102     )
 103
 104 let spl_prog_noprint =
 105   (*  a := 5 + 3;
 106    *  b := 10 * a
 107    *)
 108   Spl.CompoundStm
 109     ( Spl.AssignStm
 110         ("a", Spl.OpExp (Spl.NumExp 5, Spl.Plus, Spl.NumExp 3))
 111     , Spl.AssignStm
 112         ("b", Spl.OpExp (Spl.NumExp 10, Spl.Times, Spl.IdExp "a"))
 113     )
 114
 115 let () =
 116   let string_of_maxargs int_opt =
 117     match int_opt with
 118     | Some n -> string_of_int n
 119     | None   -> "N/A"
 120   in
 121   Printf.printf "maxargs : spl_prog_orig -> %s\n"
 122     (string_of_maxargs (Spl.maxargs spl_prog_orig));
 123   Printf.printf "maxargs : spl_prog_noprint -> %s\n"
 124     (string_of_maxargs (Spl.maxargs spl_prog_noprint))