Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
0f360c53
Commit
0f360c53
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2003-12-08 14:42:50 by cmiachon] ajout de / , /@ et d une premiere version de //
Original author: cmiachon Date: 2003-12-08 14:42:50+00:00
parent
89ae00c2
Changes
1
Hide whitespace changes
Inline
Side-by-side
query/query_parse.ml
View file @
0f360c53
...
...
@@ -11,7 +11,16 @@ open Query
let
exp
pos
e
=
LocatedExpr
(
loc_of_pos
pos
,
e
)
let
cst_nil
=
Const
Sequence
.
nil_cst
let
parse_ident
=
U
.
mk
let
id_dummy
=
ident
(
U
.
mk
"$$$"
)
let
label
=
parse_ident
let
rec
multi_prod
loc
=
function
|
[
x
]
->
x
|
x
::
l
->
mk
loc
(
Prod
(
x
,
multi_prod
loc
l
))
|
[]
->
assert
false
EXTEND
GLOBAL
:
expr
pat
keyword
;
...
...
@@ -34,7 +43,53 @@ EXTEND
if
!
Query
.
nooptim
then
Query
.
select
(
loc
,
fin
,
l
)
else
Query
.
selectOpt
(
loc
,
fin
,
l
,
condi
)
]
];
]
|
[
e
=
expr
;
"/"
;
t
=
[
a
=
pat
->
let
tag
=
mk
loc
(
Internal
(
Types
.
atom
(
Atoms
.
any
)))
in
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
a
)
,
Elem
any
))
in
let
ct
=
mk
loc
(
Regexp
(
re
,
any
))
in
let
p
=
mk
loc
(
XmlT
(
tag
,
multi_prod
loc
[
att
;
ct
]))
in
(
p
,
Var
(
Id
.
value
id_dummy
))
|
"@"
;
a
=
[
IDENT
|
keyword
]
->
(* projection sur 1 attribut *)
let
tag
=
mk
loc
(
Internal
(
Types
.
atom
Atoms
.
any
))
in
let
any
=
mk
loc
(
Internal
(
Types
.
any
))
in
let
att
=
mk
loc
(
Record
(
true
,
[(
label
a
,
mk
loc
(
PatVar
(
U
.
mk
"$$$"
)))]))
in
let
ct
=
mk
loc
(
Regexp
(
Elem
any
,
any
))
in
let
p
=
mk
loc
(
XmlT
(
tag
,
multi_prod
loc
[
att
;
ct
]))
in
(
p
,
Pair
(
Var
(
Id
.
value
id_dummy
)
,
cst_nil
))
]
->
exp
loc
(
Transform
(
e
,
[
t
]))
|
e
=
expr
;
"/"
;
"/"
;
p
=
pat
->
(* projections sur tous les descendants *)
let
assign
=
exp
loc
(
Apply
(
Dot
(
Var
(
U
.
mk
"$stack"
)
,
U
.
mk
"set"
)
,
(
Pair
(
Var
(
U
.
mk
"$$$"
)
,
(
Apply
(
Dot
(
Var
(
U
.
mk
"$stack"
)
,
U
.
mk
"get"
)
,
cst_nil
))))))
in
let
branche
=
Pair
(
Var
(
Id
.
value
id_dummy
)
,
cst_nil
)
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
))))
in
exp
loc
(
Match
(
rf
,
[
mk
loc
(
PatVar
(
U
.
mk
"$stack"
))
,
exp
loc
(
Match
(
xt
,
[
mk
loc
(
Internal
Types
.
any
)
,
exp
loc
(
Apply
(
Dot
(
Var
(
U
.
mk
"$stack"
)
,
U
.
mk
"get"
)
,
cst_nil
))]))
]))
(* equivalent as:
let $stack=ref [p*] []
in let _ = xtransform e with
$$$ & p -> $stack := [ $$$ ; !$stack] ; [$$$]
in !stack;;
NB: order is inversed
*)
]
];
cond
:
[
[
a
=
expr
->
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment