Commit 41949d9f authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2004-12-23 00:21:19 by afrisch] Clean

Original author: afrisch
Date: 2004-12-23 00:21:19+00:00
parent b4b4d74d
......@@ -1653,25 +1653,23 @@ x=(1,2)
type ('a,'b) t =
| TSucceed
| TFail
| TCapt of 'a TargExpr.t * ('a,'b) t
| TAlt of descr * Types.t * ('a,'b) t * ('a,'b) t
| TConj of Types.t * fv * ('a,'b) t * ('a,'b) t
| TOther of descr * Types.t * fv * 'b
| TFact of 'a TargExpr.t * ('a,'b) t
let get_result = function
| TFact (r,TSucceed) -> Some r
| TCapt (r,TSucceed) -> Some r
| TFail -> None
| _ -> assert false
let rec print f g ppf = function
| TSucceed -> Format.fprintf ppf "#"
| TSucceed -> Format.fprintf ppf "Succeed"
| TFail -> Format.fprintf ppf "Fail"
| TFact (fact,r) ->
Format.fprintf ppf "{%a}(%a)"
(TargExpr.print f) fact (print f g) r
| TCapt (pr,r) ->
Format.fprintf ppf "{%a}(%a)" (TargExpr.print f) pr (print f g) r
| TAlt (_,_,l,r) ->
Format.fprintf ppf "(%a | %a)"
(print f g) l (print f g) r
Format.fprintf ppf "(%a | %a)" (print f g) l (print f g) r
| TConj (_,_,l,r) ->
Format.fprintf ppf "(%a & %a)" (print f g) l (print f g) r
| TOther (_,t,xs,x) ->
......@@ -1687,22 +1685,23 @@ x=(1,2)
| Constr t -> oth (`Constr t)
| Cup ((a1,_,_) as p1,p2) -> TAlt (p, a1,mk p1, mk p2)
| Cap ((a1,fv1,_) as p1,p2) -> TConj (a1,fv1,mk p1,mk p2)
| Capture x -> TFact (TargExpr.capture x, TSucceed)
| Constant (x,c) -> TFact (TargExpr.cst x c, TSucceed)
| Capture x -> TCapt (TargExpr.capture x, TSucceed)
| Constant (x,c) -> TCapt (TargExpr.cst x c, TSucceed)
| Times (q1,q2) -> oth (`Times (q1,q2))
| Xml (q1,q2) -> oth (`Xml (q1,q2))
| Record (l,q) -> oth (`Record (l,q))
| Dummy -> assert false
let fact f p = match p with
| TFact (f2,p) -> TFact (TargExpr.merge f f2,p)
| TFail -> TFail
| p -> if IdMap.is_empty f then p else TFact (f,p)
let capt pr p =
if IdMap.is_empty pr then p else match p with
| TCapt (pr2,p) -> TCapt (TargExpr.merge pr pr2,p)
| TFail -> TFail
| p -> TCapt (pr,p)
let rec conj a1 fv1 r1 r2 = match (r1,r2) with
| TSucceed,r | r,TSucceed -> r
| TFail,r | r,TFail -> TFail
| TFact (f,r1), r2 | r2, TFact (f,r1) -> fact f (conj a1 fv1 r1 r2)
| TCapt (f,r1), r2 | r2, TCapt (f,r1) -> capt f (conj a1 fv1 r1 r2)
| r1,r2 -> TConj (a1,fv1,r1,r2)
let alt p a1 r1 r2 = match (r1,r2) with
......@@ -1710,35 +1709,32 @@ x=(1,2)
| r1,r2 -> TAlt (p,a1,r1,r2)
let opt ((a,_,_) as p) t xs f =
let factorize ((a,_,_) as p) t xs f =
if Types.disjoint a t then TFail
else
let vs = Approx.approx_var p t xs in
let xs = IdSet.diff xs vs in
let pr = TargExpr.captures vs in
let p =
capt pr (
if (Types.subtype t a) && (IdSet.is_empty xs)
then TSucceed
else f xs
in
fact pr p
else f xs
)
let rec optimize t xs = function
| TFact (pr,p) ->
| TCapt (pr,p) ->
let pr = IdMap.restrict pr xs in
fact pr (optimize t (IdSet.diff xs (IdMap.domain pr)) p)
capt pr (optimize t (IdSet.diff xs (IdMap.domain pr)) p)
| TAlt (p,a1,p1,p2) ->
opt p t xs
factorize p t xs
(fun xs ->
alt p a1
(optimize t xs p1)
(optimize (Types.diff t a1) xs p2))
alt p a1 (optimize t xs p1) (optimize (Types.diff t a1) xs p2))
| TConj (a1,fv1,p1,p2) ->
conj a1 fv1
(optimize t (IdSet.cap xs fv1) p1)
(optimize (Types.cap t a1) (IdSet.diff xs fv1) p2)
(optimize t (IdSet.cap xs fv1) p1)
(optimize (Types.cap t a1) (IdSet.diff xs fv1) p2)
| TOther (p,_,_,x) ->
opt p t xs (fun xs -> TOther (p,t,xs,x))
factorize p t xs (fun xs -> TOther (p,t,xs,x))
| (TFail | TSucceed) as p -> p
......@@ -1757,33 +1753,6 @@ x=(1,2)
print oth oth ppf (optimize t fv (mk p))
end
(*
let rec eval_pat (a,fv,d) t xs = if Types.disjoint a t then TFail
else if (IdSet.is_empty xs) && (Types.subtype t a) then TSucceed
else eval_d t xs d
and eval_d t xs = function
| Constr t ->
TConstr t
| Cup ((a1,_,_) as p1,p2) ->
TCup (eval_pat p1 t xs, eval_pat p2 (Types.diff t a1) xs)
| Cap ((a1,fv1,_) as p1,((_,fv2,_) as p2)) ->
TCap (eval_pat p1 t (IdSet.cap xs fv1),
eval_pat p2 (Types.cap t a1) (IdSet.cap xs fv2))
| Constant (x,c) when Types.subtype t (Types.constant c) ->
TCapture x
| Constant (x,c) -> TConstant (x,c)
| Capture x ->
TCapture x
| Times (q1,q2) ->
TTimes ((q1.descr, pi1 t, IdSet.cap xs q1.fv),
(q2.descr, pi2 t, IdSet.cap xs q2.fv))
| Xml (q1,q2) ->
TXml ((q1.descr, pi1 t, IdSet.cap xs q1.fv),
(q2.descr, pi2 t, IdSet.cap xs q2.fv))
| Record (l,q) ->
assert false
| Dummy -> assert false
*)
end
let approx ((_,fv,_) as p) t =
......
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