Commit 3e105c5e authored by Kim Nguyễn's avatar Kim Nguyễn

Further refactoring of the tallying code.

parent b17ef0fc
......@@ -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.CS.sl
| List of Type_tallying.Constr.sl
| Comp of (sigma * sigma)
| Sel of (var_loc * iface * sigma)
......@@ -104,7 +104,7 @@ module Print = struct
) ppf
in
function
|List ll -> Type_tallying.CS.pp_sl ppf ll
|List ll -> Type_tallying.Constr.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.CS.sl
| List of Type_tallying.Constr.sl
| 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.CS.sl
| List of Type_tallying.Constr.sl
| Comp of (sigma * sigma)
| Sel of (int * iface * sigma)
| Identity
......@@ -313,7 +313,7 @@ module Print = struct
) ppf
in
function
|List ll -> Type_tallying.CS.pp_sl ppf ll
|List ll -> Type_tallying.Constr.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.CS.sl
| List of Type_tallying.Constr.sl
| Comp of (sigma * sigma)
| Sel of (int * iface * sigma)
| Identity
......
......@@ -32,6 +32,7 @@ sig
type 'a map
external get: 'a map -> (Elem.t * 'a) list = "%identity"
val add: Elem.t -> 'a -> 'a map -> 'a map
val replace: Elem.t -> 'a -> 'a map -> 'a map
val mem: Elem.t -> 'a map -> bool
val length: 'a map -> int
val domain: 'a map -> t
......@@ -320,6 +321,14 @@ module Make(X : Custom.T) = struct
| (l1,[]) -> l1
let add x v = union_disj [(x,v)]
let rec replace x v m =
match m with
[] -> [ (x,v) ]
| ((y, w) as t) :: q ->
let c = Elem.compare x y in
if c == 0 then (x, v) :: q
else if c > 0 then t :: (replace x v q)
else (* c < 0 *) (x, v) :: m
let rec mem x l =
match l with
......
......@@ -32,6 +32,7 @@ sig
type 'a map
external get: 'a map -> (Elem.t * 'a) list = "%identity"
val add: Elem.t -> 'a -> 'a map -> 'a map
val replace: Elem.t -> 'a -> 'a map -> 'a map
val mem: Elem.t -> 'a map -> bool
val length: 'a map -> int
val domain: 'a map -> t
......
This diff is collapsed.
......@@ -8,15 +8,14 @@ exception UnSatConstr of string
exception Step1Fail
exception Step2Fail
module CS : sig
module M : sig
type key = Var.t
module Constr : sig
module Line : sig
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 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
......@@ -28,18 +27,18 @@ module CS : sig
val pp : Format.formatter -> t -> unit
end
module S : sig
type t = M.t list
type t = Line.t list
val empty : t
val add : M.t -> t -> t
val singleton : M.t -> t
val add : Line.t -> t -> t
val singleton : Line.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 elements : t -> Line.t list
val fold : (Line.t -> 'b -> 'b) -> Line.t list -> 'b -> 'b
val pp : Format.formatter -> t -> unit
end
type s = S.t
type m = M.t
type m = Line.t
type es = ES.t
type sigma = t E.t
type sl = sigma list
......@@ -57,21 +56,21 @@ module CS : sig
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
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 -> CS.sl
val tallying : Var.Set.t -> (t * t) list -> Constr.sl
val (>>) : t -> CS.sigma -> t
val (>>) : t -> Constr.sigma -> t
(** Symbolic Substitution Set *)
type symsubst =
|I (** Identity *)
|S of CS.sigma (** Substitution *)
|S of Constr.sigma (** Substitution *)
|A of (symsubst * symsubst) (** Composition si (sj t) *)
(** Cartesian Product of two symbolic substitution sets *)
......@@ -80,16 +79,16 @@ 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
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
(** 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 squaresubtype : Var.Set.t -> t -> t -> Constr.sl
val is_squaresubtype : Var.Set.t -> t -> t -> bool
(** apply_raw s t returns the 4-tuple (subst,ss, tt, res) where
......@@ -98,6 +97,6 @@ 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 -> CS.sl * t * t * t
val apply_raw : Var.Set.t -> t -> t -> Constr.sl * t * t * t
val squareapply : Var.Set.t -> t -> t -> (CS.sl * t)
val squareapply : Var.Set.t -> t -> t -> (Constr.sl * t)
......@@ -15,7 +15,7 @@ open Ident
type tpat = Patterns.node
type ttyp = Types.Node.t
type sigma = Type_tallying.CS.sl
type sigma = Type_tallying.Constr.sl
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.CS.pp_sl sl
| Subst(e,sl) -> Format.fprintf ppf "%a @@ %a" pp e Type_tallying.Constr.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