aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/cWarnings.ml21
-rw-r--r--lib/dAst.ml2
-rw-r--r--lib/dAst.mli1
-rw-r--r--lib/envars.ml2
-rw-r--r--lib/flags.ml17
-rw-r--r--lib/flags.mli17
-rw-r--r--lib/future.ml2
-rw-r--r--lib/loc.ml9
-rw-r--r--lib/loc.mli2
9 files changed, 17 insertions, 56 deletions
diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml
index 0cf989e494..f199e2e608 100644
--- a/lib/cWarnings.ml
+++ b/lib/cWarnings.ml
@@ -8,8 +8,6 @@
(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
-open Pp
-
type status =
Disabled | Enabled | AsError
@@ -158,6 +156,10 @@ let set_flags s =
warning flags string, because the warning being created might have been set
already. *)
let create ~name ~category ?(default=Enabled) pp =
+ let pp x = let open Pp in
+ pp x ++ spc () ++ str "[" ++ str name ++ str "," ++
+ str category ++ str "]"
+ in
Hashtbl.replace warnings name { default; category; status = default };
add_warning_in_category ~name ~category;
if default <> Disabled then
@@ -166,13 +168,8 @@ let create ~name ~category ?(default=Enabled) pp =
new warning is now known. *)
set_flags !flags;
fun ?loc x ->
- let w = Hashtbl.find warnings name in
- match w.status with
- | Disabled -> ()
- | AsError -> CErrors.user_err ?loc (pp x)
- | Enabled ->
- let msg =
- pp x ++ spc () ++ str "[" ++ str name ++ str "," ++
- str category ++ str "]"
- in
- Feedback.msg_warning ?loc msg
+ let w = Hashtbl.find warnings name in
+ match w.status with
+ | Disabled -> ()
+ | AsError -> CErrors.user_err ?loc (pp x)
+ | Enabled -> Feedback.msg_warning ?loc (pp x)
diff --git a/lib/dAst.ml b/lib/dAst.ml
index f34ab956a3..803b2a0cff 100644
--- a/lib/dAst.ml
+++ b/lib/dAst.ml
@@ -30,6 +30,8 @@ let make ?loc v = CAst.make ?loc (Value v)
let delay ?loc v = CAst.make ?loc (Thunk (Lazy.from_fun v))
+let force x = CAst.make ?loc:x.CAst.loc (Value (get_thunk x.v))
+
let map f n = CAst.map (fun x -> map_thunk f x) n
let map_with_loc f n =
diff --git a/lib/dAst.mli b/lib/dAst.mli
index 28c78784e6..2f58cfc41f 100644
--- a/lib/dAst.mli
+++ b/lib/dAst.mli
@@ -21,6 +21,7 @@ val get_thunk : ('a, 'b) thunk -> 'a
val make : ?loc:Loc.t -> 'a -> ('a, 'b) t
val delay : ?loc:Loc.t -> (unit -> 'a) -> ('a, [ `thunk ]) t
+val force : ('a, 'b) t -> ('a, 'b) t
val map : ('a -> 'b) -> ('a, 'c) t -> ('b, 'c) t
val map_with_loc : (?loc:Loc.t -> 'a -> 'b) -> ('a, 'c) t -> ('b, 'c) t
diff --git a/lib/envars.ml b/lib/envars.ml
index b5036e7340..0f4670688b 100644
--- a/lib/envars.ml
+++ b/lib/envars.ml
@@ -114,7 +114,7 @@ let set_coqlib ~fail =
match !coqlib with
| Some _ -> ()
| None ->
- let lib = if !Flags.boot then coqroot else guess_coqlib fail in
+ let lib = guess_coqlib fail in
coqlib := Some lib
let coqlib () = Option.default "" !coqlib
diff --git a/lib/flags.ml b/lib/flags.ml
index 55bfa3cbde..6718e7a954 100644
--- a/lib/flags.ml
+++ b/lib/flags.ml
@@ -41,12 +41,8 @@ let with_options ol f x =
let () = List.iter2 (:=) ol vl in
Exninfo.iraise reraise
-let boot = ref false
-
let record_aux_file = ref false
-let test_mode = ref false
-
let async_proofs_worker_id = ref "master"
let async_proofs_is_worker () = !async_proofs_worker_id <> "master"
@@ -103,16 +99,6 @@ let verbosely f x = without_option quiet f x
let if_silent f x = if !quiet then f x
let if_verbose f x = if not !quiet then f x
-let polymorphic_inductive_cumulativity = ref false
-let make_polymorphic_inductive_cumulativity b = polymorphic_inductive_cumulativity := b
-let is_polymorphic_inductive_cumulativity () = !polymorphic_inductive_cumulativity
-
-(** [program_mode] tells that Program mode has been activated, either
- globally via [Set Program] or locally via the Program command prefix. *)
-
-let program_mode = ref false
-let is_program_mode () = !program_mode
-
let warn = ref true
let make_warn flag = warn := flag; ()
let if_warn f x = if !warn then f x
@@ -124,8 +110,5 @@ let inline_level = ref default_inline_level
let set_inline_level = (:=) inline_level
let get_inline_level () = !inline_level
-(* Native code compilation for conversion and normalization *)
-let output_native_objects = ref false
-
let profile_ltac = ref false
let profile_ltac_cutoff = ref 2.0
diff --git a/lib/flags.mli b/lib/flags.mli
index 7336b9beaf..bf8846417b 100644
--- a/lib/flags.mli
+++ b/lib/flags.mli
@@ -31,16 +31,10 @@
(** Command-line flags *)
-val boot : bool ref
-
(** Set by coqtop to tell the kernel to output to the aux file; will
be eventually removed by cleanups such as PR#1103 *)
val record_aux_file : bool ref
-(* Flag set when the test-suite is called. Its only effect to display
- verbose information for `Fail` *)
-val test_mode : bool ref
-
(** Async-related flags *)
val async_proofs_worker_id : string ref
val async_proofs_is_worker : unit -> bool
@@ -77,14 +71,6 @@ val verbosely : ('a -> 'b) -> 'a -> 'b
val if_silent : ('a -> unit) -> 'a -> unit
val if_verbose : ('a -> unit) -> 'a -> unit
-(* Miscellaneus flags for vernac *)
-val program_mode : bool ref
-val is_program_mode : unit -> bool
-
-(** Global polymorphic inductive cumulativity flag. *)
-val make_polymorphic_inductive_cumulativity : bool -> unit
-val is_polymorphic_inductive_cumulativity : unit -> bool
-
val warn : bool ref
val make_warn : bool -> unit
val if_warn : ('a -> unit) -> 'a -> unit
@@ -116,9 +102,6 @@ val set_inline_level : int -> unit
val get_inline_level : unit -> int
val default_inline_level : int
-(** When producing vo objects, also compile the native-code version *)
-val output_native_objects : bool ref
-
(** Global profile_ltac flag *)
val profile_ltac : bool ref
val profile_ltac_cutoff : float ref
diff --git a/lib/future.ml b/lib/future.ml
index b372bedc5d..6e7c6fd9e3 100644
--- a/lib/future.ml
+++ b/lib/future.ml
@@ -33,7 +33,7 @@ let _ = CErrors.register_handler (function
| _ -> raise CErrors.Unhandled)
type fix_exn = Exninfo.iexn -> Exninfo.iexn
-let id x = prerr_endline "Future: no fix_exn.\nYou have probably created a Future.computation from a value without passing the ~fix_exn argument. You probably want to chain with an already existing future instead."; x
+let id x = x
module UUID = struct
type t = int
diff --git a/lib/loc.ml b/lib/loc.ml
index c08648911b..66b7a7da70 100644
--- a/lib/loc.ml
+++ b/lib/loc.ml
@@ -22,19 +22,17 @@ type t = {
bol_pos_last : int; (** position of the beginning of end line *)
bp : int; (** start position *)
ep : int; (** end position *)
- comm : string; (** start comment *)
- ecomm : string (** end comment *)
}
let create fname line_nb bol_pos bp ep = {
fname = fname; line_nb = line_nb; bol_pos = bol_pos;
line_nb_last = line_nb; bol_pos_last = bol_pos; bp = bp; ep = ep;
- comm = ""; ecomm = "" }
+}
let make_loc (bp, ep) = {
fname = ToplevelInput; line_nb = -1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
bp = bp; ep = ep;
- comm = ""; ecomm = "" }
+}
let mergeable loc1 loc2 =
loc1.fname = loc2.fname
@@ -50,7 +48,7 @@ let merge loc1 loc2 =
line_nb_last = loc2.line_nb_last;
bol_pos_last = loc2.bol_pos_last;
bp = loc1.bp; ep = loc2.ep;
- comm = loc1.comm; ecomm = loc2.comm }
+ }
else loc1
else if loc2.ep < loc1.ep then {
fname = loc2.fname;
@@ -59,7 +57,6 @@ let merge loc1 loc2 =
line_nb_last = loc1.line_nb_last;
bol_pos_last = loc1.bol_pos_last;
bp = loc2.bp; ep = loc1.ep;
- comm = loc2.comm; ecomm = loc1.comm
}
else loc2
diff --git a/lib/loc.mli b/lib/loc.mli
index c46311b639..23df1ebd9a 100644
--- a/lib/loc.mli
+++ b/lib/loc.mli
@@ -22,8 +22,6 @@ type t = {
bol_pos_last : int; (** position of the beginning of end line *)
bp : int; (** start position *)
ep : int; (** end position *)
- comm : string; (** start comment *)
- ecomm : string (** end comment *)
}
(** {5 Location manipulation} *)
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-05 01:48:27 +0000