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

[r2004-12-27 00:29:42 by afrisch] Get rid of [ .. ; p ], simulate it

Original author: afrisch
Date: 2004-12-27 00:29:42+00:00
parent 87acc186
...@@ -108,8 +108,7 @@ and ppat' = ...@@ -108,8 +108,7 @@ and ppat' =
| Optional of ppat | Optional of ppat
| Record of bool * (label * (ppat * ppat option)) list | Record of bool * (label * (ppat * ppat option)) list
| Constant of id * pexpr | Constant of id * pexpr
| Regexp of regexp * ppat | Regexp of regexp
(* regular expression, continuation: [ re ; cont ], e.g: [ re ; nil ] *)
and regexp = and regexp =
| Epsilon | Epsilon
......
...@@ -269,7 +269,7 @@ EXTEND ...@@ -269,7 +269,7 @@ EXTEND
let att = mk loc (Internal Types.Record.any) in let att = mk loc (Internal Types.Record.any) in
let any = mk loc (Internal (Types.any)) in let any = mk loc (Internal (Types.any)) in
let re = Star(Alt(SeqCapture(id_dummy,Elem p), Elem any)) in let re = Star(Alt(SeqCapture(id_dummy,Elem p), Elem any)) in
let ct = mk loc (Regexp (re,any)) in let ct = mk loc (Regexp re) in
let p = mk loc (XmlT (tag, multi_prod loc [att;ct])) in let p = mk loc (XmlT (tag, multi_prod loc [att;ct])) in
let b = (p, Var (Id.value id_dummy)) in let b = (p, Var (Id.value id_dummy)) in
exp loc (Transform (e,[b])) exp loc (Transform (e,[b]))
...@@ -540,9 +540,16 @@ EXTEND ...@@ -540,9 +540,16 @@ EXTEND
| "`"; c = tag_type -> c | "`"; c = tag_type -> c
| "("; l = LIST1 pat SEP ","; ")" -> multi_prod loc l | "("; l = LIST1 pat SEP ","; ")" -> multi_prod loc l
| "["; r = [ r = regexp -> r | -> Epsilon ]; | "["; r = [ r = regexp -> r | -> Epsilon ];
q = [ ";"; q = pat -> q q = [ ";"; q = pat -> Some q
| -> pat_nil ]; | -> None ];
"]" -> mk loc (Regexp (r,q)) "]" ->
let r = match q with
| Some q ->
let any = mk loc (Internal (Types.any)) in
Seq(r,Seq(Guard q, Star (Elem any)))
| None -> r
in
mk loc (Regexp r)
| "<"; t = | "<"; t =
[ x = tag_type -> x [ x = tag_type -> x
| "("; t = pat; ")" -> t ]; | "("; t = pat; ")" -> t ];
......
...@@ -83,7 +83,7 @@ mais pas prioritaire [] -> "" ...@@ -83,7 +83,7 @@ mais pas prioritaire [] -> ""
((LabelPool.value s)))^"="^string_of_ppat(ppat)^listing r ((LabelPool.value s)))^"="^string_of_ppat(ppat)^listing r
)in listing (lm) *) )in listing (lm) *)
|Constant(i,t) -> U.get_str (Id.value i) |Constant(i,t) -> U.get_str (Id.value i)
|Regexp(rg,p) -> "["^string_of_regexp rg ^ string_of_ppat p^"]" |Regexp(rg) -> "["^string_of_regexp rg ^ "]"
| _ ->"?" | _ ->"?"
) )
...@@ -120,8 +120,7 @@ let rec var_of_ppat x = ...@@ -120,8 +120,7 @@ let rec var_of_ppat x =
in in
List.fold_left aux [] lm List.fold_left aux [] lm
|Constant(i,t) -> [i] |Constant(i,t) -> [i]
|Regexp(rg,p) -> var_of_rg rg @ var_of_ppat p |Regexp(rg) -> var_of_rg rg
|_ ->[] |_ ->[]
) )
......
...@@ -69,7 +69,7 @@ EXTEND ...@@ -69,7 +69,7 @@ EXTEND
in let branches= exp loc (Match(assign,[pat_nil,branche])) in let branches= exp loc (Match(assign,[pat_nil,branche]))
in let xt=exp loc (Xtrans (e,[(mk loc(And(mk loc(PatVar(U.mk "$$$")),p))),branches])) in let xt=exp loc (Xtrans (e,[(mk loc(And(mk loc(PatVar(U.mk "$$$")),p))),branches]))
in let rf=exp loc(Ref(cst_nil,mk loc (Regexp in let rf=exp loc(Ref(cst_nil,mk loc (Regexp
(Star(Elem(p)),pat_nil)))) (Star(Elem p)))))
in exp loc(Match(rf,[mk loc(PatVar(U.mk"$stack")), in exp loc(Match(rf,[mk loc(PatVar(U.mk"$stack")),
exp loc(Match(xt, exp loc(Match(xt,
[mk loc(Internal Types.any), [mk loc(Internal Types.any),
......
...@@ -282,7 +282,7 @@ type derecurs_slot = { ...@@ -282,7 +282,7 @@ type derecurs_slot = {
| PRecord of bool * (derecurs * derecurs option) label_map | PRecord of bool * (derecurs * derecurs option) label_map
| PCapture of id | PCapture of id
| PConstant of id * Types.const | PConstant of id * Types.const
| PRegexp of derecurs_regexp * derecurs | PRegexp of derecurs_regexp
and derecurs_regexp = and derecurs_regexp =
| PEpsilon | PEpsilon
| PElem of derecurs | PElem of derecurs
...@@ -292,9 +292,6 @@ and derecurs_regexp = ...@@ -292,9 +292,6 @@ and derecurs_regexp =
| PStar of derecurs_regexp | PStar of derecurs_regexp
| PWeakStar of derecurs_regexp | PWeakStar of derecurs_regexp
let pregexp r q = PRegexp (r,q)
type descr = type descr =
| IDummy | IDummy
| IType of Types.descr | IType of Types.descr
...@@ -360,8 +357,8 @@ let rec hash_derecurs = function ...@@ -360,8 +357,8 @@ let rec hash_derecurs = function
11 + 17 * (Id.hash x) 11 + 17 * (Id.hash x)
| PConstant (x,c) -> | PConstant (x,c) ->
12 + 17 * (Id.hash x) + 257 * (Types.Const.hash c) 12 + 17 * (Id.hash x) + 257 * (Types.Const.hash c)
| PRegexp (p,q) -> | PRegexp p ->
13 + 17 * (hash_derecurs_regexp p) + 257 * (hash_derecurs q) 13 + 17 * (hash_derecurs_regexp p)
and hash_derecurs_field = function and hash_derecurs_field = function
| (p, Some e) -> 1 + 17 * hash_derecurs p + 257 * hash_derecurs e | (p, Some e) -> 1 + 17 * hash_derecurs p + 257 * hash_derecurs e
| (p, None) -> 2 + 17 * hash_derecurs p | (p, None) -> 2 + 17 * hash_derecurs p
...@@ -401,8 +398,8 @@ let rec equal_derecurs p1 p2 = (p1 == p2) || match p1,p2 with ...@@ -401,8 +398,8 @@ let rec equal_derecurs p1 p2 = (p1 == p2) || match p1,p2 with
Id.equal x1 x2 Id.equal x1 x2
| PConstant (x1,c1), PConstant (x2,c2) -> | PConstant (x1,c1), PConstant (x2,c2) ->
(Id.equal x1 x2) && (Types.Const.equal c1 c2) (Id.equal x1 x2) && (Types.Const.equal c1 c2)
| PRegexp (p1,q1), PRegexp (p2,q2) -> | PRegexp p1, PRegexp p2 ->
(equal_derecurs_regexp p1 p2) && (equal_derecurs q1 q2) equal_derecurs_regexp p1 p2
| _ -> false | _ -> false
and equal_derecurs_field r1 r2 = match (r1,r2) with and equal_derecurs_field r1 r2 = match (r1,r2) with
| (p1,None),(p2,None) -> equal_derecurs p1 p2 | (p1,None),(p2,None) -> equal_derecurs p1 p2
...@@ -595,17 +592,18 @@ let rec derecurs env p = match p.descr with ...@@ -595,17 +592,18 @@ let rec derecurs env p = match p.descr with
PRecord (o, parse_record env.penv_tenv p.loc aux r) PRecord (o, parse_record env.penv_tenv p.loc aux r)
| Constant (x,c) -> PConstant (x,const env.penv_tenv p.loc c) | Constant (x,c) -> PConstant (x,const env.penv_tenv p.loc c)
| Cst c -> PType (Types.constant (const env.penv_tenv p.loc c)) | Cst c -> PType (Types.constant (const env.penv_tenv p.loc c))
| Regexp (r,q) -> | Regexp r ->
let r,_ = derecurs_regexp IdSet.empty false IdSet.empty env r in let r,_ = derecurs_regexp IdSet.empty false IdSet.empty true env r in
PRegexp (r, derecurs env q) PRegexp r
(* Note: computing remove_regexp here is slower (because (* Note: computing remove_regexp here is slower (because
of caching ?) *) of caching ?) *)
and derecurs_regexp vars b rvars env = function and derecurs_regexp vars b rvars f env = function
(* - vars: seq variables to be propagated top-down and added (* - vars: seq variables to be propagated top-down and added
to each captured element to each captured element
- b: below a star ? - b: below a star ?
- rvars: seq variables that appear on the right of the regexp - rvars: seq variables that appear on the right of the regexp
- f: tail position
returns the set of seq variable of the regexp minus rvars returns the set of seq variable of the regexp minus rvars
(they have already been terminated if not below a star) (they have already been terminated if not below a star)
...@@ -617,26 +615,28 @@ and derecurs_regexp vars b rvars env = function ...@@ -617,26 +615,28 @@ and derecurs_regexp vars b rvars env = function
| Guard p -> | Guard p ->
PGuard (derecurs env p), IdSet.empty PGuard (derecurs env p), IdSet.empty
| Seq (p1,p2) -> | Seq (p1,p2) ->
let (p2,v2) = derecurs_regexp vars b rvars env p2 in let (p2,v2) = derecurs_regexp vars b rvars f env p2 in
let (p1,v1) = derecurs_regexp vars b (IdSet.cup rvars v2) env p1 in let (p1,v1) = derecurs_regexp vars b (IdSet.cup rvars v2) false env p1 in
PSeq (p1,p2), IdSet.cup v1 v2 PSeq (p1,p2), IdSet.cup v1 v2
| Alt (p1,p2) -> | Alt (p1,p2) ->
let (p1,v1) = derecurs_regexp vars b rvars env p1 let (p1,v1) = derecurs_regexp vars b rvars f env p1
and (p2,v2) = derecurs_regexp vars b rvars env p2 in and (p2,v2) = derecurs_regexp vars b rvars f env p2 in
PAlt (termin b (IdSet.diff v2 v1) p1, termin b (IdSet.diff v1 v2) p2), PAlt (termin b (IdSet.diff v2 v1) p1, termin b (IdSet.diff v1 v2) p2),
IdSet.cup v1 v2 IdSet.cup v1 v2
| Star p -> | Star p ->
let (p,v) = derecurs_regexp vars true rvars env p in let (p,v) = derecurs_regexp vars true rvars false env p in
termin b v (PStar p), v termin b v (PStar p), v
| WeakStar p -> | WeakStar p ->
let (p,v) = derecurs_regexp vars true rvars env p in let (p,v) = derecurs_regexp vars true rvars false env p in
termin b v (PWeakStar p), v termin b v (PWeakStar p), v
| SeqCapture (x,p) -> | SeqCapture (x,p) ->
let vars = IdSet.add x vars in let vars = if f then vars else IdSet.add x vars in
let after = IdSet.mem rvars x in let after = IdSet.mem rvars x in
let rvars = IdSet.add x rvars in let rvars = IdSet.add x rvars in
let (p,v) = derecurs_regexp vars b rvars env p in let (p,v) = derecurs_regexp vars b rvars false env p in
termin (after || b) (IdSet.singleton x) p, (if f
then PSeq (PGuard (PCapture x), p)
else termin (after || b) (IdSet.singleton x) p),
(if after then v else IdSet.add x v) (if after then v else IdSet.add x v)
...@@ -735,7 +735,7 @@ and real_compile = function ...@@ -735,7 +735,7 @@ and real_compile = function
| PRecord (o,r) -> IRecord (o, LabelMap.map compile_field r) | PRecord (o,r) -> IRecord (o, LabelMap.map compile_field r)
| PConstant (x,v) -> IConstant (x,v) | PConstant (x,v) -> IConstant (x,v)
| PCapture x -> ICapture x | PCapture x -> ICapture x
| PRegexp (r,q) -> compile (remove_regexp r q) | PRegexp r -> compile (remove_regexp r (PType Sequence.nil_type))
and compile_field = function and compile_field = function
| (p, Some e) -> (compile_slot p, Some (compile e)) | (p, Some e) -> (compile_slot p, Some (compile e))
...@@ -1527,12 +1527,12 @@ module Schema_converter = ...@@ -1527,12 +1527,12 @@ module Schema_converter =
let mk_seq_derecurs ~base facets = let mk_seq_derecurs ~base facets =
match facets with match facets with
| { length = Some (v, _) } -> | { length = Some (v, _) } ->
pregexp (mk_len_regexp ~min:v ~max:v base) nil_type PRegexp (mk_len_regexp ~min:v ~max:v base)
| { minLength = Some (v, _); maxLength = None } -> | { minLength = Some (v, _); maxLength = None } ->
pregexp (mk_len_regexp ~min:v base) nil_type PRegexp (mk_len_regexp ~min:v base)
| { minLength = None; maxLength = Some (v, _) } -> | { minLength = None; maxLength = Some (v, _) } ->
pregexp (mk_len_regexp ~max:v base) nil_type PRegexp (mk_len_regexp ~max:v base)
| _ -> pregexp base nil_type | _ -> PRegexp base
let mix_regexp = let mix_regexp =
let pcdata = PStar (PElem (PType Builtin_defs.string)) in let pcdata = PStar (PElem (PType Builtin_defs.string)) in
...@@ -1642,7 +1642,7 @@ module Schema_converter = ...@@ -1642,7 +1642,7 @@ module Schema_converter =
if mixed then if mixed then
Value.failwith' "Mixed content models aren't supported"; Value.failwith' "Mixed content models aren't supported";
let regexp = regexp_of_particle ~schema particle in let regexp = regexp_of_particle ~schema particle in
pregexp regexp (PType Sequence.nil_type) PRegexp regexp
in in
slot.pdescr <- slot.pdescr <-
PTimes (cd_type_of_attr_uses ~schema ct.ct_attrs, content_ast_node); PTimes (cd_type_of_attr_uses ~schema ct.ct_attrs, content_ast_node);
...@@ -1694,7 +1694,7 @@ module Schema_converter = ...@@ -1694,7 +1694,7 @@ module Schema_converter =
PXml (PType Types.any, cd_type_of_complex_type' ~schema ct) PXml (PType Types.any, cd_type_of_complex_type' ~schema ct)
let cd_type_of_model_group ~schema g = let cd_type_of_model_group ~schema g =
pregexp (regexp_of_model_group ~schema g) nil_type PRegexp (regexp_of_model_group ~schema g)
let typ r = Types.descr (do_typ noloc r) let typ r = Types.descr (do_typ noloc r)
......
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