camlspotter avatar camlspotter committed 64b2725

mark comments for typeloc

Comments (0)

Files changed (1)

typing/typecore.ml

   | Ppat_constraint({ppat_desc=Ppat_var name; ppat_loc=lloc},
                     ({ptyp_desc=Ptyp_poly _} as sty)) ->
       (* explicitly polymorphic type *)
-      let cty, force = Typetexp.transl_simple_type_delayed !env sty in
+      let cty, force = Typetexp.transl_simple_type_delayed !env sty in (* typeloc done *)
       let ty = cty.ctyp_type in
       unify_pat_types lloc !env ty expected_ty;
       pattern_force := force :: !pattern_force;
       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 (* CR jfuruse: world ok *)
+      (* CR jfuruse: typeloc todo for args *)
+      let ty_res = copy_with_loc loc ty_res in (* CR jfuruse: world ok, but not checked yet *)
       if constr.cstr_generalized && mode = Normal then
         unify_pat_types_gadt loc env ty_res expected_ty
       else
         pat_type = expected_ty;
         pat_env = !env }
   | Ppat_variant(l, sarg) ->
+      (* CR jfuruse: typeloc todo *)
       let arg = may_map (fun p -> type_pat p (newvar())) sarg in
       let arg_type = match arg with None -> [] | Some arg -> [arg.pat_type]  in
       let row = { row_fields =
         pat_type =  expected_ty;
         pat_env = !env }
   | Ppat_record(lid_sp_list, closed) ->
+      (* CR jfuruse: typeloc todo check *)
       let type_label_pat (label_path, label_lid, label, sarg) =
         begin_def ();
         let (vars, ty_arg, ty_res) = instance_label false label in
                 pat_extra = (Tpat_constraint cty,loc) :: p.pat_extra}
       else p
   | Ppat_type lid ->
+      (* CR jfuruse: typeloc todo check *)
       let (path, p,ty) = build_or_pat !env loc lid.txt in
       let ty = copy_with_loc loc ty in
       unify_pat_types loc !env ty expected_ty;
   in
   match sexp.pexp_desc with
   | Pexp_ident lid ->
+      (* CR jfuruse: typeloc todo *)
       begin
         if !Clflags.annotations then begin
           try let (path, annot) = Env.lookup_annot lid.txt env in
       end_def ();
       lower_args [] ty;
       begin_def ();
-      let (args, ty_res) = type_application env funct sargs in
+      let (args, ty_res) = type_application env funct sargs in (* typeloc is done here *)
       end_def ();
       unify_var env (newvar()) funct.exp_type;
       rue {
         exp_type = body.exp_type;
         exp_env = env }
   | Pexp_tuple sexpl ->
+      (* typeloc: type_expected and the exp_type are different types, for some unknown reason.
+         So we need set loc twice. *)
       let subtypes = List.map (fun _ -> newgenvar ()) sexpl in
       let to_unify = copy_with_loc loc (newgenty (Ttuple subtypes)) in
       unify_exp_types loc env to_unify ty_expected;
         exp_loc = loc; exp_extra = [];
         (* Keep sharing *)
         exp_type = copy_with_loc loc (newty (Ttuple (List.map (fun e -> e.exp_type) expl)));
-        (* CR jfuruse: why exp_type is not equal to ty_expected? *)
         exp_env = env }
   | Pexp_construct(lid, sarg, explicit_arity) ->
       type_construct env loc lid sarg explicit_arity ty_expected
   | Pexp_variant(l, sarg) ->
+      (* CR jfuruse: typeloc todo *)
       (* Keep sharing *)
       let ty_expected0 = instance env ty_expected in
       begin try match
           exp_env = env }
       end
   | Pexp_record(lid_sexp_list, opt_sexp) ->
+      (* CR jfuruse: typeloc todo *)
       let lbl_exp_list =
         type_label_a_list env (type_label_exp true env loc ty_expected)
           lid_sexp_list in
         exp_type = set_loc loc (instance env ty_expected); (* set_loc enforces loc unification *)
         exp_env = env }
   | Pexp_field(sarg, lid) ->
+      (* CR jfuruse: typeloc todo *)
       let arg = type_exp env sarg in
       let (label_path,label) = Typetexp.find_label env loc lid.txt in
       let (_, ty_arg, ty_res) = instance_label false label in
         exp_type = ty_arg;
         exp_env = env }
   | Pexp_setfield(srecord, lid, snewval) ->
+      (* CR jfuruse: typeloc todo *)
       let record = type_exp env srecord in
       let (label_path, label) = Typetexp.find_label env loc lid.txt in
       let (label_path, label_loc, label, newval) =
         exp_type = body.exp_type;
         exp_env = env }
   | Pexp_send (e, met) ->
+      (* CR jfuruse: typeloc *)
       if !Clflags.principal then begin_def ();
       let obj = type_exp env e in
       begin try
         raise(Error(e.pexp_loc, Undefined_method (obj.exp_type, met)))
       end
   | Pexp_new cl ->
+      (* CR jfuruse: typeloc *)
       let (cl_path, cl_decl) = Typetexp.find_class env loc cl.txt in
         begin match cl_decl.cty_new with
           None ->
               exp_env = env }
         end
   | Pexp_setinstvar (lab, snewval) ->
+      (* CR jfuruse: typeloc *)
       begin try
         let (path, desc) = Env.lookup_value (Longident.Lident lab.txt) env in
         match desc.val_kind with
           raise(Error(loc, Unbound_instance_variable lab.txt))
       end
   | Pexp_override lst ->
+      (* CR jfuruse: typeloc? *)
       let _ =
        List.fold_right
         (fun (lab, _) l ->
       re {
         exp_desc = Texp_assertfalse;
         exp_loc = loc; exp_extra = [];
-        exp_type = copy_with_loc loc (instance env ty_expected);
+        exp_type = instance env ty_expected;
         exp_env = env;
       }
   | Pexp_lazy e ->
         exp_env = env;
       }
   | Pexp_poly(sbody, sty) ->
+      (* CR jfuruse: typeloc todo *)
       if !Clflags.principal then begin_def ();
       let ty, cty =
         match sty with None -> repr ty_expected, None
       rue { body with exp_loc = loc; exp_type = ety;
             exp_extra = (Texp_newtype name, loc) :: body.exp_extra }
   | Pexp_pack m ->
+      (* CR jfuruse: typeloc todo *)
       let (p, nl, tl) =
         match Ctype.expand_head env (instance env ty_expected) with
           {desc = Tpackage (p, nl, tl)} ->
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.