Commit b6113d26 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2004-12-24 17:39:42 by afrisch] Empty log message

Original author: afrisch
Date: 2004-12-24 17:39:42+00:00
parent c2244da2
......@@ -1690,10 +1690,8 @@ x=(1,2)
| TCapt of TargExpr.t * t
| TAlt of descr * Types.t * t * t
| TConj of Types.t * fv * t * t
| TOther of descr * Types.t * fv * atoms
| TTimes of Types.pair_kind * int * descr * Types.t * fv * node * node
and atoms =
| TRecord of label * node
| TRecord of int * descr * Types.t * fv * label * node
let capt pr p =
if IdMap.is_empty pr then p else match p with
......@@ -1732,20 +1730,16 @@ x=(1,2)
Format.fprintf ppf "(%a | %a)" print l print r
| TConj (_,_,l,r) ->
Format.fprintf ppf "(%a & %a)" print l print r
| TOther (_,t,xs,x) ->
Format.fprintf ppf "<t=%a;xs=%a;%a>"
| TRecord (_,_,t,xs,l,q) ->
Format.fprintf ppf "<t=%a;xs=%a;{_}>"
Types.Print.print t
Print.print_xs xs
print_atom (t,xs,x)
| TTimes (kind,_,_,t,xs,q1,q2) ->
Format.fprintf ppf "<t=%a;xs=%a;(%a,%a)>"
Types.Print.print t
Print.print_xs xs
Print.print q1.descr
Print.print q2.descr
and print_atom ppf (t,xs,d) =
match d with
| TRecord _ -> Format.fprintf ppf "{_}"
let get_result = function
| TSucceed -> Some TargExpr.empty
......@@ -1761,20 +1755,19 @@ x=(1,2)
let uid = ref 0
let rec mk ((a,fv,d) as p) =
let oth x = TOther (p,Types.any,fv,x) in
match d with
| Constr t -> TConstr (t, Types.any)
| 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 -> success (TargExpr.capture x)
| Constant (x,c) -> success (TargExpr.cst x c)
| Times (q1,q2) ->
TTimes (`Normal,(incr uid; !uid), p,Types.any,fv,q1,q2)
| Xml (q1,q2) ->
TTimes (`XML,(incr uid; !uid), p,Types.any,fv,q1,q2)
| Record (l,q) -> oth (TRecord (l,q))
| Dummy -> assert false
let rec mk ((a,fv,d) as p) = match d with
| Constr t -> TConstr (t, Types.any)
| 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 -> success (TargExpr.capture x)
| Constant (x,c) -> success (TargExpr.cst x c)
| Times (q1,q2) ->
TTimes (`Normal,(incr uid; !uid), p,Types.any,fv,q1,q2)
| Xml (q1,q2) ->
TTimes (`XML,(incr uid; !uid), p,Types.any,fv,q1,q2)
| Record (l,q) ->
TRecord ((incr uid; !uid),p, Types.any,fv,l,q)
| Dummy -> assert false
let constr a t =
if Types.disjoint a t then TFail
......@@ -1814,8 +1807,8 @@ x=(1,2)
| TConstr (a,_) -> constr a t
| TTimes (kind,uid, p,_,_,q1,q2) ->
factorize p t xs (fun xs -> TTimes (kind,uid, p,t,xs,q1,q2))
| TOther (p,_,_,x) ->
factorize p t xs (fun xs -> TOther (p,t,xs,x))
| TRecord (uid,p,_,_,l,q) ->
factorize p t xs (fun xs -> TRecord (uid,p,t,xs,l,q))
| TSucceed -> if Types.is_empty t then TFail else TSucceed
| TFail -> TFail
......@@ -1852,19 +1845,17 @@ x=(1,2)
try TargExpr.merge r (find_binds q (PatList.Map.get reqs) binds fetch)
with Not_found -> r
let pair swap l r = let (l,r) = swap (l,r) in TargExpr.SrcPair (l,r)
let rec set_times k swap swap' extra1 extra2 reqs1 reqs2 binds1 binds2 =
let rec aux =
function
| TTimes (kind,uid,_,t,xs,q1,q2) when k == kind->
let (q1,q2) = swap (q1,q2) in
let r1 = find_binds q1 reqs1 binds1 TargExpr.fetch_left uid extra1
and r2 = find_binds q2 reqs2 binds2 TargExpr.fetch_right uid extra2
in
let r = IdMap.merge (fun l r ->
let (l,r) = swap' (l,r) in
TargExpr.SrcPair (l,r)) r1 r2 in
success (IdMap.restrict r xs)
| x -> map aux x
let rec aux = function
| TTimes (kind,uid,_,t,xs,q1,q2) when k == kind->
let (q1,q2) = swap (q1,q2) in
let r1 = find_binds q1 reqs1 binds1 TargExpr.fetch_left uid extra1
and r2 = find_binds q2 reqs2 binds2 TargExpr.fetch_right uid extra2
in
let r = IdMap.merge (pair swap') r1 r2 in
success (IdMap.restrict r xs)
| x -> map aux x
in
aux
......
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