From 06d511c857fbf2f0144b1dfa88ef3cd8eb95cf37 Mon Sep 17 00:00:00 2001
From: Jacques Garrigue <garrigue at math.nagoya-u.ac.jp>
Date: Oct 03 2013 12:51:30 +0000
Subject: more exception paths requiring normalization


git-svn-id: http://caml.inria.fr/svn/ocaml/branches/module-alias@14211 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

---

diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml
index baaefc8..01c55af 100644
--- a/bytecomp/lambda.ml
+++ b/bytecomp/lambda.ml
@@ -386,6 +386,11 @@ let rec transl_path = function
   | Papply(p1, p2) ->
       fatal_error "Lambda.transl_path"
 
+(* Translation of value identifiers *)
+
+let transl_ident_path env path =
+  transl_path (Env.normalize_path env path) 
+
 (* Compile a sequence of expressions *)
 
 let rec make_sequence fn = function
diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli
index 42cb02b..6538c6f 100644
--- a/bytecomp/lambda.mli
+++ b/bytecomp/lambda.mli
@@ -211,6 +211,7 @@ val free_variables: lambda -> IdentSet.t
 val free_methods: lambda -> IdentSet.t
 
 val transl_path: Path.t -> lambda
+val transl_ident_path: Env.t -> Path.t -> lambda
 val make_sequence: ('a -> lambda) -> 'a list -> lambda
 
 val subst_lambda: lambda Ident.tbl -> lambda -> lambda
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml
index 2572b84..57270e3 100644
--- a/bytecomp/matching.ml
+++ b/bytecomp/matching.ml
@@ -2158,7 +2158,8 @@ let combine_constructor arg ex_pat cstr partial ctx def
           match ex with
           | Cstr_exception (path, _) ->
               Lifthenelse(Lprim(Pintcomp Ceq,
-                                [Lprim(Pfield 0, [arg]); transl_path path]),
+                                [Lprim(Pfield 0, [arg]);
+                                 transl_ident_path ex_pat.pat_env path]),
                           act, rem)
           | _ -> assert false)
         tests default in
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index 8808072..abada85 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -38,10 +38,6 @@ let transl_object =
   ref (fun id s cl -> assert false :
        Ident.t -> string list -> class_expr -> lambda)
 
-(* Translation of value identifiers *)
-let transl_ident_path env path =
-  transl_path (Env.normalize_path env path) 
-
 (* Translation of primitives *)
 
 let comparisons_table = create_hashtable 11 [
@@ -725,7 +721,8 @@ and transl_exp0 e =
             Lprim(Pmakeblock(n, Immutable), ll)
           end
       | Cstr_exception (path, _) ->
-          Lprim(Pmakeblock(0, Immutable), transl_path path :: ll)
+          Lprim(Pmakeblock(0, Immutable),
+                transl_ident_path e.exp_env path :: ll)
       end
   | Texp_variant(l, arg) ->
       let tag = Btype.hash_variant l in
@@ -803,7 +800,8 @@ and transl_exp0 e =
       in
       event_after e lam
   | Texp_new (cl, _, _) ->
-      Lapply(Lprim(Pfield 0, [transl_path cl]), [lambda_unit], Location.none)
+      Lapply(Lprim(Pfield 0, [transl_ident_path e.exp_env cl]),
+             [lambda_unit], Location.none)
   | Texp_instvar(path_self, path, _) ->
       Lprim(Parrayrefu Paddrarray, [transl_path path_self; transl_path path])
   | Texp_setinstvar(path_self, path, _, expr) ->
diff --git a/bytecomp/translcore.mli b/bytecomp/translcore.mli
index 7977578..842ed78 100644
--- a/bytecomp/translcore.mli
+++ b/bytecomp/translcore.mli
@@ -24,7 +24,6 @@ val transl_let: rec_flag -> value_binding list -> lambda -> lambda
 val transl_primitive: Location.t -> Primitive.description -> lambda
 val transl_exception:
       Path.t option -> constructor_declaration -> lambda
-val transl_ident_path: Env.t -> Path.t -> lambda
 
 val check_recursive_lambda: Ident.t list -> lambda -> bool