camlspotter avatar camlspotter committed d0fa0e4

include tweak

Comments (0)

Files changed (12)

 
   module T = struct
     let kident_of_sigitem = function
-      | Sig_value (id, _)     -> [Kind.Value, id]
-      | Sig_exception (id, _) -> [Kind.Exception, id]
-      | Sig_module (id, _, _) -> [Kind.Module, id]
-      | Sig_type (id, _, _) -> [Kind.Type, id]
-      | Sig_modtype (id, _)   -> [Kind.Module_type, id]
-      | Sig_class (id, _, _) -> [Kind.Class, id]
+      | Sig_value (id, _)         -> [Kind.Value, id]
+      | Sig_exception (id, _)     -> [Kind.Exception, id]
+      | Sig_module (id, _, _)     -> [Kind.Module, id]
+      | Sig_type (id, _, _)       -> [Kind.Type, id]
+      | Sig_modtype (id, _)       -> [Kind.Module_type, id]
+      | Sig_class (id, _, _)      -> [Kind.Class, id]
       | Sig_class_type (id, _, _) -> [Kind.Class_type, id]
 
     let rec signature sg = AMod_structure (List.map signature_item sg)
     let sg = match mexp.mod_type with Mty_signature sg -> sg | _ -> assert false in
     let kids = List.concat_map T.kident_of_sigitem sg in
     (* [ids] only contain things with values, i.e. values, modules and classes *)
-    List.map (fun (k,id) -> match k with
-    | Kind.Value | Kind.Module | Kind.Class -> 
-        begin match List.find_all (fun id' -> Ident0.name id' = Ident0.name id) ids with
-        | [id'] -> id', (k, id)
-        | _ -> assert false
-        end
-    | _ -> Ident.unsafe_create_with_stamp (Ident0.name id) (-1), (k, id)) kids
+(*
+    Format.eprintf "@[<2>DEBUG alias: [ @[%a@] ]@ + [ @[%a@] ]@]@."
+      (Format.list ";@ " Ident.format) ids
+      (Format.list ";@ " (fun ppf (k, id) -> Format.fprintf ppf "%s:%a" (Kind.name k) Ident.format id)) kids;
+*)
+    let must_be_empty, res = List.fold_left (fun (ids, res) (k, id) ->
+      match k with
+      | Kind.Value | Kind.Module | Kind.Class | Kind.Exception -> (* has value. id must be in ids *)
+          begin match ids with
+          | [] -> assert false
+          | id'::ids ->
+              assert (Ident0.name id = Ident0.name id');
+              (ids, (id', (k,id)) :: res)
+          end
+      | _ (* has no value *) -> 
+          (ids, (Ident.unsafe_create_with_stamp (Ident0.name id) (-1), (k, id)) :: res)) (ids, []) kids
+    in
+    assert (must_be_empty = []);
+    res
 
   let rec module_expr mexp =
     try
         | Tmod_functor (id, {loc}, _, _) ->
             (* CR jfuruse: must rethink *)
             record loc (Str (AStr_module (id, AMod_functor_parameter)));
-            record loc (Functor_parameter id);
+            record loc (Functor_parameter id); (* CR jfuruse: required? *)
         | Tmod_structure _
         | Tmod_apply _
         | Tmod_constraint _
         begin match sitem.str_desc with (* CR jfuruse; todo add env *)
         | Tstr_include (mexp, idents) ->
             let loc = sitem.str_loc in
-            let id_kid_list = aliases_of_include mexp idents in
+            let id_kid_list = try aliases_of_include mexp idents with e -> prerr_endline "structure_item include failed!!!"; raise e in
             let m = module_expr mexp in
             List.iter (fun (id, (k, id')) -> 
               record loc (Str (AStr_included (id, m, k, id')))) id_kid_list
               end
             else begin 
               lazy begin
-                Debug.format "find_path %s in { %s }@." 
+                Debug.format "find_path %s:%s in { %s }@." 
+                  (Kind.name kind)
                   (Path.name p)
                   (String.concat "; " 
                     (List.map Ident.name (Env.domain env)));
                   (* it may be a predefed thing *)
                   try !!(snd (Env.find Env.predef id)) with Not_found ->
     *)
-                  Error (Failure (Printf.sprintf "%s not found in { %s }" 
-                                    (Ident.name id)
-                                    (String.concat "; " 
-                                       (List.map Ident.name (Env.domain env)))))
+                    (* If it is a non-value object, it might be included with stamp = -1 *)
+                    let error id = 
+                      Error (Failure (Printf.sprintf "%s:%s not found in { %s }" 
+                                        (Kind.name kind)
+                                        (Ident.name id)
+                                        (String.concat "; " 
+                                           (List.map Ident.name (Env.domain env)))))
+                    in
+                    match kind with
+                    | Kind.Value | Kind.Module | Kind.Class | Kind.Exception -> error id
+                    | _ ->
+                        let gid = Ident.unsafe_create_with_stamp (Ident0.name id) (-1) in
+                        match Env.find env gid with
+                        | Some (_, lazy v) -> v
+                        | None -> error id
               end
             end
             end
-bigmodtest.cmi: target.cmo
-class.cmi:
-class2.cmi:
-open_in_mli.cmi: target.cmo
-siginclude.cmi:
-siginclude2.cmi:
-signature2.cmi:
-test15.cmi:
-applied_sig.cmo:
-applied_sig.cmx:
-bug_private_row.cmo:
-bug_private_row.cmx:
-capital_idents.cmo:
-capital_idents.cmx:
-capital_idents_include.cmo: capital_idents.cmo
-capital_idents_include.cmx: capital_idents.cmx
-class.cmo: class.cmi
-class.cmx: class.cmi
-exception.cmo: target.cmo
-exception.cmx: target.cmx
-external.cmo: target.cmo
-external.cmx: target.cmx
-external_include.cmo:
-external_include.cmx:
-fstclassmodule.cmo:
-fstclassmodule.cmx:
-functor.cmo:
-functor.cmx:
-functor_parameter.cmo:
-functor_parameter.cmx:
-immediate_include.cmo:
-immediate_include.cmx:
-include.cmo:
-include.cmx:
-include_functor_app.cmo:
-include_functor_app.cmx:
-include_override.cmo:
-include_override.cmx:
-included_and_flat.cmo:
-included_and_flat.cmx:
-inherit.cmo:
-inherit.cmx:
-inherit2.cmo:
-inherit2.cmx:
-interface.cmo:
-interface.cmx:
-intermodule.cmo:
-intermodule.cmx:
-localvar.cmo:
-localvar.cmx:
-module.cmo:
-module.cmx:
-module_alias.cmo:
-module_alias.cmx:
-module_alias_ext.cmo: module_alias.cmo
-module_alias_ext.cmx: module_alias.cmx
-module_and_modtype.cmo:
-module_and_modtype.cmx:
-module_and_modtype2.cmo: module_and_modtype.cmo
-module_and_modtype2.cmx: module_and_modtype.cmx
-module_type.cmo:
-module_type.cmx:
-module_use.cmo:
-module_use.cmx:
-multiple_definition.cmo:
-multiple_definition.cmx:
-object.cmo:
-object.cmx:
-ocaml312.cmo:
-ocaml312.cmx:
-open.cmo: target.cmo
-open.cmx: target.cmx
-open_pack.cmo: packed.cmo
-open_pack.cmx: packed.cmx
-override_x.cmo:
-override_x.cmx:
-packed.cmo:
-packed.cmx:
-packed_alias.cmo:
-packed_alias.cmx:
-pathname.cmo:
-pathname.cmx:
-perv.cmo:
-perv.cmx:
-primitive.cmo:
-primitive.cmx:
-recmodule.cmo:
-recmodule.cmx:
-record.cmo:
-record.cmx:
-self.cmo:
-self.cmx:
-set_field.cmo:
-set_field.cmx:
-signature.cmo:
-signature.cmx:
-subpath.cmo:
-subpath.cmx:
-target.cmo:
-target.cmx:
-test.cmo:
-test.cmx:
-test1.cmo:
-test1.cmx:
-test10.cmo:
-test10.cmx:
-test11.cmo: test10.cmo
-test11.cmx: test10.cmx
-test12.cmo: test10.cmo test.cmo
-test12.cmx: test10.cmx test.cmx
-test13.cmo:
-test13.cmx:
-test14.cmo:
-test14.cmx:
-test16.cmo: test15.cmi
-test16.cmx: test15.cmi
-test17.cmo:
-test17.cmx:
-test18.cmo:
-test18.cmx:
-test19.cmo:
-test19.cmx:
-test24.cmo:
-test24.cmx:
-test3.cmo:
-test3.cmx:
-test5.cmo: dir1/test4.cmo
-test5.cmx: dir1/test4.cmx
-test7.cmo:
-test7.cmx:
-test8.cmo: test7.cmo
-test8.cmx: test7.cmx
-test9.cmo: test7.cmo
-test9.cmx: test7.cmx
-twotypes.cmo:
-twotypes.cmx:
-type_def.cmo:
-type_def.cmx:
-types_in_type_def.cmo: type_def.cmo
-types_in_type_def.cmx: type_def.cmx
-use_record.cmo: record.cmo
-use_record.cmx: record.cmx
-utf8.cmo:
-utf8.cmx:
-variant.cmo:
-variant.cmx:
-variant_external.cmo: variant.cmo
-variant_external.cmx: variant.cmx
-with_type.cmo:
-with_type.cmx:
-with_type2.cmo:
-with_type2.cmx:
-dir1/test4.cmo: test.cmo
-dir1/test4.cmx: test.cmx
-dir2/test6.cmo: test5.cmo
-dir2/test6.cmx: test5.cmx

tests/Makefile.targets

 functor_parameter.cmo \
 immediate_include.cmo \
 include.cmo \
+include_exception.cmo \
 include_functor_app.cmo \
+include_modtype.cmo \
 include_override.cmo \
+included.cmo \
 included_and_flat.cmo \
 included_value.cmo \
+including.cmo \
 inherit.cmo \
 inherit2.cmo \
 interface.cmo \

tests/capital_idents.ml

 let z = 1
 
-type t = (* constr E => *) E (* <= constr E *)
+type (* type t => *) t (* <= type t *) = (* constr E => *) E (* <= constr E *)
 
 module (* module E => *) E (* <= module E *) = struct let (* E.x => *) x (* <= E.x *) = 1 end 
 

tests/capital_idents_include.ml

 
 module N : E (* ? modtype E *) = M (* ? module M *)
 
-type u = t (* ? constr E *)
+type u = t (* ? type t *)
-include List
-let _ = length
+module L = struct
+  let (* length => *) length (* <= length *) = List.length
+end
+include L
+let _ = length (* ? length *)
 

tests/include_exception.ml

+include Capital_idents
+
+let _ = (E (* ? exception E *) : exn)

tests/include_modtype.ml

+include Capital_idents
+
+module N : E (* ? modtype E *) = M (* ? module M *)

tests/included.ml

+module type (* S => *) S (* <= S *) = sig val x : int end

tests/including.ml

+include Included
+
+module M : S (* ? S *) = struct
+  let x = 1
+end
 end
 
 class nnc = object
-  inherit (* nc => *) let _y = 1 in nc (* <= nc *) (* limitation *)
+  inherit let _y = 1 in (* nc => *) nc (* <= nc *)
   method n = y (* ? nc *)
 end
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.