Commits

camlspotter  committed d7a9f26 Merge

merge

  • Participants
  • Parent commits fa3870b, 2e9ffa4
  • Branches dev

Comments (0)

Files changed (5)

+bdf1996aaaf9e6698d9c775268ae570d567f5cc2 working1
+eada479ed9ec500b0402c15cb2590297066710f9 working2
 # Compilation
 #############
 OCAMLSRCDIR=..
-INCLUDES_DEP=-I $(OCAMLDIR)/compiler-libs
+INCLUDES_DEP=-I +compiler-libs
 
 # Requires unix!
 COMPFLAGS= $(INCLUDES_DEP) -I +unix
     | AStr_modtype    of Ident.t * module_expr
     | AStr_class      of Ident.t
     | AStr_class_type of Ident.t
-    | AStr_include    of module_expr * (Ident.t * (Kind.t * Ident.t)) list
     | AStr_included   of Ident.t * module_expr * Kind.t * Ident.t
 
   let rec format_module_expr ppf = function
           format_module_expr mexp
     | AStr_class id -> fprintf ppf "class %s" (Ident.name id)
     | AStr_class_type id -> fprintf ppf "class type %s" (Ident.name id)
-    | AStr_include (mexp, aliases) ->
-        fprintf ppf "@[<v4>include %a@ { @[<v>%a@] }@]"
-          format_module_expr mexp
-          (list ";@ " (fun ppf (id', (k,id)) -> 
-            fprintf ppf "%s %a = %a" 
-              (Kind.name k)
-              Ident.format id' 
-              Ident.format id))
-          aliases
     | AStr_included (id, mexp, kind, id') ->
         fprintf ppf "@[<v4>included %s %a = %a@ { @[<v>%a@] }@]"
           (Kind.name kind)
     | AStr_module (id, _)  -> Some (Kind.Module, id)
     | AStr_modtype (id, _) -> Some (Kind.Module_type, id)
     | AStr_class id        -> Some (Kind.Class, id)
-    | AStr_class_type id       -> Some (Kind.Class_type, id)
-    | AStr_include _       -> None
+    | AStr_class_type id   -> Some (Kind.Class_type, id)
     | AStr_included (id, _, kind, _) -> Some (kind, id)
 
   module Module_expr = struct
 	    id1 = id2 && Module_expr.equal mexp1 mexp2
 	| AStr_modtype (id1, mty1), AStr_modtype (id2, mty2) ->
             id1 = id2 && Module_expr.equal mty1 mty2
-	| AStr_include (mexp1, aliases1), AStr_include (mexp2, aliases2) ->
-            aliases1 = aliases2
-            && Module_expr.equal mexp1 mexp2
 	| AStr_included (id1, mexp1, kind1, id1'), AStr_included (id2, mexp2, kind2, id2') ->
             id1 = id2 && kind1 = kind2 && id1' = id2'
             && Module_expr.equal mexp1 mexp2
 	| (AStr_value _ | AStr_type _ | AStr_exception _ | AStr_modtype _ 
-	  | AStr_class _ | AStr_class_type _ | AStr_module _ | AStr_include _ | AStr_included _),
+	  | AStr_class _ | AStr_class_type _ | AStr_module _ | AStr_included _),
 	  (AStr_value _ | AStr_type _ | AStr_exception _ | AStr_modtype _ 
-	  | AStr_class _ | AStr_class_type _ | AStr_module _ | AStr_include _ | AStr_included _) -> false
+	  | AStr_class _ | AStr_class_type _ | AStr_module _ | AStr_included _) -> false
 
       let hash = Hashtbl.hash
     end
 	List.map (fun (cls, _names, _) -> AStr_class cls.ci_id_class) classdescs
     | Tstr_class_type iddecls ->
 	List.map (fun (id, _, _) -> AStr_class_type id) iddecls
