Commit 32925cd8 authored by Kim Nguyễn's avatar Kim Nguyễn

Refactoring of the Type_tallying module, using more sensible name and removing unneeded functions.

parent 5d9c8545
......@@ -26,7 +26,7 @@ type iface = (Types.descr * Types.descr) list
type sigma =
| Identity (* this is basically as Types.Tallying.CS.sat *)
| List of Type_tallying.Constr.sl
| List of Types.t Type_tallying.VarMap.map list
| Comp of (sigma * sigma)
| Sel of (var_loc * iface * sigma)
......@@ -104,7 +104,7 @@ module Print = struct
) ppf
in
function
|List ll -> Type_tallying.Constr.pp_sl ppf ll
|List ll -> Type_tallying.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 Type_tallying.Constr.sl
| List of Types.t Type_tallying.VarMap.map list
| Comp of (sigma * sigma)
| Sel of (var_loc * iface * sigma)
......
......@@ -3,7 +3,7 @@ open Encodings
type iface = (Types.t * Types.t) list
type sigma =
| List of Type_tallying.Constr.sl
| List of Types.t Type_tallying.VarMap.map list
| Comp of (sigma * sigma)
| Sel of (int * iface * sigma)
| Identity
......@@ -313,7 +313,7 @@ module Print = struct
) ppf
in
function
|List ll -> Type_tallying.Constr.pp_sl ppf ll
|List ll -> Type_tallying.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"
......
......@@ -3,7 +3,7 @@ open Encodings
type iface = (Types.t * Types.t) list
type sigma =
| List of Type_tallying.Constr.sl
| List of Types.t Type_tallying.VarMap.map list
| Comp of (sigma * sigma)
| Sel of (int * iface * sigma)
| Identity
......
......@@ -73,6 +73,7 @@ sig
val compare: ('a -> 'a -> int) -> 'a map -> 'a map -> int
val hash: ('a -> int) -> 'a map -> int
val equal: ('a -> 'a -> bool) -> 'a map -> 'a map -> bool
val remove_min : 'a map -> (Elem.t * 'a) * 'a map
end
module MakeMap(Y : Custom.T) : sig
include Custom.T with type t = Y.t Map.map
......@@ -468,6 +469,10 @@ module Make(X : Custom.T) = struct
| [x,a] -> Elem.check x; f a
| _ -> ()
let remove_min = function
e :: l -> e, l
| _ -> failwith "SortedList.Map.min_binding"
end (* Map *)
......
......@@ -73,6 +73,7 @@ sig
val compare: ('a -> 'a -> int) -> 'a map -> 'a map -> int
val hash: ('a -> int) -> 'a map -> int
val equal: ('a -> 'a -> bool) -> 'a map -> 'a map -> bool
val remove_min : 'a map -> (Elem.t * 'a) * 'a map
end
module MakeMap(Y : Custom.T) : sig
include Custom.T with type t = Y.t Map.map
......
This diff is collapsed.
open Types
type constr =
| Pos of (Var.t * t) (** alpha <= t | alpha \in P *)
| Neg of (t * Var.t) (** t <= alpha | alpha \in N *)
exception UnSatConstr of string
exception Step1Fail
exception Step2Fail
module Constr : sig
module Line : sig
type t
val compare : t -> t -> int
val empty : t
val add : Var.Set.t -> Var.t -> descr*descr -> t -> t
val singleton : Var.t -> descr*descr -> t
val print : Format.formatter -> t -> unit
val inter : Var.Set.t -> t -> t -> t
end
module E : sig
include Map.S with type key = Var.t
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 = Line.t list
val empty : t
val add : Line.t -> t -> t
val singleton : Line.t -> t
val union : t -> t -> t
val elements : t -> Line.t list
val fold : (Line.t -> 'b -> 'b) -> Line.t list -> 'b -> 'b
val pp : Format.formatter -> t -> unit
end
module VarMap : module type of Var.Set.Map
type s = S.t
type m = Line.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 -> Constr.s
val merge : Var.Set.t -> Constr.m -> Constr.s
val solve : Var.Set.t -> Constr.s -> Constr.es
val unify : Constr.sigma -> Constr.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 -> Constr.sl
val (>>) : t -> Constr.sigma -> t
val (>>) : t -> Descr.t VarMap.map -> t
(** Symbolic Substitution Set *)
type symsubst =
|I (** Identity *)
|S of Constr.sigma (** Substitution *)
|S of Descr.t VarMap.map (** Substitution *)
|A of (symsubst * symsubst) (** Composition si (sj t) *)
(** Cartesian Product of two symbolic substitution sets *)
......@@ -79,16 +19,19 @@ val ( ++ ) : symsubst list -> symsubst list -> symsubst list
(** Evaluation of a substitution *)
val (@@) : t -> symsubst -> t
val domain : Constr.sl -> Var.Set.t
val codomain : Constr.sl -> Var.Set.t
val is_identity : Constr.sl -> bool
val identity : Constr.sl
val filter : (Var.t -> bool) -> Constr.sl -> Constr.sl
val domain : Descr.t VarMap.map list -> Var.Set.t
val codomain : Descr.t VarMap.map list -> Var.Set.t
val is_identity : Descr.t VarMap.map list -> bool
val identity : Descr.t VarMap.map list
val filter : (Var.t -> bool) -> Descr.t VarMap.map list -> Descr.t VarMap.map list
val tallying : Var.Set.t -> (Types.t * Types.t) list ->
Types.t VarMap.map list
(** 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 -> Constr.sl
val squaresubtype : Var.Set.t -> t -> t -> Descr.t VarMap.map list
val is_squaresubtype : Var.Set.t -> t -> t -> bool
(** apply_raw s t returns the 4-tuple (subst,ss, tt, res) where
......@@ -97,6 +40,8 @@ val is_squaresubtype : Var.Set.t -> t -> t -> bool
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 -> Constr.sl * t * t * t
val apply_raw : Var.Set.t -> t -> t -> Descr.t VarMap.map list * t * t * t
val squareapply : Var.Set.t -> t -> t -> (Descr.t VarMap.map list * t)
val squareapply : Var.Set.t -> t -> t -> (Constr.sl * t)
val pp_sl : Format.formatter -> Types.t VarMap.map list -> unit
......@@ -15,7 +15,7 @@ open Ident
type tpat = Patterns.node
type ttyp = Types.Node.t
type sigma = Type_tallying.Constr.sl
type sigma = Types.t Type_tallying.VarMap.map list
type texpr =
{ exp_loc : loc;
......@@ -108,7 +108,7 @@ module Print = struct
and pp_aux ppf e =
match e.exp_descr with
| Subst(e,sl) -> Format.fprintf ppf "%a @@ %a" pp e Type_tallying.Constr.pp_sl sl
| Subst(e,sl) -> Format.fprintf ppf "%a @@ %a" pp e Type_tallying.pp_sl sl
| Forget(e, _) -> Format.fprintf ppf "Forget(%a)" pp e
| Check(_, e, _) -> Format.fprintf ppf "Check(%a)" pp e
| TVar(id, name) ->
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment