An interpreter for the IR

src/desugar.ml

@@ -29,7 +29,11 @@ let phrase' f x = {x with it = f x.at x.note x.it}
 
 let
   rec exps es = List.map (exp) es
-  and exp e = phrase' exp' e
+  and exp e =
+    (* We short-cut AnnotE here, so that we get the position of the inner expression *)
+    match e.it with
+    | S.AnnotE (e,_) -> exp e
+    | _ -> phrase' exp' e
   and exp' at note = function
     | S.PrimE p -> I.PrimE p
     | S.VarE i -> I.VarE i
@@ -86,7 +90,7 @@ let
     | S.AwaitE e -> I.AwaitE (exp e)
     | S.AssertE e -> I.AssertE (exp e)
     | S.IsE (e1, e2) -> I.IsE (exp e1, exp e2)
-    | S.AnnotE (e, _) -> exp' at note e.it
+    | S.AnnotE (_, _) -> assert false
     | S.DecE (d, ot) -> I.BlockE (decs [d], !ot)
     | S.DeclareE (i, t, e) -> I.DeclareE (i, t, exp e)
     | S.DefineE (i, m, e) -> I.DefineE (i, m, exp e)

src/flags.ml

@@ -6,5 +6,6 @@ let async_lowering = ref false
 let dump_parse = ref false
 let dump_tc = ref false
 let dump_lowering = ref false
+let interpret_ir = ref false
 let source_map = ref false
 let prelude = ref true

src/interpret.ml

@@ -20,11 +20,13 @@ type env =
     async : bool
   }
 
-let adjoin_vals c ve = {c with vals = V.Env.adjoin c.vals ve}
-let adjoin = adjoin_vals
+let adjoin_scope s ve = V.Env.adjoin s ve
+let adjoin_vals c ve = {c with vals = adjoin_scope c.vals ve}
 
-let empty_env =
-  { vals = V.Env.empty;
+let empty_scope = V.Env.empty
+
+let env_of_scope ve =
+  { vals = ve;
     labs = V.Env.empty;
     rets = None;
     async = false;
@@ -42,7 +44,6 @@ let find id env =
   with Not_found ->
     trap no_region "unbound identifier %s" id
 
-
 (* Tracing *)
 
 let trace_depth = ref 0
@@ -59,12 +60,19 @@ let string_of_arg = function
 
 (* Debugging aids *)
 
-let last_env = ref empty_env
+let last_env = ref (env_of_scope empty_scope)
 let last_region = ref Source.no_region
 
-let get_last_env () = !last_env
-let get_last_region () = !last_region
-
+let print_exn exn =
+  Printf.printf "%!";
+  let at = Source.string_of_region !last_region in
+  Printf.eprintf "%s: internal error, %s\n" at (Printexc.to_string exn);
+  Printf.eprintf "\nLast environment:\n";
+  Value.Env.iter (fun x d -> Printf.eprintf "%s = %s\n" x (Value.string_of_def d))
+    (!last_env.vals);
+  Printf.eprintf "\n";
+  Printexc.print_backtrace stderr;
+  Printf.eprintf "%!"
 
 (* Scheduling *)
 
@@ -713,7 +721,8 @@ and interpret_func env id pat f v (k : V.value V.cont) =
 
 (* Programs *)
 
-let interpret_prog env p : V.value option * scope =
+let interpret_prog scope p : V.value option * scope =
+  let env = env_of_scope scope in
   trace_depth := 0;
   let vo = ref None in
   let ve = ref V.Env.empty in

src/interpret.mli

@@ -1,26 +1,13 @@
 module V = Value
 module T = Type
 
-type val_env = V.def V.Env.t
-type lab_env = V.value V.cont V.Env.t
-type ret_env = V.value V.cont option
-
-type scope = val_env
-
-type env =
-  { vals : val_env;
-    labs : lab_env;
-    rets : ret_env;
-    async : bool
-  }
-
-val empty_env : env
-val adjoin : env -> scope -> env
+type scope = V.def V.Env.t
 
+val empty_scope : scope
+val adjoin_scope : scope -> scope -> scope
 
 exception Trap of Source.region * string
 
-val interpret_prog : env -> Syntax.prog -> V.value option * val_env
+val interpret_prog : scope -> Syntax.prog -> V.value option * scope
 
-val get_last_region : unit -> Source.region
-val get_last_env : unit -> env
+val print_exn : exn -> unit