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
c6236954
Commit
c6236954
authored
Oct 22, 2022
by
Kim Nguyễn
Browse files
Test result update and reformating.
parent
0e7b9efe
Changes
11
Expand all
Hide whitespace changes
Inline
Side-by-side
tests/full/good/addrbook.t/run.t
View file @
c6236954
...
...
@@ -6,6 +6,5 @@
val
print_value
:
Any
->
[
]
val
mkTelListAcc
:
Addrbook
->
[
(
Name
Tel
)
*
]
$
cduce
--
run
addrbook
.
cdo
Uncaught
CDuce
exception:
"
File
\"
cduce/types/charSet.ml
\"
, line 158, characters 10-16: Assertion failed
"
[
1
]
[
<
name
>
[
'
Benjamin Pierce
'
]
<
tel
>
[
'
123-456-789
'
]
]
[
<
name
>
[
'
Benjamin Pierce
'
]
<
tel
>
[
'
123-456-789
'
]
]
tests/full/good/list.t/run.t
View file @
c6236954
...
...
@@ -2,7 +2,7 @@
val
init
:
Int
->
(
Int
->
'
a) -> [
'
a
*
]
val
sort
:
('
a ->
'
a
->
Int
)
->
[
'
a* ] -> [
'
a
*
]
val
iter
:
('
a -> [ ]) -> [
'
a
*
]
->
[
]
val
flatten
:
X1
->
[
'
a* ] where X1 =
'
a
\
[
Any
*
]
|
[
X1
*
]
val
flatten
:
X1
->
[
'
a* ] where X1 =
[ X1* ] |
'
a
\
[
Any
*
]
val
concat
:
[
'
a* ] -> [
'
b
*
]
->
[
'
a*
'
b
*
]
val
rev
:
[
'
a* ] -> [
'
a
*
]
val
rev_append
:
[
'
a* ] -> [
'
b
*
]
->
[
('
a |
'
b
)
*
]
...
...
tests/full/good/patricia.t/run.t
View file @
c6236954
...
...
@@ -3,13 +3,13 @@
val
update
:
'
a ->
'
a
->
'
a
val iter : (
'
a
->
[
])
->
Dict
('
a) -> [ ]
val iteri : (Caml_int ->
'
a
->
[
])
->
Dict
('
a) -> [ ]
val merge : (
'
a
->
'
a ->
'
a
)
->
(
Dict
('
a),Dict (
'
a
))
->
<
leaf
key
=
Caml_int
>
'
a |
<brch bit=Caml_int pre=Caml_int>X1 | [ ] where X1 = [ X2 X2 ] and
X2 =
<leaf key=Caml_int>
'
a
|
<
brch
bit
=
Caml_int
pre
=
Caml_int
>
X1
val merge : (
'
a
->
'
a ->
'
a
)
->
(
Dict
('
a),Dict (
'
a
))
->
<
brch
bit
=
Caml_int
pre
=
Caml_int
>
X1
|
<
leaf
key
=
Caml_int
>
'
a |
[ ] where X1 = [ X2 X2 ] and
X2 = <brch bit=Caml_int pre=Caml_int>X1
| <leaf key=Caml_int>
'
a
val
swap
:
X1
->
X1
where
X1
=
'
a ->
'
a
->
'
a
val max :
'
a
->
'
b ->
'
a
|
'
b
val insert : (
'
a
->
'
a ->
'
a
)
->
Caml_int
->
'
a -> Dict (
'
a
)
->
Leaf
('
a) |
Branch
(
'
a
)
val
join
:
Caml_int
->
X1
->
Caml_int
->
X2
->
Branch
('
a) where X1 =
<leaf key=Caml_int>
'
a
|
<
brch
bit
=
Caml_int
pre
=
Caml_int
>
[
X1
X1
]
and
X2
=
<
leaf
key
=
Caml_int
>
'
a |
<brch bit=Caml_int pre=Caml_int>[ X2 X2 ]
val insert : (
'
a
->
'
a ->
'
a
)
->
Caml_int
->
'
a -> Dict (
'
a
)
->
Branch
('
a) |
Leaf
(
'
a
)
val
join
:
Caml_int
->
X1
->
Caml_int
->
X2
->
Branch
('
a) where X1 = <brch bit=Caml_int pre=Caml_int>[ X1 X1 ]
| <leaf key=Caml_int>
'
a
and
X2
=
<
brch
bit
=
Caml_int
pre
=
Caml_int
>
[
X2
X2
]
|
<
leaf
key
=
Caml_int
>
'
a
val lookup : Caml_int -> Dict (
'
a
)
->
[
'
a? ]
val zero_bit : Caml_int -> Caml_int -> Bool
val match_prefix : Caml_int -> Caml_int -> Caml_int -> Bool
...
...
tests/full/good/poly-ok.t/run.t
View file @
c6236954
...
...
@@ -9,8 +9,8 @@
val
max
:
'
a ->
'
a
->
'
a
val f :
'
a
|
'
b |
'
c
->
(
*--
0
|
4
--*
)
&
'
d &
'
e
->
Any
val
sum
:
Int
->
Int
->
Int
val
f
:
('
a ->
'
a
->
'
a) ->
'
a
->
A
('
a) |
B
(
'
a
)
->
A
('
a)
val x : Int -> X1 -> <a>Int where X1 = <
a>Int | <b>[ X1 ]
val
f
:
('
a ->
'
a
->
'
a) ->
'
a
->
B
('
a) |
A
(
'
a
)
->
A
('
a)
val x : Int -> X1 -> <a>Int where X1 = <
b>[ X1 ] | <a>Int
val f : B (
'
a
)
->
'
a
val v : 32
$ cduce --run poly-ok.cdo
tests/full/good/red-black.t/run.t
View file @
c6236954
$
cduce
--
verbose
--
compile
red
-
black
.
cd
val
cardinal
:
(
<
black
elem
=
'
a>[ (RBtree (
'
a
))
(
RBtree
('
a)) ]
| <red elem=
'
a
>
[
X1
X1
]
->
1
--*
)
&
([
]
->
0
)
where
X1
=
<
black
elem
=
'
a>[ (RBtree (
'
a
))
(
RBtree
('
a)) ] | [ ]
val
cardinal
:
(
<
red
elem
=
'
a>[ X1 X1 ] |
<black elem=
'
a
>
[
(
RBtree
('
a)) (RBtree (
'
a
))
]
->
1
--*
)
&
([
]
->
0
)
where
X1
=
<
black
elem
=
'
a>[ (RBtree (
'
a
))
(
RBtree
('
a)) ] | [ ]
val singleton :
'
a
->
Btree
('
a)
val member : (
'
a
->
RBtree
('
a) -> Bool) & (
'
a
->
[
]
->
`
false)
val iter : ('a -> [ ]) -> RBtree ('a) -> [ ]
val is_empty : (Any
\
[ ] ->
`
false
)
&
([
]
->
`
true)
val insert : 'a -> Btree ('a) -> <black elem='a>X1 where X1 = [ X2 X2 ] and
X2 =
<black elem='a>X1 |
<red elem='a>[ (Btree ('a)) (Btree ('a)) ] | [ ]
val balance : ('b
\
<black elem=Any>[ <red elem=Any>[ <red elem=Any>X
1 X5 | X8
<red elem=Any>X11
]
X15
| X17
<red elem=Any>[ <red elem=Any>X
19 X23 | X26
<red elem=Any>X2
9 ]
] -> 'b
\
Unbalanced (Any)) & (Unbalanced ('a) -> Rtree ('a)) where X1 = [ X
4
X
4
] and
X2 = [ X
3
X
3
] and
X3 =
<black elem=Any>X2 | <red elem=Any>X1 | [
] and
X4 = <black elem=Any>X
2
| [ ] and
X5 = <black elem=Any>X
6
| [ ] and
X6 = [ X
7
X
7
] and
X7 =
<black elem=Any>X6 | <red elem=Any>
[ X
5
X
5 ] | [
] and
X8 = <black elem=Any>X
9
| [ ] and
X9 =
[ X10 X10
] and
X10 =
<black elem=Any>X9 | <red elem=Any>[ X8 X8 ] | [
] and
X11 = [ X1
4
X1
4
] and
X12 =
[ X13 X13
] and
X13 = <black elem=Any>X1
2 | <red elem=Any>X11
| [ ] and
X14 =
<black elem=Any>X12 | [
] and
X15 = <black elem=Any>
[ X15 X15 ] | <red elem=Any>[ X16 X16 ]
| [ ] and
X16 = <
black
elem=Any>[ X15 X15 ] | [ ] and
X17 =
<black elem=Any>
[ X1
7
X1
7 ] | <red elem=Any>[ X18 X18 ] | [
] and
X18 = <black elem=Any>
[
X17
X17 ]
| [ ] and
X19 =
[ X22 X22
] and
X20 = [ X2
1
X2
1
] and
X21 =
<black elem=Any>X20 | <red elem=Any>X19 | [
] and
X22 = <black elem=Any>X20 | [ ] and
X23 = <black elem=Any>X2
4
| [ ] and
X24 = [ X2
5
X2
5
] and
X25 =
<black elem=Any>X24 | <red elem=Any>
[ X2
3
X2
3 ] | [
] and
X26 = <black elem=Any>X2
7
| [ ] and
X27 =
[ X28 X28
] and
X28 =
<black elem=Any>X27 | <red elem=Any>[ X26 X26 ] | [
] and
X29 =
[ X32 X32
] and
X30 =
[ X31 X31
] and
X31 = <
black
elem=Any>
X30 | <red elem=Any>X29
| [ ] and
X32 = <black elem=Any>
X30
| [ ]
X2 = <red elem='a>[ (Btree ('a)) (Btree ('a)) ] |
<black elem='a>X1 |
[ ]
val balance : ('b
\
<black elem=Any>[
X1
<red elem=Any>[
X4
<red elem=Any>X
7 |
<red elem=Any>X11 X15
] |
<red elem=Any>[
X18
<red elem=Any>X
21 |
<red elem=Any>X2
5 X29 ] X31
] -> 'b
\
Unbalanced (Any)) & (Unbalanced ('a) -> Rtree ('a)) where X1 =
<red elem=Any>
[ X
2
X
2 ] | <black elem=Any>[ X1 X1 ] | [
] and
X2 =
<black elem=Any>
[ X
1
X
1 ] | [
] and
X3 =
[ X5 X5
] and
X4 = <black elem=Any>X
3
| [ ] and
X5 =
<red elem=Any>[ X4 X4 ] |
<black elem=Any>X
3
| [ ] and
X6 = [ X
8
X
8
] and
X7 = [ X
9
X
9
] and
X8 =
<red elem=Any>X7 |
<black elem=Any>X
6
| [ ] and
X9 =
<black elem=Any>X6 | [
] and
X10 =
[ X12 X12
] and
X11 = [ X1
3
X1
3
] and
X12 =
<red elem=Any>X11 | <black elem=Any>X10 | [
] and
X13 = <black elem=Any>X1
0
| [ ] and
X14 =
[ X16 X16
] and
X15 = <black elem=Any>
X14
| [ ] and
X16 = <
red
elem=Any>[ X15 X15 ] |
<black elem=Any>X14 |
[ ] and
X17 = [ X1
9
X1
9
] and
X18 = <black elem=Any>X17 | [ ] and
X19 =
<red elem=Any>[ X18 X18 ] | <black elem=Any>X17 | [
] and
X20 = [ X2
2
X2
2
] and
X21 =
[ X23 X23
] and
X22 =
<red elem=Any>X21 |
<black elem=Any>X20 | [ ] and
X23 = <black elem=Any>X2
0
| [ ] and
X24 = [ X2
6
X2
6
] and
X25 = [ X2
7
X2
7
] and
X26 =
<red elem=Any>X25 |
<black elem=Any>X2
4
| [ ] and
X27 =
<black elem=Any>X24 | [
] and
X28 =
[ X30 X30
] and
X29 =
<black elem=Any>X28 | [
] and
X30 =
<red elem=Any>[ X29 X29 ] | <black elem=Any>X28 | [
] and
X31 = <
red
elem=Any>
[ X32 X32 ] | <black elem=Any>[ X31 X31 ]
| [ ] and
X32 = <black elem=Any>
[ X31 X31 ]
| [ ]
$ cduce --run red-black.cdo
1
4
...
...
tests/full/good/web_site.t/run.t
View file @
c6236954
$
cduce
--
verbose
--
compile
web_site
.
cd
val
input
:
[
'
../../../common/site.xml
'
]
val
outdir
:
[
]
val
input
:
[
'
../../../common/site.xml
'
]
val
load_include
:
Latin1
->
[
Any
*
]
val
extra_head
:
[
H_script
*
]
val
main_page
:
Page
val
footer
:
[
Item
*
]
val
header
:
[
(
<
global_header
>
Content
Item
*
)?
]
val
main_page
:
Page
val
site
:
String
val
split_comma
:
String
->
[
String
*
]
val
xhighlight
:
String
->
[
(
H_strong
|
H_i
|
Char
)
*
]
val
highlight
:
String
->
[
(
H_strong
|
H_i
|
Char
)
*
]
val
xhighlight
:
String
->
[
(
H_
i
|
H_
strong
|
Char
)
*
]
val
highlight
:
String
->
[
(
H_
i
|
H_
strong
|
Char
)
*
]
val
split_thumbnails
:
String
->
Namespaces
val
hwbox
:
[
Flow
'
lef
t
'
|
Flow
'
righ
t
'
]
->
Block
val
hwbox_title
:
[
Flow
String
String
'
lef
t
'
|
Flow
String
String
'
righ
t
'
]
->
Block
val
hwbox
:
[
Flow
'
righ
t
'
|
Flow
'
lef
t
'
]
->
Block
val
hwbox_title
:
[
Flow
String
String
'
righ
t
'
|
Flow
String
String
'
lef
t
'
]
->
Block
val
box
:
Flow
->
Block
val
box_title
:
[
Flow
String
Char
*
]
->
Block
val
meta
:
Flow
->
Block
...
...
@@ -22,11 +22,11 @@
val
display_sitemap
:
Tree
->
H_li
val
ol
:
([
H_li
*
],{
style
=
?
String
})
->
[
H_ol
?
]
val
ul
:
[
H_li
*
]
->
[
H_ul
?
]
val
compute_sitemap
:
External
|
Page
->
Tree
val
compute_sitemap
:
Page
|
External
->
Tree
val
local_link
:
[
Tree
String
Char
*
]
->
[
Inline
?
]
val
find_local_link
:
[
[
Tree
*
]
Char
*
]
->
Tree
val
authors
:
[
Author
+
]
->
Flow
val
render
:
String
->
{
presenter
=
?[
'
yes
'
|
'
no
'
]
..
}
->
Flow
val
render
:
String
->
{
presenter
=
?[
'
no
'
|
'
yes
'
]
..
}
->
Flow
val
url_of_page
:
Page
->
String
val
gen_page_seq
:
(
String
,(
PageO
,([
Page
*
],(
PageO
,(
Path
,
Tree
)))))
->
(
PageO
,
PageO
)
val
gen_page
:
(
String
,(
PageO
,(
Page
,(
PageO
,(
Path
,
Tree
)))))
->
PageO
...
...
tests/type_printer/good/test1.t/run.t
View file @
c6236954
...
...
@@ -16,14 +16,14 @@
-----
printed
and
reparsed
correctly
OK:
type
X1
where
X1
=
(`
c
,(
S2,S2
)) | (
`
s
,(
X1,X1
)) | `e
X1
where
X1
=
(`
s
,(
X1,X1
)) | (
`
c
,(
S2
,
S2
))
|
`
e
-----printed and reparsed correctly
OK:
type
((
`
d
,(`
e,Any)) -> (
`
c
,(`
a,
`
a
)))
&
((`
c,(
`
e
,
Any
))
->
(`
c,(
`
e
,`
e))) &
((
`
d
,
X3
)
->
(`
c,(
`
b
,`
b))) & ((
`
c
,
X3
)
->
(`
c,(X2,X2))) &
((
`
c
,(
X1
,
Any
))
->
(`
c,(X1,X1))) & (
`
e
->
`
e) where
X1 = Any
\
((
`
d
,(
S
1
,
S
1
))
|
(`
c
,(S
2
,S
2
)) |
`
e
)
and
X2
=
(`
d
,(S
1
,S
1
)) | (
`
c
,(
S
2
,
S
2
))
and
X1 = Any
\
((
`
c
,(
S
2
,
S
2
))
|
(`
d
,(S
1
,S
1
)) |
`
e
)
and
X2
=
(`
c
,(S
2
,S
2
)) | (
`
d
,(
S
1
,
S
1
))
and
X3
=
(
X2
,
Any
)
-----
printed
and
reparsed
correctly
tests/type_printer/good/xhtml-strict.t/run.t
View file @
c6236954
This diff is collapsed.
Click to expand it.
types/subst.ml
View file @
c6236954
...
...
@@ -187,7 +187,7 @@ let _v_string = function
|
`Neg
v
->
Format
.
asprintf
"`Neg %a"
Var
.
print
v
|
_
->
"`Not_var"
let
check_var_aux
(
vrs
:
Var
.
Set
.
t
)
t
=
let
check_var_aux
(
vrs
:
Var
.
Set
.
t
)
t
=
let
res
=
match
(
vrs
:>
Var
.
t
list
)
with
|
[]
...
...
types/types.ml
View file @
c6236954
...
...
@@ -160,13 +160,13 @@ module Descr = struct
if
a
.
hash
>=
0
then
a
.
hash
else
let
accu
=
Bdd
.
VarCharSet
.
hash
a
.
chars
in
let
accu
=
(
accu
+
accu
lsl
4
)
+
Bdd
.
VarIntervals
.
hash
a
.
ints
in
let
accu
=
(
accu
+
accu
lsl
4
)
+
Bdd
.
VarAtomSet
.
hash
a
.
atoms
in
let
accu
=
(
accu
+
accu
lsl
4
)
+
BoolPair
.
hash
a
.
times
in
let
accu
=
(
accu
+
accu
lsl
4
)
+
BoolPair
.
hash
a
.
xml
in
let
accu
=
(
accu
+
accu
lsl
4
)
+
BoolPair
.
hash
a
.
arrow
in
let
accu
=
(
accu
+
accu
lsl
4
)
+
BoolRec
.
hash
a
.
record
in
let
accu
=
(
accu
+
accu
lsl
4
)
+
Bdd
.
VarAbstractSet
.
hash
a
.
abstract
in
let
accu
=
accu
+
(
accu
lsl
4
)
+
Bdd
.
VarIntervals
.
hash
a
.
ints
in
let
accu
=
accu
+
(
accu
lsl
4
)
+
Bdd
.
VarAtomSet
.
hash
a
.
atoms
in
let
accu
=
accu
+
(
accu
lsl
4
)
+
BoolPair
.
hash
a
.
times
in
let
accu
=
accu
+
(
accu
lsl
4
)
+
BoolPair
.
hash
a
.
xml
in
let
accu
=
accu
+
(
accu
lsl
4
)
+
BoolPair
.
hash
a
.
arrow
in
let
accu
=
accu
+
(
accu
lsl
4
)
+
BoolRec
.
hash
a
.
record
in
let
accu
=
accu
+
(
accu
lsl
4
)
+
Bdd
.
VarAbstractSet
.
hash
a
.
abstract
in
let
accu
=
if
a
.
absent
then
accu
+
5
else
accu
in
let
accu
=
max_int
land
accu
in
let
()
=
a
.
hash
<-
accu
in
...
...
types/var.ml
View file @
c6236954
...
...
@@ -25,7 +25,7 @@ let print ppf v = Format.fprintf ppf "'%s" v.name
module
Set
=
struct
include
SortedList
.
Make
(
V
)
let
print
ppf
(
s
:
t
)
=
let
print
ppf
(
s
:
t
)
=
let
open
Format
in
fprintf
ppf
"%a"
(
pp_print_list
~
pp_sep
:
(
fun
ppf
()
->
fprintf
ppf
",@ "
)
print
)
...
...
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