Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
CHARGUERAUD Arthur
cfml
Commits
0dfb5e23
Commit
0dfb5e23
authored
Mar 31, 2016
by
charguer
Browse files
progress_gen
parent
73751081
Changes
15
Hide whitespace changes
Inline
Side-by-side
examples/BasicDemos/Demo.ml
View file @
0dfb5e23
...
...
@@ -33,6 +33,16 @@ let top_fun_poly_pair_homogeneous (x:'a) (y:'a) =
(
x
,
y
)
(********************************************************************)
(* ** Infix functions *)
let
(
+++
)
x
y
=
x
+
y
let
infix_aux
x
y
=
x
+
y
let
(
---
)
=
infix_aux
(********************************************************************)
(* ** Return *)
...
...
generator/characteristic.ml
View file @
0dfb5e23
...
...
@@ -42,12 +42,32 @@ let external_modules_reset () =
external_modules
:=
[]
(*#########################################################################*)
(* ** Idenntifier name renaming conventions *)
(** Convention for naming record types *)
let
record_type_name
name
=
name
^
"_record_"
(** Convention for naming record constructors *)
let
record_constructor
name
=
name
^
"_record_of_"
(** Convention for naming module names*)
let
module_name
name
=
name
^
"_ml"
(*#########################################################################*)
(* ** Lifting of paths *)
let
lift_ident_name
id
=
let
name
=
Ident
.
name
id
in
let
coqname
=
name
^
"_ml"
in
let
coqname
=
module_name
name
in
if
Ident
.
persistent
id
then
external_modules_add
coqname
;
coqname
...
...
@@ -60,7 +80,7 @@ let lift_ident_name id =
let
rec
lift_full_path
=
function
|
Pident
id
->
Pident
(
Ident
.
create
(
lift_ident_name
id
))
|
Pdot
(
p
,
s
,
pos
)
->
Pdot
(
lift_full_path
p
,
"ML"
^
s
,
pos
)
|
Pdot
(
p
,
s
,
pos
)
->
Pdot
(
lift_full_path
p
,
(
module_name
s
)
,
pos
)
|
Papply
(
p1
,
p2
)
->
assert
false
let
lift_path
=
function
...
...
@@ -81,16 +101,6 @@ let lift_full_path_name p =
let
lift_path_name
p
=
Path
.
name
(
lift_path
p
)
(** Convention for naming record types *)
let
record_type_name
name
=
"_"
^
name
(** Convention for naming record constructors *)
let
record_constructor
name
=
"_"
^
name
^
"_of"
(*#########################################################################*)
(* ** Lifting of types *)
...
...
@@ -346,7 +356,10 @@ let exp_find_inlined_primitive e oargs =
when
m
>
0
&&
let
x
=
Path
.
name
f
in
x
=
"Pervasives.mod"
||
x
=
"Pervasives./"
->
find_inlined_primitive
(
Path
.
name
f
)
primitive_special
|
Texp_ident
(
f
,
d
)
,
_
->
find_inlined_primitive
(
Path
.
name
f
)
(
List
.
length
args
)
let
r
=
find_inlined_primitive
(
Path
.
name
f
)
(
List
.
length
args
)
in
(* debug: Printf.printf "exp_find_inlined_primitive: %s %d\n" (Path.name f) (List.length args);
if r = None then Printf.printf "failed\n"; *)
r
|
_
->
None
let
exp_is_inlined_primitive
e
oargs
=
...
...
@@ -495,6 +508,47 @@ let rec pattern_ident p =
let
pattern_name
p
=
Ident
.
name
(
pattern_ident
p
)
(** Auxiliary function for encoding infix function names *)
let
infix_name_symbols
=
[
'
!
'
,
'
a'
;
'
$
'
,
'
b'
;
'
%
'
,
'
c'
;
'
&
'
,
'
d'
;
'
*
'
,
'
e'
;
'
+
'
,
'
f'
;
'
-
'
,
'
g'
;
'.'
,
'
h'
;
'
/
'
,
'
i'
;
'
:
'
,
'
j'
;
'
<
'
,
'
k'
;
'
=
'
,
'
l'
;
'
>
'
,
'
m'
;
'
?
'
,
'
n'
;
'
@
'
,
'
o'
;
'
^
'
,
'
p'
;
'
|
'
,
'
q'
;
'
~
'
,
'
r'
]
let
infix_name_encode
name
=
let
gen
=
String
.
map
(
fun
c
->
try
List
.
assoc
c
infix_name_symbols
with
Not_found
->
failwith
(
"infix_name_encode: cannot encode name: "
^
name
))
name
in
"infix_"
^
gen
^
"_"
(** Takes a function name and encodes its name in case of an infix operator *)
let
pattern_name_protect_infix
p
=
let
name
=
pattern_name
p
in
let
n
=
String
.
length
name
in
let
r
=
if
n
>
0
&&
List
.
mem_assoc
name
.
[
0
]
infix_name_symbols
then
infix_name_encode
name
else
name
in
(* debug: Printf.printf "protect %s as %s\n" name r;*)
r
(** An alternative version of function extract_label_names, for obtaining record labels *)
let
rec
extract_label_names_simple
env
ty
=
...
...
@@ -567,7 +621,7 @@ let rec cfg_exp env e =
List.fold_left (fun (pat,bod) acc -> Ident.add (pattern_ident pat) 0 acc) env pat_expr_list *)
|
Default
->
unsupported
"Default recursion mode"
in
let
ncs
=
List
.
map
(
fun
(
pat
,
bod
)
->
(
pattern_name
pat
,
cfg_func
env'
fvs
pat
bod
))
pat_expr_list
in
let
ncs
=
List
.
map
(
fun
(
pat
,
bod
)
->
(
pattern_name
_protect_infix
pat
,
cfg_func
env'
fvs
pat
bod
))
pat_expr_list
in
let
cf_body
=
cfg_exp
env'
body
in
add_used_label
(
fst
(
List
.
hd
ncs
));
Cf_letfunc
(
ncs
,
cf_body
)
...
...
@@ -577,8 +631,7 @@ let rec cfg_exp env e =
end
else
begin
if
(
List
.
length
pat_expr_list
<>
1
)
then
not_normal
()
;
let
(
pat
,
bod
)
=
List
.
hd
pat_expr_list
in
let
x
=
pattern_name
pat
in
(* todo: une diffrence entre pattern_name et pattern_ident utils plus bas? *)
let
x
=
pattern_name_protect_infix
pat
in
let
fvs_typ
,
typ
=
lift_typ_sch
pat
.
pat_type
in
let
fvs
=
List
.
map
name_of_type
fvs
in
let
fvs_strict
=
list_intersect
fvs
fvs_typ
in
...
...
@@ -714,7 +767,7 @@ and cfg_func env fvs pat bod =
get_typed_args
((
pattern_name
p1
,
coq_typ_pat
p1
)
::
acc
)
e1
|
_
->
List
.
rev
acc
,
e
in
let
f
=
pattern_name
pat
in
let
f
=
pattern_name
_protect_infix
pat
in
let
targs
,
body
=
get_typed_args
[]
bod
in
let
typ
=
coq_typ
body
in
let
cf_body
=
cfg_exp
env
body
in
...
...
@@ -762,7 +815,7 @@ let rec cfg_structure_item s : cftops =
List.fold_left (fun (pat,bod) acc -> Ident.add (pattern_ident pat) 0 acc) env pat_expr_list *)
|
Default
->
unsupported
"Default recursion mode"
in
let
ncs
=
List
.
map
(
fun
(
pat
,
bod
)
->
(
pattern_name
pat
,
cfg_func
env'
fvs
pat
bod
))
pat_expr_list
in
let
ncs
=
List
.
map
(
fun
(
pat
,
bod
)
->
(
pattern_name
_protect_infix
pat
,
cfg_func
env'
fvs
pat
bod
))
pat_expr_list
in
(
List
.
map
(
fun
(
name
,_
)
->
Cftop_val
(
name
,
val_type
))
ncs
)
@
(
List
.
map
(
fun
(
name
,
cf_body
)
->
Cftop_fun_cf
(
name
,
cf_body
))
ncs
)
@
[
Cftop_coqs
(
List
.
map
(
fun
(
name
,_
)
->
register_cf
name
)
ncs
)]
...
...
@@ -770,7 +823,7 @@ let rec cfg_structure_item s : cftops =
(* let-binding of a single value *)
end
else
if
(
List
.
length
pat_expr_list
=
1
)
then
begin
(* later: check it is not a function *)
let
(
pat
,
bod
)
=
List
.
hd
pat_expr_list
in
let
x
=
pattern_name
pat
in
let
x
=
pattern_name
_protect_infix
pat
in
if
(
hack_recognize_okasaki_lazy
x
)
then
[]
else
begin
let
fvs_typ
,
typ
=
lift_typ_sch
pat
.
pat_type
in
let
fvs
=
List
.
map
name_of_type
fvs
in
...
...
@@ -844,7 +897,7 @@ let rec cfg_structure_item s : cftops =
[
Cftop_coqs
[
Coqtop_require_import
(
lift_full_path_name
path
)
]
]
|
Tstr_primitive
(
id
,
descr
)
->
let
id
=
lift_i
dent
_
name
id
in
let
id
=
I
dent
.
name
id
in
let
fvs
,
typ
=
lift_typ_sch
descr
.
val_desc
.
ctyp_type
in
let
typ
=
coq_fun_types
fvs
typ
in
[
Cftop_val
(
id
,
typ
)
]
...
...
@@ -1171,7 +1224,8 @@ and cfg_type_decls (decls : (Ident.t * Typedtree.type_declaration) list) =
and
cfg_structure
s
=
reset_used_labels
()
;
let
body
=
list_concat_map
(
fun
si
->
reset_names
()
;
cfg_structure_item
si
)
s
.
str_items
in
cfg_extract_labels
()
@
body
(* cfg_extract_labels() @ *)
body
(** Generate the top-level Coq declarations associated with
a Caml signature definition. *)
...
...
generator/main.ml
View file @
0dfb5e23
...
...
@@ -75,7 +75,7 @@ let _ =
|
Some
f
->
f
in
let
debugdir
=
Filename
.
concat
dirname
"output"
in
let
debugdir
=
Filename
.
concat
dirname
"
_
output"
in
let
debugdirBase
=
Filename
.
concat
debugdir
(
String
.
capitalize
basename
)
in
(* FAILURE ON WINDOWS *)
let
cmd
=
Printf
.
sprintf
"mkdir -p %s"
debugdir
in
...
...
@@ -108,11 +108,14 @@ let _ =
|
None
->
failwith
"Could not typecheck the normalized source code
\n
Check out the file output/_normalized.ml."
|
Some
typedtree2
->
typedtree2
in
file_put_contents
(
debugdirBase
^
"_normalized_typed.ml"
)
(
Print_tast
.
string_of_structure
typedtree2
);
ignore
(
typedtree2
);
(*---------------------------------------------------*)
trace
"5) dumping .cmj file"
;
file_put_contents
(
debugdirBase
^
"_normalized_typed.ml"
)
(
Print_tast
.
string_of_structure
typedtree2
);
(* ignore (typedtree2); *)
if
!
onlycmj
then
begin
trace
"
5
) exiting
after cmj has been generated
"
;
trace
"
6
) exiting
since -onlycmj
"
;
exit
0
;
end
;
...
...
@@ -126,13 +129,16 @@ let _ =
let
coqtops
=
Formula
.
coqtops_of_cftops
cftops
in
(*---------------------------------------------------*)
trace
"7)
printing coq ast
"
;
trace
"7)
dumping debug formula file
"
;
let
result
=
Print_coq
.
tops
coqtops
in
file_put_contents
(
debugdirBase
^
"_formulae.v"
)
result
;
(*---------------------------------------------------*)
trace
"8) dumping .v file"
;
file_put_contents
outputfile
result
;
(*---------------------------------------------------*)
trace
"
8
) characteristic formulae successfully generated
\n
"
trace
"
9
) characteristic formulae successfully generated
\n
"
(*########################################################
...
...
generator/primitives.ml
View file @
0dfb5e23
...
...
@@ -152,6 +152,7 @@ let builtin_constructors_table =
(** Find the inlined primitive associated with [p] of arity [arity] *)
let
find_inlined_primitive
p
arity
=
Printf
.
printf
"find_inlined_primitive: %s %d
\n
"
p
arity
;
match
list_assoc_option
p
inlined_primitives_table
with
|
None
->
None
|
Some
(
n
,
y
)
->
if
n
=
arity
then
Some
y
else
None
...
...
lib/make/Makefile.cf
View file @
0dfb5e23
...
...
@@ -151,7 +151,7 @@ include $(CFML)/lib/make/Makefile.coq
clean
::
rm
-f
*
.cmj
*
_ml.v
*
.vio
*
.d
*
.v.d
*
.vo
*
.vq
*
.aux .
*
.aux
*
.glob
rm
-rf
output
rm
-rf
_
output
# ==> TODO: rename output into _output
examples/S
tdlib/Array.ml
→
s
tdlib/Array.ml
View file @
0dfb5e23
let
make
=
Primitives
.
array_make
let
length
=
Primitives
.
array_length
(* Temporary: because [||] is not supported. *)
external
make_empty
:
unit
->
'
a
array
=
"%array_make_empty"
external
make
:
int
->
'
a
->
'
a
array
=
"%array_make"
external
length
:
'
a
array
->
int
=
"%array_length"
external
get
:
'
a
array
->
int
->
'
a
=
"%array_get"
external
set
:
'
a
array
->
int
->
'
a
->
unit
=
"%array_set"
let
get
=
Primitives
.
array_get
let
set
=
Primitives
.
array_set
let
init
n
f
=
assert
(
n
>=
0
);
if
n
=
0
then
[
||
]
else
begin
let
res
=
creat
e
n
(
f
0
)
in
if
n
=
0
then
make_empty
()
else
begin
let
res
=
mak
e
n
(
f
0
)
in
for
i
=
1
to
pred
n
do
unsafe_
set
res
i
(
f
i
)
set
res
i
(
f
i
)
done
;
res
end
...
...
@@ -21,47 +28,48 @@ let init n f =
let
fill
a
start
nb
v
=
assert
(
not
(
start
<
0
||
nb
<
0
||
start
>
length
a
-
nb
));
for
i
=
start
to
pred
(
start
+
nb
)
do
a
.
(
i
)
<-
v
;
set
a
i
v
;
done
let
blit
a1
start1
a2
start2
nb
=
assert
(
not
(
nb
<
0
||
start1
<
0
||
start1
>
length
a1
-
nb
||
start2
<
0
||
start2
>
length
a2
-
nb
));
for
i
=
0
to
pred
nb
do
a2
.
(
start2
+
i
)
<-
a1
.
(
start1
+
i
);
set
a2
(
start2
+
i
)
(
get
a1
(
start1
+
i
)
)
;
done
let
append
a1
a2
=
let
n1
=
length
a1
in
let
n2
=
length
a2
in
if
n1
=
0
&&
n2
=
0
then
[
||
]
else
begin
let
d
=
(
if
n1
<>
0
then
a1
.
(
0
)
else
a2
.
(
0
)
)
in
if
n1
=
0
&&
n2
=
0
then
make_empty
()
else
begin
let
d
=
(
if
n1
<>
0
then
get
a1
0
else
get
a2
0
)
in
let
a
=
make
(
n1
+
n2
)
d
in
for
i
=
0
to
pred
n1
do
a
.
(
i
)
<-
a1
.
(
i
);
set
a
i
(
get
a1
i
);
done
;
for
i
=
0
to
pred
n2
do
a
.
(
n1
+
i
)
<-
a2
.
(
i
)
set
a
(
n1
+
i
)
(
get
a2
i
)
;
done
;
a
end
(* Remark: might be optimized by using a sub-array to avoid initialization *)
let
iter
f
a
=
for
i
=
0
to
pred
(
length
a
)
do
f
a
.
(
i
)
f
(
get
a
i
)
done
let
iteri
f
a
=
for
i
=
0
to
pred
(
length
a
)
do
f
i
a
.
(
i
)
f
i
(
get
a
i
)
done
let
map
f
a
=
let
n
=
length
a
in
if
n
=
0
then
[
||
]
else
begin
let
r
=
make
n
(
f
a
.
(
0
))
in
if
n
=
0
then
make_empty
()
else
begin
let
r
=
make
n
(
f
(
get
a
0
))
in
for
i
=
1
to
pred
n
do
r
.
(
i
)
<-
f
a
.
(
i
);
set
r
i
(
f
(
get
a
i
)
);
done
;
r
end
...
...
@@ -69,10 +77,10 @@ let map f a =
let
mapi
f
a
=
let
n
=
length
a
in
if
n
=
0
then
[
||
]
else
begin
let
r
=
make
n
(
f
0
a
.
(
0
))
in
if
n
=
0
then
make_empty
()
else
begin
let
r
=
make
n
(
f
0
(
get
a
0
))
in
for
i
=
1
to
pred
n
do
r
.
(
i
)
<-
f
i
a
.
(
i
);
set
r
i
(
f
i
(
get
a
i
)
);
done
;
r
end
...
...
@@ -81,13 +89,17 @@ let mapi f a =
let
fold_left
f
x
a
=
let
r
=
ref
x
in
for
i
=
0
to
pred
(
length
a
)
do
r
:=
f
!
r
a
.
(
i
)
r
:=
f
!
r
(
get
a
i
)
done
;
!
r
(* TODO: add support for downto in CFML
let fold_right f a x =
let r = ref x in
for i = pred (length a) downto 0 do
r
:=
f
a
.
(
i
)
!
r
r := f
(get a
i) !r
done;
!r
*)
examples/S
tdlib/Array_proof.v
→
s
tdlib/Array_proof.v
View file @
0dfb5e23
File moved
examples/S
tdlib/List.ml
→
s
tdlib/List.ml
View file @
0dfb5e23
...
...
@@ -15,7 +15,7 @@ let tl = function
let
length
l
=
let
rec
aux
len
=
function
|
[]
->
len
|
a
::
l
->
length_
aux
(
len
+
1
)
l
|
a
::
l
->
aux
(
len
+
1
)
l
in
aux
0
l
...
...
@@ -48,7 +48,7 @@ let rev l =
let
rec
concat
=
function
|
[]
->
[]
|
l
::
r
->
l
@
flatten
r
|
l
::
r
->
l
@
concat
r
let
rec
iter
f
=
function
...
...
@@ -76,7 +76,7 @@ let mapi f l =
let
r
=
f
i
a
in
r
::
aux
(
i
+
1
)
l
in
mapi
0
f
l
aux
0
l
(* USEFUL?
let rev_map f l =
...
...
@@ -115,7 +115,7 @@ let rec find p = function
let
filter
p
l
=
let
rec
aux
acc
=
function
|
[]
->
rev
acc
|
a
::
l
->
if
p
a
then
aux
(
a
::
acc
)
l
else
find
acc
l
|
a
::
l
->
if
p
a
then
aux
(
a
::
acc
)
l
else
aux
acc
l
in
aux
[]
l
...
...
@@ -148,7 +148,7 @@ let take n l =
if
n
=
0
then
[]
else
begin
match
l
with
|
[]
->
assert
false
|
a
::
l
->
a
::
(
aux
(
n
-
1
)
l
)
in
|
a
::
l
->
a
::
(
aux
(
n
-
1
)
l
)
end
in
aux
n
l
...
...
@@ -159,7 +159,7 @@ let drop n l =
if
n
=
0
then
l
else
begin
match
l
with
|
[]
->
assert
false
|
a
::
l
->
aux
(
n
-
1
)
l
in
|
a
::
l
->
aux
(
n
-
1
)
l
end
in
aux
n
l
...
...
examples/S
tdlib/List_proof.v
→
s
tdlib/List_proof.v
View file @
0dfb5e23
File moved
stdlib/Makefile
0 → 100644
View file @
0dfb5e23
##############################################################
# Parameters
READLINK
=
$(
shell
if
hash
greadlink 2>/dev/null
;
then
echo
greadlink
;
else
echo readlink
;
fi
)
# Path to CFML relative to immediate subfolders of $(CFML)/examples.
CFML
:=
..
# Absolute path to CFML.
CFML
:=
$(
shell
$(READLINK)
-f
$(CFML)
)
# Include any local settings.
-include
$(CFML)/settings.sh
ifeq
($(findstring $(MAKECMDGOALS),clean),)
include
$(CFML)/lib/make/Makefile.tools
endif
ifndef
COQINCLUDE
COQINCLUDE
:=
-R
$(CFML)
/lib/coq/ CFML
-R
$(CFML)
/lib/tlc/ TLC
-R
.
EXAMPLE
endif
ifndef
OCAML_FLAGS
OCAML_FLAGS
:=
# e.g. -rectypes
endif
COQC
:=
$(COQBIN)
coqc
# TODO :needed?
# OCAMLDEP := $(OCAMLBIN)ocamldep
# OCAMLPOST := $(CFML)/lib/make/ocamldep.post
##############################################################
# Files
# ML := $(filter-out myocamlbuild.ml,$(shell ls *.ml))
ML
:=
$(
shell
ls
*
.ml
)
CMJ
:=
$(
patsubst
%.ml,%.cmj,
$(ML)
)
MLV
:=
$(
patsubst
%.ml,%_ml.v,
$(ML)
)
MLVIO
:=
$(
patsubst
%.ml,%_ml.vio,
$(ML)
)
MLVO
:=
$(
patsubst
%.ml,%_ml.vo,
$(ML)
)
D
:=
$(
patsubst
%.ml,%.d,
$(ML)
)
##############################################################
# Targets
all
:
cmj vo
quick
:
cmj vio
cmj
:
$(CMJ)
vo
:
$(MLVO)
vio
:
$(MLVIO)
tools
:
@
$(MAKE)
-C
$(CFML)
--no-print-directory
tools
##############################################################
# CMJ/MLV generation rules
# TODO: use per-file flags hack
Pervasives.cmj
:
Pervasives.ml $(CFML_MLV)
# Make sure CFML tools are up-to-date.
# Needed only when developing CFML. Ideally, should be removed.
@$(MAKE)
-C
$(CFML)
--no-print-directory
tools
$(CFML_MLV)
$(OCAML_FLAGS)
-nostdlib
-nopervasives
-I
.
$<
||
(rm
-f
$@;
exit
1)
# note: we need to delete the cmj file if mlv has failed
%.cmj
:
%.ml Pervasives.cmj $(CFML_MLV)
# Needed only when developing CFML. Ideally, should be removed.
@$(MAKE)
-C
$(CFML)
--no-print-directory
tools
$(CFML_MLV)
$(OCAML_FLAGS)
-nostdlib
-I
.
$<
||
(rm
-f
$@;
exit
1)
##############################################################
# Coq compilation rules
# We use Coq to produce a .vio file out of a .v file.
# We declare a dependency on the .cmj file, since %_ml.v is not known to "make".
Array_ml.vo List_ml.vo
:
Pervasives_ml.vo
Array_ml.vio List_ml.vio
:
Pervasives_ml.vio
%_ml.vo
:
%.cmj
$(COQC)
$(COQINCLUDE)
$*
_ml.v
%_ml.vio
:
%.cmj
$(COQC)
-quick
$(COQINCLUDE)
$*
_ml.v
# V := $(MLV)
# include $(CFML)/lib/make/Makefile.coq
##############################################################
# Cleanup
# Do not delete intermediate files.
.SECONDARY
:
.PRECIOUS
:
*.vio
clean
::
@
make
CFML
=
$(CFML)
-f
$(CFML)
/lib/make/Makefile.cf clean
examples/S
tdlib/Pervasives.ml
→
s
tdlib/Pervasives.ml
View file @
0dfb5e23
(************************************************************)
(** Exception *)
external
raise
:
exn
->
'
a
=
"%raise"
(************************************************************)
(** Type conversion *)
external
magic
:
'
a
->
'
b
=
"%magic"
(************************************************************)
(** Boolean *)
let
not
x
=
if
x
then
false
else
true
(************************************************************)
(** Physical equality *)
...
...
@@ -22,12 +38,12 @@ let ( !== ) = physical_neq
(************************************************************)
(** Comparison *)
let
compare_eq
:
'
a
->
'
a
->
bool
=
"%compare_eq"
let
compare_neq
:
'
a
->
'
a
->
bool
=
"%compare_neq"
let
compare_lt
:
'
a
->
'
a
->
bool
=
"%compare_lt"
let
compare_gt
:
'
a
->
'
a
->
bool
=
"%compare_gt"
let
compare_le
:
'
a
->
'
a
->
bool
=
"%compare_le"
let
compare_ge
:
'
a
->
'
a
->
bool
=
"%compare_ge"
external
compare_eq
:
'
a
->
'
a
->
bool
=
"%compare_eq"
external
compare_neq
:
'
a
->
'
a
->
bool
=
"%compare_neq"
external
compare_lt
:
'
a
->
'
a
->
bool
=
"%compare_lt"
external
compare_gt
:
'
a
->
'
a
->
bool
=
"%compare_gt"
external
compare_le
:
'
a
->
'
a
->
bool
=
"%compare_le"
external
compare_ge
:
'
a
->
'
a
->
bool
=
"%compare_ge"
let
(
=
)
=
compare_eq
let
(
<>
)
=
compare_neq
...
...
@@ -53,6 +69,34 @@ let ( && ) = bool_and
let
(
||
)
=
bool_or
(************************************************************)
(** Integer *)
external
int_neg
:
int
->
int
=
"%int_neg"
external
int_add
:
int
->
int
->
int
=
"%int_add"