Commit 2c528d10 authored by POTTIER Francois's avatar POTTIER Francois

Merge branch 'master' of gitlab.inria.fr:fpottier/alphaLib

parents f34affb2 161d3f5f
...@@ -58,6 +58,8 @@ Look at the visitors in Why3. ...@@ -58,6 +58,8 @@ Look at the visitors in Why3.
TODO (POSSIBLY): TODO (POSSIBLY):
Change all of the macros to build objects on the fly instead of using classes?
Avoid reduce, which is not tail recursive. Avoid reduce, which is not tail recursive.
Use iter in [ba] and [fa]. Use iter in [ba] and [fa].
That should save a constant factor in stack usage? That should save a constant factor in stack usage?
...@@ -243,8 +243,8 @@ let () = ...@@ -243,8 +243,8 @@ let () =
TApp (subst1 u x t1, subst1 u x t2)) TApp (subst1 u x t1, subst1 u x t2))
end end
); );
let x = Atom.freshh "x" let x = Atom.fresh "x"
and y = Atom.freshh "y" in and y = Atom.fresh "y" in
let u = generate_nominal atoms size_of_u in let u = generate_nominal atoms size_of_u in
assert (subst1 u x (TVar x) = u); assert (subst1 u x (TVar x) = u);
assert (subst1 u x (TVar y) = TVar y); assert (subst1 u x (TVar y) = TVar y);
...@@ -330,10 +330,10 @@ let () = ...@@ -330,10 +330,10 @@ let () =
(* Sample terms. *) (* Sample terms. *)
let x = let x =
Atom.freshh "x" Atom.fresh "x"
let y = let y =
Atom.freshh "y" Atom.fresh "y"
let id = let id =
TLambda (x, TVar x) TLambda (x, TVar x)
......
open AlphaLib open AlphaLib
open BindingForms open BindingForms
type ('fn, 'bn) term = type ('bn, 'fn) term =
| TVar of 'fn | TVar of 'fn
| TLambda of ('bn, ('fn, 'bn) term) abs | TLambda of ('bn, ('bn, 'fn) term) abs
| TApp of ('fn, 'bn) term * ('fn, 'bn) term | TApp of ('bn, 'fn) term * ('bn, 'fn) term
[@@deriving [@@deriving
......
...@@ -89,7 +89,7 @@ let rec atoms accu k = ...@@ -89,7 +89,7 @@ let rec atoms accu k =
if k = 0 then if k = 0 then
accu accu
else else
let a = AlphaLib.Atom.freshh "a" in let a = AlphaLib.Atom.fresh "a" in
atoms (AtomSet.add a accu) (k - 1) atoms (AtomSet.add a accu) (k - 1)
let atoms = let atoms =
......
...@@ -11,7 +11,7 @@ type tyvar = ...@@ -11,7 +11,7 @@ type tyvar =
(* Types. *) (* Types. *)
#define TYP ('fn, 'bn) typ #define TYP ('bn, 'fn) typ
type TYP = type TYP =
| TyVar of 'fn | TyVar of 'fn
...@@ -25,7 +25,7 @@ and tevar = (string[@opaque]) ...@@ -25,7 +25,7 @@ and tevar = (string[@opaque])
(* Terms. *) (* Terms. *)
#define TERM ('fn, 'bn) term #define TERM ('bn, 'fn) term
and TERM = and TERM =
| TeVar of tevar | TeVar of tevar
...@@ -93,10 +93,6 @@ __AVOID ...@@ -93,10 +93,6 @@ __AVOID
AVOID(typ) AVOID(typ)
AVOID(term) AVOID(term)
__SHOW
SHOW(typ)
SHOW(term)
__IMPORT __IMPORT
IMPORT(typ) IMPORT(typ)
IMPORT(term) IMPORT(term)
...@@ -105,6 +101,10 @@ __EXPORT ...@@ -105,6 +101,10 @@ __EXPORT
EXPORT(typ) EXPORT(typ)
EXPORT(term) EXPORT(term)
__SHOW
SHOW(typ)
SHOW(term)
__SIZE __SIZE
SIZE(typ) SIZE(typ)
SIZE(term) SIZE(term)
......
...@@ -3,9 +3,9 @@ ...@@ -3,9 +3,9 @@
#define VISIT(term) \ #define VISIT(term) \
CONCAT(visit_, term) CONCAT(visit_, term)
(* -------------------------------------------------------------------------- *) (* For comments about the operations that follow, see [ToolboxOutput.ml]. *)
(* [fa_term] computes the set of the free atoms of a term. *) (* -------------------------------------------------------------------------- *)
#define FA_CLASS __fa #define FA_CLASS __fa
#define FA_FUN(term) CONCAT(fa_, term) #define FA_FUN(term) CONCAT(fa_, term)
...@@ -22,14 +22,6 @@ ...@@ -22,14 +22,6 @@
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* [filter_term p t] returns a free atom of the term [t] that satisfies the
predicate [p], if such an atom exists. *)
(* [closed_term t] tests whether the term [t] is closed, that is, whether
[t] has no free atom. *)
(* [occurs_term x t] tests whether the atom [x] occurs free in the term [t]. *)
#define FILTER_CLASS __filter #define FILTER_CLASS __filter
#define FILTER_FUN(term) CONCAT(filter_, term) #define FILTER_FUN(term) CONCAT(filter_, term)
#define CLOSED_FUN(term) CONCAT(closed_, term) #define CLOSED_FUN(term) CONCAT(closed_, term)
...@@ -55,8 +47,6 @@ ...@@ -55,8 +47,6 @@
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* [ba_term] computes the set of bound atoms of a term. *)
#define BA_CLASS __ba #define BA_CLASS __ba
#define BA_FUN(term) CONCAT(ba_, term) #define BA_FUN(term) CONCAT(ba_, term)
...@@ -72,11 +62,6 @@ ...@@ -72,11 +62,6 @@
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* [avoids_term env t] tests whether the bound atoms of [t] avoid the set [env],
that is, [ba(t) # env]. It also checks that there is no shadowing within [t],
that is, no atom is bound twice along a branch. It returns [true] if these
two conditions are satisfied. *)
#define AVOIDS_CLASS __avoids #define AVOIDS_CLASS __avoids
#define AVOIDS_FUN(term) CONCAT(avoids_, term) #define AVOIDS_FUN(term) CONCAT(avoids_, term)
...@@ -92,17 +77,6 @@ ...@@ -92,17 +77,6 @@
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* [guq_term] tests whether a term satisfies global uniqueness, that is, no atom
is bound twice within this term (not even along different branches). *)
(* [guq_terms] checks that a list of terms satisfies global uniqueness, that is,
no atom is bound twice within this list (not even within two distinct list
elements). *)
(* [guq_term] and [guq_terms] should be used only in debugging mode, typically
in an [assert] construct. They print the identity of one offending atom on
the standard error channel. *)
#define GUQ_CLASS __guq #define GUQ_CLASS __guq
#define GUQ_FUN(term) CONCAT(guq_, term) #define GUQ_FUN(term) CONCAT(guq_, term)
#define GUQS_FUN(term) GUQ_FUN(CONCAT(term, s)) #define GUQS_FUN(term) GUQ_FUN(CONCAT(term, s))
...@@ -127,9 +101,6 @@ ...@@ -127,9 +101,6 @@
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* [copy_term] returns a copy of its argument where every bound name has been
replaced with a fresh copy, and every free name is unchanged. *)
#define COPY_CLASS __copy #define COPY_CLASS __copy
#define COPY_FUN(term) CONCAT(copy_, term) #define COPY_FUN(term) CONCAT(copy_, term)
...@@ -145,10 +116,6 @@ ...@@ -145,10 +116,6 @@
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* [avoid_term bad] returns a copy of its argument where some bound names have
been replaced with a fresh copy, so as to ensure that no bound name is in
the set [bad]. *)
#define AVOID_CLASS __avoid #define AVOID_CLASS __avoid
#define AVOID_FUN(term) CONCAT(avoid_, term) #define AVOID_FUN(term) CONCAT(avoid_, term)
...@@ -164,53 +131,22 @@ ...@@ -164,53 +131,22 @@
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* [show_term] converts its argument to a raw term, in a NONHYGIENIC manner,
using [Atom.show] both at free name occurrences and bound name occurrences.
It is a debugging tool. *)
#define SHOW_CLASS __show
#define SHOW_FUN(term) CONCAT(show_, term)
#define __SHOW \
class ['self] SHOW_CLASS = object (_ : 'self) \
inherit [_] map \
inherit [_] KitShow.map \
end \
#define SHOW(term) \
let SHOW_FUN(term) t = \
new SHOW_CLASS # VISIT(term) () t \
(* -------------------------------------------------------------------------- *)
(* [import_term] converts a raw term to a nominal term that satisfies the
Global Uniqueness Hypothesis, that is, a nominal term where every binding
name occurrence is represented by a unique atom. [import] expects every
free name occurrence to be in the domain of [env]. If that is not the case,
the exception [Unbound] is raised. *)
(* TEMPORARY use string * loc so as to be able to give a location *) (* TEMPORARY use string * loc so as to be able to give a location *)
#define IMPORT_CLASS __import
#define IMPORT_FUN(term) CONCAT(import_, term) #define IMPORT_FUN(term) CONCAT(import_, term)
#define __IMPORT \ #define __IMPORT \
exception Unbound = KitImport.Unbound \ exception Unbound = KitImport.Unbound \
class ['self] IMPORT_CLASS = object (_ : 'self) \
inherit [_] map \
inherit [_] KitImport.map \
end \
#define IMPORT(term) \ #define IMPORT(term) \
let IMPORT_FUN(term) env t = \ let IMPORT_FUN(term) env t = \
new IMPORT_CLASS # VISIT(term) env t \ (object \
inherit [_] map \
inherit [_] KitImport.map \
end) # VISIT(term) env t \
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* [export_term] converts a nominal term to a raw term, in a hygienic manner.
This is the proper way of displaying a term. [export] expects every free
name occurrence to be in the domain of [env]. *)
#define EXPORT_CLASS __export #define EXPORT_CLASS __export
#define EXPORT_FUN(term) CONCAT(export_, term) #define EXPORT_FUN(term) CONCAT(export_, term)
...@@ -226,10 +162,20 @@ ...@@ -226,10 +162,20 @@
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* [size_term] computes the size of its argument. *) #define SHOW_CLASS __show
#define SHOW_FUN(term) CONCAT(show_, term)
(* Beware: this counts the nodes whose type is [term], but does not count the #define __SHOW \
nodes of other types. *) class ['self] SHOW_CLASS = object (_ : 'self) \
inherit [_] map \
inherit [_] KitShow.map \
end \
#define SHOW(term) \
let SHOW_FUN(term) t = \
new SHOW_CLASS # VISIT(term) () t \
(* -------------------------------------------------------------------------- *)
#define SIZE_CLASS __size #define SIZE_CLASS __size
#define SIZE_FUN(term) CONCAT(size_, term) #define SIZE_FUN(term) CONCAT(size_, term)
...@@ -249,8 +195,6 @@ ...@@ -249,8 +195,6 @@
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* [equiv_term] tests whether two terms are alpha-equivalent. *)
#define EQUIV_CLASS __equiv #define EQUIV_CLASS __equiv
#define EQUIV_FUN(term) CONCAT(equiv_, term) #define EQUIV_FUN(term) CONCAT(equiv_, term)
...@@ -268,26 +212,6 @@ ...@@ -268,26 +212,6 @@
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* [subst_thing_term] applies a substitution to a nominal term,
yielding a nominal term. *)
(* [subst_thing_term1] applies a singleton substitution to a nominal term,
yielding a nominal term. *)
(* A substitution is a finite map of atoms to nominal things. Things need not
be terms: this is a thing-in-term substitution, substituting things for
variables in terms. *)
(* When applying a substitution [sigma] to a term [t], the GUH guarantees that
the free atoms of (the codomain of) [sigma] cannot be captured by a binder
within [t]. The GUH also guarantees that a binder within [t] cannot appear
in the domain of [sigma], which means that we can go down into [t] and apply
[sigma] to every variable. *)
(* Global uniqueness can be preserved, if desired, by copying the things that
are grafted into [t]. The user decides which [copy] operation should be used.
It could be [copy_thing], or it could be the identity. *)
#define SUBST_CLASS(Var) CONCAT(__subst_, Var) #define SUBST_CLASS(Var) CONCAT(__subst_, Var)
#define SUBST_FUN(Var, term) CONCAT(subst_, CONCAT(Var, CONCAT(_, term))) #define SUBST_FUN(Var, term) CONCAT(subst_, CONCAT(Var, CONCAT(_, term)))
#define SUBST_FUN1(Var, term) CONCAT(SUBST_FUN(Var, term), 1) #define SUBST_FUN1(Var, term) CONCAT(SUBST_FUN(Var, term), 1)
......
...@@ -72,11 +72,11 @@ let allocate () = ...@@ -72,11 +72,11 @@ let allocate () =
assert (number >= 0); assert (number >= 0);
number number
(* [freshh hint] produces a fresh atom. *) (* [fresh hint] produces a fresh atom. *)
(* The argument [hint] must not be a string of digits. *) (* The argument [hint] must not be a string of digits. *)
let freshh hint = let fresh hint =
let identity = allocate() let identity = allocate()
and hint = share (remove_trailing_digits hint) in and hint = share (remove_trailing_digits hint) in
{ identity; hint } { identity; hint }
...@@ -84,7 +84,7 @@ let freshh hint = ...@@ -84,7 +84,7 @@ let freshh hint =
(* [fresha a] returns a fresh atom modeled after the atom [a]. *) (* [fresha a] returns a fresh atom modeled after the atom [a]. *)
let fresha a = let fresha a =
freshh a.hint fresh a.hint
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
......
...@@ -14,7 +14,7 @@ val print: out_channel -> atom -> unit ...@@ -14,7 +14,7 @@ val print: out_channel -> atom -> unit
(* Producing fresh atoms. *) (* Producing fresh atoms. *)
val freshh: string -> atom val fresh: string -> atom
val fresha: atom -> atom val fresha: atom -> atom
(* Comparison of atoms. *) (* Comparison of atoms. *)
......
(* This kit serves to construct an [import] function for terms, that is, a (* This kit serves to construct an [import] function for terms, that is, a
function that transforms strings to atoms. *) function that transforms strings to atoms. *)
(* We impose the GUH by mapping each binding occurrence to a fresh atom. *) (* We map every binding occurrence to a fresh atom, so the term that we
produce satisfies global uniqueness. *)
module StringMap = module StringMap =
Map.Make(String) Map.Make(String)
...@@ -13,7 +14,7 @@ let empty = ...@@ -13,7 +14,7 @@ let empty =
StringMap.empty StringMap.empty
let extend (x : string) (env : env) : Atom.t * env = let extend (x : string) (env : env) : Atom.t * env =
let a = Atom.freshh x in let a = Atom.fresh x in
let env = StringMap.add x a env in let env = StringMap.add x a env in
a, env a, env
...@@ -26,6 +27,6 @@ let lookup (env : env) (x : string) : Atom.t = ...@@ -26,6 +27,6 @@ let lookup (env : env) (x : string) : Atom.t =
raise (Unbound x) raise (Unbound x)
class ['self] map = object (_ : 'self) class ['self] map = object (_ : 'self)
method private extend = extend method private extend x env = extend x env
method private visit_'fn = lookup method private visit_'fn env x = lookup env x
end end
open ToolboxInput
(* This functor is applied to a type of terms, equipped with visitor classes. (* This functor is applied to a type of terms, equipped with visitor classes.
It produces a toolbox of useful functions that operate on terms. *) It produces a toolbox of useful functions that operate on terms. *)
module Make (Term : ToolboxInput.INPUT) = struct module Make (Term : INPUT) = struct
open Term include Term
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
...@@ -53,15 +55,15 @@ module Make (Term : ToolboxInput.INPUT) = struct ...@@ -53,15 +55,15 @@ module Make (Term : ToolboxInput.INPUT) = struct
__AVOID __AVOID
AVOID(term) AVOID(term)
__SHOW
SHOW(term)
__IMPORT __IMPORT
IMPORT(term) IMPORT(term)
__EXPORT __EXPORT
EXPORT(term) EXPORT(term)
__SHOW
SHOW(term)
__SIZE __SIZE
SIZE(term) SIZE(term)
......
open ToolboxInput
open ToolboxOutput
(* This functor is applied to a type of terms, equipped with visitor classes. (* This functor is applied to a type of terms, equipped with visitor classes.
It produces a toolbox of useful functions that operate on terms. *) It produces a toolbox of useful functions that operate on terms. *)
module Make (Term : ToolboxInput.INPUT) : sig module Make (Term : INPUT) : OUTPUT
with type ('bn, 'fn) term = ('bn, 'fn) Term.term
open Term
(* A raw term is one where every name is represented as a string. This form
is typically produced by a parser, and consumed by a printer. It is not
used internally. *)
type raw_term =
(string, string) term
(* A nominal term is one where every name is represented as an atom. Although
this is not visible in this type definition, we may additionally impose a
Global Uniqueness Hypothesis (GUH), that is, we may require every binding
name occurrence to carry a distinct atom. *)
type nominal_term =
(Atom.t, Atom.t) term
val fa_term: nominal_term -> Atom.Set.t
val filter_term: (Atom.t -> bool) -> nominal_term -> Atom.t option
val closed_term: nominal_term -> bool
val occurs_term: Atom.t -> nominal_term -> bool
val ba_term: nominal_term -> Atom.Set.t
val avoids_term: Atom.Set.t -> nominal_term -> bool
val guq_term: nominal_term -> bool
val guq_terms: nominal_term list -> bool
val copy_term: nominal_term -> nominal_term
val avoid_term: Atom.Set.t -> nominal_term -> nominal_term
val show_term: nominal_term -> raw_term
exception Unbound of string (* = KitImport.Unbound *)
val import_term: KitImport.env -> raw_term -> nominal_term
val export_term: KitExport.env -> nominal_term -> raw_term
val size_term: (_, _) term -> int
val equiv_term: nominal_term -> nominal_term -> bool
val subst_TVar_term:
(nominal_term -> nominal_term) ->
nominal_term Atom.Map.t -> nominal_term -> nominal_term
val subst_TVar_term1:
(nominal_term -> nominal_term) ->
nominal_term -> Atom.t -> nominal_term -> nominal_term
end
module type INPUT = sig module type INPUT = sig
(* Suppose there is a type of terms, which is parameterized over the (* Suppose there is a type of terms, which is parameterized over the
representations of free name occurrences and binding name occurrences. *) representations of binding name occurrences and free name occurrences. *)
type ('fn, 'bn) term type ('bn, 'fn) term
(* Suppose the type of terms is equipped with the following visitors. *) (* Suppose the type of terms is equipped with the following visitors. *)
...@@ -22,21 +22,21 @@ module type INPUT = sig ...@@ -22,21 +22,21 @@ module type INPUT = sig
class virtual ['self] iter : object ('self) class virtual ['self] iter : object ('self)
method private virtual extend : 'bn -> 'env -> 'env method private virtual extend : 'bn -> 'env -> 'env
method private virtual visit_'fn : 'env -> 'fn -> _ method private virtual visit_'fn : 'env -> 'fn -> _
method visit_term : 'env -> ('fn, 'bn) term -> unit method visit_term : 'env -> ('bn, 'fn) term -> unit
end end
class virtual ['self] map : object ('self) class virtual ['self] map : object ('self)
method private virtual extend : 'bn1 -> 'env -> 'bn2 * 'env method private virtual extend : 'bn1 -> 'env -> 'bn2 * 'env
method private virtual visit_'fn : 'env -> 'fn1 -> 'fn2 method private virtual visit_'fn : 'env -> 'fn1 -> 'fn2
method visit_term : 'env -> ('fn1, 'bn1) term -> ('fn2, 'bn2) term method visit_term : 'env -> ('bn1, 'fn1) term -> ('bn2, 'fn2) term
method private visit_TVar : 'env -> 'fn1 -> ('fn2, 'bn2) term method private visit_TVar : 'env -> 'fn1 -> ('bn2, 'fn2) term
end end
class virtual ['self] endo : object ('self) class virtual ['self] endo : object ('self)
method private virtual extend : 'bn -> 'env -> 'bn * 'env method private virtual extend : 'bn -> 'env -> 'bn * 'env
method private virtual visit_'fn : 'env -> 'fn -> 'fn method private virtual visit_'fn : 'env -> 'fn -> 'fn
method visit_term : 'env -> ('fn, 'bn) term -> ('fn, 'bn) term method visit_term : 'env -> ('bn, 'fn) term -> ('bn, 'fn) term
method private visit_TVar : 'env -> ('fn, 'bn) term -> 'fn -> ('fn, 'bn) term method private visit_TVar : 'env -> ('bn, 'fn) term -> 'fn -> ('bn, 'fn) term
end end
class virtual ['self] reduce : object ('self) class virtual ['self] reduce : object ('self)
...@@ -45,13 +45,13 @@ module type INPUT = sig ...@@ -45,13 +45,13 @@ module type INPUT = sig
method private virtual zero : 'z method private virtual zero : 'z
method private virtual plus : 'z -> 'z -> 'z method private virtual plus : 'z -> 'z -> 'z
method private virtual restrict : 'bn -> 'z -> 'z method private virtual restrict : 'bn -> 'z -> 'z
method visit_term : 'env -> ('fn, 'bn) term -> 'z method visit_term : 'env -> ('bn, 'fn) term -> 'z
end end
class virtual ['self] iter2 : object ('self) class virtual ['self] iter2 : object ('self)
method private virtual extend : 'bn1 -> 'bn2 -> 'env -> 'env method private virtual extend : 'bn1 -> 'bn2 -> 'env -> 'env
method private virtual visit_'fn : 'env -> 'fn1 -> 'fn2 -> _ method private virtual visit_'fn : 'env -> 'fn1 -> 'fn2 -> _
method visit_term : 'env -> ('fn1, 'bn1) term -> ('fn2, 'bn2) term -> unit method visit_term : 'env -> ('bn1, 'fn1) term -> ('bn2, 'fn2) term -> unit
end end
end end
module type OUTPUT = sig
(* A type of terms, is parameterized over the representations of binding
name occurrences and free name occurrences. *)
type ('bn, 'fn) term
(* A raw term is one where every name is represented as a string. This form
is typically produced by a parser, and consumed by a printer. It is not
used internally. *)
type raw_term =
(string, string) term
(* A nominal term is one where every name is represented as an atom. Although
this is not visible in this type definition, we may additionally impose a
Global Uniqueness Hypothesis (GUH), that is, we may require every binding
name occurrence to carry a distinct atom. *)
type nominal_term =
(Atom.t, Atom.t) term
(* [fa_term] computes the set of the free atoms of a term. *)
val fa_term: nominal_term -> Atom.Set.t
(* [filter_term p t] returns a free atom of the term [t] that satisfies the
predicate [p], if such an atom exists. *)
val filter_term: (Atom.t -> bool) -> nominal_term -> Atom.t option
(* [closed_term t] tests whether the term [t] is closed, that is, whether
[t] has no free atom. *)
val closed_term: nominal_term -> bool
(* [occurs_term x t] tests whether the atom [x] occurs free in the term [t]. *)
val occurs_term: Atom.t -> nominal_term -> bool
(* [ba_term] computes the set of bound atoms of a term. *)
val ba_term: nominal_term -> Atom.Set.t
(* [avoids_term env t] tests whether the bound atoms of [t] avoid the set [env],
that is, [ba(t) # env]. It also checks that there is no shadowing within [t],
that is, no atom is bound twice along a branch. It returns [true] if these
two conditions are satisfied. *)
val avoids_term: Atom.Set.t -> nominal_term -> bool
(* [guq_term] tests whether a term satisfies global uniqueness, that is, no atom
is bound twice within this term (not even along different branches). *)
(* [guq_terms] checks that a list of terms satisfies global uniqueness, that is,
no atom is bound twice within this list (not even within two distinct list
elements). *)
(* [guq_term] and [guq_terms] should be used only in debugging mode, typically
in an [assert] construct. They print the identity of one offending atom on
the standard error channel. *)