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
057c12c6
Commit
057c12c6
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2004-06-28 04:51:58 by afrisch] -static
Original author: afrisch Date: 2004-06-28 04:51:59+00:00
parent
f6ac2e83
Changes
9
Hide whitespace changes
Inline
Side-by-side
driver/cduce.ml
View file @
057c12c6
...
...
@@ -288,7 +288,7 @@ let compile src out_dir =
let
out
=
Filename
.
concat
out_dir
(
cu
^
".cdo"
)
in
let
id
=
Types
.
CompUnit
.
mk
(
U
.
mk_latin1
cu
)
in
Librarian
.
compile
!
verbose
cu
id
src
;
Librarian
.
save
id
out
;
Librarian
.
save
cu
id
out
;
exit
0
with
exn
->
catch_exn
Format
.
err_formatter
exn
;
exit
1
...
...
driver/librarian.ml
View file @
057c12c6
...
...
@@ -64,6 +64,7 @@ let deserialize s =
let
types
=
Serialize
.
Get
.
array
Types
.
deserialize
s
in
mk
((
typing
,
compile
,
code
)
,
types
)
(*
let serialize_dep=
Serialize.Put.list
(Serialize.Put.pair Encodings.Utf8.serialize Serialize.Put.string)
...
...
@@ -71,6 +72,7 @@ let serialize_dep=
let deserialize_dep =
Serialize.Get.list
(Serialize.Get.pair Encodings.Utf8.deserialize Serialize.Get.string)
*)
let
find_obj
id
=
...
...
@@ -79,7 +81,7 @@ 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
=
let
save
name
id
out
=
protect_op
"Save compilation unit"
;
let
cu
=
find
id
in
...
...
@@ -103,10 +105,10 @@ let save id out =
)
depend
with
Not_found
->
assert
false
in
let
depend
=
Serialize
.
Put
.
run
serialize_dep
depend
in
(*
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
,
cu
.
stub
)
[]
;
Marshal
.
to_channel
oc
(
name
,
digest
,
depend
,
raw
,
cu
.
stub
)
[]
;
close_out
oc
...
...
@@ -192,28 +194,40 @@ let rec load id =
try
open_in
obj
with
Sys_error
_
->
raise
(
CannotOpen
obj
)
in
let
(
dig
,
depend
,
raw
,
stub
)
=
let
(
name
,
dig
,
depend
,
raw
,
stub
)
=
try
Marshal
.
from_channel
ic
with
Failure
_
|
End_of_file
->
raise
(
InvalidObject
obj
)
in
close_in
ic
;
let
depend
=
Serialize
.
Get
.
run
deserialize_dep
depend
in
(*
let depend = Serialize.Get.run deserialize_dep depend in
*)
check_loop
id
;
if
!
during_compile
then
depends
:=
id
::
!
depends
;
List
.
iter
(
fun
(
id
,
dig
)
->
load_check
(
C
.
mk
id
)
dig
)
depend
;
C
.
enter
id
;
let
cu
=
Serialize
.
Get
.
run
deserialize
raw
in
C
.
leave
()
;
cu
.
depends
<-
List
.
map
(
fun
(
id
,_
)
->
C
.
mk
id
)
depend
;
cu
.
digest
<-
Some
dig
;
C
.
Tbl
.
add
tbl
id
cu
;
Typer
.
register_types
id
cu
.
typing
;
cu
load_from_string
id
raw
dig
depend
and
load_check
id
exp
=
let
cu
=
load
id
in
check_digest
id
exp
cu
.
digest
and
load_from_string
id
raw
dig
depend
=
List
.
iter
(
fun
(
id
,
dig
)
->
load_check
(
C
.
mk
id
)
dig
)
depend
;
C
.
enter
id
;
let
cu
=
Serialize
.
Get
.
run
deserialize
raw
in
C
.
leave
()
;
cu
.
depends
<-
List
.
map
(
fun
(
id
,_
)
->
C
.
mk
id
)
depend
;
C
.
Tbl
.
add
tbl
id
cu
;
Typer
.
register_types
id
cu
.
typing
;
cu
.
digest
<-
Some
dig
;
cu
let
load_from_string
id
raw
dig
depend
=
if
C
.
Tbl
.
mem
tbl
id
then
failwith
"Librarian: unit already loaded"
;
load_from_string
id
raw
dig
depend
let
register_unit
id
raw
dig
depend
=
let
id
=
C
.
mk
(
Ident
.
U
.
mk
id
)
in
let
depend
=
List
.
map
(
fun
(
x
,
y
)
->
(
Ident
.
U
.
mk
x
,
y
))
depend
in
ignore
(
load_from_string
id
raw
dig
depend
)
let
rec
run
id
=
let
cu
=
find
id
in
match
cu
.
status
with
...
...
@@ -238,8 +252,12 @@ let rec run id =
let
import
id
=
ignore
(
load
id
)
let
import_check
id
chk
=
ignore
(
load_check
id
chk
)
let
import_and_run
id
=
import
id
;
run
id
let
import_from_string
id
str
dig
dep
=
ignore
(
load_from_string
id
str
dig
dep
)
let
()
=
Typer
.
from_comp_unit
:=
(
fun
cu
->
(
load
cu
)
.
typing
);
Compile
.
from_comp_unit
:=
(
fun
cu
->
(
load
cu
)
.
compile
);
...
...
driver/librarian.mli
View file @
057c12c6
...
...
@@ -9,8 +9,12 @@ val obj_path: string list ref
val
compile
:
bool
->
string
->
Types
.
CompUnit
.
t
->
string
->
unit
val
run
:
Types
.
CompUnit
.
t
->
unit
val
import
:
Types
.
CompUnit
.
t
->
unit
val
import_check
:
Types
.
CompUnit
.
t
->
Digest
.
t
->
unit
val
import_from_string
:
Types
.
CompUnit
.
t
->
string
->
string
->
(
Ident
.
U
.
t
*
Digest
.
t
)
list
->
unit
val
register_unit
:
string
->
string
->
string
->
(
string
*
string
)
list
->
unit
val
import_and_run
:
Types
.
CompUnit
.
t
->
unit
val
save
:
Types
.
CompUnit
.
t
->
string
->
unit
val
save
:
string
->
Types
.
CompUnit
.
t
->
string
->
unit
val
registered_types
:
Types
.
CompUnit
.
t
->
Types
.
t
array
...
...
misc/inttbl.ml
View file @
057c12c6
...
...
@@ -7,6 +7,7 @@ module type S = sig
val
clear
:
'
a
t
->
unit
val
add
:
'
a
t
->
key
->
'
a
->
unit
val
find
:
'
a
t
->
key
->
'
a
val
mem
:
'
a
t
->
key
->
bool
end
type
key
=
int
...
...
@@ -46,3 +47,8 @@ let find t i =
|
None
->
raise
Not_found
|
Some
x
->
x
let
mem
t
i
=
if
i
>=
Array
.
length
!
t
then
false
else
match
(
!
t
)
.
(
i
)
with
|
None
->
false
|
Some
_
->
true
misc/inttbl.mli
View file @
057c12c6
...
...
@@ -7,6 +7,7 @@ module type S = sig
val
clear
:
'
a
t
->
unit
val
add
:
'
a
t
->
key
->
'
a
->
unit
val
find
:
'
a
t
->
key
->
'
a
val
mem
:
'
a
t
->
key
->
bool
end
include
S
with
type
key
=
int
ocamliface/cdo2ml.ml
View file @
057c12c6
let
loc
=
(
-
1
,-
1
)
let
usage
=
"Usage: cdo2ml <module>.cdo
"Usage: cdo2ml
[-static]
<module>.cdo
Can also be used as a preprocessor for OCaml:
ocamlc -c -pp cdo2ml -impl <module>.cdo
ocamlc -c -pp
\"
cdo2ml -static
\"
-impl <module>.cdo
"
let
err
()
=
prerr_endline
usage
;
exit
1
let
()
=
let
fn
=
if
Array
.
length
Sys
.
argv
!=
2
then
(
prerr_endline
usage
;
exit
1
)
else
Sys
.
argv
.
(
1
)
in
let
fn
,
static
=
match
Array
.
length
Sys
.
argv
with
|
2
->
Sys
.
argv
.
(
1
)
,
false
|
3
->
if
Sys
.
argv
.
(
1
)
<>
"-static"
then
err
()
;
Sys
.
argv
.
(
2
)
,
true
|
_
->
err
()
in
let
ic
=
try
open_in
(
Sys
.
argv
.
(
1
))
try
open_in
fn
with
Sys_error
x
->
prerr_endline
x
;
exit
1
in
let
(
digest
,
depend
,
raw
,
extra
)
=
input_value
ic
in
let
(
name
,
digest
,
depend
,
raw
,
stub
)
:
string
*
Digest
.
t
*
(
string
*
string
)
list
*
string
*
(
string
*
MLast
.
str_item
list
)
option
=
input_value
ic
in
let
(
prolog
,
code
)
=
match
extra
with
match
stub
with
|
None
->
Printf
.
eprintf
"Error: no stub found in this cdo file !
\n
"
;
exit
1
|
Some
x
->
x
in
print_endline
"(* Automatically generated by cdo2ml.ml. Do no edit ! *)"
;
if
static
then
(
Printf
.
printf
"let () = CDuce_all.Librarian.register_unit %S %S %S ["
name
raw
digest
;
List
.
iter
(
fun
(
cu
,
chk
)
->
Printf
.
printf
"(%S,%S)"
cu
chk
)
depend
;
Printf
.
printf
"]
\n
"
;
);
print_endline
prolog
;
let
code
=
List
.
map
(
fun
x
->
(
x
,
loc
))
code
in
!
Pcaml
.
print_implem
code
ocamliface/mlstub.ml
View file @
057c12c6
...
...
@@ -460,7 +460,7 @@ let stub name ty_env c_env values =
<:
str_item
<
Librarian
.
run
cu
>>
]
@
(
if
g
=
[]
then
[]
else
[
<:
str_item
<
value
rec
$
list
:
g
$
>>
])
@
[
<:
str_item
<
value
$
list
:
items
$
>>
]
(
if
items
=
[]
then
[]
else
[
<:
str_item
<
value
$
list
:
items
$
>>
]
)
...
...
@@ -469,13 +469,15 @@ let () =
(
fun
cu
ty_env
c_env
->
try
let
name
=
String
.
capitalize
cu
in
let
(
prolog
,
values
)
=
Mltypes
.
read_cmi
name
in
let
(
prolog
,
values
)
=
try
Mltypes
.
read_cmi
name
with
Not_found
->
Printf
.
eprintf
"Warning: no caml interface
\n
"
;
(
""
,
[]
)
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
,
[
||
]
with
Mltypes
.
Error
s
->
raise
(
Location
.
Generic
s
)
);
Externals
.
register_external
:=
...
...
tests/ocaml/Makefile
View file @
057c12c6
...
...
@@ -2,9 +2,12 @@
run
:
ocamlc
-c
a.mli
../../cduce
--compile
c.cd
../../cduce
--compile
a.cd
../../cdo2ml a.cdo
>
a.ml
ocamlfind ocamlc
-package
cduce
-linkpkg
-o
a a.ml b.ml
../../cdo2ml
-static
c.cdo
>
c.ml
../../cdo2ml
-static
a.cdo
>
a.ml
ocamlfind ocamlc
-package
cduce
-linkpkg
-o
a c.ml a.ml b.ml
rm
*
.cdo
./a
clean
:
...
...
tests/ocaml/a.cd
View file @
057c12c6
...
...
@@ -18,7 +18,7 @@ let pp (x : Any) : Latin1 = string_of x
let exists = external "Sys.file_exists"
let i =
1
let i =
c:j
let home = external "Sys.getenv" "HOME"
...
...
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