summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--driver/compile.ml11
-rw-r--r--driver/optcompile.ml11
-rw-r--r--otherlibs/labltk/browser/main.ml4
-rw-r--r--otherlibs/labltk/browser/searchpos.ml4
-rw-r--r--toplevel/topdirs.ml3
-rw-r--r--toplevel/topmain.ml4
-rw-r--r--utils/misc.ml9
-rw-r--r--utils/misc.mli3
8 files changed, 26 insertions, 23 deletions
diff --git a/driver/compile.ml b/driver/compile.ml
index d9511dfb5..008331e72 100644
--- a/driver/compile.ml
+++ b/driver/compile.ml
@@ -19,15 +19,6 @@ open Config
open Format
open Typedtree
-(* Expand a -I option: if it starts with +, make it relative to the standard
- library directory *)
-
-let expand_directory s =
- if String.length s > 0 && s.[0] = '+'
- then Filename.concat Config.standard_library
- (String.sub s 1 (String.length s - 1))
- else s
-
(* Initialize the search path.
The current directory is always searched first,
then the directories specified with the -I option (in command-line order),
@@ -39,7 +30,7 @@ let init_path () =
then "+threads" :: !Clflags.include_dirs
else !Clflags.include_dirs in
let exp_dirs =
- List.map expand_directory dirs in
+ List.map (expand_directory Config.standard_library) dirs in
load_path := "" :: List.rev (Config.standard_library :: exp_dirs);
Env.reset_cache()
diff --git a/driver/optcompile.ml b/driver/optcompile.ml
index 992c1150a..6392e98bf 100644
--- a/driver/optcompile.ml
+++ b/driver/optcompile.ml
@@ -19,15 +19,6 @@ open Config
open Format
open Typedtree
-(* Expand a -I option: if it starts with +, make it relative to the standard
- library directory *)
-
-let expand_directory s =
- if String.length s > 0 && s.[0] = '+'
- then Filename.concat Config.standard_library
- (String.sub s 1 (String.length s - 1))
- else s
-
(* Initialize the search path.
The current directory is always searched first,
then the directories specified with the -I option (in command-line order),
@@ -39,7 +30,7 @@ let init_path () =
then "+threads" :: !Clflags.include_dirs
else !Clflags.include_dirs in
let exp_dirs =
- List.map expand_directory dirs in
+ List.map (expand_directory Config.standard_library) dirs in
load_path := "" :: List.rev (Config.standard_library :: exp_dirs);
Env.reset_cache()
diff --git a/otherlibs/labltk/browser/main.ml b/otherlibs/labltk/browser/main.ml
index 1a0cb2788..6e0b4618b 100644
--- a/otherlibs/labltk/browser/main.ml
+++ b/otherlibs/labltk/browser/main.ml
@@ -38,7 +38,9 @@ let _ =
\032 default setting is A (all warnings enabled)"]
~others:(fun name -> raise(Arg.Bad("don't know what to do with " ^ name)))
~errmsg:"ocamlbrowser :";
- Config.load_path := List.rev !path @ [Config.standard_library];
+ Config.load_path :=
+ List.rev_map ~f:(Misc.expand_directory Config.standard_library) !path
+ @ [Config.standard_library];
Warnings.parse_options ~iserror:false !Shell.warnings;
Unix.putenv "TERM" "noterminal";
begin
diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml
index c224c5fbe..3950e2b25 100644
--- a/otherlibs/labltk/browser/searchpos.ml
+++ b/otherlibs/labltk/browser/searchpos.ml
@@ -612,6 +612,7 @@ let rec search_pos_structure ~pos str =
| Tstr_class l ->
List.iter l ~f:(fun (id, _, _, cl) -> search_pos_class_expr cl ~pos)
| Tstr_cltype _ -> ()
+ | Tstr_include (m, _) -> search_pos_module_expr m ~pos
end
and search_pos_class_expr ~pos cl =
@@ -731,6 +732,9 @@ and search_pos_expr ~pos exp =
| Texp_letmodule (id, modexp, exp) ->
search_pos_module_expr modexp ~pos;
search_pos_expr exp ~pos
+ | Texp_assertfalse -> ()
+ | Texp_assert exp ->
+ search_pos_expr exp ~pos
end;
raise (Found_str (`Exp(`Expr, exp.exp_type), exp.exp_env))
end
diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
index 957150784..d75405179 100644
--- a/toplevel/topdirs.ml
+++ b/toplevel/topdirs.ml
@@ -35,7 +35,8 @@ let _ = Hashtbl.add directive_table "quit" (Directive_none dir_quit)
(* To add a directory to the load path *)
let dir_directory s =
- Config.load_path := s :: !Config.load_path;
+ Config.load_path :=
+ expand_directory Config.standard_library s :: !Config.load_path;
Env.reset_cache()
let _ = Hashtbl.add directive_table "directory" (Directive_string dir_directory)
diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml
index 69105668d..85bd04fb7 100644
--- a/toplevel/topmain.ml
+++ b/toplevel/topmain.ml
@@ -21,7 +21,9 @@ let file_argument name =
let main () =
Arg.parse [
- "-I", Arg.String(fun dir -> include_dirs := dir :: !include_dirs),
+ "-I", Arg.String(fun dir ->
+ let dir = Misc.expand_directory Config.standard_library dir in
+ include_dirs := dir :: !include_dirs),
"<dir> Add <dir> to the list of include directories";
"-labels", Arg.Clear classic, " Use commuting label mode";
"-modern", Arg.Clear classic, " (deprecated) same as -labels";
diff --git a/utils/misc.ml b/utils/misc.ml
index bfd09005b..e6b659290 100644
--- a/utils/misc.ml
+++ b/utils/misc.ml
@@ -77,6 +77,15 @@ let remove_file filename =
with Sys_error msg ->
()
+(* Expand a -I option: if it starts with +, make it relative to the standard
+ library directory *)
+
+let expand_directory alt s =
+ if String.length s > 0 && s.[0] = '+'
+ then Filename.concat alt
+ (String.sub s 1 (String.length s - 1))
+ else s
+
(* Hashtable functions *)
let create_hashtable size init =
diff --git a/utils/misc.mli b/utils/misc.mli
index db4a58ef1..47baee949 100644
--- a/utils/misc.mli
+++ b/utils/misc.mli
@@ -39,6 +39,9 @@ val find_in_path: string list -> string -> string
(* Search a file in a list of directories. *)
val remove_file: string -> unit
(* Delete the given file if it exists. Never raise an error. *)
+val expand_directory: string -> string -> string
+ (* [expand_directory alt file] eventually expands a [+] at the
+ beginning of file into [alt] (an alternate root directory) *)
val create_hashtable: int -> ('a * 'b) list -> ('a, 'b) Hashtbl.t
(* Create a hashtable of the given size and fills it with the