Commit e4ca1b20 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 54599eec
......@@ -108,8 +108,7 @@ and ppat' =
| Optional of ppat
| Record of bool * (label * (ppat * ppat option)) list
| Constant of id * pexpr
| Regexp of regexp * ppat
(* regular expression, continuation: [ re ; cont ], e.g: [ re ; nil ] *)
| Regexp of regexp
and regexp =
| Epsilon
......
......@@ -269,7 +269,7 @@ EXTEND
let att = mk loc (Internal Types.Record.any) in
let any = mk loc (Internal (Types.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 b = (p, Var (Id.value id_dummy)) in
exp loc (Transform (e,[b]))
......@@ -540,9 +540,16 @@ EXTEND
| "`"; c = tag_type -> c
| "("; l = LIST1 pat SEP ","; ")" -> multi_prod loc l
| "["; r = [ r = regexp -> r | -> Epsilon ];
q = [ ";"; q = pat -> q
| -> pat_nil ];
"]" -> mk loc (Regexp (r,q))
q = [ ";"; q = pat -> Some q
| -> None ];
"]" ->
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 =
[ x = tag_type -> x
| "("; t = pat; ")" -> t ];
......
......@@ -83,7 +83,7 @@ mais pas prioritaire [] -> ""
((LabelPool.value s)))^"="^string_of_ppat(ppat)^listing r
)in listing (lm) *)
|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 =
in
List.fold_left aux [] lm
|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
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 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")),
exp loc(Match(xt,
[mk loc(Internal Types.any),
......
......@@ -282,7 +282,7 @@ type derecurs_slot = {
| PRecord of bool * (derecurs * derecurs option) label_map
| PCapture of id
| PConstant of id * Types.const
| PRegexp of derecurs_regexp * derecurs
| PRegexp of derecurs_regexp
and derecurs_regexp =
| PEpsilon
| PElem of derecurs
......@@ -292,9 +292,6 @@ and derecurs_regexp =
| PStar of derecurs_regexp
| PWeakStar of derecurs_regexp
let pregexp r q = PRegexp (r,q)
type descr =
| IDummy
| IType of Types.descr
......@@ -360,8 +357,8 @@ let rec hash_derecurs = function
11 + 17 * (Id.hash x)
| PConstant (x,c) ->
12 + 17 * (Id.hash x) + 257 * (Types.Const.hash c)
| PRegexp (p,q) ->
13 + 17 * (hash_derecurs_regexp p) + 257 * (hash_derecurs q)
| PRegexp p ->
13 + 17 * (hash_derecurs_regexp p)
and hash_derecurs_field = function
| (p, Some e) -> 1 + 17 * hash_derecurs p + 257 * hash_derecurs e
| (p, None) -> 2 + 17 * hash_derecurs p
......@@ -401,8 +398,8 @@ let rec equal_derecurs p1 p2 = (p1 == p2) || match p1,p2 with
Id.equal x1 x2
| PConstant (x1,c1), PConstant (x2,c2) ->
(Id.equal x1 x2) && (Types.Const.equal c1 c2)
| PRegexp (p1,q1), PRegexp (p2,q2) ->
(equal_derecurs_regexp p1 p2) && (equal_derecurs q1 q2)
| PRegexp p1, PRegexp p2 ->
equal_derecurs_regexp p1 p2
| _ -> false
and equal_derecurs_field r1 r2 = match (r1,r2) with
| (p1,None),(p2,None) -> equal_derecurs p1 p2
......@@ -595,17 +592,18 @@ let rec derecurs env p = match p.descr with
PRecord (o, parse_record env.penv_tenv p.loc aux r)
| Constant (x,c) -> PConstant (x,const env.penv_tenv p.loc c)
| Cst c -> PType (Types.constant (const env.penv_tenv p.loc c))
| Regexp (r,q) ->
let r,_ = derecurs_regexp IdSet.empty false IdSet.empty env r in
PRegexp (r, derecurs env q)
| Regexp r ->
let r,_ = derecurs_regexp IdSet.empty false IdSet.empty true env r in
PRegexp r
(* Note: computing remove_regexp here is slower (because
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
to each captured element
- b: below a star ?
- 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
(they have already been terminated if not below a star)
......@@ -617,26 +615,28 @@ and derecurs_regexp vars b rvars env = function
| Guard p ->
PGuard (derecurs env p), IdSet.empty
| Seq (p1,p2) ->
let (p2,v2) = derecurs_regexp vars b rvars env p2 in
let (p1,v1) = derecurs_regexp vars b (IdSet.cup rvars v2) env p1 in
let (p2,v2) = derecurs_regexp vars b rvars f env p2 in
let (p1,v1) = derecurs_regexp vars b (IdSet.cup rvars v2) false env p1 in
PSeq (p1,p2), IdSet.cup v1 v2
| Alt (p1,p2) ->
let (p1,v1) = derecurs_regexp vars b rvars env p1
and (p2,v2) = derecurs_regexp vars b rvars env p2 in
let (p1,v1) = derecurs_regexp vars b rvars f env p1
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),
IdSet.cup v1 v2
| 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
| 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
| 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 rvars = IdSet.add x rvars in
let (p,v) = derecurs_regexp vars b rvars env p in
termin (after || b) (IdSet.singleton x) p,
let (p,v) = derecurs_regexp vars b rvars false env p in
(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)
......@@ -735,7 +735,7 @@ and real_compile = function
| PRecord (o,r) -> IRecord (o, LabelMap.map compile_field r)
| PConstant (x,v) -> IConstant (x,v)
| 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
| (p, Some e) -> (compile_slot p, Some (compile e))
......@@ -1527,12 +1527,12 @@ module Schema_converter =
let mk_seq_derecurs ~base facets =
match facets with
| { 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 } ->
pregexp (mk_len_regexp ~min:v base) nil_type
PRegexp (mk_len_regexp ~min:v base)
| { minLength = None; maxLength = Some (v, _) } ->
pregexp (mk_len_regexp ~max:v base) nil_type
| _ -> pregexp base nil_type
PRegexp (mk_len_regexp ~max:v base)
| _ -> PRegexp base
let mix_regexp =
let pcdata = PStar (PElem (PType Builtin_defs.string)) in
......@@ -1642,7 +1642,7 @@ module Schema_converter =
if mixed then
Value.failwith' "Mixed content models aren't supported";
let regexp = regexp_of_particle ~schema particle in
pregexp regexp (PType Sequence.nil_type)
PRegexp regexp
in
slot.pdescr <-
PTimes (cd_type_of_attr_uses ~schema ct.ct_attrs, content_ast_node);
......@@ -1694,7 +1694,7 @@ module Schema_converter =
PXml (PType Types.any, cd_type_of_complex_type' ~schema ct)
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)
......
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