Straight-line program interpreter

Chapter 1 of the Tiger book

type id = string
 
type binop = Plus | Minus | Times | Div
 
type stm = CompoundStm of stm * stm
	 | AssignStm of id * exp
	 | PrintStm of exp list
 
and exp = IdExp of id
	| NumExp of int
        | OpExp of exp * binop * exp
        | EseqExp of stm * exp
 
(* 
prog:
a = 5 + 3; 
b = (print [a, a-1]; 10 * a);
print b;
*)
let prog = 
 CompoundStm(
   AssignStm("a", 
             OpExp(NumExp 5, Plus, NumExp 3)),
   CompoundStm(
     AssignStm("b",
       EseqExp(PrintStm[IdExp "a"; OpExp(IdExp "a", Minus, NumExp 1)],
               OpExp(NumExp 10, Times, IdExp "a"))),
     PrintStm[IdExp "b"]))
 
 
(* 1: maxargs *)
let rec maxargs stm = 
  match stm with
    | CompoundStm (s1, s2) -> max (maxargs s1) (maxargs s2)
    | AssignStm (_, e) -> maxargs_exp e
    | PrintStm l -> let max_aux i e = max i (maxargs_exp e)
                    in let maxsub = List.fold_left max_aux  0 l
                    in max (List.length l) maxsub
and maxargs_exp exp =
  match exp with
    | IdExp _ -> 0
    | NumExp _ -> 0
    | OpExp (e1, _, e2) -> max (maxargs_exp e1) (maxargs_exp e2)
    | EseqExp (s, e) -> max (maxargs s) (maxargs_exp e)
 
 
(* 2: interpreter *)
type table = (id * int) list 
 
let rec lookup id env =
  match env with
    | [] -> raise Not_found
    | (x,v)::_ when x = id -> v
    | _::p -> lookup id p 
 
let set x v env = (x, v) :: env
 
let apply op v1 v2 = 
  match op with
    | Plus -> v1 + v2
    | Minus -> v1 - v2
    | Times -> v1 * v2
    | Div -> v1 / v2
 
let rec interp_stm expr env =
  match expr with 
    | CompoundStm (s1, s2) -> let env' = interp_stm s1 env
                              in interp_stm s2 env'
    | AssignStm (id, expr') -> let res, env' = interp_exp expr' env
                               in set id res env
    | PrintStm exprs -> 
      let print_exp env exp = 
        let v, env' = interp_exp exp env
        in print_string (string_of_int v ^ " "); env'   
      in let env' = List.fold_left print_exp env exprs
         in print_string "\n"; env'
 
and interp_exp expr env = 
  match expr with
    | IdExp id -> lookup id env, env 
    | NumExp n -> n, env
    | OpExp (e1, op , e2) -> let v1, env1 = interp_exp e1 env
                             in let v2, env2 = interp_exp e2 env1
                                in apply op v1 v2, env2
    | EseqExp (s, e) -> let env' = interp_stm s env 
                        in interp_exp e env'
 
let _ = 
  print_endline (string_of_int (maxargs prog)); (* => 2 *)
  interp_stm prog []                            (* => 8 7\n 80 *)

Les commentaires sont fermés.