Commits

camlspotter committed 561303a Merge

merge with typeloc

  • Participants
  • Parent commits 80476bb, b6832c5
  • Branches custom

Comments (0)

Files changed (3)

File testsuite/typeloc/pvar2.ml

+let x = `A
+
+let y = [x; `B] (* ok *)
+
+let z = [y; 1]
+

File testsuite/typeloc/pvar_constraint.ml

+let x = `A
+
+let y = [x; `B] (* ok *)
+
+let f : [`B] -> [`B] = fun x -> x (* ok *)
+
+let _ = f y
+

File typing/typetexp.ml

 	    in
 	    { field_desc = desc; field_loc = pf.pfield_loc })
 	  fields in
-      let ty = newobj (transl_fields env policy [] fields) in (* CR jfuruse: typloc todo *)
+      let ty = copy_with_loc loc (newobj (transl_fields env policy [] fields)) in
 	ctyp (Ttyp_object fields) ty env loc
   | Ptyp_class(lid, stl, present) ->
       let (path, decl, is_variant) =
              raise (Error(sty.ptyp_loc, Type_mismatch (swap_list trace))))
         (List.combine stl args) params;
 	let ty_args = List.map (fun ctyp -> ctyp.ctyp_type) args in
-      let ty = (* CR jfuruse: typloc todo *)
+      let ty =
         try Ctype.expand_head env (newconstr path ty_args)
         with Unify trace ->
           raise (Error(styp.ptyp_loc, Type_mismatch trace))
             else if policy <> Univars then row
             else { row with row_more = new_pre_univar () }
           in
-          newty (Tvariant row)
+          copy_with_loc loc (newty (Tvariant row))
       | Tobject (fi, _) ->
           let _, tv = flatten_fields fi in
           if policy = Univars then pre_univars := tv :: !pre_univars;
-          ty
+          ty  (* CR jfuruse: typloc todo *)
       | _ ->
           assert false
       in
         else if policy <> Univars then row
         else { row with row_more = new_pre_univar () }
       in
-      let ty = newty (Tvariant row) in (* CR jfuruse: tyloc todo *)
+      let ty = copy_with_loc loc (newty (Tvariant row)) in
       ctyp (Ttyp_variant (tfields, closed, present)) ty env loc
    | Ptyp_poly(vars, st) ->
       begin_def();
             end else tyl)
           [] new_univars
       in
-       (* CR jfuruse: tyloc todo *)
-      let ty' = Btype.newgenty (Tpoly(ty, List.rev ty_list)) in
+      (* CR jfuruse: tyloc not sure *)
+      let ty' = copy_with_loc loc (Btype.newgenty (Tpoly(ty, List.rev ty_list))) in
       unify_var env (newvar()) ty';
       ctyp (Ttyp_poly (vars, cty)) ty' env loc
   | Ptyp_package (p, l) ->