diff options
Diffstat (limited to 'tools')
| -rw-r--r-- | tools/coq_makefile.ml | 2 | ||||
| -rw-r--r-- | tools/coqdep.ml | 4 | ||||
| -rw-r--r-- | tools/coqdep_boot.ml | 51 | ||||
| -rw-r--r-- | tools/coqdep_common.ml | 73 | ||||
| -rw-r--r-- | tools/coqdep_common.mli | 7 | ||||
| -rw-r--r-- | tools/ocamllibdep.mll | 210 |
6 files changed, 248 insertions, 99 deletions
diff --git a/tools/coq_makefile.ml b/tools/coq_makefile.ml index 8f4772e28..36d29a1e8 100644 --- a/tools/coq_makefile.ml +++ b/tools/coq_makefile.ml @@ -447,7 +447,7 @@ let variables is_install opt (args,defs) = (* Caml executables and relative variables *) if !some_ml4file || !some_mlfile || !some_mlifile then begin print "COQSRCLIBS?=-I \"$(COQLIB)kernel\" -I \"$(COQLIB)lib\" \\ - -I \"$(COQLIB)library\" -I \"$(COQLIB)parsing\" -I \"$(COQLIB)pretyping\" \\ + -I \"$(COQLIB)library\" -I \"$(COQLIB)parsing\" -I \"$(COQLIB)engine\" -I \"$(COQLIB)pretyping\" \\ -I \"$(COQLIB)interp\" -I \"$(COQLIB)printing\" -I \"$(COQLIB)intf\" \\ -I \"$(COQLIB)proofs\" -I \"$(COQLIB)tactics\" -I \"$(COQLIB)tools\" \\ -I \"$(COQLIB)toplevel\" -I \"$(COQLIB)stm\" -I \"$(COQLIB)grammar\" \\ diff --git a/tools/coqdep.ml b/tools/coqdep.ml index 2e0cce6e5..dd5593f65 100644 --- a/tools/coqdep.ml +++ b/tools/coqdep.ml @@ -9,6 +9,7 @@ open Printf open Coqdep_lexer open Coqdep_common +open System (** The basic parts of coqdep (i.e. the parts used by [coqdep -boot]) are now in [Coqdep_common]. The code that remains here concerns @@ -461,7 +462,7 @@ let rec parse = function | "-R" :: ([] | [_]) -> usage () | "-dumpgraph" :: f :: ll -> option_dump := Some (false, f); parse ll | "-dumpgraphbox" :: f :: ll -> option_dump := Some (true, f); parse ll - | "-exclude-dir" :: r :: ll -> norec_dirnames := r::!norec_dirnames; parse ll + | "-exclude-dir" :: r :: ll -> System.exclude_directory r; parse ll | "-exclude-dir" :: [] -> usage () | "-coqlib" :: r :: ll -> Flags.coqlib_spec := true; Flags.coqlib := r; parse ll | "-coqlib" :: [] -> usage () @@ -482,6 +483,7 @@ let coqdep () = if !option_boot then begin add_rec_dir add_known "theories" ["Coq"]; add_rec_dir add_known "plugins" ["Coq"]; + add_caml_dir "tactics"; add_rec_dir (fun _ -> add_caml_known) "theories" ["Coq"]; add_rec_dir (fun _ -> add_caml_known) "plugins" ["Coq"]; end else begin diff --git a/tools/coqdep_boot.ml b/tools/coqdep_boot.ml deleted file mode 100644 index bc3435a64..000000000 --- a/tools/coqdep_boot.ml +++ /dev/null @@ -1,51 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -open Coqdep_common - -(** [coqdep_boot] is a stripped-down version of [coqdep], whose - behavior is the one of [coqdep -boot]. Its only dependencies - are [Coqdep_lexer], [Coqdep_common] and [Unix], and it should stay so. - If it needs someday some additional information, pass it via - options (see for instance [option_natdynlk] below). -*) - -let rec parse = function - | "-natdynlink" :: "no" :: ll -> option_natdynlk := false; parse ll - | "-c" :: ll -> option_c := true; parse ll - | "-boot" :: ll -> parse ll (* We're already in boot mode by default *) - | "-mldep" :: ocamldep :: ll -> - option_mldep := Some ocamldep; option_c := true; parse ll - | "-I" :: r :: ll -> - (* To solve conflict (e.g. same filename in kernel and checker) - we allow to state an explicit order *) - add_caml_dir r; - norec_dirs:=r::!norec_dirs; - parse ll - | f :: ll -> treat_file None f; parse ll - | [] -> () - -let coqdep_boot () = - let () = option_boot := true in - if Array.length Sys.argv < 2 then exit 1; - parse (List.tl (Array.to_list Sys.argv)); - if !option_c then begin - add_rec_dir add_known "." []; - add_rec_dir (fun _ -> add_caml_known) "." ["Coq"]; - end - else begin - add_rec_dir add_known "theories" ["Coq"]; - add_rec_dir add_known "plugins" ["Coq"]; - add_caml_dir "tactics"; - add_rec_dir (fun _ -> add_caml_known) "theories" ["Coq"]; - add_rec_dir (fun _ -> add_caml_known) "plugins" ["Coq"]; - end; - if !option_c then mL_dependencies (); - coq_dependencies () - -let _ = Printexc.catch coqdep_boot () diff --git a/tools/coqdep_common.ml b/tools/coqdep_common.ml index d86e05d8c..9b7845b09 100644 --- a/tools/coqdep_common.ml +++ b/tools/coqdep_common.ml @@ -9,6 +9,7 @@ open Printf open Coqdep_lexer open Unix +open System (** [coqdep_boot] is a stripped-down version of [coqdep], whose behavior is the one of [coqdep -boot]. Its only dependencies @@ -27,26 +28,11 @@ let option_boot = ref false let option_mldep = ref None let norec_dirs = ref ([] : string list) -let norec_dirnames = ref ["CVS"; "_darcs"] let suffixe = ref ".vo" type dir = string option -(* Filename.concat but always with a '/' *) -let is_dir_sep s i = - match Sys.os_type with - | "Unix" -> s.[i] = '/' - | "Cygwin" | "Win32" -> - let c = s.[i] in c = '/' || c = '\\' || c = ':' - | _ -> assert false - -let (//) dirname filename = - let l = String.length dirname in - if l = 0 || is_dir_sep dirname (l-1) - then dirname ^ filename - else dirname ^ "/" ^ filename - (** [get_extension f l] checks whether [f] has one of the extensions listed in [l]. It returns [f] without its extension, alongside with the extension. When no extension match, [(f,"")] is returned *) @@ -163,6 +149,10 @@ let warning_clash file dir = eprintf "%s and %s; used the latter)\n" d2 d1 | _ -> assert false +let warning_cannot_open_dir dir = + eprintf "*** Warning: cannot open %s\n" dir; + flush stderr + let safe_assoc verbose file k = if verbose && List.mem_assoc k !clash_v then warning_clash file k; Hashtbl.find vKnown k @@ -461,42 +451,43 @@ let add_known recur phys_dir log_dir f = List.iter (fun f -> Hashtbl.add coqlibKnown f ()) paths | _ -> () -(* Visits all the directories under [dir], including [dir], - or just [dir] if [recur=false] *) +(* Visits all the directories under [dir], including [dir] *) -let rec add_directory recur add_file phys_dir log_dir = - let dirh = opendir phys_dir in - try - while true do - let f = readdir dirh in - (* we avoid all files and subdirs starting by '.' (e.g. .svn), - plus CVS and _darcs and any subdirs given via -exclude-dirs *) - if f.[0] <> '.' then - let phys_f = if phys_dir = "." then f else phys_dir//f in - match try (stat phys_f).st_kind with _ -> S_BLK with - | S_DIR when recur -> - if List.mem f !norec_dirnames then () - else - if List.mem phys_f !norec_dirs then () - else - add_directory recur add_file phys_f (log_dir@[f]) - | S_REG -> add_file phys_dir log_dir f - | _ -> () - done - with End_of_file -> closedir dirh +let is_not_seen_directory phys_f = + not (List.mem phys_f !norec_dirs) + +let rec add_directory add_file phys_dir log_dir = + let f = function + | FileDir (phys_f,f) -> + if is_not_seen_directory phys_f then + add_directory add_file phys_f (log_dir @ [f]) + | FileRegular f -> + add_file phys_dir log_dir f + in + System.check_unix_dir (fun s -> eprintf "*** Warning: %s\n" s) phys_dir; + if exists_dir phys_dir then + process_directory f phys_dir + else + warning_cannot_open_dir phys_dir (** -Q semantic: go in subdirs but only full logical paths are known. *) let add_dir add_file phys_dir log_dir = - try add_directory true (add_file false) phys_dir log_dir with Unix_error _ -> () + try add_directory (add_file false) phys_dir log_dir with Unix_error _ -> () (** -R semantic: go in subdirs and suffixes of logical paths are known. *) let add_rec_dir add_file phys_dir log_dir = - handle_unix_error (add_directory true (add_file true) phys_dir) log_dir + add_directory (add_file true) phys_dir log_dir + +(** -R semantic but only on immediate capitalized subdirs *) + +let add_rec_uppercase_subdirs add_file phys_dir log_dir = + process_subdirectories (fun phys_dir f -> + add_directory (add_file true) phys_dir (log_dir@[String.capitalize f])) + phys_dir (** -I semantic: do not go in subdirs. *) let add_caml_dir phys_dir = - handle_unix_error (add_directory true add_caml_known phys_dir) [] - + add_directory add_caml_known phys_dir [] let rec treat_file old_dirname old_name = let name = Filename.basename old_name diff --git a/tools/coqdep_common.mli b/tools/coqdep_common.mli index 71b96ca0e..3ac602183 100644 --- a/tools/coqdep_common.mli +++ b/tools/coqdep_common.mli @@ -12,10 +12,8 @@ val option_boot : bool ref val option_natdynlk : bool ref val option_mldep : string option ref val norec_dirs : string list ref -val norec_dirnames : string list ref val suffixe : string ref type dir = string option -val ( // ) : string -> string -> string val get_extension : string -> string list -> string * string val basename_noext : string -> string val mlAccu : (string * string * dir) list ref @@ -41,13 +39,12 @@ val coq_dependencies : unit -> unit val suffixes : 'a list -> 'a list list val add_known : bool -> string -> string list -> string -> unit val add_caml_known : string -> string list -> string -> unit -val add_directory : - bool -> - (string -> string list -> string -> unit) -> string -> string list -> unit val add_caml_dir : string -> unit val add_dir : (bool -> string -> string list -> string -> unit) -> string -> string list -> unit val add_rec_dir : (bool -> string -> string list -> string -> unit) -> string -> string list -> unit +val add_rec_uppercase_subdirs : + (bool -> string -> string list -> string -> unit) -> string -> string list -> unit val treat_file : dir -> string -> unit val error_cannot_parse : string -> int * int -> 'a diff --git a/tools/ocamllibdep.mll b/tools/ocamllibdep.mll new file mode 100644 index 000000000..4e5edcf6c --- /dev/null +++ b/tools/ocamllibdep.mll @@ -0,0 +1,210 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +{ + exception Syntax_error of int*int + + let syntax_error lexbuf = + raise (Syntax_error (Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf)) +} + +let space = [' ' '\t' '\n' '\r'] +let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255'] +let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222'] +let identchar = + ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] +let caml_up_ident = uppercase identchar* +let caml_low_ident = lowercase identchar* + +rule mllib_list = parse + | caml_up_ident { let s = String.uncapitalize (Lexing.lexeme lexbuf) + in s :: mllib_list lexbuf } + | "*predef*" { mllib_list lexbuf } + | space+ { mllib_list lexbuf } + | eof { [] } + | _ { syntax_error lexbuf } + +{ +open Printf +open Unix + +(** [coqdep_boot] is a stripped-down version of [coqdep] used to treat + with mllib files. +*) + +(* Makefile's escaping rules are awful: $ is escaped by doubling and + other special characters are escaped by backslash prefixing while + backslashes themselves must be escaped only if part of a sequence + followed by a special character (i.e. in case of ambiguity with a + use of it as escaping character). Moreover (even if not crucial) + it is apparently not possible to directly escape ';' and leading '\t'. *) + +let escape = + let s' = Buffer.create 10 in + fun s -> + Buffer.clear s'; + for i = 0 to String.length s - 1 do + let c = s.[i] in + if c = ' ' || c = '#' || c = ':' (* separators and comments *) + || c = '%' (* pattern *) + || c = '?' || c = '[' || c = ']' || c = '*' (* expansion in filenames *) + || i=0 && c = '~' && (String.length s = 1 || s.[1] = '/' || + 'A' <= s.[1] && s.[1] <= 'Z' || + 'a' <= s.[1] && s.[1] <= 'z') (* homedir expansion *) + then begin + let j = ref (i-1) in + while !j >= 0 && s.[!j] = '\\' do + Buffer.add_char s' '\\'; decr j (* escape all preceding '\' *) + done; + Buffer.add_char s' '\\'; + end; + if c = '$' then Buffer.add_char s' '$'; + Buffer.add_char s' c + done; + Buffer.contents s' + +(* Filename.concat but always with a '/' *) +let is_dir_sep s i = + match Sys.os_type with + | "Unix" -> s.[i] = '/' + | "Cygwin" | "Win32" -> + let c = s.[i] in c = '/' || c = '\\' || c = ':' + | _ -> assert false + +let (//) dirname filename = + let l = String.length dirname in + if l = 0 || is_dir_sep dirname (l-1) + then dirname ^ filename + else dirname ^ "/" ^ filename + +(** [get_extension f l] checks whether [f] has one of the extensions + listed in [l]. It returns [f] without its extension, alongside with + the extension. When no extension match, [(f,"")] is returned *) + +let rec get_extension f = function + | [] -> (f, "") + | s :: _ when Filename.check_suffix f s -> (Filename.chop_suffix f s, s) + | _ :: l -> get_extension f l + +let file_name s = function + | None -> s + | Some "." -> s + | Some d -> d // s + +type dir = string option + +(* Visits all the directories under [dir], including [dir], + or just [dir] if [recur=false] *) + +let rec add_directory add_file phys_dir = + let dirh = opendir phys_dir in + try + while true do + let f = readdir dirh in + (* we avoid all files and subdirs starting by '.' (e.g. .svn), + plus CVS and _darcs and any subdirs given via -exclude-dirs *) + if f.[0] <> '.' then + let phys_f = if phys_dir = "." then f else phys_dir//f in + match try (stat phys_f).st_kind with _ -> S_BLK with + | S_REG -> add_file phys_dir f + | _ -> () + done + with End_of_file -> closedir dirh + +let error_cannot_parse s (i,j) = + Printf.eprintf "File \"%s\", characters %i-%i: Syntax error\n" s i j; + exit 1 + +let warning_ml_clash x s suff s' suff' = + if suff = suff' then + eprintf + "*** Warning: %s%s already found in %s (discarding %s%s)\n" x suff + (match s with None -> "." | Some d -> d) + ((match s' with None -> "." | Some d -> d) // x) suff + +let mkknown () = + let h = (Hashtbl.create 19 : (string, dir * string) Hashtbl.t) in + let add x s suff = + try let s',suff' = Hashtbl.find h x in warning_ml_clash x s' suff' s suff + with Not_found -> Hashtbl.add h x (s,suff) + and search x = + try Some (fst (Hashtbl.find h x)) + with Not_found -> None + in add, search + +let add_ml_known, search_ml_known = mkknown () +let add_mlpack_known, search_mlpack_known = mkknown () + +let mllibAccu = ref ([] : (string * dir) list) + +let add_caml_known phys_dir f = + let basename,suff = get_extension f [".ml";".ml4";".mlpack"] in + match suff with + | ".ml"|".ml4" -> add_ml_known basename (Some phys_dir) suff + | ".mlpack" -> add_mlpack_known basename (Some phys_dir) suff + | _ -> () + +let add_caml_dir phys_dir = + handle_unix_error (add_directory add_caml_known) phys_dir + +let traite_fichier_modules md ext = + try + let chan = open_in (md ^ ext) in + let list = mllib_list (Lexing.from_channel chan) in + List.fold_left + (fun a_faire str -> match search_mlpack_known str with + | Some mldir -> + let file = file_name str mldir in + a_faire^" "^file + | None -> + match search_ml_known str with + | Some mldir -> + let file = file_name str mldir in + a_faire^" "^file + | None -> a_faire) "" list + with + | Sys_error _ -> "" + | Syntax_error (i,j) -> error_cannot_parse (md^ext) (i,j) + +let addQueue q v = q := v :: !q + +let rec treat_file old_name = + let name = Filename.basename old_name in + let dirname = Some (Filename.dirname old_name) in + match get_extension name [".mllib"] with + | (base,".mllib") -> addQueue mllibAccu (base,dirname) + | _ -> () + +let mllib_dependencies () = + List.iter + (fun (name,dirname) -> + let fullname = file_name name dirname in + let dep = traite_fichier_modules fullname ".mllib" in + let efullname = escape fullname in + printf "%s_MLLIB_DEPENDENCIES:=%s\n" efullname dep; + printf "%s.cma:$(addsuffix .cmo,$(%s_MLLIB_DEPENDENCIES))\n" efullname efullname; + printf "%s.cmxa %s.cmxs:$(addsuffix .cmx,$(%s_MLLIB_DEPENDENCIES))\n" efullname efullname efullname; + flush Pervasives.stdout) + (List.rev !mllibAccu) + +let rec parse = function + | "-I" :: r :: ll -> + (* To solve conflict (e.g. same filename in kernel and checker) + we allow to state an explicit order *) + add_caml_dir r; + parse ll + | f :: ll -> treat_file f; parse ll + | [] -> () + +let coqdep_boot () = + if Array.length Sys.argv < 2 then exit 1; + parse (List.tl (Array.to_list Sys.argv)); + mllib_dependencies () + +let _ = Printexc.catch coqdep_boot () +} |