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
837c43b8
Commit
837c43b8
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2004-06-28 01:16:40 by afrisch] Fix capture in stub gen, registered types, functions
Original author: afrisch Date: 2004-06-28 01:16:40+00:00
parent
394baf3c
Changes
7
Hide whitespace changes
Inline
Side-by-side
Makefile.distrib
View file @
837c43b8
...
...
@@ -193,7 +193,7 @@ ALL_OBJECTS = $(OBJECTS) $(CQL_OBJECTS) \
ALL_INTERFACES
=
schema/schema_types.mli
ifneq
($(ML_INTERFACE), false)
ALL_INTERFACES
+=
ocamliface/mltypes.mli ocaml
u
face/mlstub.mli
ALL_INTERFACES
+=
ocamliface/mltypes.mli ocaml
i
face/mlstub.mli
endif
DEPEND
=
$(ALL_OBJECTS:.cmo=.ml)
$(ALL_OBJECTS:.cmo=.mli)
$(ALL_INTERFACES)
...
...
depend
View file @
837c43b8
...
...
@@ -220,28 +220,30 @@ driver/librarian.cmx: types/builtin.cmx compile/compile.cmx \
misc/encodings.cmx runtime/eval.cmx types/ident.cmx compile/lambda.cmx \
parser/location.cmx parser/parser.cmx misc/serialize.cmx typing/typer.cmx \
types/types.cmx runtime/value.cmx driver/librarian.cmi
ocamliface/mltypes.cmo: cdo2cmo/asttypes.cmo types/ident.cmo
types/types.cmi
\
ocamliface/mltypes.cmi
ocamliface/mltypes.cmx: cdo2cmo/asttypes.cmx types/ident.cmx
types/types.cmx
\
ocamliface/mltypes.cmi
ocamliface/mltypes.cmo: cdo2cmo/asttypes.cmo types/ident.cmo \
driver/librarian.cmi types/types.cmi
ocamliface/mltypes.cmi
ocamliface/mltypes.cmx: cdo2cmo/asttypes.cmx types/ident.cmx \
driver/librarian.cmx types/types.cmx
ocamliface/mltypes.cmi
ocamliface/mlstub.cmo: types/atoms.cmi types/builtin_defs.cmi \
compile/compile.cmi types/ident.cmo ocamliface/mltypes.cmi misc/ns.cmi \
types/sequence.cmi typing/typer.cmi types/types.cmi ocamliface/mlstub.cmi
compile/compile.cmi types/ident.cmo driver/librarian.cmi \
ocamliface/mltypes.cmi misc/ns.cmi types/sequence.cmi typing/typer.cmi \
types/types.cmi ocamliface/mlstub.cmi
ocamliface/mlstub.cmx: types/atoms.cmx types/builtin_defs.cmx \
compile/compile.cmx types/ident.cmx ocamliface/mltypes.cmx misc/ns.cmx \
types/sequence.cmx typing/typer.cmx types/types.cmx ocamliface/mlstub.cmi
compile/compile.cmx types/ident.cmx driver/librarian.cmx \
ocamliface/mltypes.cmx misc/ns.cmx types/sequence.cmx typing/typer.cmx \
types/types.cmx ocamliface/mlstub.cmi
driver/cduce.cmo: parser/ast.cmo types/builtin.cmi compile/compile.cmi \
misc/encodings.cmi runtime/eval.cmi runtime/explain.cmi types/ident.cmo \
driver/librarian.cmi parser/location.cmi
ocamliface/mlstub
.cmi \
ocamliface/mltypes.cmi misc/ns.cmi parser/parser.cmi types/patterns
.cmi \
types/sample.c
mi
sc
hema/schema_common.cmi misc/state
.cmi typ
ing
/typer.cmi \
types/types.cmi parser/ulexer.cmi
runtime/value.cmi driver/cduce.cmi
driver/librarian.cmi parser/location.cmi
misc/ns.cmi parser/parser
.cmi \
types/patterns.cmi types/sample.cmi schema/schema_common
.cmi \
misc
/state.cmi typing/typer
.cmi typ
es
/type
s.cmi parser/ulexe
r.cmi \
runtime/value.cmi driver/cduce.cmi
driver/cduce.cmx: parser/ast.cmx types/builtin.cmx compile/compile.cmx \
misc/encodings.cmx runtime/eval.cmx runtime/explain.cmx types/ident.cmx \
driver/librarian.cmx parser/location.cmx
ocamliface/mlstub
.cmx \
ocamliface/mltypes.cmx misc/ns.cmx parser/parser.cmx types/patterns
.cmx \
types/sample.cmx schema/schema_common.cmx misc/state.cmx typing/typ
er.cmx \
types/types.cmx parser/ulexer.cmx
runtime/value.cmx driver/cduce.cmi
driver/librarian.cmx parser/location.cmx
misc/ns.cmx parser/parser
.cmx \
types/patterns.cmx types/sample.cmx schema/schema_common
.cmx \
misc/state.cmx typing/typer.cmx types/types.cmx parser/ulex
er.cmx \
runtime/value.cmx driver/cduce.cmi
query/query.cmo: parser/ast.cmo types/atoms.cmi types/builtin_defs.cmi \
types/chars.cmi types/ident.cmo types/intervals.cmi parser/location.cmi \
parser/parser.cmi types/types.cmi query/query.cmi
...
...
driver/cduce.ml
View file @
837c43b8
...
...
@@ -275,18 +275,6 @@ let run rule ppf ppf_err input =
let
topinput
=
run
Parser
.
top_phrases
let
script
=
run
Parser
.
prog
ifdef
ML_INTERFACE
then
let
stub_ml
cu
id
=
try
let
name
=
String
.
capitalize
cu
in
let
(
prolog
,
values
)
=
Mltypes
.
read_cmi
name
in
let
stub
=
Mlstub
.
stub
cu
id
values
in
Some
(
prolog
,
stub
)
with
|
Mltypes
.
Error
s
->
raise
(
Generic
s
)
|
Not_found
->
Printf
.
eprintf
"Warning: no caml interface
\n
"
;
None
else
let
stub_ml
cu
id
=
None
;;
let
compile
src
out_dir
=
try
...
...
@@ -299,9 +287,8 @@ let compile src out_dir =
|
Some
x
->
x
in
let
out
=
Filename
.
concat
out_dir
(
cu
^
".cdo"
)
in
let
id
=
Types
.
CompUnit
.
mk
(
U
.
mk_latin1
cu
)
in
Librarian
.
compile
!
verbose
id
src
;
let
stub
=
stub_ml
cu
id
in
Librarian
.
save
id
out
stub
;
Librarian
.
compile
!
verbose
cu
id
src
;
Librarian
.
save
id
out
;
exit
0
with
exn
->
catch_exn
Format
.
err_formatter
exn
;
exit
1
...
...
@@ -311,7 +298,7 @@ let compile_run src =
then
raise
(
InvalidInputFilename
src
);
let
cu
=
Filename
.
chop_suffix
(
Filename
.
basename
src
)
".cd"
in
let
id
=
Types
.
CompUnit
.
mk
(
U
.
mk_latin1
cu
)
in
Librarian
.
compile
!
verbose
id
src
;
Librarian
.
compile
!
verbose
cu
id
src
;
Librarian
.
run
id
with
exn
->
catch_exn
Format
.
err_formatter
exn
;
exit
1
...
...
driver/librarian.ml
View file @
837c43b8
open
Location
open
Ident
type
stub_ml
let
stub_ml
=
ref
(
fun
cu
ty_env
c_env
->
None
,
[
|
|
])
module
C
=
Types
.
CompUnit
exception
InconsistentCrc
of
C
.
t
...
...
@@ -13,20 +17,26 @@ type t = {
typing
:
Typer
.
t
;
compile
:
Compile
.
env
;
code
:
Lambda
.
code_item
list
;
types
:
Types
.
t
array
;
mutable
digest
:
Digest
.
t
option
;
vals
:
Value
.
t
array
;
mutable
depends
:
C
.
t
list
;
mutable
status
:
[
`Evaluating
|
`Unevaluated
|
`Evaluated
]
mutable
status
:
[
`Evaluating
|
`Unevaluated
|
`Evaluated
];
mutable
stub
:
stub_ml
option
}
let
mk
(
typing
,
compile
,
code
)
=
let
mk
(
(
typing
,
compile
,
code
)
,
types
)
=
{
typing
=
typing
;
compile
=
compile
;
code
=
code
;
types
=
types
;
digest
=
None
;
vals
=
Array
.
make
(
Compile
.
global_size
compile
)
Value
.
Absent
;
depends
=
[]
;
status
=
`Unevaluated
;
stub
=
None
}
let
magic
=
"CDUCE:compunit:00003"
...
...
@@ -43,14 +53,16 @@ let serialize s cu =
Serialize
.
Put
.
magic
s
magic
;
Typer
.
serialize
s
cu
.
typing
;
Compile
.
serialize
s
cu
.
compile
;
Lambda
.
Put
.
codes
s
cu
.
code
Lambda
.
Put
.
codes
s
cu
.
code
;
Serialize
.
Put
.
array
Types
.
serialize
s
cu
.
types
let
deserialize
s
=
Serialize
.
Get
.
magic
s
magic
;
let
typing
=
Typer
.
deserialize
s
in
let
compile
=
Compile
.
deserialize
s
in
let
code
=
Lambda
.
Get
.
codes
s
in
mk
(
typing
,
compile
,
code
)
let
types
=
Serialize
.
Get
.
array
Types
.
deserialize
s
in
mk
((
typing
,
compile
,
code
)
,
types
)
let
serialize_dep
=
Serialize
.
Put
.
list
...
...
@@ -67,9 +79,11 @@ let find_obj id =
List
.
find
(
fun
p
->
Sys
.
file_exists
(
Filename
.
concat
p
base
))
!
obj_path
in
Filename
.
concat
p
base
let
save
id
out
extra
=
let
save
id
out
=
protect_op
"Save compilation unit"
;
let
cu
=
find
id
in
C
.
enter
id
;
let
raw
=
Serialize
.
Put
.
run
serialize
cu
in
let
depend
=
C
.
close_serialize
()
in
...
...
@@ -92,7 +106,7 @@ let save id out extra =
let
depend
=
Serialize
.
Put
.
run
serialize_dep
depend
in
let
digest
=
Digest
.
string
raw
in
let
oc
=
open_out
out
in
Marshal
.
to_channel
oc
(
digest
,
depend
,
raw
,
extra
)
[]
;
Marshal
.
to_channel
oc
(
digest
,
depend
,
raw
,
cu
.
stub
)
[]
;
close_out
oc
...
...
@@ -123,7 +137,9 @@ let show ppf id t v =
Types
.
Print
.
print
t
|
None
->
()
let
rec
compile
verbose
id
src
=
let
rec
compile
verbose
name
id
src
=
check_loop
id
;
protect_op
"Compile external file"
;
let
ic
=
...
...
@@ -145,14 +161,16 @@ let rec compile verbose id src =
if
verbose
then
Some
(
show
Format
.
std_formatter
)
else
None
in
let
cu
=
let
(
ty_env
,
c_env
,_
)
as
cu
=
Compile
.
comp_unit
?
show
Builtin
.
env
(
Compile
.
empty
id
)
p
in
let
cu
=
mk
cu
in
let
stub
,
types
=
!
stub_ml
name
ty_env
c_env
in
let
cu
=
mk
(
cu
,
types
)
in
cu
.
stub
<-
stub
;
C
.
Tbl
.
add
tbl
id
cu
;
C
.
leave
()
;
during_compile
:=
false
;
...
...
@@ -233,3 +251,4 @@ let () =
|
_
->
assert
false
);;
let
registered_types
cu
=
(
load
cu
)
.
types
driver/librarian.mli
View file @
837c43b8
...
...
@@ -6,9 +6,15 @@ exception NoImplementation of Types.CompUnit.t
val
obj_path
:
string
list
ref
val
compile
:
bool
->
Types
.
CompUnit
.
t
->
string
->
unit
val
compile
:
bool
->
string
->
Types
.
CompUnit
.
t
->
string
->
unit
val
run
:
Types
.
CompUnit
.
t
->
unit
val
import
:
Types
.
CompUnit
.
t
->
unit
val
import_and_run
:
Types
.
CompUnit
.
t
->
unit
val
save
:
Types
.
CompUnit
.
t
->
string
->
'
a
->
unit
val
save
:
Types
.
CompUnit
.
t
->
string
->
unit
val
registered_types
:
Types
.
CompUnit
.
t
->
Types
.
t
array
type
stub_ml
val
stub_ml
:
(
string
->
Typer
.
t
->
Compile
.
env
->
stub_ml
option
*
Types
.
t
array
)
ref
ocamliface/mlstub.ml
View file @
837c43b8
...
...
@@ -67,10 +67,12 @@ and variant = function
(* Syntactic tools *)
let
var_counter
=
ref
0
let
mk_var
_
=
incr
var_counter
;
Printf
.
sprintf
"x%i"
!
var_counter
let
mk_vars
l
=
let
i
=
ref
0
in
List
.
map
(
fun
t
->
incr
i
;
Printf
.
sprintf
"x%i"
!
i
)
l
let
mk_vars
=
List
.
map
mk_var
let
loc
=
(
-
1
,-
1
)
...
...
@@ -93,15 +95,39 @@ let rec matches ine oute = function
|
[
v1
;
v2
]
->
let_in
<:
patt
<
(
$
lid
:
v1
$,$
lid
:
v2
$
)
>>
<:
expr
<
Value
.
get_pair
$
ine
$
>>
oute
|
v
::
vl
->
let
oute
=
matches
<:
expr
<
r
>>
oute
vl
in
let_in
<:
patt
<
(
$
lid
:
v
$,
r
)
>>
<:
expr
<
Value
.
get_pair
$
ine
$
>>
oute
let
r
=
mk_var
()
in
let
oute
=
matches
<:
expr
<
$
lid
:
r
$
>>
oute
vl
in
let_in
<:
patt
<
(
$
lid
:
v
$,$
lid
:
r
$
)
>>
<:
expr
<
Value
.
get_pair
$
ine
$
>>
oute
|
[]
->
assert
false
let
list_lit
el
=
List
.
fold_right
(
fun
a
e
->
<:
expr
<
[
$
a
$
::
$
e
$
]
>>
)
el
<:
expr
<
[]
>>
(* Registered types *)
module
HashTypes
=
Hashtbl
.
Make
(
Types
)
let
registered_types
=
HashTypes
.
create
13
let
nb_registered_types
=
ref
0
let
register_type
t
=
let
n
=
try
HashTypes
.
find
registered_types
t
with
Not_found
->
let
i
=
!
nb_registered_types
in
HashTypes
.
add
registered_types
t
i
;
incr
nb_registered_types
;
i
in
<:
expr
<
types
.
(
$
int
:
string_of_int
n
$
)
>>
let
get_registered_types
()
=
let
a
=
Array
.
make
!
nb_registered_types
Types
.
empty
in
HashTypes
.
iter
(
fun
t
i
->
a
.
(
i
)
<-
t
)
registered_types
;
a
(* OCaml -> CDuce conversions *)
let
to_cd_gen
=
ref
[]
let
to_cd_fun_name
t
=
...
...
@@ -111,6 +137,15 @@ let to_cd_fun t =
to_cd_gen
:=
t
::
!
to_cd_gen
;
to_cd_fun_name
t
let
to_ml_gen
=
ref
[]
let
to_ml_fun_name
t
=
Printf
.
sprintf
"to_ml_%i"
t
.
uid
let
to_ml_fun
t
=
to_ml_gen
:=
t
::
!
to_ml_gen
;
to_ml_fun_name
t
let
rec
tuple
=
function
|
[
v
]
->
v
|
v
::
l
->
<:
expr
<
Value
.
Pair
(
$
v
$,
$
tuple
l
$
)
>>
...
...
@@ -129,7 +164,15 @@ let rec to_cd e t =
and
to_cd_descr
e
=
function
|
Link
t
->
to_cd
e
t
|
Arrow
(
t
,
s
)
->
failwith
"to_cd: Arrow. TODO"
|
Arrow
(
t
,
s
)
->
(* Value.Abstraction (t,s, fun x -> s(<...> (t(x))) *)
let
x
=
mk_var
()
in
let
arg
=
to_ml
<:
expr
<
$
lid
:
x
$
>>
t
in
let
res
=
to_cd
<:
expr
<
$
e
$
$
arg
$
>>
s
in
let
abs
=
<:
expr
<
fun
$
lid
:
x
$
->
$
res
$
>>
in
let
tt
=
register_type
(
Types
.
descr
(
typ
t
))
in
let
ss
=
register_type
(
Types
.
descr
(
typ
s
))
in
<:
expr
<
Value
.
Abstraction
(
$
tt
$,$
ss
$,$
abs
$
)
>>
|
Tuple
tl
->
(* let (x1,...,xn) = ... in Value.Pair (t1(x1), Value.Pair(...,tn(xn))) *)
let
vars
=
mk_vars
tl
in
...
...
@@ -165,14 +208,15 @@ and to_cd_descr e = function
pmatch
e
cases
|
Record
(
l
,_
)
->
(* let x = <...> in Value.record [ l1,t1(x.l1); ...; ln,x.ln ] *)
let
x
=
mk_var
()
in
let
l
=
List
.
map
(
fun
(
lab
,
t
)
->
let
e
=
to_cd
<:
expr
<
x
.$
lid
:
lab
$>>
t
in
let
e
=
to_cd
<:
expr
<
$
lid
:
x
$
.$
lid
:
lab
$>>
t
in
<:
expr
<
(
$
label_ascii
lab
$,
$
e
$
)
>>
)
l
in
let_in
<:
patt
<
x
>>
e
<:
expr
<
Value
.
record
$
list_lit
l
$
>>
let_in
<:
patt
<
$
lid
:
x
$
>>
e
<:
expr
<
Value
.
record
$
list_lit
l
$
>>
|
Abstract
"int"
->
<:
expr
<
ocaml2cduce_int
$
e
$
>>
|
Abstract
"char"
->
<:
expr
<
ocaml2cduce_char
$
e
$
>>
...
...
@@ -191,16 +235,9 @@ and tuple_to_cd tl vars = List.map2 (fun t id -> to_cd <:expr< $lid:id$ >> t) tl
(* CDuce -> OCaml conversions *)
let
to_ml_gen
=
ref
[]
let
to_ml_fun_name
t
=
Printf
.
sprintf
"to_ml_%i"
t
.
uid
let
to_ml_fun
t
=
to_ml_gen
:=
t
::
!
to_ml_gen
;
to_ml_fun_name
t
let
rec
to_ml
e
t
=
and
to_ml
e
t
=
(* Format.fprintf Format.std_formatter "to_ml %a@."
Mltypes.print t; *)
if
t
.
recurs
>
0
then
<:
expr
<
$
lid
:
to_ml_fun
t
$
$
e
$
>>
...
...
@@ -210,9 +247,10 @@ and to_ml_descr e = function
|
Link
t
->
to_ml
e
t
|
Arrow
(
t
,
s
)
->
(* fun x -> s(Eval.eval_apply <...> (t(x))) *)
let
arg
=
to_cd
<:
expr
<
x
>>
t
in
let
x
=
mk_var
()
in
let
arg
=
to_cd
<:
expr
<
$
lid
:
x
$
>>
t
in
let
res
=
to_ml
<:
expr
<
Eval
.
eval_apply
$
e
$
$
arg
$
>>
s
in
<:
expr
<
fun
x
->
$
res
$
>>
<:
expr
<
fun
$
lid
:
x
$
->
$
res
$
>>
|
Tuple
tl
->
(* let (x1,r) = Value.get_pair <...> in
...
...
@@ -229,6 +267,7 @@ and to_ml_descr e = function
| "A",None -> `A
| "B",Some x -> `B (t(x))
*)
let
x
=
mk_var
()
in
let
cases
=
List
.
map
(
function
...
...
@@ -236,8 +275,10 @@ and to_ml_descr e = function
<:
patt
<
(
$
str
:
String
.
escaped
lab
$,
None
)
>>,
<:
expr
<
`
$
lid
:
lab
$
>>
|
(
lab
,
Some
t
)
->
<:
patt
<
(
$
str
:
String
.
escaped
lab
$,
Some
x
)
>>,
<:
expr
<
`
$
lid
:
lab
$
$
to_ml
<:
expr
<
x
>>
t
$
>>
let
x
=
mk_var
()
in
let
ex
=
<:
expr
<
$
lid
:
x
$
>>
in
<:
patt
<
(
$
str
:
String
.
escaped
lab
$,
Some
$
lid
:
x
$
)
>>,
<:
expr
<
`
$
lid
:
lab
$
$
to_ml
ex
t
$
>>
)
l
in
pmatch
<:
expr
<
Value
.
get_variant
$
e
$
>>
cases
|
Variant
(
l
,
false
)
->
...
...
@@ -257,13 +298,17 @@ and to_ml_descr e = function
|
"false"
->
<:
expr
<
False
>>
|
lab
->
<:
expr
<
$
lid
:
lab
$
>>
)
|
(
lab
,
[
t
])
->
<:
patt
<
(
$
str
:
String
.
escaped
lab
$,
Some
x
)
>>,
<:
expr
<
$
lid
:
lab
$
$
to_ml
<:
expr
<
x
>>
t
$
>>
let
x
=
mk_var
()
in
let
ex
=
<:
expr
<
$
lid
:
x
$
>>
in
<:
patt
<
(
$
str
:
String
.
escaped
lab
$,
Some
$
lid
:
x
$
)
>>,
<:
expr
<
$
lid
:
lab
$
$
to_ml
ex
t
$
>>
|
(
lab
,
tl
)
->
let
vars
=
mk_vars
tl
in
let
el
=
tuple_to_ml
tl
vars
in
<:
patt
<
(
$
str
:
String
.
escaped
lab
$,
Some
x
)
>>,
matches
<:
expr
<
x
>>
<:
expr
<
$
lid
:
lab
$
(
$
list
:
el
$
)
>>
vars
let
x
=
mk_var
()
in
<:
patt
<
(
$
str
:
String
.
escaped
lab
$,
Some
$
lid
:
x
$
)
>>,
matches
<:
expr
<
$
lid
:
x
$
>>
<:
expr
<
$
lid
:
lab
$
(
$
list
:
el
$
)
>>
vars
)
l
in
pmatch
<:
expr
<
Value
.
get_variant
$
e
$
>>
cases
|
Record
(
l
,
false
)
->
...
...
@@ -271,12 +316,13 @@ and to_ml_descr e = function
|
Record
(
l
,
true
)
->
(* let x = <...> in
{ l1 = t1(Value.get_field x "l1"); ... } *)
let
x
=
mk_var
()
in
let
l
=
List
.
map
(
fun
(
lab
,
t
)
->
(
<:
patt
<
$
uid
:
lab
$>>,
to_ml
<:
expr
<
Value
.
get_field
x
$
label_ascii
lab
$
>>
t
))
l
in
let_in
<:
patt
<
x
>>
e
<:
expr
<
{
$
list
:
l
$
}
>>
to_ml
<:
expr
<
Value
.
get_field
$
lid
:
x
$
$
label_ascii
lab
$
>>
t
))
l
in
let_in
<:
patt
<
$
lid
:
x
$
>>
e
<:
expr
<
{
$
list
:
l
$
}
>>
|
Abstract
"int"
->
<:
expr
<
cduce2ocaml_int
$
e
$
>>
|
Abstract
"char"
->
<:
expr
<
cduce2ocaml_char
$
e
$
>>
...
...
@@ -359,11 +405,10 @@ let check_value ty_env c_env (s,caml_t,t) =
let
e
=
to_ml
<:
expr
<
Eval
.
get_slot
cu
$
int
:
string_of_int
slot
$
>>
t
in
<:
patt
<
$
uid
:
s
$
>>,
e
let
stub
name
cu
values
=
let
ty_env
=
!
Typer
.
from_comp_unit
cu
in
let
c_env
=
!
Compile
.
from_comp_unit
cu
in
let
stub
name
ty_env
c_env
values
=
let
items
=
List
.
map
(
check_value
ty_env
c_env
)
values
in
let
g
=
global_transl
()
in
(* open Cdml
open CDuce_all
...
...
@@ -374,9 +419,22 @@ let stub name cu values =
[
<:
str_item
<
open
Cdml
>>;
<:
str_item
<
open
CDuce_all
>>;
<:
str_item
<
value
cu
=
Cdml
.
initialize
$
str
:
String
.
escaped
name
$
>>
]
@
<:
str_item
<
value
cu
=
Cdml
.
initialize
$
str
:
String
.
escaped
name
$
>>;
<:
str_item
<
value
types
=
Librarian
.
registered_types
cu
>>
]
@
(
if
g
=
[]
then
[]
else
[
<:
str_item
<
value
rec
$
list
:
g
$
>>
])
@
[
<:
str_item
<
value
$
list
:
items
$
>>
]
let
()
=
Librarian
.
stub_ml
:=
fun
cu
ty_env
c_env
->
try
let
name
=
String
.
capitalize
cu
in
let
(
prolog
,
values
)
=
Mltypes
.
read_cmi
name
in
let
code
=
stub
cu
ty_env
c_env
values
in
Some
(
Obj
.
magic
(
prolog
,
code
))
,
get_registered_types
()
with
|
Mltypes
.
Error
s
->
raise
(
Location
.
Generic
s
)
|
Not_found
->
Printf
.
eprintf
"Warning: no caml interface
\n
"
;
None
,
[
||
]
ocamliface/mlstub.mli
View file @
837c43b8
val
stub
:
string
->
Types
.
CompUnit
.
t
->
(
string
*
OCaml_all
.
Types
.
type_expr
*
Mltypes
.
t
)
list
->
MLast
.
str_item
list
(* nothing *)
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