diff options
| -rw-r--r-- | toplevel/topdirs.ml | 3 | ||||
| -rw-r--r-- | toplevel/trace.ml | 6 | ||||
| -rw-r--r-- | toplevel/trace.mli | 2 |
3 files changed, 6 insertions, 5 deletions
diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml index 42c97a764..c8bfc1852 100644 --- a/toplevel/topdirs.ml +++ b/toplevel/topdirs.ml @@ -233,7 +233,8 @@ let dir_trace lid = closure = clos; initial_closure = old_clos; instrumented_fun = - instrument_closure lid (Ctype.instance desc.val_type) + instrument_closure !toplevel_env lid + (Ctype.instance desc.val_type) old_clos} :: !traced_functions; (* Redirect the code field of the old closure *) diff --git a/toplevel/trace.ml b/toplevel/trace.ml index 86d9836c9..5e14f585f 100644 --- a/toplevel/trace.ml +++ b/toplevel/trace.ml @@ -52,15 +52,15 @@ let overwrite_closure dst src = (* Return a closure that performs as the given closure, but also traces its execution. *) -let rec instrument_closure name clos_typ = - match (Ctype.repr clos_typ).desc with +let rec instrument_closure env name clos_typ = + match (Ctype.repr(Ctype.expand_root env clos_typ)).desc with Tarrow(t1, t2) -> let starred_name = match name with Lident s -> Lident(s ^ "*") | Ldot(lid, s) -> Ldot(lid, s ^ "*") | Lapply(l1, l2) -> fatal_error "Trace.instrument_closure" in - let trace_res = instrument_closure starred_name t2 in + let trace_res = instrument_closure env starred_name t2 in (fun clos_val -> Obj.repr(fun arg -> open_hovbox 2; diff --git a/toplevel/trace.mli b/toplevel/trace.mli index d9ebe1b05..149b2849d 100644 --- a/toplevel/trace.mli +++ b/toplevel/trace.mli @@ -24,5 +24,5 @@ val is_traced: Obj.t -> Path.t option val copy_closure: Obj.t -> Obj.t val overwrite_closure: Obj.t -> Obj.t -> unit val instrument_closure: - Longident.t -> Typedtree.type_expr -> Obj.t -> Obj.t + Env.t -> Longident.t -> Typedtree.type_expr -> Obj.t -> Obj.t val print_trace: Obj.t -> Obj.t -> Obj.t |