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
093f0462
Commit
093f0462
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2002-11-08 23:26:40 by cvscast] Empty log message
Original author: cvscast Date: 2002-11-08 23:26:40+00:00
parent
01d26c82
Changes
4
Hide whitespace changes
Inline
Side-by-side
parser/parser.ml
View file @
093f0462
...
...
@@ -23,7 +23,10 @@ let rec tuple loc = function
|
[
x
]
->
x
|
x
::
l
->
mk
(
x
.
loc
)
(
Pair
(
x
,
tuple
loc
l
))
|
[]
->
assert
false
let
tuple_queue
=
List
.
fold_right
(
fun
x
q
->
mk
x
.
loc
(
Pair
(
x
,
q
)))
let
char
=
mk
noloc
(
Internal
(
Types
.
char
Chars
.
any
))
let
string_regexp
=
Star
(
Elem
char
)
...
...
@@ -124,8 +127,12 @@ EXTEND
|
"("
;
l
=
LIST1
expr
SEP
","
;
")"
->
tuple
loc
l
|
"["
;
l
=
LIST0
seq_elem
;
e
=
OPT
[
";"
;
e
=
expr
->
e
];
"]"
->
let
e
=
match
e
with
Some
e
->
e
|
None
->
cst_nil
in
let
l
=
List
.
flatten
l
in
tuple
loc
(
l
@
[
e
])
List
.
fold_right
(
fun
x
q
->
match
x
with
|
`Elems
l
->
tuple_queue
l
q
|
`Explode
x
->
mk
x
.
loc
(
Op
(
"@"
,
[
x
;
q
]))
)
l
e
|
t
=
[
a
=
TAG
->
mk
loc
(
Cst
(
Types
.
Atom
(
Types
.
AtomPool
.
mk
a
)))
|
"<"
;
e
=
expr
LEVEL
"no_appl"
->
e
];
...
...
@@ -134,15 +141,16 @@ EXTEND
|
"{"
;
r
=
[
expr_record_spec
|
->
mk
loc
(
RecordLitt
[]
)
];
"}"
->
r
|
s
=
STRING2
->
tuple
loc
(
char_list
loc
s
@
[
cst_nil
])
|
"!"
;
t
=
pat
->
mk
loc
(
DebugTyper
t
)
(*
| "!"; t = pat -> mk loc (DebugTyper t)
*)
|
a
=
LIDENT
->
mk
loc
(
Var
a
)
]
];
seq_elem
:
[
[
x
=
STRING1
->
char_list
loc
x
|
e
=
expr
LEVEL
"no_appl"
->
[
e
]
[
x
=
STRING1
->
`Elems
(
char_list
loc
x
)
|
e
=
expr
LEVEL
"no_appl"
->
`Elems
[
e
]
|
"!"
;
e
=
expr
LEVEL
"no_appl"
->
`Explode
e
]
];
...
...
tests/biblio.cd
View file @
093f0462
...
...
@@ -35,7 +35,7 @@ let fun do_biblio (Biblio -> Html)
in
<html>
[
<head>
[
<title>
h ]
<body>
body ]
in
let bib =
let bib
: Biblio
=
<bibliography>
[
<heading>
"Alain Frisch's bibliography"
<paper>
[
...
...
tests/eval_concat.cd
View file @
093f0462
...
...
@@ -10,3 +10,5 @@ let fun h (x : [Int*] | ([Int*] -> [Int*])) : [Int*] = x [ 1 2 3 ];;
h [ 10 20 ];;
h (fun (x : [Int*]) : [Int*] = [ 100 200 ] x);;
(* 'explode' subsequences *)
[ 1 2 3 ![4 5 6] 7 8 9 ];;
types/types.ml
View file @
093f0462
...
...
@@ -320,11 +320,17 @@ let get_record r =
let
diff_t
d
t
=
diff
d
(
descr
t
)
let
cap_t
d
t
=
cap
d
(
descr
t
)
let
cup_t
d
t
=
cup
d
(
descr
t
)
let
cap_product
l
=
List
.
fold_left
(
fun
(
d1
,
d2
)
(
t1
,
t2
)
->
(
cap_t
d1
t1
,
cap_t
d2
t2
))
(
any
,
any
)
l
let
cup_product
l
=
List
.
fold_left
(
fun
(
d1
,
d2
)
(
t1
,
t2
)
->
(
cup_t
d1
t1
,
cup_t
d2
t2
))
(
empty
,
empty
)
l
module
Assumptions
=
Set
.
Make
(
struct
type
t
=
descr
let
compare
=
compare
end
)
...
...
@@ -369,7 +375,16 @@ and empty_rec_times_aux (left,right) =
in
let
(
accu1
,
accu2
)
=
cap_product
left
in
(
empty_rec
accu1
)
||
(
empty_rec
accu2
)
||
(
try
aux
accu1
accu2
right
;
true
with
NotEmpty
->
false
)
(* OPT? It does'nt seem so ... The hope was to return false quickly
for large right hand-side *)
(
((
*
if
(
List
length
right
>
2
)
then
let
(
cup1
,
cup2
)
=
cup_product
right
in
(
empty_rec
(
diff
accu1
cup1
))
&&
(
empty_rec
(
diff
accu2
cup2
))
else
*
)
true
)
&&
(
try
aux
accu1
accu2
right
;
true
with
NotEmpty
->
false
)
)
and
empty_rec_arrow
c
=
List
.
for_all
empty_rec_arrow_aux
c
...
...
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