Commit 32780738 authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

Code refactoring. Move the Tallying code outside of the Types module.

parent ae31d5c7
......@@ -167,7 +167,7 @@ OBJECTS = \
\
types/compunit.cmo types/sortedList.cmo types/ident.cmo types/var.cmo types/bool.cmo \
types/intervals.cmo types/chars.cmo types/atoms.cmo types/normal.cmo \
types/types.cmo compile/auto_pat.cmo \
types/types.cmo compile/auto_pat.cmo types/type_tallying.cmo \
types/sequence.cmo types/builtin_defs.cmo \
\
runtime/value.cmo \
......
......@@ -75,13 +75,13 @@ let enter_global_cu cu env x =
let rec domain = function
|Identity -> Var.Set.empty
|List l -> Types.Tallying.domain l
|List l -> Type_tallying.domain l
|Comp (s1,s2) -> Var.Set.cup (domain s1) (domain s2)
|Sel(_,_,sigma) -> (domain sigma)
let rec codomain = function
| Identity -> Var.Set.empty
| List(l) -> Types.Tallying.codomain l
| List(l) -> Type_tallying.codomain l
| Comp(s1,s2) -> Var.Set.cup (codomain s1) (codomain s2)
| Sel(_,_,sigma) -> (codomain sigma)
......
......@@ -26,7 +26,7 @@ type iface = (Types.descr * Types.descr) list
type sigma =
| Identity (* this is basically as Types.Tallying.CS.sat *)
| List of Types.Tallying.CS.sl
| List of Type_tallying.CS.sl
| Comp of (sigma * sigma)
| Sel of (var_loc * iface * sigma)
......@@ -104,7 +104,7 @@ module Print = struct
) ppf
in
function
|List ll -> Types.Tallying.CS.pp_sl ppf ll
|List ll -> Type_tallying.CS.pp_sl ppf ll
|Comp(s1,s2) -> Format.fprintf ppf "Comp(%a,%a)" pp_sigma s1 pp_sigma s2
|Sel(x,iface,s) -> Format.fprintf ppf "Sel(%a,%a,%a)" pp_vloc x pp_aux iface pp_sigma s
|Identity -> Format.fprintf ppf "Id"
......
......@@ -26,7 +26,7 @@ type iface = (Types.t * Types.t) list
type sigma =
| Identity
| List of Types.Tallying.CS.sl
| List of Type_tallying.CS.sl
| Comp of (sigma * sigma)
| Sel of (var_loc * iface * sigma)
......
......@@ -56,6 +56,12 @@ compile/auto_pat.cmo : types/types.cmi types/ident.cmo types/chars.cmi \
types/atoms.cmi compile/auto_pat.cmi
compile/auto_pat.cmx : types/types.cmx types/ident.cmx types/chars.cmx \
types/atoms.cmx compile/auto_pat.cmi
types/type_tallying.cmo : types/var.cmi misc/utils.cmo types/types.cmi \
types/sortedList.cmi types/intervals.cmi misc/custom.cmo types/chars.cmi \
types/atoms.cmi types/type_tallying.cmi
types/type_tallying.cmx : types/var.cmx misc/utils.cmx types/types.cmx \
types/sortedList.cmx types/intervals.cmx misc/custom.cmx types/chars.cmx \
types/atoms.cmx types/type_tallying.cmi
types/sequence.cmo : types/types.cmi misc/custom.cmo types/chars.cmi \
types/atoms.cmi types/sequence.cmi
types/sequence.cmx : types/types.cmx misc/custom.cmx types/chars.cmx \
......@@ -67,13 +73,13 @@ types/builtin_defs.cmx : types/types.cmx types/sequence.cmx \
types/intervals.cmx types/ident.cmx misc/encodings.cmx types/chars.cmx \
types/atoms.cmx types/builtin_defs.cmi
runtime/value.cmo : types/var.cmi misc/utils.cmo misc/upool.cmi \
types/types.cmi types/sequence.cmi misc/ns.cmi types/intervals.cmi \
misc/imap.cmi types/ident.cmo misc/encodings.cmi types/chars.cmi \
types/atoms.cmi runtime/value.cmi
types/types.cmi types/type_tallying.cmi types/sequence.cmi misc/ns.cmi \
types/intervals.cmi misc/imap.cmi types/ident.cmo misc/encodings.cmi \
types/chars.cmi types/atoms.cmi runtime/value.cmi
runtime/value.cmx : types/var.cmx misc/utils.cmx misc/upool.cmx \
types/types.cmx types/sequence.cmx misc/ns.cmx types/intervals.cmx \
misc/imap.cmx types/ident.cmx misc/encodings.cmx types/chars.cmx \
types/atoms.cmx runtime/value.cmi
types/types.cmx types/type_tallying.cmx types/sequence.cmx misc/ns.cmx \
types/intervals.cmx misc/imap.cmx types/ident.cmx misc/encodings.cmx \
types/chars.cmx types/atoms.cmx runtime/value.cmi
schema/schema_pcre.cmo : misc/encodings.cmi schema/schema_pcre.cmi
schema/schema_pcre.cmx : misc/encodings.cmx schema/schema_pcre.cmi
schema/schema_types.cmo : runtime/value.cmi misc/ns.cmi misc/encodings.cmi \
......@@ -121,19 +127,21 @@ compile/print_auto.cmo : types/types.cmi types/ident.cmo \
compile/print_auto.cmx : types/types.cmx types/ident.cmx \
compile/auto_pat.cmx compile/print_auto.cmi
compile/lambda.cmo : runtime/value.cmi misc/utils.cmo misc/upool.cmi \
types/types.cmi schema/schema_validator.cmi misc/ns.cmi misc/imap.cmi \
types/ident.cmo misc/encodings.cmi types/compunit.cmi \
compile/auto_pat.cmi compile/lambda.cmi
types/types.cmi types/type_tallying.cmi schema/schema_validator.cmi \
misc/ns.cmi misc/imap.cmi types/ident.cmo misc/encodings.cmi \
types/compunit.cmi compile/auto_pat.cmi compile/lambda.cmi
compile/lambda.cmx : runtime/value.cmx misc/utils.cmx misc/upool.cmx \
types/types.cmx schema/schema_validator.cmx misc/ns.cmx misc/imap.cmx \
types/ident.cmx misc/encodings.cmx types/compunit.cmx \
compile/auto_pat.cmx compile/lambda.cmi
types/types.cmx types/type_tallying.cmx schema/schema_validator.cmx \
misc/ns.cmx misc/imap.cmx types/ident.cmx misc/encodings.cmx \
types/compunit.cmx compile/auto_pat.cmx compile/lambda.cmi
runtime/run_dispatch.cmo : runtime/value.cmi misc/upool.cmi types/types.cmi \
misc/imap.cmi types/ident.cmo misc/encodings.cmi types/chars.cmi \
compile/auto_pat.cmi types/atoms.cmi runtime/run_dispatch.cmi
types/type_tallying.cmi misc/imap.cmi types/ident.cmo misc/encodings.cmi \
types/chars.cmi compile/auto_pat.cmi types/atoms.cmi \
runtime/run_dispatch.cmi
runtime/run_dispatch.cmx : runtime/value.cmx misc/upool.cmx types/types.cmx \
misc/imap.cmx types/ident.cmx misc/encodings.cmx types/chars.cmx \
compile/auto_pat.cmx types/atoms.cmx runtime/run_dispatch.cmi
types/type_tallying.cmx misc/imap.cmx types/ident.cmx misc/encodings.cmx \
types/chars.cmx compile/auto_pat.cmx types/atoms.cmx \
runtime/run_dispatch.cmi
runtime/explain.cmo : runtime/value.cmi misc/upool.cmi types/types.cmi \
runtime/run_dispatch.cmi misc/imap.cmi types/ident.cmo misc/encodings.cmi \
types/chars.cmi compile/auto_pat.cmi types/atoms.cmi runtime/explain.cmi
......@@ -169,13 +177,15 @@ parser/parser.cmx : types/var.cmx parser/ulexer.cmx types/types.cmx \
misc/encodings.cmx types/chars.cmx parser/cduce_loc.cmx types/atoms.cmx \
parser/ast.cmx parser/parser.cmi
typing/typed.cmo : types/var.cmi misc/utils.cmo misc/upool.cmi \
types/types.cmi schema/schema_validator.cmi types/patterns.cmi \
misc/ns.cmi types/intervals.cmi types/ident.cmo misc/encodings.cmi \
types/compunit.cmi types/chars.cmi parser/cduce_loc.cmi types/atoms.cmi
types/types.cmi types/type_tallying.cmi schema/schema_validator.cmi \
types/patterns.cmi misc/ns.cmi types/intervals.cmi types/ident.cmo \
misc/encodings.cmi types/compunit.cmi types/chars.cmi \
parser/cduce_loc.cmi types/atoms.cmi
typing/typed.cmx : types/var.cmx misc/utils.cmx misc/upool.cmx \
types/types.cmx schema/schema_validator.cmx types/patterns.cmx \
misc/ns.cmx types/intervals.cmx types/ident.cmx misc/encodings.cmx \
types/compunit.cmx types/chars.cmx parser/cduce_loc.cmx types/atoms.cmx
types/types.cmx types/type_tallying.cmx schema/schema_validator.cmx \
types/patterns.cmx misc/ns.cmx types/intervals.cmx types/ident.cmx \
misc/encodings.cmx types/compunit.cmx types/chars.cmx \
parser/cduce_loc.cmx types/atoms.cmx
typing/typepat.cmo : types/types.cmi types/sequence.cmi types/patterns.cmi \
types/ident.cmo misc/encodings.cmi types/chars.cmi typing/typepat.cmi
typing/typepat.cmx : types/types.cmx types/sequence.cmx types/patterns.cmx \
......@@ -183,26 +193,26 @@ typing/typepat.cmx : types/types.cmx types/sequence.cmx types/patterns.cmx \
types/externals.cmo : parser/cduce_loc.cmi types/externals.cmi
types/externals.cmx : parser/cduce_loc.cmx types/externals.cmi
typing/typer.cmo : types/var.cmi misc/utils.cmo types/types.cmi \
typing/typepat.cmi typing/typed.cmo types/sequence.cmi \
schema/schema_validator.cmi types/patterns.cmi misc/ns.cmi \
types/ident.cmo types/externals.cmi types/compunit.cmi types/chars.cmi \
parser/cduce_loc.cmi types/builtin_defs.cmi types/atoms.cmi \
parser/ast.cmo typing/typer.cmi
typing/typepat.cmi typing/typed.cmo types/type_tallying.cmi \
types/sequence.cmi schema/schema_validator.cmi types/patterns.cmi \
misc/ns.cmi types/ident.cmo types/externals.cmi types/compunit.cmi \
types/chars.cmi parser/cduce_loc.cmi types/builtin_defs.cmi \
types/atoms.cmi parser/ast.cmo typing/typer.cmi
typing/typer.cmx : types/var.cmx misc/utils.cmx types/types.cmx \
typing/typepat.cmx typing/typed.cmx types/sequence.cmx \
schema/schema_validator.cmx types/patterns.cmx misc/ns.cmx \
types/ident.cmx types/externals.cmx types/compunit.cmx types/chars.cmx \
parser/cduce_loc.cmx types/builtin_defs.cmx types/atoms.cmx \
parser/ast.cmx typing/typer.cmi
typing/typepat.cmx typing/typed.cmx types/type_tallying.cmx \
types/sequence.cmx schema/schema_validator.cmx types/patterns.cmx \
misc/ns.cmx types/ident.cmx types/externals.cmx types/compunit.cmx \
types/chars.cmx parser/cduce_loc.cmx types/builtin_defs.cmx \
types/atoms.cmx parser/ast.cmx typing/typer.cmi
compile/compile.cmo : types/var.cmi runtime/value.cmi misc/upool.cmi \
types/types.cmi typing/typer.cmi typing/typed.cmo types/patterns.cmi \
misc/ns.cmi compile/lambda.cmi misc/imap.cmi types/ident.cmo \
runtime/eval.cmi types/compunit.cmi parser/cduce_loc.cmi \
types/types.cmi typing/typer.cmi typing/typed.cmo types/type_tallying.cmi \
types/patterns.cmi misc/ns.cmi compile/lambda.cmi misc/imap.cmi \
types/ident.cmo runtime/eval.cmi types/compunit.cmi parser/cduce_loc.cmi \
compile/auto_pat.cmi parser/ast.cmo compile/compile.cmi
compile/compile.cmx : types/var.cmx runtime/value.cmx misc/upool.cmx \
types/types.cmx typing/typer.cmx typing/typed.cmx types/patterns.cmx \
misc/ns.cmx compile/lambda.cmx misc/imap.cmx types/ident.cmx \
runtime/eval.cmx types/compunit.cmx parser/cduce_loc.cmx \
types/types.cmx typing/typer.cmx typing/typed.cmx types/type_tallying.cmx \
types/patterns.cmx misc/ns.cmx compile/lambda.cmx misc/imap.cmx \
types/ident.cmx runtime/eval.cmx types/compunit.cmx parser/cduce_loc.cmx \
compile/auto_pat.cmx parser/ast.cmx compile/compile.cmi
schema/schema_parser.cmo : parser/url.cmi schema/schema_xml.cmi \
schema/schema_validator.cmi schema/schema_types.cmi \
......@@ -290,9 +300,9 @@ query/query_aggregates.cmo : runtime/value.cmi types/sequence.cmi \
compile/operators.cmi types/intervals.cmi types/builtin_defs.cmi
query/query_aggregates.cmx : runtime/value.cmx types/sequence.cmx \
compile/operators.cmx types/intervals.cmx types/builtin_defs.cmx
parser/cduce_netclient.cmo : runtime/value.cmi parser/url.cmi \
parser/cduce_curl.cmo : runtime/value.cmi parser/url.cmi \
driver/cduce_config.cmi
parser/cduce_netclient.cmx : runtime/value.cmx parser/url.cmx \
parser/cduce_curl.cmx : runtime/value.cmx parser/url.cmx \
driver/cduce_config.cmx
runtime/cduce_pxp.cmo : runtime/value.cmi parser/url.cmi \
schema/schema_xml.cmi runtime/load_xml.cmi driver/cduce_config.cmi \
......@@ -376,11 +386,12 @@ types/types.cmi : types/var.cmi misc/ns.cmi types/intervals.cmi \
types/atoms.cmi
compile/auto_pat.cmi : types/types.cmi types/ident.cmo types/chars.cmi \
types/atoms.cmi
types/type_tallying.cmi : types/var.cmi types/types.cmi
types/sequence.cmi : types/types.cmi types/atoms.cmi
types/builtin_defs.cmi : types/types.cmi types/ident.cmo types/atoms.cmi
runtime/value.cmi : types/types.cmi misc/ns.cmi types/intervals.cmi \
misc/imap.cmi types/ident.cmo misc/encodings.cmi types/chars.cmi \
types/atoms.cmi
runtime/value.cmi : types/types.cmi types/type_tallying.cmi misc/ns.cmi \
types/intervals.cmi misc/imap.cmi types/ident.cmo misc/encodings.cmi \
types/chars.cmi types/atoms.cmi
schema/schema_pcre.cmi : misc/encodings.cmi
schema/schema_types.cmi : runtime/value.cmi misc/ns.cmi misc/encodings.cmi \
types/atoms.cmi
......@@ -396,8 +407,8 @@ types/patterns.cmi : types/types.cmi types/ident.cmo misc/custom.cmo \
compile/auto_pat.cmi
compile/print_auto.cmi : compile/auto_pat.cmi
compile/lambda.cmi : runtime/value.cmi types/types.cmi \
schema/schema_validator.cmi misc/ns.cmi misc/imap.cmi types/ident.cmo \
types/compunit.cmi compile/auto_pat.cmi
types/type_tallying.cmi schema/schema_validator.cmi misc/ns.cmi \
misc/imap.cmi types/ident.cmo types/compunit.cmi compile/auto_pat.cmi
runtime/run_dispatch.cmi : runtime/value.cmi compile/auto_pat.cmi
runtime/explain.cmi : runtime/value.cmi compile/auto_pat.cmi
runtime/eval.cmi : runtime/value.cmi misc/ns.cmi compile/lambda.cmi \
......
......@@ -201,7 +201,7 @@ let rec eval_sigma env =
List.fold_left (fun acc sigma_j ->
let exists_sub =
List.exists (fun (_,s_i) ->
inzero env env.(x) (Types.Tallying.(s_i >> sigma_j))
inzero env env.(x) (Type_tallying.(s_i >> sigma_j))
) iface
in
if exists_sub then sigma_j::acc else acc
......@@ -219,7 +219,7 @@ and inzero env v t =
| Abstraction (Some iface,_,sigma) ->
let s = List.fold_left (fun acc t -> Types.cap acc (snd t)) Types.any iface in
List.for_all (fun si ->
Types.subtype (Types.Tallying.(s >> si)) t
Types.subtype (Type_tallying.(s >> si)) t
) (eval_sigma env sigma)
| _ -> true
......
......@@ -3,7 +3,7 @@ open Encodings
type iface = (Types.t * Types.t) list
type sigma =
| List of Types.Tallying.CS.sl
| List of Type_tallying.CS.sl
| Comp of (sigma * sigma)
| Sel of (int * iface * sigma)
| Identity
......@@ -26,13 +26,13 @@ and t =
let rec domain = function
| Identity | Mono -> Var.Set.empty
| List(l) -> Types.Tallying.domain l
| List(l) -> Type_tallying.domain l
| Comp(s1,s2) -> Var.Set.cup (domain s1) (domain s2)
| Sel(_,_,sigma) -> (domain sigma)
let rec codomain = function
| Identity | Mono -> Var.Set.empty
| List(l) -> Types.Tallying.codomain l
| List(l) -> Type_tallying.codomain l
| Comp(s1,s2) -> Var.Set.cup (codomain s1) (codomain s2)
| Sel(_,_,sigma) -> (codomain sigma)
......@@ -313,7 +313,7 @@ module Print = struct
) ppf
in
function
|List ll -> Types.Tallying.CS.pp_sl ppf ll
|List ll -> Type_tallying.CS.pp_sl ppf ll
|Comp(s1,s2) -> Format.fprintf ppf "Comp(%a,%a)" pp_sigma s1 pp_sigma s2
|Sel(x,iface,s) -> Format.fprintf ppf "Sel(%d,%a,%a)" x pp_aux iface pp_sigma s
|Identity -> Format.fprintf ppf "Id"
......@@ -506,7 +506,7 @@ let rec compare_sigma x y =
| List(sl1), List(sl2) ->
if List.for_all2 (fun v1 v2 ->
Types.Tallying.E.comparea v1 v2 ) sl1 sl2 = 0 then 0
Type_tallying.E.comparea v1 v2 ) sl1 sl2 = 0 then 0
else (List.length sl1) - (List.length sl2)
| Sel(t1,if1,s1), Sel(t2,if2,s2) ->
......
......@@ -3,7 +3,7 @@ open Encodings
type iface = (Types.t * Types.t) list
type sigma =
| List of Types.Tallying.CS.sl
| List of Type_tallying.CS.sl
| Comp of (sigma * sigma)
| Sel of (int * iface * sigma)
| Identity
......
This diff is collapsed.
open Types
type constr =
| Pos of (Var.var * t) (** alpha <= t | alpha \in P *)
| Neg of (t * Var.var) (** t <= alpha | alpha \in N *)
exception UnSatConstr of string
exception Step1Fail
exception Step2Fail
module CS : sig
module M : sig
type key = Var.var
type t
val compare : t -> t -> int
val empty : t
val add : Var.Set.t -> key -> descr*descr -> t -> t
val singleton : key -> descr*descr -> t
val pp : Format.formatter -> t -> unit
val inter : Var.Set.t -> t -> t -> t
end
module E : sig
include Map.S with type key = Var.var
val pp : Format.formatter -> descr t -> unit
end
module ES : sig
include Set.S with type elt = descr E.t
val pp : Format.formatter -> t -> unit
end
module S : sig
type t = M.t list
val empty : t
val add : M.t -> t -> t
val singleton : M.t -> t
val union : t -> t -> t
val elements : t -> M.t list
val fold : (M.t -> 'b -> 'b) -> M.t list -> 'b -> 'b
val pp : Format.formatter -> t -> unit
end
type s = S.t
type m = M.t
type es = ES.t
type sigma = t E.t
type sl = sigma list
val pp_s : Format.formatter -> s -> unit
val pp_m : Format.formatter -> m -> unit
val pp_e : Format.formatter -> sigma -> unit
val pp_sl : Format.formatter -> sl -> unit
(* val merge : m -> m -> m *)
val singleton : constr -> s
val sat : s
val unsat : s
val union : s -> s -> s
val prod : Var.Set.t -> s -> s -> s
end
val norm : Var.Set.t -> t -> CS.s
val merge : Var.Set.t -> CS.m -> CS.s
val solve : Var.Set.t -> CS.s -> CS.es
val unify : CS.sigma -> CS.sigma
(* [s1 ... sn] . si is a solution for tallying problem
if si # delta and for all (s,t) in C si @ s < si @ t *)
val tallying : Var.Set.t -> (t * t) list -> CS.sl
val (>>) : t -> CS.sigma -> t
(** Symbolic Substitution Set *)
type symsubst =
|I (** Identity *)
|S of CS.sigma (** Substitution *)
|A of (symsubst * symsubst) (** Composition si (sj t) *)
(** Cartesian Product of two symbolic substitution sets *)
val ( ++ ) : symsubst list -> symsubst list -> symsubst list
(** Evaluation of a substitution *)
val (@@) : t -> symsubst -> t
val domain : CS.sl -> Var.Set.t
val codomain : CS.sl -> Var.Set.t
val is_identity : CS.sl -> bool
val identity : CS.sl
val filter : (Var.t -> bool) -> CS.sl -> CS.sl
(** Square Subtype relation. [squaresubtype delta s t] .
True if there exists a substitution such that s < t only
considering variables that are not in delta *)
val squaresubtype : Var.Set.t -> t -> t -> CS.sl
val is_squaresubtype : Var.Set.t -> t -> t -> bool
(** apply_raw s t returns the 4-tuple (subst,ss, tt, res) where
subst is the set of substitution that make the application succeed,
ss and tt are the expansions of s and t corresponding to that substitution
and res is the type of the result of the application *)
val apply_full : Var.Set.t -> t -> t -> t
val apply_raw : Var.Set.t -> t -> t -> CS.sl * t * t * t
val squareapply : Var.Set.t -> t -> t -> (CS.sl * t)
......@@ -397,7 +397,7 @@ and VarRec : VarTypeSig with module Atom = Rec
end
module type VarType = VarTypeSig with type descr = Descr.t
type var_type = (module VarType)
module DescrHash = Hashtbl.Make(Descr)
module DescrMap = Map.Make(Descr)
......
......@@ -69,20 +69,43 @@ end
(** Algebra **)
module VarAtoms : Bool.V with type Atom.t = Atoms.t
module VarIntervals : Bool.V with type Atom.t = Intervals.t
module Descr : Custom.T
module VarChars : Bool.V with type Atom.t = Chars.t
include Custom.T with type t = Descr.t
module VarAbstracts: Bool.V with type Atom.t = Abstracts.t
include Custom.T
module Node : Custom.T
type descr = t
module type VarType = sig
include Bool.V
type descr = Descr.t
val inj : t -> descr
val proj : descr -> t
val update : descr -> t -> descr
end
type var_type = (module VarType)
module VarAtoms : VarType with type Atom.t = Atoms.t
module VarIntervals : VarType with type Atom.t = Intervals.t
module VarChars : VarType with type Atom.t = Chars.t
module VarAbstracts : VarType with type Atom.t = Abstracts.t
module Pair : Bool.S with type elem = Node.t * Node.t
module Rec : Bool.S with type elem = bool * Node.t Ident.LabelMap.map
module VarTimes : VarType with module Atom = Pair
module VarXml : VarType with module Atom = Pair
module VarArrow : VarType with module Atom = Pair
module VarRec : VarType with module Atom = Rec
val make: unit -> Node.t
val define: Node.t -> t -> unit
......@@ -139,6 +162,15 @@ val rec_of_list: bool -> (bool * Ns.Label.t * t) list -> t
val empty_closed_record: t
val empty_open_record: t
module Iter : sig
val simplify : t -> t
val map : ?abs:(bool -> bool) -> (var_type -> t -> t) -> t -> t
val iter : ?abs:(bool -> unit) ->(var_type -> t -> unit) -> t -> unit
val fold : ?abs:(bool -> 'a -> 'a) -> (var_type -> t -> 'a -> 'a) -> t -> 'a -> 'a
end
(** Positive systems and least solutions **)
module Positive : sig
......@@ -152,11 +184,18 @@ module Positive : sig
val solve: v -> Node.t
end
module Variable : sig
val extract : t -> Var.var * bool
end
module Substitution : sig
val full : t -> (Var.var * t) list -> t
val single : t -> (Var.var * t) -> t
val freshen : Var.Set.t -> t -> t
val hide_vars : t -> t
val solve_rectype : t -> Var.var -> t
val kind : Var.Set.t -> Var.kind -> t -> t
val clean_type : Var.Set.t -> t -> t
end
......@@ -310,6 +349,13 @@ val subtype : t -> t -> bool
val disjoint : t -> t -> bool
val equiv : t -> t -> bool
(** intermediary representation for records *)
(*** TODO : SEAL OFF *)
val get_record : Rec.t -> (Label.t list * (bool * t array) * ((bool * t array) list)) list
(** Tools for compilation of PM **)
val cond_partition: t -> (t * t) list -> t list
......@@ -352,112 +398,7 @@ module Cache : sig
type 'a cache
val emp: 'a cache
val find: (t -> 'a) -> t -> 'a cache -> 'a cache * 'a
val lookup : t -> 'a cache -> 'a option
val memo: (t -> 'a) -> (t -> 'a)
end
module Tallying : sig
type constr =
|Pos of (Var.var * t) (** alpha <= t | alpha \in P *)
|Neg of (t * Var.var) (** t <= alpha | alpha \in N *)
exception UnSatConstr of string
exception Step1Fail
exception Step2Fail
module CS : sig
module M : sig
type key = Var.var
type t
val compare : t -> t -> int
val empty : t
val add : Var.Set.t -> key -> descr*descr -> t -> t
val singleton : key -> descr*descr -> t
val pp : Format.formatter -> t -> unit
val inter : Var.Set.t -> t -> t -> t
end
module E : sig
include Map.S with type key = Var.var
val pp : Format.formatter -> descr t -> unit
end
module ES : sig
include Set.S with type elt = descr E.t
val pp : Format.formatter -> t -> unit
end
module S : sig
type t = M.t list
val empty : t
val add : M.t -> t -> t
val singleton : M.t -> t
val union : t -> t -> t
val elements : t -> M.t list
val fold : (M.t -> 'b -> 'b) -> M.t list -> 'b -> 'b
val pp : Format.formatter -> t -> unit
end
type s = S.t
type m = M.t
type es = ES.t
type sigma = t E.t
type sl = sigma list
val pp_s : Format.formatter -> s -> unit
val pp_m : Format.formatter -> m -> unit
val pp_e : Format.formatter -> sigma -> unit
val pp_sl : Format.formatter -> sl -> unit
(* val merge : m -> m -> m *)
val singleton : constr -> s
val sat : s
val unsat : s
val union : s -> s -> s
val prod : Var.Set.t -> s -> s -> s
end
val norm : Var.Set.t -> t -> CS.s
val merge : Var.Set.t -> CS.m -> CS.s
val solve : Var.Set.t -> CS.s -> CS.es
val unify : CS.sigma -> CS.sigma
(* [s1 ... sn] . si is a solution for tallying problem
if si # delta and for all (s,t) in C si @ s < si @ t *)
val tallying : Var.Set.t -> (t * t) list -> CS.sl
val (>>) : t -> CS.sigma -> t
(** Symbolic Substitution Set *)
type symsubst =
|I (** Identity *)
|S of CS.sigma (** Substitution *)
|A of (symsubst * symsubst) (** Composition si (sj t) *)
(** Cartesian Product of two symbolic substitution sets *)
val ( ++ ) : symsubst list -> symsubst list -> symsubst list
(** Evaluation of a substitution *)
val (@@) : t -> symsubst -> t
val domain : CS.sl -> Var.Set.t
val codomain : CS.sl -> Var.Set.t
val is_identity : CS.sl -> bool
val identity : CS.sl
val filter : (Var.t -> bool) -> CS.sl -> CS.sl
end
(** Square Subtype relation. [squaresubtype delta s t] .
True if there exists a substitution such that s < t only
considering variables that are not in delta *)