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
2e678f4e
Commit
2e678f4e
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2004-06-30 17:29:12 by afrisch] Error messages
Original author: afrisch Date: 2004-06-30 17:29:12+00:00
parent
2c8136b9
Changes
8
Hide whitespace changes
Inline
Side-by-side
Makefile.distrib
View file @
2e678f4e
...
...
@@ -149,7 +149,6 @@ OBJECTS = \
\
compile/lambda.cmo
\
runtime/value.cmo
\
types/externals.cmo
\
\
schema/schema_types.cmo
\
schema/schema_xml.cmo
\
...
...
@@ -160,6 +159,7 @@ OBJECTS = \
\
parser/location.cmo parser/url.cmo parser/ulexer.cmo parser/ast.cmo parser/parser.cmo
\
\
types/externals.cmo
\
typing/typed.cmo typing/typer.cmo
\
\
runtime/load_xml.cmo runtime/run_dispatch.cmo
\
...
...
depend
View file @
2e678f4e
...
...
@@ -80,8 +80,8 @@ runtime/value.cmo: types/atoms.cmi types/builtin_defs.cmi types/chars.cmi \
runtime/value.cmx: types/atoms.cmx types/builtin_defs.cmx types/chars.cmx \
misc/encodings.cmx types/ident.cmx types/intervals.cmx compile/lambda.cmx \
misc/ns.cmx types/sequence.cmx types/types.cmx runtime/value.cmi
types/externals.cmo: types/externals.cmi
types/externals.cmx: types/externals.cmi
types/externals.cmo:
parser/location.cmi
types/externals.cmi
types/externals.cmx:
parser/location.cmx
types/externals.cmi
schema/schema_types.cmo: misc/encodings.cmi types/intervals.cmi misc/ns.cmi \
runtime/value.cmi schema/schema_types.cmi
schema/schema_types.cmx: misc/encodings.cmx types/intervals.cmx misc/ns.cmx \
...
...
@@ -258,6 +258,10 @@ ocamliface/mlstub.cmx: types/atoms.cmx types/builtin_defs.cmx \
ocamliface/mlstub.cmi
parser/cduce_curl.cmo: driver/config.cmi parser/url.cmi
parser/cduce_curl.cmx: driver/config.cmx parser/url.cmx
runtime/cduce_pxp.cmo: driver/config.cmi runtime/load_xml.cmi \
parser/location.cmi parser/url.cmi
runtime/cduce_pxp.cmx: driver/config.cmx runtime/load_xml.cmx \
parser/location.cmx parser/url.cmx
runtime/cduce_expat.cmo: driver/config.cmi runtime/load_xml.cmi \
parser/location.cmi parser/url.cmi
runtime/cduce_expat.cmx: driver/config.cmx runtime/load_xml.cmx \
...
...
driver/run.ml
View file @
2e678f4e
...
...
@@ -72,7 +72,6 @@ let err s =
let
mode
()
=
Arg
.
parse
!
specs
(
fun
s
->
src
:=
s
::
!
src
)
"Usage:
\n
cduce [OPTIONS ...] [FILE ...] [--arg argument ...]
\n\n
Options:"
;
Config
.
init_all
()
;
match
(
!
compile
,!
out_dir
,!
run
,!
src
,!
args
)
with
|
false
,
_
::_,
_
,
_
,
_
->
err
"--obj-dir option can be used only with --compile"
...
...
@@ -176,16 +175,21 @@ let save () =
let
main
()
=
match
mode
()
with
|
`Toplevel
args
->
Config
.
inhibit
"ocaml"
;
Config
.
init_all
()
;
Builtin
.
argv
:=
argv
args
;
restore
()
;
toploop
()
;
save
()
|
`Script
(
f
,
args
)
->
Config
.
init_all
()
;
Builtin
.
argv
:=
argv
args
;
Cduce
.
compile_run
f
|
`Compile
(
f
,
o
)
->
Config
.
init_all
()
;
Cduce
.
compile
f
o
|
`Run
(
f
,
args
)
->
Config
.
init_all
()
;
Builtin
.
argv
:=
argv
args
;
Cduce
.
run
f
...
...
ocamliface/cdo2ml.ml
View file @
2e678f4e
...
...
@@ -53,10 +53,10 @@ let () =
(
fun
(
cu
,
chk
)
->
<:
expr
<
(
$
str
:
str
cu
$,$
str
:
str
chk
$
)
>>
)
depend
)
in
<:
expr
<
C
D
uce_
all
.
Librarian
.
register_unit
<:
expr
<
C
d
uce_
lib
.
Librarian
.
register_unit
$
str
:
str
name
$
$
str
:
str
raw
$
$
str
:
str
digest
$
$
dep
$
>>
else
<:
expr
<
C
D
uce_
all
.
Librarian
.
load_unit
$
str
:
str
name
$
$
str
:
str
digest
$
>>
<:
expr
<
C
d
uce_
lib
.
Librarian
.
load_unit
$
str
:
str
name
$
$
str
:
str
digest
$
>>
in
let
cu
=
<:
str_item
<
value
cu
=
$
cu
$
>>
in
...
...
ocamliface/mlstub.ml
View file @
2e678f4e
...
...
@@ -48,7 +48,7 @@ and typ_descr = function
|
Abstract
s
->
Types
.
abstract
(
Types
.
Abstract
.
atom
s
)
|
Builtin
(
"list"
,
[
t
])
->
Types
.
descr
(
Sequence
.
star_node
(
typ
t
))
|
Builtin
(
"Pervasives.ref"
,
[
t
])
->
Builtin_defs
.
ref_type
(
typ
t
)
|
Builtin
(
"C
D
uce_
all
.Value.t"
,
[]
)
->
Types
.
any
|
Builtin
(
"C
d
uce_
lib
.Value.t"
,
[]
)
->
Types
.
any
|
Builtin
(
"unit"
,
[]
)
->
Sequence
.
nil_type
|
Var
i
->
Types
.
descr
(
!
vars
)
.
(
i
)
|
_
->
assert
false
...
...
@@ -268,7 +268,7 @@ and to_cd_descr e = function
<:
expr
<
Value
.
mk_ext_ref
$
tt
$
$
get
$
$
set
$
>>
)
|
Builtin
(
"C
D
uce_
all
.Value.t"
,
[]
)
->
e
|
Builtin
(
"C
d
uce_
lib
.Value.t"
,
[]
)
->
e
|
Builtin
(
"unit"
,
[]
)
->
<:
expr
<
do
{
$
e
$;
Value
.
nil
}
>>
|
Var
_
->
e
|
_
->
assert
false
...
...
@@ -386,7 +386,7 @@ and to_ml_descr e = function
let
e
=
<:
expr
<
Value
.
get_field
$
e
$
$
label_ascii
"get"
$
>>
in
let
e
=
<:
expr
<
Eval
.
eval_apply
$
e
$
Value
.
nil
>>
in
<:
expr
<
Pervasives
.
ref
$
to_ml
e
t
$
>>
|
Builtin
(
"C
D
uce_
all
.Value.t"
,
[]
)
->
e
|
Builtin
(
"C
d
uce_
lib
.Value.t"
,
[]
)
->
e
|
Builtin
(
"unit"
,
[]
)
->
<:
expr
<
ignore
$
e
$
>>
|
Var
_
->
e
|
_
->
assert
false
...
...
@@ -469,7 +469,7 @@ let stub name ty_env c_env values =
let (v1,v2,...,vn) =
let module C = struct
let cu = ...
open C
D
uce_
all
open C
d
uce_
lib
let types = ...
let rec <global translation functions>
<fills external slots>
...
...
@@ -483,7 +483,7 @@ let stub name ty_env c_env values =
let
items_pat
=
List
.
map
(
fun
(
p
,_,_
)
->
p
)
items
in
let
m
=
[
<:
str_item
<
open
C
D
uce_
all
>>;
[
<:
str_item
<
open
C
d
uce_
lib
>>;
<:
str_item
<
value
types
=
Librarian
.
registered_types
cu
>>
]
@
(
if
g
=
[]
then
[]
else
[
<:
str_item
<
value
rec
$
list
:
g
$
>>
])
@
[
<:
str_item
<
Librarian
.
set_externals
cu
[
|$
list
:
exts
$|
]
>>;
...
...
@@ -516,24 +516,22 @@ let register () =
Externals
.
register
:=
(
fun
i
s
args
->
let
(
t
,
n
)
=
try
Mltypes
.
find_value
s
with
Not_found
->
Printf
.
eprintf
"Cannot resolve the external symbol %s
\n
"
s
;
exit
1
in
let
m
=
List
.
length
args
in
if
n
<>
m
then
(
Printf
.
eprintf
"Wrong arity for external symbol %s (real arity = %i; given = %i)
\n
"
s
n
m
;
exit
1
);
exts
:=
(
s
,
t
)
::
!
exts
;
vars
:=
Array
.
of_list
args
;
let
cdt
=
Types
.
descr
(
typ
t
)
in
vars
:=
[
|
|
];
cdt
try
let
(
t
,
n
)
=
Mltypes
.
find_value
s
in
let
m
=
List
.
length
args
in
if
n
<>
m
then
Location
.
raise_generic
(
Printf
.
sprintf
"Wrong arity for external symbol %s (real arity = %i; given = %i)"
s
n
m
);
exts
:=
(
s
,
t
)
::
!
exts
;
vars
:=
Array
.
of_list
args
;
let
cdt
=
Types
.
descr
(
typ
t
)
in
vars
:=
[
|
|
];
cdt
with
Not_found
->
Location
.
raise_generic
(
Printf
.
sprintf
"Cannot resolve ocaml external %s"
s
)
)
let
()
=
...
...
types/externals.ml
View file @
2e678f4e
...
...
@@ -2,9 +2,14 @@ let nb_ext_syms = ref 0
let
nb
()
=
!
nb_ext_syms
let
register
=
ref
(
fun
i
s
args
->
assert
false
)
let
register
=
ref
(
fun
i
s
args
->
Location
.
raise_generic
"No built-in support for ocaml externals"
)
let
resolve
s
args
=
let
i
=
!
nb_ext_syms
in
let
x
=
!
register
i
s
args
in
incr
nb_ext_syms
;
(
i
,
!
register
i
s
args
)
(
i
,
x
)
types/externals.mli
View file @
2e678f4e
...
...
@@ -2,4 +2,4 @@ val nb: unit -> int
val
register
:
ref
(
int
->
string
->
Types
.
Node
.
t
list
->
Types
.
t
)
val
resolve
:
string
->
Types
.
Node
.
t
list
->
int
*
Types
.
t
val
resolve
:
string
->
Types
.
Node
.
t
list
->
(
int
*
Types
.
t
)
typing/typer.ml
View file @
2e678f4e
...
...
@@ -948,9 +948,11 @@ let rec expr env loc = function
extern
loc
env
s
args
and
extern
loc
env
s
args
=
let
args
=
List
.
map
(
typ
env
)
args
in
let
args
=
List
.
map
(
typ
env
)
args
in
try
let
(
i
,
t
)
=
Externals
.
resolve
s
args
in
exp
loc
Fv
.
empty
(
Typed
.
External
(
t
,
i
))
with
exn
->
raise_loc
loc
exn
and
branches
env
b
=
let
fv
=
ref
Fv
.
empty
in
...
...
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