123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454(******************************************************************************)(* *)(* Fix *)(* *)(* François Pottier, Inria Paris *)(* *)(* Copyright Inria. All rights reserved. This file is distributed under the *)(* terms of the GNU Library General Public License version 2, with a *)(* special exception on linking, as described in the file LICENSE. *)(* *)(******************************************************************************)(* -------------------------------------------------------------------------- *)(**A type alone. *)moduletypeTYPE=sigtypetend(* -------------------------------------------------------------------------- *)(**An ordered type. *)moduletypeOrderedType=Map.OrderedType(**A hashed type. *)moduletypeHashedType=Hashtbl.HashedType(* -------------------------------------------------------------------------- *)(**A type whose elements can be enumerated. *)moduletypeFINITE_TYPE=sigtypetvalforeach:(t->unit)->unitend(* -------------------------------------------------------------------------- *)(* Association maps. *)(**{!PERSISTENT_MAPS} is a fragment of the standard signature [Map.S]. *)moduletypePERSISTENT_MAPS=sig(**The type of keys. *)typekey(**The type of association maps. *)type'datat(**The empty map. *)valempty:'datat(**{!add} inserts a new entry or replaces an existing entry. *)valadd:key->'data->'datat->'datat(**{!find} raises [Not_found] if the key is not in the domain of
the map. *)valfind:key->'datat->'data(**{!iter} iterates over all entries. *)valiter:(key->'data->unit)->'datat->unitendmoduletypeMINIMAL_IMPERATIVE_MAPS=sig(**The type of keys. *)typekey(**The type of association maps. *)type'datat(**[create()] creates a fresh empty map. *)valcreate:unit->'datat(**{!add} inserts a new entry or replaces an existing entry.
The map is updated in place. *)valadd:key->'data->'datat->unit(**{!find} raises [Not_found] if the key is not in the domain of
the map. *)valfind:key->'datat->'dataendmoduletypeIMPERATIVE_MAPS=sigincludeMINIMAL_IMPERATIVE_MAPS(**{!clear} empties a map. *)valclear:'datat->unit(**{!iter} iterates over all entries. *)valiter:(key->'data->unit)->'datat->unitend(**An instance of the signature [ARRAY] represents one mutable map.
There is no type ['data t] and no [create] operation; there exists
just one map. Furthermore, the type [value], which corresponds to
['data] in the previous signatures, is fixed.
The domain of the map never changes:
- [set] does not extend the map,
- [get] cannot raise [Not_found]. *)moduletypeARRAY=sig(**The type of keys. *)typekey(**The type of values. *)typevalue(**[get] looks up the map. It cannot raise an exception. *)valget:key->value(**[set] updates the map at an existing key. *)valset:key->value->unitend(* -------------------------------------------------------------------------- *)(**The signature {!PROPERTY} is used by {!Fix.Make}, the least fixed point
computation algorithm. *)moduletypePROPERTY=sig(**The type {!property} must form a partial order, and must be equipped with
a least element {!bottom} and with an equality test {!equal}. The partial
order must satisfy the ascending chain condition: every monotone sequence
must eventually stabilize.
We do not require an ordering test [leq] or a join operation [join]. *)typeproperty(**{!bottom} is the least property. *)valbottom:property(**[equal p q] determines whether the properties [p] and [q] are equal.
In the implementation of this test, it is permitted to assume that
[p <= q] holds. *)valequal:property->property->bool(**[is_maximal p] determines whether the property [p] is maximal with
respect to the partial order. A conservative check suffices: it is always
permitted for [is_maximal p] to be [false]. If [is_maximal p] is [true],
then [p] must have no strict upper bound. In particular, if properties
form a lattice, then [is_maximal p = true] implies that [p] is the top
element of the lattice. *)valis_maximal:property->boolend(* -------------------------------------------------------------------------- *)(**The signature {!SEMI_LATTICE} offers separate [leq] and [join] functions.
The functor {!Glue.MinimalSemiLattice} can be used, if necessary, to
convert this signature to {!MINIMAL_SEMI_LATTICE}. *)moduletypeSEMI_LATTICE=sig(**The type {!property} must form a partial order, which must satisfy the
ascending chain condition: every monotone sequence must eventually
stabilize. *)typeproperty(**[leq p q] determines whether [p <= q] holds. *)valleq:property->property->bool(**[join p q] is the least upper bound of the properties [p] and [q]. *)valjoin:property->property->propertyend(**The signature {!MINIMAL_SEMI_LATTICE} is used by {!DataFlow.Run} and
friends. *)moduletypeMINIMAL_SEMI_LATTICE=sig(**The type {!property} must form a partial order, which must satisfy the
ascending chain condition: every monotone sequence must eventually
stabilize. *)typeproperty(** [leq_join p q] must compute the join of [p] and [q]. If the result
is logically equal to [q], then [q] itself must be returned. Thus,
we have [leq_join p q == q] if and only if [leq p q] holds. *)valleq_join:property->property->propertyend(* -------------------------------------------------------------------------- *)(**['a fix] is the type of a fixed point combinator that constructs a value of
type ['a]. *)type'afix=('a->'a)->'a(* -------------------------------------------------------------------------- *)(**A memoizer is a higher-order function that constructs memoizing functions. *)moduletypeMEMOIZER=sig(**The type of keys. *)typekey(**{!memoize} is a memoization combinator for the type {!key}.
The function call [memoize f] produces a function [f'] that
behaves extensionally like [f], but is memoized. *)valmemoize:(key->'a)->(key->'a)(**The type of memoization tables. *)type'at(**{!visibly_memoize} is a memoization combinator that exposes the
memoization table. The function call [visibly_memoize f] returns
a pair of a memoized function [f'] and a memoization table. *)valvisibly_memoize:(key->'a)->(key->'a)*'at(**{!val-fix} is a recursive memoization combinator. *)valfix:(key->'a)fix(**{!Cycle} is raised by {!defensive_fix} when a dependency cycle is
detected. *)exceptionCycleofkeylist*key(**{!defensive_fix} works like {!val-fix}, except it detects circular
dependencies, which can arise if the second-order function supplied by
the user does not follow a well-founded recursion pattern. When the user
invokes [f x], where [f] is the function returned by {!defensive_fix}, if
a cyclic dependency is detected, then [Cycle (zs, z)] is raised, where
the list [zs] begins with [z] and continues with a series of intermediate
keys, leading back to [z]. Note that undetected divergence remains
possible; this corresponds to an infinite dependency chain, without a
cycle. *)valdefensive_fix:(key->'a)fix(**{!curried} can be used to obtain a curried version of {!val-fix} or
{!defensive_fix} in a concrete instance where the type {!key} is a
product type. *)valcurried:('a*'b->'c)fix->('a->'b->'c)fixend(* -------------------------------------------------------------------------- *)(**A tabulator is a higher-order function that constructs tabulated
functions. *)moduletypeTABULATOR=sig(**The type of keys. *)typekey(**{!tabulate} is a tabulation combinator for the type {!key}. The
function call [tabulate f] produces a function [f'] that behaves
extensionally like [f], but is tabulated.
Like memoization, tabulation guarantees that, for every key [x], the
image [f x] is computed at most once. Unlike memoization, where this
computation takes place on demand, here, the computation of [f x] for
every [x] takes place eagerly, when [tabulate] is invoked. The graph of
the function [f], a table, is constructed and held in memory. *)valtabulate:(key->'a)->(key->'a)end(* -------------------------------------------------------------------------- *)(**A solver is a higher-order function that computes the least solution of a
monotone system of equations. *)moduletypeSOLVER=sig(**The type of variables. *)typevariable(**The type of properties. *)typeproperty(**A valuation is a mapping of variables to properties. *)typevaluation=variable->property(**A right-hand side, when supplied with a valuation that gives
meaning to its free variables, evaluates to a property. More
precisely, a right-hand side is a monotone function of
valuations to properties. *)typerhs=valuation->property(**A system of equations is a mapping of variables to right-hand
sides. *)typeequations=variable->rhs(**[lfp eqs] produces the least solution of the system of monotone
equations [eqs].
It is guaranteed that, for each variable [v], the application [eqs v]
is performed at most once (whereas the right-hand side produced by this
application is, in general, evaluated multiple times). This guarantee
can be used to perform costly pre-computation, or memory allocation,
when [eqs] is applied to its first argument.
When {!lfp} is applied to a system of equations [eqs], it performs no
actual computation. It produces a valuation, [get], which represents
the least solution of the system of equations. The actual fixed point
computation takes place, on demand, when [get] is applied. *)vallfp:equations->valuationend(* -------------------------------------------------------------------------- *)(**The signature [SOLUTION] describes the result of {!DataFlow.Run} and
friends. *)moduletypeSOLUTION=sig(**The type of variables. *)typevariable(**The type of properties. *)typeproperty(**The least solution of the system of monotone equations. *)valsolution:variable->propertyend(* -------------------------------------------------------------------------- *)(**The signature {!GRAPH} describes a directed, rooted graph. It is used
by {!GraphNumbering.Make} and friends. *)moduletypeGRAPH=sig(**The type of vertices. *)typet(**[foreach_root yield] must call [yield x] at least once for every vertex
[x] that is considered a root (an entry point) of the graph. It may
call [yield x] several times at a single vertex [x]. *)valforeach_root:(t->unit)->unit(**[foreach_successor x yield] must call [yield y] for every vertex [y]
that is a successor of the vertex [x] in the graph. *)valforeach_successor:t->(t->unit)->unitend(* -------------------------------------------------------------------------- *)(**The signature {!DATA_FLOW_GRAPH} describes a data flow analysis
problem. It is used by {!DataFlow.Run} and friends. *)moduletypeDATA_FLOW_GRAPH=sig(**The type of variables, or graph vertices. *)typevariable(**The type of properties. *)typeproperty(**{!foreach_root} describes the root nodes of the data flow graph as well
as the properties associated with them. [foreach_root contribute] must
call [contribute x p] to indicate that [x] is a root and that [p] is a
lower bound on the solution at [x]. It may call [contribute x _]
several times at a single root [x]. *)valforeach_root:(variable->property->unit)->unit(**{!foreach_successor} describes the edges of the data flow graph as well
as the manner in which a property at the source of an edge is
transformed into a property at the target. The property at the target
must of course be a monotonic function of the property at the source.
Furthermore, if the property at the source is [bottom] then the
property that is transmitted to each target should be [bottom] as well. *)valforeach_successor:variable->property->(variable->property->unit)->unitend(* -------------------------------------------------------------------------- *)(**An ongoing numbering of (a subset of) a type [t]. *)moduletypeONGOING_NUMBERING=sig(**The type {!t} of values of interest. *)typet(**{!encode} maps a value of type {!t} to a unique integer code. If
applied twice to the same value, {!encode} returns the same code; if
applied to a value that has never been encountered, it returns a fresh
code.*)valencode:t->int(**[current()] returns the next available code, which is also the number
of values that have been encoded so far. *)valcurrent:unit->int(**[has_been_encoded x] determines whether the value [x] has been encoded
already. *)valhas_been_encoded:t->boolend(**A fixed numbering of (a subset of) a type [t]. *)moduletypeNUMBERING=sig(**The type {!t} of values of interest. *)typet(**{!n} is the number of values of type {!t} that have been encoded. The
functions {!encode} and {!decode} represent an isomorphism between this
subset of [t] and the interval [\[0..n)]. *)valn:int(**{!encode} maps a value of type {!t} to an integer code in the interval
[\[0..n)]. *)valencode:t->int(**{!decode} maps an integer code in the interval [\[0..n)] back to a
value of type {!t}. *)valdecode:int->tend(**The signature {!TWO_PHASE_NUMBERING} combines the signatures
{!ONGOING_NUMBERING} and {!NUMBERING}. It describes a numbering process
that is organized in two phases. During the first phase, the numbering is
ongoing: one can encode keys, but not decode. Applying the functor
[Done()] ends the first phase. A fixed numbering then becomes available,
which gives access to the total number [n] of encoded keys and to both
[encode] and [decode] functions. *)moduletypeTWO_PHASE_NUMBERING=sigincludeONGOING_NUMBERING(**The functor {!Done} ends the numbering process. *)moduleDone():NUMBERINGwithtypet=tend(* -------------------------------------------------------------------------- *)(**An injection of a type into a type. *)moduletypeINJECTION=sig(**The source type of the injection. *)typet(**The destination type of the injection. *)typeu(**An injection of [t] into [u] is an injective function of type [t -> u].
Because {!encode} is injective, the value [encode x] can be thought of
as the identity of the object [x]. *)valencode:t->uend