Commits

camlspotter committed 5261d86

more typelocs

Comments (0)

Files changed (1)

typing/typecore.ml

   unify_vars p1_vs p2_vs
 
 let rec build_as_type env p =
+  let loc = p.pat_loc in
   match p.pat_desc with
     Tpat_alias(p1,_, _) -> build_as_type env p1
   | Tpat_tuple pl ->
       let tyl = List.map (build_as_type env) pl in
-      newty (Ttuple tyl)
+      copy_with_loc loc (newty (Ttuple tyl))
   | Tpat_construct(_, _, cstr, pl,_) ->
+      (* CR jfuruse: typeloc todo *)
       let keep = cstr.cstr_private = Private || cstr.cstr_existentials <> [] in
       if keep then p.pat_type else
       let tyl = List.map (build_as_type env) pl in
         (List.combine pl tyl) ty_args;
       ty_res
   | Tpat_variant(l, p', _) ->
+      (* CR jfuruse: typeloc todo *)
       let ty = may_map (build_as_type env) p' in
       newty (Tvariant{row_fields=[l, Rpresent ty]; row_more=newvar();
                       row_bound=(); row_name=None;
                       row_fixed=false; row_closed=false})
   | Tpat_record (lpl,_) ->
+      (* CR jfuruse: typeloc todo *)
       let lbl = thd4 (List.hd lpl) in
       if lbl.lbl_private = Private then p.pat_type else
       let ty = newvar () in
         pat_type = expected_ty;
         pat_env = !env }
   | Ppat_unpack name ->
+      (* CR jfuruse: typeloc todo *)
       let id = enter_variable loc name expected_ty ~is_module:true in
       rp {
         pat_desc = Tpat_var (id, name);
       let (ty_args, ty_res) =
         instance_constructor ~in_pattern:(env, get_newtype_level ()) constr
       in
-      (* let ty_res = copy_with_loc loc ty_res in ??? *)
+      let ty_res = copy_with_loc loc ty_res in (* CR jfuruse: world ok *)
       if constr.cstr_generalized && mode = Normal then
         unify_pat_types_gadt loc env ty_res expected_ty
       else
         begin_def ();
         let (vars, ty_arg, ty_res) = instance_label false label in
         if vars = [] then end_def ();
-(* fails ocamldoc? (not sure yet)
         let ty_arg = copy_with_loc loc ty_arg in
-*)
         begin try
           unify_pat_types loc !env ty_res expected_ty
         with Unify trace ->
       (* Separate when not already separated by !principal *)
       let separate = true in
       if separate then begin_def();
-      let cty, force = Typetexp.transl_simple_type_delayed !env sty in
+      let cty, force = Typetexp.transl_simple_type_delayed !env sty in (* tyloc is done here *)
+
       let ty = cty.ctyp_type in
       let ty, expected_ty' =
         if separate then begin
           instance !env ty, instance !env ty
         end else ty, ty
       in
-      (* let ty = copy_with_loc loc ty in *) (* CR jfuruse: fails at Camlp4.ml *)
       unify_pat_types loc !env ty expected_ty;
       let p = type_pat sp expected_ty' in
       (*Format.printf "%a@.%a@."
             (arg, arg.exp_type,None,None)
         | (Some sty, None) ->
             if separate then begin_def ();
-            let cty = Typetexp.transl_simple_type env false sty in
+            let cty = Typetexp.transl_simple_type env false sty in (* tyloc is done here *)
             let ty = cty.ctyp_type in
             if separate then begin
               end_def ();
               (type_argument env sarg ty ty, ty, Some cty, None)
         | (None, Some sty') ->
             let (cty', force) =
-              Typetexp.transl_simple_type_delayed env sty'
+              Typetexp.transl_simple_type_delayed env sty' (* tyloc is done here *)
             in
             let ty' = cty'.ctyp_type in
             if separate then begin_def ();
         | (Some sty, Some sty') ->
             if separate then begin_def ();
             let (cty, force) =
-              Typetexp.transl_simple_type_delayed env sty
+              Typetexp.transl_simple_type_delayed env sty (* tyloc is done here *)
             and (cty', force') =
-              Typetexp.transl_simple_type_delayed env sty'
+              Typetexp.transl_simple_type_delayed env sty'(* tyloc is done here *)
             in
             let ty = cty.ctyp_type in
             let ty' = cty'.ctyp_type in
       rue {
         exp_desc = arg.exp_desc;
         exp_loc = arg.exp_loc;
-        exp_type = (* copy_with_loc arg.exp_loc WRONG? *) ty';
+        exp_type = ty';
         exp_env = env;
         exp_extra = (Texp_constraint (cty, cty'), loc) :: arg.exp_extra;
       }