Skip to content

GitLab

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
Expand all Hide whitespace changes
Inline Side-by-side
Makefile.distrib
View file @ 32780738
......@@ -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 \
......
compile/compile.ml
View file @ 32780738
......@@ -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)
......
compile/lambda.ml
View file @ 32780738
......@@ -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"
......
compile/lambda.mli
View file @ 32780738
......@@ -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)
......
depend
View file @ 32780738
......@@ -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 \
......
runtime/run_dispatch.ml
View file @ 32780738
......@@ -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
......
runtime/value.ml
View file @ 32780738
......@@ -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) ->
......
runtime/value.mli
View file @ 32780738
......@@ -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
......
types/type_tallying.ml 0 → 100644
View file @ 32780738
This diff is collapsed.
types/type_tallying.mli 0 → 100644
View file @ 32780738
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)
types/types.ml
View file @ 32780738
......@@ -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)
......
types/types.mli
View file @ 32780738
......@@ -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 *)
val squaresubtype : Var.Set.t -> t -> t -> Tallying.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