Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
CHARGUERAUD Arthur
cfml
Commits
2c481a82
Commit
2c481a82
authored
Aug 22, 2020
by
charguer
Browse files
mutablepairing
parent
873dcea1
Changes
1
Hide whitespace changes
Inline
Sidebyside
Showing
1 changed file
with
55 additions
and
0 deletions
+55
0
examples/Tour/MutablePairing.ml
examples/Tour/MutablePairing.ml
+55
0
No files found.
examples/Tour/MutablePairing.ml
0 → 100644
View file @
2c481a82
module
Stack
=
struct
type
'
a
t
=
'
a
list
ref
let
create
()
=
ref
[]
let
is_empty
s
=
!
s
=
[]
let
push
x
s
=
s
:=
x
::!
s
let
pop
s
=
match
!
s
with

[]
>
raise
Not_found

x
::
t
>
s
:=
t
;
x
end
type
elem
=
int
type
node
=
{
value
:
elem
;
sub
:
node
Stack
.
t
}
type
contents
=
Empty

Nonempty
of
node
type
heap
=
contents
ref
let
create
()
=
ref
Empty
let
is_empty
p
=
!
p
=
Empty
let
merge
q1
q2
=
if
q1
.
value
<
q2
.
value
then
(
Stack
.
push
q2
q1
.
sub
;
q1
)
else
(
Stack
.
push
q1
q2
.
sub
;
q2
)
let
insert
p
x
=
let
q2
=
{
value
=
x
;
sub
=
Stack
.
create
()
}
in
match
!
p
with

Empty
>
p
:=
Nonempty
q2

Nonempty
q1
>
p
:=
Nonempty
(
merge
q1
q2
)
let
rec
merge_pairs
l
=
let
q1
=
Stack
.
pop
l
in
if
Stack
.
is_empty
l
then
q1
else
let
q2
=
Stack
.
pop
l
in
let
q
=
merge
q1
q2
in
if
Stack
.
is_empty
l
then
q
else
merge
q
(
merge_pairs
l
)
let
pop_min
p
=
match
!
p
with

Empty
>
raise
Not_found

Nonempty
q
>
let
x
=
q
.
value
in
if
Stack
.
is_empty
q
.
sub
then
p
:=
Empty
else
p
:=
Nonempty
(
merge_pairs
q
.
sub
);
x
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