[r2004-03-11 13:34:18 by jdemouth] Petite modification.

Original author: jdemouth
Date: 2004-03-11 13:34:18+00:00

cdo2cmo/ml_ocaml.ml

@@ -5,6 +5,7 @@ open Ml_types
 
 ifdef ML_INTERFACE then
 type error =
+  | File_not_found of string
   | Unsupported_feature of string
 
 ifdef ML_INTERFACE then
@@ -16,8 +17,10 @@ let error e = raise ( Error e )
 ifdef ML_INTERFACE then
 let report_error err =
   let msg = match err with
+    | File_not_found s ->
+	"ml interface : error file " ^ s ^ " not found in object path"
     | Unsupported_feature s -> 
-	"cdo2cmo : error unsupported " ^ s ^ " in interface file (.mli)"
+	"ml interface : error unsupported " ^ s ^ " in interface file (.mli)"
   in
   Format.eprintf "%s@." msg
 
@@ -373,10 +376,17 @@ let rec translate_ident env path spath = function
 and load_module env name =
   let file = String.copy name in
   String.set file 0 ( Char.lowercase ( String.get file 0 ) );
-  let file = Format.sprintf "%s.cmi" file in
+  let file = find_file ( Format.sprintf "%s.cmi" file ) in
   let sign = ML.Env.read_signature name file in
   let _ = translate_signature ( Env.external_env env name ) sign in ()
 
+and find_file name =
+  try
+    List.find ( 
+      fun dir -> Sys.file_exists ( Filename.concat dir name ) 
+    ) !Librarian.obj_path
+  with Not_found -> error ( File_not_found name )
+
 and translate_tdesc env id = function
   | ML.Types.Tvar -> 
       env, ML_var id
@@ -516,13 +526,12 @@ and translate_signature env signature =
 ifdef ML_INTERFACE then
 module CompUnit : sig 
   type t
-  val from_bytecode : string -> t
+  val from_bytecode : string -> string -> t
   val iter : ( ( bool * Type.t list ) -> unit ) -> t -> unit
 end = struct
   type t = { cu_list: ( bool * ocaml_t list ) list }
 
-  let from_bytecode file_name =
-    let mod_name = Filename.chop_suffix file_name ".cmi" in
+  let from_bytecode file_name mod_name =
     String.set mod_name 0 (Char.uppercase (String.get mod_name 0));
     let signature = ML.Env.read_signature mod_name file_name in
     let env = Env.current mod_name in