-    | Tstr_include (mexp, ids) ->
-        let aliases = try aliases_of_include mexp ids with _ -> assert false in
-        [AStr_include (module_expr mexp, aliases)]
+    | Tstr_include (mexp, idents) ->
+        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.map (fun (id, (k, id')) -> AStr_included (id, m, k, id')) id_kid_list
+
 
   (* CR jfuruse: caching like module_expr_sub *)
   and module_type mty = module_type_desc mty.mty_desc
         List.map (fun (id, _, mty) -> AStr_module (id, module_type mty)) lst
     | Tsig_open _ -> []
     | Tsig_include (mty, sg) -> 
+        let m = module_type mty in
         let sg0 = try match Mtype.scrape mty.mty_env mty.mty_type with Mty_signature sg -> sg | _ -> assert false with _ -> assert false in
-        let ids = List.map (fun sitem -> snd (T.kident_of_sigitem sitem)) sg in
+        let ids = List.map (fun si -> snd (T.kident_of_sigitem si)) sg in
         let aliases = try aliases_of_include' false sg0 ids with _ -> assert false in
-        [AStr_include (module_type mty, aliases)]
+        List.map (fun (id, (k, id')) -> AStr_included (id, m, k, id')) aliases
         
   and modtype_declaration = function
     | Tmodtype_abstract -> AMod_abstract
     | AStr_modtype    of Ident.t * module_expr
     | AStr_class      of Ident.t
     | AStr_class_type of Ident.t
-    | AStr_include    of module_expr * (Ident.t * (Kind.t * Ident.t)) list
     | AStr_included   of Ident.t * module_expr * Kind.t * Ident.t
 
   val ident_of_structure_item : structure_item -> (Kind.t * Ident.t) option
             | AStr_class      _ -> Kind.Class
             | AStr_class_type _ -> Kind.Class_type
             | AStr_included (_, _, kind, _) -> kind
-            | AStr_module _ | AStr_include _ -> assert false
+            | AStr_module _ -> assert false
           in
           (id, (kind, eager v)) :: str
 
                 Error (Failure "not found in include")
           end in
           (id', (k, v)) :: str
-
-      | AStr_include (mexp, aliases) ->
-          (* be careful: everything must be done lazily *)
-          let v = lazy begin
-            (* createate it lazily for recursiveness of flat *)
-            let env = Env.overrides env0 str in
-            !!(module_expr env None(*?*) mexp)
-          end in
-          let kid_ztbl = 
-            lazy begin match !!v with
-            | Structure (_, str, _ (* CR jfuruse *) ) -> 
-                List.map (fun (id, (k, v)) -> (k, id), v) str
-            | Parameter pid -> 
-                List.map (fun (_, (k,id)) -> (k, id), eager (Parameter pid)) aliases
-            | Ident _ -> assert false
-            | Closure _ -> assert false
-            | Error _ -> [] (* error *)
-            end
-          in
-          let str' = List.map (fun (id', (k, id)) ->
-            let v = lazy begin
-              let kid_tbl = !!kid_ztbl in
-              (* include does not preserve id stamp, so we must ignore them *)
-              match 
-                List.find_map_opt (fun ((k', id'), v) -> 
-                  if k = k' && Ident0.name id = Ident0.name id' then Some v else None) kid_tbl
-              with
-              | Some vz -> !!vz
-              | None -> 
-                Format.eprintf "INCLUDE ERROR: %s %a in @[%a@]@."
-                  (Kind.name k)
-                  Ident.format id
-                  (Format.list ";@ " (fun ppf ((k,id), _) -> 
-                    Format.fprintf ppf "%s %a" (Kind.name k) Ident.format id))
-                  kid_tbl;
-                Error (Failure "not found in include")
-            end in
-            id', (k, v)) aliases
-          in
-          str' @ str
-(*
-      | AStr_include (_ids (* CR jfuruse: todo *), mexp, kids) ->
-          (* be careful: everything must be done lazily *)
-          let v = lazy begin
-            (* createate it lazily for recursiveness of flat *)
-            let env = Env.overrides env0 str in
-            !!(module_expr env None(*?*) mexp)
-          end in
-          let kname_ztbl = 
-            lazy begin match !!v with
-            | Structure (_, str, _ (* CR jfuruse *) ) -> 
-                List.map (fun (id, (k, v)) -> (k, Ident0.name id), v) str
-            | Parameter pid -> 
-                List.map (fun (k,id) -> 
-                  (k, Ident0.name id), eager (Parameter pid)) kids
-            | Ident _ -> assert false
-            | Closure _ -> assert false
-            | Error _ -> [] (* error *)
-            end
-          in
-          let str' =
-            List.map (fun (k, id) ->
-              let v = 
-                lazy begin
-                  try
-                    !!(List.assoc (k, Ident0.name id) !!kname_ztbl)
-                  with
-                  | Not_found -> Error Not_found
-                end
-              in
-              id, (k, v)) kids
-          in
-          str' @ str
-*)
           ) [] sitems
 
   and apply v1 v2 =