aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/cArray.ml4
-rw-r--r--lib/clib.mllib1
-rw-r--r--lib/dAst.ml41
-rw-r--r--lib/dAst.mli28
-rw-r--r--lib/loc.ml15
-rw-r--r--lib/loc.mli13
6 files changed, 96 insertions, 6 deletions
diff --git a/lib/cArray.ml b/lib/cArray.ml
index d08f24d490..013585735c 100644
--- a/lib/cArray.ml
+++ b/lib/cArray.ml
@@ -334,7 +334,7 @@ let smartmap f (ar : 'a array) =
Array.unsafe_set ans !i v;
incr i;
while !i < len do
- let v = Array.unsafe_get ar !i in
+ let v = Array.unsafe_get ans !i in
let v' = f v in
if v != v' then Array.unsafe_set ans !i v';
incr i
@@ -527,7 +527,7 @@ struct
Array.unsafe_set ans !i v;
incr i;
while !i < len do
- let v = Array.unsafe_get ar !i in
+ let v = Array.unsafe_get ans !i in
let v' = f arg v in
if v != v' then Array.unsafe_set ans !i v';
incr i
diff --git a/lib/clib.mllib b/lib/clib.mllib
index d5c938fe54..5c1f7d9af8 100644
--- a/lib/clib.mllib
+++ b/lib/clib.mllib
@@ -19,6 +19,7 @@ Flags
Control
Loc
CAst
+DAst
CList
CString
Deque
diff --git a/lib/dAst.ml b/lib/dAst.ml
new file mode 100644
index 0000000000..0fe323d013
--- /dev/null
+++ b/lib/dAst.ml
@@ -0,0 +1,41 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+open CAst
+
+type ('a, _) thunk =
+| Value : 'a -> ('a, 'b) thunk
+| Thunk : 'a Lazy.t -> ('a, [ `thunk ]) thunk
+
+type ('a, 'b) t = ('a, 'b) thunk CAst.t
+
+let map_thunk (type s) f : (_, s) thunk -> (_, s) thunk = function
+| Value x -> Value (f x)
+| Thunk k -> Thunk (lazy (f (Lazy.force k)))
+
+let get_thunk (type s) : ('a, s) thunk -> 'a = function
+| Value x -> x
+| Thunk k -> Lazy.force k
+
+let get x = get_thunk x.v
+
+let make ?loc v = CAst.make ?loc (Value v)
+
+let delay ?loc v = CAst.make ?loc (Thunk (Lazy.from_fun v))
+
+let map f n = CAst.map (fun x -> map_thunk f x) n
+
+let map_with_loc f n =
+ CAst.map_with_loc (fun ?loc x -> map_thunk (fun x -> f ?loc x) x) n
+
+let map_from_loc f (loc, x) =
+ make ?loc (f ?loc x)
+
+let with_val f n = f (get n)
+
+let with_loc_val f n = f ?loc:n.CAst.loc (get n)
diff --git a/lib/dAst.mli b/lib/dAst.mli
new file mode 100644
index 0000000000..5b51677fc6
--- /dev/null
+++ b/lib/dAst.mli
@@ -0,0 +1,28 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(** Lazy AST node wrapper. Only used for [glob_constr] as of today. *)
+
+type ('a, _) thunk =
+| Value : 'a -> ('a, 'b) thunk
+| Thunk : 'a Lazy.t -> ('a, [ `thunk ]) thunk
+
+type ('a, 'b) t = ('a, 'b) thunk CAst.t
+
+val get : ('a, 'b) t -> 'a
+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 map : ('a -> 'b) -> ('a, 'c) t -> ('b, 'c) t
+val map_with_loc : (?loc:Loc.t -> 'a -> 'b) -> ('a, 'c) t -> ('b, 'c) t
+val map_from_loc : (?loc:Loc.t -> 'a -> 'b) -> 'a Loc.located -> ('b, 'c) t
+
+val with_val : ('a -> 'b) -> ('a, 'c) t -> 'b
+val with_loc_val : (?loc:Loc.t -> 'a -> 'b) -> ('a, 'c) t -> 'b
diff --git a/lib/loc.ml b/lib/loc.ml
index 9f036d90f9..4a935a9d9c 100644
--- a/lib/loc.ml
+++ b/lib/loc.ml
@@ -8,8 +8,12 @@
(* Locations management *)
+type source =
+ | InFile of string
+ | ToplevelInput
+
type t = {
- fname : string; (** filename *)
+ fname : source; (** filename or toplevel input *)
line_nb : int; (** start line number *)
bol_pos : int; (** position of the beginning of start line *)
line_nb_last : int; (** end line number *)
@@ -23,10 +27,15 @@ let create fname line_nb bol_pos bp ep = {
line_nb_last = line_nb; bol_pos_last = bol_pos; bp = bp; ep = ep; }
let make_loc (bp, ep) = {
- fname = ""; line_nb = -1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
+ fname = ToplevelInput; line_nb = -1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
bp = bp; ep = ep; }
+let mergeable loc1 loc2 =
+ loc1.fname = loc2.fname
+
let merge loc1 loc2 =
+ if not (mergeable loc1 loc2) then
+ failwith "Trying to merge unmergeable locations.";
if loc1.bp < loc2.bp then
if loc1.ep < loc2.ep then {
fname = loc1.fname;
@@ -53,6 +62,8 @@ let merge_opt l1 l2 = match l1, l2 with
let unloc loc = (loc.bp, loc.ep)
+let shift_loc kb kp loc = { loc with bp = loc.bp + kb ; ep = loc.ep + kp }
+
(** Located type *)
type 'a located = t option * 'a
diff --git a/lib/loc.mli b/lib/loc.mli
index 1fbaae8368..fde490cc8a 100644
--- a/lib/loc.mli
+++ b/lib/loc.mli
@@ -8,8 +8,12 @@
(** {5 Basic types} *)
+type source =
+ | InFile of string
+ | ToplevelInput
+
type t = {
- fname : string; (** filename *)
+ fname : source; (** filename or toplevel input *)
line_nb : int; (** start line number *)
bol_pos : int; (** position of the beginning of start line *)
line_nb_last : int; (** end line number *)
@@ -22,7 +26,7 @@ type t = {
(** This is inherited from CAMPL4/5. *)
-val create : string -> int -> int -> int -> int -> t
+val create : source -> int -> int -> int -> int -> t
(** Create a location from a filename, a line number, a position of the
beginning of the line, a start and end position *)
@@ -36,6 +40,11 @@ val merge : t -> t -> t
val merge_opt : t option -> t option -> t option
(** Merge locations, usually generating the largest possible span *)
+val shift_loc : int -> int -> t -> t
+(** [shift_loc loc n p] shifts the beginning of location by [n] and
+ the end by [p]; it is assumed that the shifts do not change the
+ lines at which the location starts and ends *)
+
(** {5 Located exceptions} *)
val add_loc : Exninfo.info -> t -> Exninfo.info
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-01 03:13:46 +0000