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
9a271256
Commit
9a271256
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2004-02-18 22:58:35 by jdemouth] Some bug fixes... (but still unstable)
Original author: jdemouth Date: 2004-02-18 22:58:35+00:00
parent
68d800dc
Changes
5
Hide whitespace changes
Inline
Side-by-side
cdo2cmo/src/cduce.ml
View file @
9a271256
...
...
@@ -63,17 +63,18 @@ and from_decl left array = function
|
ML_variant
list
->
List
.
fold_left
(
fun
t
(
name
,
list
)
->
let
node
=
CD
.
Types
.
make
()
in
let
atom
=
CD
.
Atoms
.
atom
(
CD
.
Atoms
.
V
.
mk_ascii
name
)
in
let
atom
=
CD
.
Types
.
cons
(
CD
.
Types
.
atom
atom
)
in
CD
.
Types
.
define
node
(
CD
.
Types
.
atom
atom
)
;
let
desc
=
match
list
with
|
[]
->
CD
.
Types
.
descr
atom
CD
.
Types
.
descr
node
|
hd
::
[]
->
let
desc
=
from_desc
left
array
hd
in
CD
.
Types
.
times
atom
desc
CD
.
Types
.
times
node
desc
|
_
->
let
tuple
=
tuple_of_list
left
array
list
in
CD
.
Types
.
times
atom
tuple
CD
.
Types
.
times
node
tuple
in
CD
.
Types
.
cup
t
desc
)
CD
.
Types
.
empty
list
...
...
@@ -81,51 +82,71 @@ and from_decl left array = function
and
from_desc
left
array
=
function
|
ML_arrow
(
lbl
,
d1
,
d2
)
->
let
node
=
CD
.
Types
.
make
()
in
let
l
=
from_desc
true
array
d1
and
r
=
from_desc
false
array
d2
in
CD
.
Types
.
cons
(
CD
.
Types
.
arrow
l
r
)
CD
.
Types
.
define
node
(
CD
.
Types
.
arrow
l
r
);
node
|
ML_bool
->
CD
.
Types
.
cons
(
CD
.
Builtin_defs
.
bool
)
|
ML_ident
(
id
,
params
,
ocaml
)
->
let
node
=
from_ocaml_type
left
params
ocaml
.
ml_id
ocaml
.
ml_decl
in
let
node
=
CD
.
Types
.
make
()
in
CD
.
Types
.
define
node
(
CD
.
Builtin_defs
.
bool
);
node
|
ML_char
->
let
node
=
CD
.
Types
.
make
()
in
CD
.
Types
.
define
node
(
CD
.
Types
.
char
(
CD
.
Chars
.
mk_classes
[
(
0
,
255
)
]
)
);
node
|
ML_ident
(
id
,
params
,
ocaml
)
->
from_ocaml_type
left
params
ocaml
.
ml_id
ocaml
.
ml_decl
|
ML_int
->
let
node
=
CD
.
Types
.
make
()
in
let
lB
=
CD
.
Intervals
.
V
.
mk
(
string_of_int
min_int
)
and
uB
=
CD
.
Intervals
.
V
.
mk
(
string_of_int
max_int
)
in
CD
.
Types
.
cons
(
CD
.
Types
.
interval
(
CD
.
Intervals
.
bounded
lB
uB
)
)
CD
.
Types
.
define
node
(
CD
.
Types
.
interval
(
CD
.
Intervals
.
bounded
lB
uB
)
);
node
|
ML_list
d
->
let
desc
=
CD
.
Types
.
descr
(
from_desc
left
array
d
)
in
CD
.
Types
.
cons
(
CD
.
Sequence
.
star
desc
)
let
desc
=
from_desc
left
array
d
in
CD
.
Sequence
.
star
_node
desc
|
ML_option
desc
->
let
node
=
CD
.
Types
.
make
()
in
let
trans
=
CD
.
Types
.
descr
(
from_desc
left
array
desc
)
in
CD
.
Types
.
cons
(
CD
.
Types
.
cup
trans
cd_type_nil
)
CD
.
Types
.
define
node
(
CD
.
Types
.
cup
trans
cd_type_nil
);
node
|
ML_reference
desc
->
let
node
=
CD
.
Types
.
make
()
in
let
get
=
ML_arrow
(
None
,
ML_unit
,
desc
)
and
set
=
ML_arrow
(
None
,
desc
,
ML_unit
)
in
let
ref
=
ML_record
[
"get"
,
get
;
"set"
,
set
]
in
CD
.
Types
.
cons
(
from_decl
left
array
ref
)
CD
.
Types
.
define
node
(
from_decl
left
array
ref
);
node
|
ML_string
->
CD
.
Types
.
cons
(
CD
.
Builtin_defs
.
string_latin1
)
let
node
=
CD
.
Types
.
make
()
in
CD
.
Types
.
define
node
(
CD
.
Builtin_defs
.
string_latin1
);
node
|
ML_tuple
list
->
assert
(
List
.
length
list
>=
2
);
tuple_of_list
left
array
list
|
ML_unit
->
CD
.
Types
.
cons
(
CD
.
Sequence
.
nil_type
)
let
node
=
CD
.
Types
.
make
()
in
CD
.
Types
.
define
node
CD
.
Sequence
.
nil_type
;
node
|
ML_var
id
->
from_desc
left
array
array
.
(
id
)
and
tuple_of_list
left
array
list
=
let
rec
internal
tail
=
function
|
hd
::
[]
->
let
node
=
CD
.
Types
.
make
()
in
let
desc
=
from_desc
left
array
hd
in
CD
.
Types
.
times
desc
(
CD
.
Types
.
cons
tail
)
CD
.
Types
.
define
node
(
CD
.
Types
.
times
tail
desc
);
node
|
hd
::
tl
->
let
node
=
CD
.
Types
.
make
()
in
let
desc
=
from_desc
left
array
hd
in
let
tail
=
CD
.
Types
.
times
desc
(
CD
.
Types
.
con
s
tail
)
in
internal
tail
tl
CD
.
Types
.
define
node
(
CD
.
Types
.
time
s
tail
desc
);
internal
node
tl
|
[]
->
assert
false
in
let
tail
=
CD
.
Types
.
descr
(
from_desc
left
array
(
List
.
hd
list
)
)
in
CD
.
Types
.
cons
(
internal
tail
(
List
.
tl
list
)
)
let
tail
=
from_desc
left
array
(
List
.
hd
list
)
in
internal
tail
(
List
.
tl
list
)
(***********************************************************************************)
...
...
cdo2cmo/src/checker.ml
View file @
9a271256
...
...
@@ -10,10 +10,10 @@ let error e = raise ( Error e )
let
report_error
=
function
|
Undefined_value
(
file
,
func
)
->
Format
.
eprintf
"
E
rror in file %s.cmi:@."
file
;
Format
.
eprintf
"
cdo2cmo : e
rror in file %s.cmi:@."
file
;
Format
.
eprintf
"Value %s has no counterpart in file %s.cdo@."
func
file
|
Type_mismatch
(
file
,
ml_t
,
cd_t
)
->
Format
.
eprintf
"
E
rror in file %s.cmi:@."
file
;
Format
.
eprintf
"
cdo2cmo : e
rror in file %s.cmi:@."
file
;
Cduce
.
Type
.
print
Format
.
err_formatter
cd_t
;
Format
.
eprintf
"
\n
is not a subtype of@."
;
Ocaml
.
Type
.
print
Format
.
err_formatter
(
true
,
[
ml_t
]
)
...
...
@@ -32,6 +32,6 @@ let run ml_cu cd_cu =
then
error
(
Type_mismatch
(
file
,
ml_t
,
cd_base
)
);
with
Not_found
->
error
(
Undefined_value
(
file
,
ml_t
.
Types
.
ml_name
)
)
)
|
_
->
()
|
_
->
()
)
ml_cu
with
Error
e
->
report_error
e
;
exit
1
cdo2cmo/src/generator.ml
View file @
9a271256
...
...
@@ -37,6 +37,7 @@ end
type
code_t
=
|
To_CDuce_bool
|
To_CDuce_char
|
To_CDuce_fun
of
string
*
string
*
code_t
*
code_t
|
To_CDuce_int
|
To_CDuce_list
of
code_t
...
...
@@ -46,8 +47,9 @@ type code_t =
|
To_CDuce_tuple
of
code_t
list
|
To_CDuce_type
of
string
|
To_CDuce_unit
|
To_CDuce_variant
of
(
string
*
code_t
option
)
list
|
To_CDuce_variant
of
(
string
*
code_t
list
)
list
|
To_OCaml_bool
|
To_OCaml_char
|
To_OCaml_fun
of
string
*
code_t
*
code_t
|
To_OCaml_int
|
To_OCaml_list
of
code_t
...
...
@@ -57,7 +59,7 @@ type code_t =
|
To_OCaml_tuple
of
code_t
list
|
To_OCaml_type
of
string
|
To_OCaml_unit
|
To_OCaml_variant
of
(
string
*
code_t
option
)
list
|
To_OCaml_variant
of
(
string
*
code_t
list
)
list
type
value_t
=
|
Type_to_cd
of
string
*
bool
*
bool
*
code_t
...
...
@@ -74,7 +76,8 @@ let rec dump fmt = function
|
false
,
_
->
Format
.
fprintf
fmt
"and "
in
Format
.
fprintf
fmt
"ocaml2cduce__%s cdo2cmo__val = @."
name
;
dump_code
fmt
"cdo2cmo__val"
code
dump_code
fmt
"cdo2cmo__val"
code
;
Format
.
fprintf
fmt
"@."
|
Type_to_ml
(
name
,
first
,
is_rec
,
code
)
->
let
()
=
match
first
,
is_rec
with
|
true
,
true
->
Format
.
fprintf
fmt
"let rec "
...
...
@@ -82,60 +85,63 @@ let rec dump fmt = function
|
false
,
_
->
Format
.
fprintf
fmt
"and "
in
Format
.
fprintf
fmt
"cduce2ocaml__%s cdo2cmo__val = @."
name
;
dump_code
fmt
"cdo2cmo__val"
code
dump_code
fmt
"cdo2cmo__val"
code
;
Format
.
fprintf
fmt
"@."
|
Value
(
name
,
slot
,
code
)
->
Format
.
fprintf
fmt
"let %s ="
name
;
Format
.
fprintf
fmt
"
let cdo2cmo__val = @."
;
Format
.
fprintf
fmt
"
!CDuce_all.Eval.from_comp_unit cdo2cmo__cu %d in@."
slot
;
Format
.
fprintf
fmt
"let cdo2cmo__val = @."
;
Format
.
fprintf
fmt
"!CDuce_all.Eval.from_comp_unit cdo2cmo__cu %d in@."
slot
;
dump_code
fmt
"cdo2cmo__val"
code
and
dump_code
fmt
name
=
function
|
To_CDuce_bool
->
Format
.
fprintf
fmt
" CDuce_all.Value.vbool %s@."
name
Format
.
fprintf
fmt
"CDuce_all.Value.vbool %s@."
name
|
To_CDuce_char
->
assert
false
(* TODO *)
|
To_CDuce_fun
(
func
,
arg
,
code1
,
code2
)
->
Format
.
fprintf
fmt
"let %s = fun %s -> @."
func
arg
;
Format
.
fprintf
fmt
"
let cdo2cmo__p = @."
;
Format
.
fprintf
fmt
"let cdo2cmo__p = @."
;
dump_code
fmt
arg
code1
;
Format
.
fprintf
fmt
"
in @."
;
Format
.
fprintf
fmt
"
let cdo2cmo__val = %s cdo2cmo__p in@."
func
;
Format
.
fprintf
fmt
"in @."
;
Format
.
fprintf
fmt
"let cdo2cmo__val = %s cdo2cmo__p in@."
func
;
dump_code
fmt
"cdo2cmo__val"
code2
;
Format
.
fprintf
fmt
"
in@."
;
Format
.
fprintf
fmt
"
CDuce_all.Value.Abstraction( [], %s )@."
func
Format
.
fprintf
fmt
"in@."
;
Format
.
fprintf
fmt
"CDuce_all.Value.Abstraction( [], %s )@."
func
|
To_CDuce_int
->
Format
.
fprintf
fmt
"
CDuce_all.Value.const (@."
;
Format
.
fprintf
fmt
"
CDuce_all.Types.Integer (@."
;
Format
.
fprintf
fmt
"
CDuce_all.Intervals.V.mk (@."
;
Format
.
fprintf
fmt
"
string_of_int %s ))) @."
name
Format
.
fprintf
fmt
"CDuce_all.Value.const (@."
;
Format
.
fprintf
fmt
"CDuce_all.Types.Integer (@."
;
Format
.
fprintf
fmt
"CDuce_all.Intervals.V.mk (@."
;
Format
.
fprintf
fmt
"string_of_int %s ))) @."
name
|
To_CDuce_list
code
->
Format
.
fprintf
fmt
"
CDuce_all.Value.sequence (@."
;
Format
.
fprintf
fmt
"
List.map (fun cdo2cmo__e -> @."
;
Format
.
fprintf
fmt
"CDuce_all.Value.sequence (@."
;
Format
.
fprintf
fmt
"List.map (fun cdo2cmo__e -> @."
;
dump_code
fmt
"cdo2cmo__e"
code
;
Format
.
fprintf
fmt
"
) %s )@."
name
Format
.
fprintf
fmt
") %s )@."
name
|
To_CDuce_option
code
->
Format
.
fprintf
fmt
"
match %s with @."
name
;
Format
.
fprintf
fmt
"
| None -> CDuce_all.Value.nil@."
;
Format
.
fprintf
fmt
"
| Some %s -> (@."
name
;
Format
.
fprintf
fmt
"match %s with @."
name
;
Format
.
fprintf
fmt
"| None -> CDuce_all.Value.nil@."
;
Format
.
fprintf
fmt
"| Some %s -> (@."
name
;
dump_code
fmt
name
code
;
Format
.
fprintf
fmt
"
)@."
Format
.
fprintf
fmt
")@."
|
To_CDuce_record
list
->
Format
.
fprintf
fmt
"
CDuce_all.Value.vrecord [@."
;
Format
.
fprintf
fmt
"CDuce_all.Value.vrecord [@."
;
let
rec
print_list
=
function
|
[]
->
()
|
[
(
field
,
desc
)
]
->
Format
.
fprintf
fmt
"( CDuce_all.Ns.mk_ascii
\"\"
, @."
;
Format
.
fprintf
fmt
"
CDuce_all.Encodings.Utf8.mk
\"
%s
\"
), @. "
field
;
Format
.
fprintf
fmt
"CDuce_all.Encodings.Utf8.mk
\"
%s
\"
), @. "
field
;
dump_code
fmt
(
Format
.
sprintf
"%s.%s"
name
field
)
desc
|
(
field
,
desc
)
::
tl
->
Format
.
fprintf
fmt
"( CDuce_all.Ns.mk_ascii
\"\"
, @."
;
Format
.
fprintf
fmt
"
CDuce_all.Encodings.Utf8.mk
\"
%s
\"
), @. "
field
;
Format
.
fprintf
fmt
"CDuce_all.Encodings.Utf8.mk
\"
%s
\"
), @. "
field
;
dump_code
fmt
(
Format
.
sprintf
"%s.%s"
name
field
)
desc
;
print_list
tl
in
print_list
list
;
Format
.
fprintf
fmt
" ]@."
|
To_CDuce_string
->
Format
.
fprintf
fmt
"
CDuce_all.Value.string_latin1 %s@."
name
Format
.
fprintf
fmt
"CDuce_all.Value.string_latin1 %s@."
name
|
To_CDuce_unit
->
Format
.
fprintf
fmt
"
CDuce_all.Value.sequence [] @."
Format
.
fprintf
fmt
"CDuce_all.Value.sequence [] @."
|
To_CDuce_tuple
list
->
let
rec
print_proj
n
=
function
|
[]
->
assert
false
...
...
@@ -164,24 +170,50 @@ and dump_code fmt name = function
|
To_CDuce_type
id
->
Format
.
fprintf
fmt
"ocaml2cduce__%s %s"
id
name
|
To_CDuce_variant
list
->
let
print
(
label
,
desc
)
=
match
desc
with
|
None
->
Format
.
fprintf
fmt
" | %s -> @."
label
;
let
rec
print_proj
n
m
=
if
n
<
m
then
begin
Format
.
fprintf
fmt
"cdo2cmo__v%d"
n
;
if
(
n
+
1
)
<
m
then
Format
.
fprintf
fmt
", "
;
print_proj
(
n
+
1
)
m
end
;
in
let
rec
print_list
n
=
function
|
[
cde
]
->
dump_code
fmt
"cdo2cmo__v0"
cde
|
d1
::
[
d2
]
->
Format
.
fprintf
fmt
"CDuce_all.Value.Pair ( @."
;
Format
.
fprintf
fmt
" CDuce_all.Value.Atom ( @."
;
Format
.
fprintf
fmt
" CDuce_all.Atoms.V.mk_ascii
\"
%s
\"
),@."
label
;
Format
.
fprintf
fmt
" CDuce_all.Value.nil )@."
|
Some
desc
->
Format
.
fprintf
fmt
" | %s cdo2cmo__x -> @."
label
;
dump_code
fmt
(
Format
.
sprintf
"cdo2cmo__v%d"
n
)
d1
;
Format
.
fprintf
fmt
", "
;
dump_code
fmt
(
Format
.
sprintf
"cdo2cmo__v%d"
(
n
+
1
)
)
d2
;
Format
.
fprintf
fmt
")@."
|
d1
::
tl
->
Format
.
fprintf
fmt
"CDuce_all.Value.Pair ( @."
;
dump_code
fmt
(
Format
.
sprintf
"cdo2cmo__v%d"
n
)
d1
;
Format
.
fprintf
fmt
", "
;
print_list
(
n
+
1
)
tl
;
Format
.
fprintf
fmt
")@."
|
_
->
assert
false
in
let
print
(
label
,
list
)
=
match
list
with
|
[]
->
Format
.
fprintf
fmt
"| %s -> @."
label
;
Format
.
fprintf
fmt
"CDuce_all.Value.Pair ( @."
;
Format
.
fprintf
fmt
" CDuce_all.Value.Atom ( @."
;
Format
.
fprintf
fmt
" CDuce_all.Atoms.V.mk_ascii
\"
%s
\"
),@."
label
;
dump_code
fmt
"cdo2cmo__x"
desc
;
Format
.
fprintf
fmt
"CDuce_all.Value.Atom ( @."
;
Format
.
fprintf
fmt
"CDuce_all.Atoms.V.mk_ascii
\"
%s
\"
),@."
label
;
Format
.
fprintf
fmt
"CDuce_all.Value.nil )@."
|
list
->
Format
.
fprintf
fmt
"| %s ( "
label
;
print_proj
0
(
List
.
length
list
);
Format
.
fprintf
fmt
" ) -> @."
;
Format
.
fprintf
fmt
"CDuce_all.Value.Pair ( @."
;
Format
.
fprintf
fmt
"CDuce_all.Value.Atom ( @."
;
Format
.
fprintf
fmt
"CDuce_all.Atoms.V.mk_ascii
\"
%s
\"
),@."
label
;
print_list
0
list
;
Format
.
fprintf
fmt
")@."
in
Format
.
fprintf
fmt
"
match %s with @."
name
;
Format
.
fprintf
fmt
"match %s with @."
name
;
List
.
iter
print
list
|
To_OCaml_bool
->
Format
.
fprintf
fmt
" CDuce_all.Value.equal %s CDuce_all.Value.vtrue@."
name
|
To_OCaml_char
->
assert
false
(* TODO *)
|
To_OCaml_fun
(
lbl
,
code1
,
code2
)
->
Format
.
fprintf
fmt
"fun %s -> @."
lbl
;
Format
.
fprintf
fmt
" let cdo2cmo__p = @."
;
...
...
@@ -256,16 +288,31 @@ and dump_code fmt name = function
|
To_OCaml_unit
->
Format
.
fprintf
fmt
" ()@."
|
To_OCaml_variant
list
->
let
rec
print_proj
n
m
=
if
n
<
m
then
begin
Format
.
fprintf
fmt
"cdo2cmo__v%d"
n
;
if
n
+
1
<
m
then
Format
.
fprintf
fmt
",@."
;
print_proj
(
n
+
1
)
m
end
;
in
let
rec
print_list
=
function
|
[]
->
Format
.
fprintf
fmt
" | _ -> assert false @."
|
(
field
,
None
)
::
tl
->
|
(
field
,
[]
)
::
tl
->
Format
.
fprintf
fmt
" |
\"
%s
\"
-> %s@."
field
field
;
print_list
tl
|
(
field
,
Some
desc
)
::
tl
->
Format
.
fprintf
fmt
" |
\"
%s
\"
-> %s ( @."
field
field
;
dump_code
fmt
"cdo2cmo__desc"
desc
;
Format
.
fprintf
fmt
" ) @."
;
|
(
field
,
list
)
::
tl
->
Format
.
fprintf
fmt
" |
\"
%s
\"
-> ( @."
field
;
let
cnt
=
ref
0
in
List
.
iter
(
fun
desc
->
Format
.
fprintf
fmt
"let cdo2cmo__v%d = @."
!
cnt
;
dump_code
fmt
"cdo2cmo__desc"
desc
;
Format
.
fprintf
fmt
"in@."
;
incr
cnt
)
list
;
Format
.
fprintf
fmt
"%s ( "
field
;
print_proj
0
(
List
.
length
list
);
Format
.
fprintf
fmt
") ) @."
;
print_list
tl
in
Format
.
fprintf
fmt
" let cdo2cmo__atom, cdo2cmo__desc = match %s with @."
name
;
Format
.
fprintf
fmt
" | CDuce_all.Value.Pair ( @."
;
...
...
@@ -298,13 +345,14 @@ and generate_to_ml ctx name = function
|
ML_variant
list
->
let
list
=
List
.
map
(
fun
(
field
,
desc
)
->
match
desc
with
|
[]
->
field
,
None
|
[]
->
field
,
[]
|
[
x
]
->
let
d
=
generate_desc_to_ml_rec
ctx
x
in
field
,
Some
d
|
_
->
let
d
=
generate_desc_to_ml_rec
ctx
(
ML_tuple
desc
)
in
field
,
Some
d
let
d
esc
=
generate_desc_to_ml_rec
ctx
x
in
field
,
[
desc
]
|
list
->
let
list
=
List
.
map
(
generate_desc_to_ml_rec
ctx
)
list
in
field
,
list
)
list
in
To_OCaml_variant
list
|
ML_nil
->
assert
false
...
...
@@ -314,6 +362,7 @@ and generate_desc_to_ml ctx name desc =
and
generate_desc_to_ml_rec
ctx
(* name *)
=
function
|
ML_bool
->
To_OCaml_bool
|
ML_char
->
To_OCaml_char
|
ML_int
->
To_OCaml_int
|
ML_string
->
To_OCaml_string
|
ML_unit
->
To_OCaml_unit
...
...
@@ -346,13 +395,14 @@ and generate_to_cd ctx name = function
|
ML_variant
list
->
let
list
=
List
.
map
(
fun
(
field
,
desc
)
->
match
desc
with
|
[]
->
field
,
None
|
[]
->
field
,
[]
|
[
x
]
->
let
d
=
generate_desc_to_cd_rec
ctx
name
x
in
field
,
Some
d
let
d
esc
=
generate_desc_to_cd_rec
ctx
name
x
in
field
,
[
desc
]
|
_
->
let
d
=
generate_desc_to_cd_rec
ctx
name
(
ML_tuple
desc
)
in
field
,
Some
d
let
list
=
List
.
map
(
generate_desc_to_cd_rec
ctx
name
)
desc
in
field
,
list
)
list
in
To_CDuce_variant
list
|
ML_nil
->
assert
false
...
...
@@ -361,7 +411,8 @@ and generate_desc_to_cd ctx name desc =
generate_desc_to_cd_rec
ctx
name
desc
and
generate_desc_to_cd_rec
ctx
name
=
function
|
ML_bool
->
To_CDuce_bool
|
ML_bool
->
To_CDuce_bool
|
ML_char
->
To_CDuce_char
|
ML_int
->
To_CDuce_int
|
ML_string
->
To_CDuce_string
|
ML_unit
->
To_CDuce_unit
...
...
cdo2cmo/src/ocaml.ml
View file @
9a271256
...
...
@@ -12,7 +12,7 @@ let error e = raise ( Error e )
let
report_error
err
=
let
msg
=
match
err
with
|
Unsupported_feature
s
->
"
U
nsupported "
^
s
^
" in interface file (.mli)"
"
cdo2cmo : error u
nsupported "
^
s
^
" in interface file (.mli)"
in
Format
.
eprintf
"%s@."
msg
...
...
@@ -68,9 +68,9 @@ and ml_print_decl fmt = function
|
hd
::
[]
->
Format
.
fprintf
fmt
"%s of "
name
;
ml_print_desc
fmt
hd
|
hd
::
tl
->
|
list
->
Format
.
fprintf
fmt
"%s of "
name
;
ml_print_list
fmt
" * "
ml_print_desc
t
l
ml_print_list
fmt
" * "
ml_print_desc
l
ist
)
list
|
_
->
assert
false
...
...
@@ -86,6 +86,7 @@ and ml_print_desc fmt = function
Format
.
fprintf
fmt
" ) -> "
;
ml_print_desc
fmt
d2
|
ML_bool
->
Format
.
fprintf
fmt
"bool"
|
ML_char
->
Format
.
fprintf
fmt
"char"
|
ML_ident
(
name
,
[
||
]
,
_
)
->
Format
.
fprintf
fmt
"%s"
name
|
ML_ident
(
name
,
array
,
_
)
->
...
...
@@ -268,11 +269,8 @@ module Env = struct
node
(* Flush recursive type buffer. *)
let
flush_types
env
=
match
env
.
env_queue
with
|
[]
->
Format
.
eprintf
"Flush empty env.@."
;
env
|
[]
->
env
|
values
->
Format
.
eprintf
"Flush env@."
;
let
len
=
Path
.
length
env
.
env_path
=
1
in
{
env
with
env_list
=
env
.
env_list
@
[
len
,
values
];
...
...
@@ -313,6 +311,7 @@ let path_to_mlpath path =
let
rec
translate_ident
env
path
spath
=
function
|
[]
when
spath
=
"bool"
->
env
,
ML_bool
|
[]
when
spath
=
"char"
->
env
,
ML_char
|
[]
when
spath
=
"int"
->
env
,
ML_int
|
[]
when
spath
=
"string"
->
env
,
ML_string
|
[]
when
spath
=
"unit"
->
env
,
ML_unit
...
...
cdo2cmo/src/types.ml
View file @
9a271256
...
...
@@ -19,6 +19,7 @@ and ocaml_decl =
and
ocaml_desc
=
|
ML_arrow
of
string
option
*
ocaml_desc
*
ocaml_desc
|
ML_bool
|
ML_char
|
ML_ident
of
string
*
ocaml_desc
array
*
ocaml_t
|
ML_int
|
ML_list
of
ocaml_desc
...
...
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