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
08c96461
Commit
08c96461
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2005-03-06 19:02:15 by afrisch] Record concatenation in types
Original author: afrisch Date: 2005-03-06 19:02:15+00:00
parent
48ac778a
Changes
4
Hide whitespace changes
Inline
Side-by-side
CHANGES
View file @
08c96461
...
...
@@ -26,7 +26,8 @@ Since 0.2.2
- the ";" between fields is optional even for records
(used to be optional only for attributes)
* Keywords are now allowed as type names
* Concatenatiom @ allowed in types
* Concatenation @ allowed in types
* Record concatenation + allowed in types
- Tools:
* A new tool cduce_mktop produces customized CDuce toplevels with embedded
...
...
parser/ast.ml
View file @
08c96461
...
...
@@ -113,6 +113,7 @@ and ppat' =
|
Constant
of
U
.
t
*
pexpr
|
Regexp
of
regexp
|
Concat
of
ppat
*
ppat
|
Merge
of
ppat
*
ppat
and
regexp
=
|
Epsilon
...
...
parser/parser.ml
View file @
08c96461
...
...
@@ -554,7 +554,8 @@ EXTEND
(
la
,
a
,
y
)
]
SEP
"and"
->
mk
loc
(
Recurs
(
x
,
b
))
]
|
RIGHTA
[
x
=
pat
;
"->"
;
y
=
pat
->
mk
loc
(
Arrow
(
x
,
y
))
|
x
=
pat
;
"@"
;
y
=
pat
->
mk
loc
(
Concat
(
x
,
y
))
]
|
x
=
pat
;
"@"
;
y
=
pat
->
mk
loc
(
Concat
(
x
,
y
))
|
x
=
pat
;
"+"
;
y
=
pat
->
mk
loc
(
Merge
(
x
,
y
))
]
|
"no_arrow"
[
x
=
pat
;
"|"
;
y
=
pat
->
mk
loc
(
Or
(
x
,
y
))
]
|
"simple"
[
x
=
pat
;
"&"
;
y
=
pat
->
mk
loc
(
And
(
x
,
y
))
|
x
=
pat
;
"
\\
"
;
y
=
pat
->
mk
loc
(
Diff
(
x
,
y
))
]
...
...
typing/typer.ml
View file @
08c96461
...
...
@@ -282,6 +282,7 @@ module IType = struct
|
ICapture
of
id
|
IConstant
of
id
*
Types
.
const
|
IConcat
of
node
*
node
|
IMerge
of
node
*
node
let
rec
node_temp
=
{
desc
=
ILink
node_temp
;
...
...
@@ -310,7 +311,7 @@ module IType = struct
257
*
(
LabelMap
.
hash
(
hash_field
f
)
r
)
|
ICapture
x
->
10
+
17
*
(
Id
.
hash
x
)
|
IConstant
(
x
,
c
)
->
11
+
17
*
(
Id
.
hash
x
)
+
257
*
(
Types
.
Const
.
hash
c
)
|
IConcat
(
p1
,
p2
)
->
assert
false
|
IConcat
_
|
IMerge
_
->
assert
false
let
hash0
=
hash
(
fun
n
->
1
)
let
hash1
=
hash
hash0
...
...
@@ -526,7 +527,7 @@ module IType = struct
|
IRecord
(
o
,
r
)
->
Types
.
record'
(
o
,
LabelMap
.
map
compute_typ_field
r
)
|
ILink
_
->
assert
false
|
ICapture
_
|
IConstant
(
_
,_
)
->
assert
false
|
IConcat
_
->
assert
false
|
IConcat
_
|
IMerge
_
->
assert
false
and
compute_typ_field
=
function
|
(
s
,
None
)
->
typ_node
s
|
(
s
,
Some
_
)
->
...
...
@@ -586,7 +587,7 @@ module IType = struct
|
IConstant
(
x
,
c
)
->
Patterns
.
constant
x
c
|
IArrow
_
->
raise
(
Patterns
.
Error
"Arrows are not allowed in patterns"
)
|
IType
_
|
ILink
_
|
IConcat
_
->
assert
false
|
IType
_
|
ILink
_
|
IConcat
_
|
IMerge
_
->
assert
false
and
pat_node
n
=
let
n
=
repr
n
in
...
...
@@ -795,6 +796,10 @@ module IType = struct
let
n
=
mk
(
IConcat
(
derecurs
env
p1
,
derecurs
env
p2
))
in
concats
:=
n
::
!
concats
;
n
|
Merge
(
p1
,
p2
)
->
let
n
=
mk
(
IMerge
(
derecurs
env
p1
,
derecurs
env
p2
))
in
concats
:=
n
::
!
concats
;
n
and
derecurs_regexp
vars
b
rvars
f
env
=
function
(* - vars: seq variables to be propagated top-down and added
...
...
@@ -879,11 +884,62 @@ module IType = struct
let
rec
elim_concat
n
=
match
n
.
desc
with
|
IConcat
(
a
,
b
)
->
if
(
n
.
sid
>
0
)
then
raise
(
Patterns
.
Error
"Ill-formed concatenation loop"
);
if
(
n
.
sid
>
0
)
then
raise
(
Patterns
.
Error
"Ill-formed concatenation loop"
);
n
.
sid
<-
1
;
n
.
desc
<-
ILink
(
elim_conc
a
b
)
|
IMerge
(
a
,
b
)
->
if
(
n
.
sid
>
0
)
then
raise
(
Patterns
.
Error
"Ill-formed concatenation loop"
);
n
.
sid
<-
1
;
n
.
desc
<-
ILink
(
elim_merge
a
b
)
|
_
->
()
and
elim_merge
a
b
=
let
get_rec
t
=
let
t
=
Types
.
Record
.
get
t
in
List
.
map
(
fun
(
l
,
o
,_
)
->
o
,
LabelMap
.
map
(
fun
(
opt
,
x
)
->
let
x
=
itype
x
in
(
if
opt
then
mk
(
IOptional
x
)
else
x
)
,
None
)
l
)
t
in
let
merge
(
o1
,
l1
)
(
o2
,
l2
)
=
mk
(
IRecord
(
o1
||
o2
,
LabelMap
.
merge
(
fun
_
x
->
x
)
l1
l2
))
in
(* Problem: repr can loop with ill-formed recursion.
type t = s + t where s = s | s;; *)
match
(
repr
a
)
.
desc
,
(
repr
b
)
.
desc
with
|
IType
(
t1
,_
)
,
IType
(
t2
,_
)
->
if
not
(
Types
.
subtype
t1
Types
.
Record
.
any
)
then
raise
(
Patterns
.
Error
"Left argument of record concatenation is not a record type"
);
if
not
(
Types
.
subtype
t2
Types
.
Record
.
any
)
then
raise
(
Patterns
.
Error
"Right argument of record concatenation is not a record type"
);
itype
(
Types
.
Record
.
merge
t1
t2
)
|
IOr
(
a1
,
a2
)
,
_
->
ior
(
elim_merge
a1
b
)
(
elim_merge
a2
b
)
|
_
,
IOr
(
b1
,
b2
)
->
ior
(
elim_merge
a
b1
)
(
elim_merge
a
b2
)
|
IRecord
(
o1
,
l1
)
,
IRecord
(
o2
,
l2
)
->
merge
(
o1
,
l1
)
(
o2
,
l2
)
|
IType
(
t1
,_
)
,
IRecord
(
o2
,
l2
)
->
if
not
(
Types
.
subtype
t1
Types
.
Record
.
any
)
then
raise
(
Patterns
.
Error
"Left argument of record concatenation is not a record type"
);
List
.
fold_left
(
fun
accu
(
o1
,
l1
)
->
ior
accu
(
merge
(
o1
,
l1
)
(
o2
,
l2
)))
iempty
(
get_rec
t1
)
|
IRecord
(
o1
,
l1
)
,
IType
(
t2
,_
)
->
if
not
(
Types
.
subtype
t2
Types
.
Record
.
any
)
then
raise
(
Patterns
.
Error
"Right argument of record concatenation is not a record type"
);
List
.
fold_left
(
fun
accu
(
o2
,
l2
)
->
ior
accu
(
merge
(
o1
,
l1
)
(
o2
,
l2
)))
iempty
(
get_rec
t2
)
|
_
->
raise
(
Patterns
.
Error
"Cannot compute record concatenation"
)
and
elim_conc
n
q
=
let
mem
=
ref
[]
in
let
rec
aux
n
=
...
...
@@ -892,14 +948,13 @@ module IType = struct
let
r
=
mk_delayed
()
in
mem
:=
(
n
,
r
)
::
!
mem
;
let
rec
aux2
n
=
let
m
=
match
n
.
desc
with
match
n
.
desc
with
|
ILink
n'
->
aux2
n'
|
IOr
(
a
,
b
)
->
ior
(
aux
a
)
(
aux
b
)
|
ITimes
(
a
,
b
)
->
mk
(
ITimes
(
a
,
aux
b
))
|
IConcat
(
a
,
b
)
->
elim_concat
n
;
aux2
n
|
IType
(
t
,_
)
->
elim_concat_type
t
q
|
_
->
assert
false
in
m
|
_
->
raise
(
Patterns
.
Error
"Cannot compute concatenation"
)
in
r
.
desc
<-
ILink
(
aux2
n
);
r
...
...
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