l4/pkg/ocaml/contrib/camlp4/Camlp4/Struct/DynLoader.ml

   1 (* camlp4r pa_macro.cmo *)
   2 (****************************************************************************)
   3 (*                                                                          *)
   4 (*                              Objective Caml                              *)
   5 (*                                                                          *)
   6 (*                            INRIA Rocquencourt                            *)
   7 (*                                                                          *)
   8 (*  Copyright 2001-2006 Institut National de Recherche en Informatique et   *)
   9 (*  en Automatique.  All rights reserved.  This file is distributed under   *)
  10 (*  the terms of the GNU Library General Public License, with the special   *)
  11 (*  exception on linking described in LICENSE at the top of the Objective   *)
  12 (*  Caml source tree.                                                       *)
  13 (*                                                                          *)
  14 (****************************************************************************)
  15
  16 (* Authors:
  17  * - Daniel de Rauglaudre: initial version
  18  * - Nicolas Pouillard: refactoring
  19  *)
  20
  21
  22
  23
  24 type t = Queue.t string;
  25
  26 exception Error of string and string;
  27
  28 value include_dir x y = Queue.add y x;
  29
  30 value fold_load_path x f acc = Queue.fold (fun x y -> f y x) acc x;
  31
  32 value mk ?(ocaml_stdlib = True) ?(camlp4_stdlib = True) () =
  33   let q = Queue.create () in do {
  34     if ocaml_stdlib then include_dir q Camlp4_config.ocaml_standard_library else ();
  35     if camlp4_stdlib then do {
  36       include_dir q Camlp4_config.camlp4_standard_library;
  37       include_dir q (Filename.concat Camlp4_config.camlp4_standard_library "Camlp4Parsers");
  38       include_dir q (Filename.concat Camlp4_config.camlp4_standard_library "Camlp4Printers");
  39       include_dir q (Filename.concat Camlp4_config.camlp4_standard_library "Camlp4Filters");
  40     } else ();
  41     include_dir q ".";
  42   q
  43 };
  44
  45 (* Load files in core *)
  46
  47 value find_in_path x name =
  48   if not (Filename.is_implicit name) then
  49     if Sys.file_exists name then name else raise Not_found
  50   else
  51     let res =
  52       fold_load_path x
  53         (fun dir ->
  54           fun
  55           [ None ->
  56               let fullname = Filename.concat dir name in
  57               if Sys.file_exists fullname then Some fullname else None
  58           | x -> x ]) None
  59     in match res with [ None -> raise Not_found | Some x -> x ];
  60
  61 value load =
  62   let _initialized = ref False in
  63   fun _path file ->
  64     do {
  65       if not _initialized.val then
  66         try do {
  67           Dynlink.init ();
  68           Dynlink.allow_unsafe_modules True;
  69          _initialized.val := True
  70         }
  71         with
  72         [ Dynlink.Error e ->
  73            raise (Error "Camlp4's dynamic loader initialization" (Dynlink.error_message e)) ]
  74       else ();
  75       let fname =
  76         try find_in_path _path file with
  77         [ Not_found -> raise (Error file "file not found in path") ]
  78       in
  79       try Dynlink.loadfile fname with
  80       [ Dynlink.Error e -> raise (Error fname (Dynlink.error_message e)) ]
  81     };
  82
  83
  84 value is_native = Dynlink.is_native;