Skip to content
GitLab
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
1ae5d9ce
Commit
1ae5d9ce
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2003-05-11 11:36:01 by cvscast] Changed ttree into xtransform. BEPPE
Original author: cvscast Date: 2003-05-11 11:36:01+00:00
parent
7caa2d6e
Changes
6
Hide whitespace changes
Inline
Side-by-side
parser/ast.ml
View file @
1ae5d9ce
...
...
@@ -43,7 +43,7 @@ and pexpr =
|
Op
of
string
*
pexpr
list
|
Match
of
pexpr
*
branches
|
Map
of
pexpr
*
branches
|
T
tr
ee
of
pexpr
*
branches
|
X
tr
ans
of
pexpr
*
branches
|
Dot
of
pexpr
*
label
|
RemoveField
of
pexpr
*
label
...
...
parser/parser.ml
View file @
1ae5d9ce
...
...
@@ -134,7 +134,7 @@ EXTEND
Op
(
"raise"
,
[
Var
(
ident
"x"
)])
in
exp
loc
(
Try
(
e
,
b
@
[
default
]))
|
"map"
;
e
=
SELF
;
"with"
;
b
=
branches
->
exp
loc
(
Map
(
e
,
b
))
|
"
ttree
"
;
e
=
SELF
;
"with"
;
b
=
branches
->
exp
loc
(
T
tr
ee
(
e
,
b
))
|
"
xtransform
"
;
e
=
SELF
;
"with"
;
b
=
branches
->
exp
loc
(
X
tr
ans
(
e
,
b
))
|
"if"
;
e
=
SELF
;
"then"
;
e1
=
SELF
;
"else"
;
e2
=
SELF
->
let
p1
=
mk
loc
(
Internal
(
Builtin
.
true_type
))
and
p2
=
mk
loc
(
Internal
(
Builtin
.
false_type
))
in
...
...
runtime/eval.ml
View file @
1ae5d9ce
...
...
@@ -53,7 +53,7 @@ let rec eval env e0 =
|
Typed
.
Cst
c
->
const
c
|
Typed
.
Match
(
arg
,
brs
)
->
eval_branches
env
brs
(
eval
env
arg
)
|
Typed
.
Map
(
arg
,
brs
)
->
eval_map
env
brs
(
eval
env
arg
)
|
Typed
.
T
tr
ee
(
arg
,
brs
)
->
eval_
t
tr
ee
env
brs
(
eval
env
arg
)
|
Typed
.
X
tr
ans
(
arg
,
brs
)
->
eval_
x
tr
ans
env
brs
(
eval
env
arg
)
|
Typed
.
Op
(
"raise"
,
[
e
])
->
raise
(
CDuceExn
(
eval
env
e
))
|
Typed
.
Try
(
arg
,
brs
)
->
(
try
eval
env
arg
with
CDuceExn
v
->
eval_branches
env
brs
v
)
...
...
@@ -128,9 +128,9 @@ and eval_transform env brs = function
|
String_latin1
(
_
,_,_,_
)
|
String_utf8
(
_
,_,_,_
)
as
v
->
eval_transform
env
brs
(
normalize
v
)
|
q
->
q
and
eval_
t
tr
ee
env
brs
=
function
and
eval_
x
tr
ans
env
brs
=
function
|
Pair
(
x
,
y
)
->
let
y
=
eval_
t
tr
ee
env
brs
y
in
(* Beware of evaluation order !! Reverse it ? *)
let
y
=
eval_
x
tr
ans
env
brs
y
in
(* Beware of evaluation order !! Reverse it ? *)
(
try
let
x
=
eval_branches
env
brs
x
in
(* TODO: avoid raising exceptions (for each character/element !) *)
...
...
@@ -138,12 +138,12 @@ and eval_ttree env brs = function
with
EMatchFail
->
let
x
=
match
x
with
|
Xml
(
tag
,
Pair
(
attr
,
child
))
->
let
child
=
eval_
t
tr
ee
env
brs
child
in
let
child
=
eval_
x
tr
ans
env
brs
child
in
Xml
(
tag
,
Pair
(
attr
,
child
))
|
Xml
(
_
,_
)
->
assert
false
|
x
->
x
in
Pair
(
x
,
y
))
|
String_latin1
(
_
,_,_,_
)
|
String_utf8
(
_
,_,_,_
)
as
v
->
eval_
t
tr
ee
env
brs
(
normalize
v
)
|
String_latin1
(
_
,_,_,_
)
|
String_utf8
(
_
,_,_,_
)
as
v
->
eval_
x
tr
ans
env
brs
(
normalize
v
)
(* TODO: optimize for strings, to avoid decomposing compound String values *)
|
q
->
q
...
...
tests/
t
tr
ee
.cd
→
tests/
x
tr
ans
.cd
View file @
1ae5d9ce
include "../web/xhtml-strict.cd";;
(*
let fun f (x : Xhtml) : [ Xhtml ] =
ttree [ x ] with <a>t -> [];;
*)
xtransform [ x ] with <a>t -> [];;
(*
let fun g (x : Xhtml) : [ Xhtml ] =
ttree [ x ] with <a>t -> [ <b>t ];;
*)
xtransform [ x ] with <a>t -> [ <b>t ];;
(*
type T = <a>[ <b>[] T* <b>[] ];;
type S = <a>[ <x>[] S* <x>[] ];;
let fun f (x : [ T ]) : [ S ] =
ttree
x with <b>_ -> [ <x>[] ];;
xtransform
x with <b>_ -> [ <x>[] ];;
let x = f [ <a>[ <b>[] <b>[] ] ];;
*)
typing/typed.ml
View file @
1ae5d9ce
...
...
@@ -36,7 +36,7 @@ and texpr' =
|
Op
of
string
*
texpr
list
|
Match
of
texpr
*
branches
|
Map
of
texpr
*
branches
|
T
tr
ee
of
texpr
*
branches
|
X
tr
ans
of
texpr
*
branches
|
RemoveField
of
texpr
*
label
|
Dot
of
texpr
*
label
...
...
typing/typer.ml
View file @
1ae5d9ce
...
...
@@ -567,11 +567,11 @@ let rec expr loc = function
let
(
fv1
,
e
)
=
expr
loc
e
and
(
fv2
,
b
)
=
branches
b
in
exp
loc
(
Fv
.
cup
fv1
fv2
)
(
Typed
.
Map
(
e
,
b
))
|
T
tr
ee
(
e
,
b
)
->
|
X
tr
ans
(
e
,
b
)
->
let
b
=
b
@
[
mknoloc
(
Internal
Types
.
any
)
,
MatchFail
]
in
let
(
fv1
,
e
)
=
expr
loc
e
and
(
fv2
,
b
)
=
branches
b
in
exp
loc
(
Fv
.
cup
fv1
fv2
)
(
Typed
.
T
tr
ee
(
e
,
b
))
exp
loc
(
Fv
.
cup
fv1
fv2
)
(
Typed
.
X
tr
ans
(
e
,
b
))
|
MatchFail
->
exp
loc
(
Fv
.
empty
)
Typed
.
MatchFail
|
Try
(
e
,
b
)
->
...
...
@@ -837,7 +837,7 @@ and compute_type' loc env = function
|
Op
(
op
,
el
)
->
let
args
=
List
.
map
(
fun
e
->
(
e
.
exp_loc
,
compute_type
env
e
))
el
in
type_op
loc
op
args
|
T
tr
ee
(
e
,
b
)
->
|
X
tr
ans
(
e
,
b
)
->
let
t
=
type_check
env
e
Sequence
.
any
true
in
let
r
=
Sequence
.
map_tree
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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