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
0659f7bc
Commit
0659f7bc
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2004-07-05 13:19:51 by afrisch] eval
Original author: afrisch Date: 2004-07-05 13:19:52+00:00
parent
8a816d45
Changes
18
Hide whitespace changes
Inline
Side-by-side
Makefile
View file @
0659f7bc
...
...
@@ -35,7 +35,7 @@ charme_build:
install_web_distant
:
$(MAKE)
webpages
scp CHANGES INSTALL INSTALL.WIN32 web/www/
*
.html web/cduce.css cduce@iris:public_html/
scp CHANGES INSTALL INSTALL.WIN32 web/www/
*
.html web/cduce.css cduce@iris
.ens.fr
:public_html/
SCRIPT
=
INCLUDES_DEB
=
$(INCLUDES)
$(
shell
ocamlfind query
-i-format
-recursive
$(PACKAGES)
)
...
...
Makefile.distrib
View file @
0659f7bc
...
...
@@ -81,6 +81,7 @@ INSTALL := $(shell which install)
ifeq
($(NATIVE),true)
.PHONY
:
cduce_lib.cma
cduce_lib.cma
:
$(HIDE)$(MAKE)
NATIVE
=
false
$@
endif
...
...
@@ -233,8 +234,9 @@ cduce_packed: cduce_packed.$(EXTENSION)
cduce_lib.$(EXTENSION_LIB)
:
$(OBJECTS:.cmo=.$(EXTENSION))
@
echo
"
Build
$@
"
@
echo
"
Pack cduce_lib.
$(EXTENSION)
"
$(HIDE)$(COMPILE)
-o
cduce_lib.
$(EXTENSION)
-pack
$^
@
echo
"Build
$@
"
$(HIDE)$(COMPILE)
-a
-o
$@
cduce_lib.
$(EXTENSION)
...
...
depend
View file @
0659f7bc
...
...
@@ -210,12 +210,12 @@ types/builtin.cmo: types/atoms.cmi types/builtin_defs.cmi types/chars.cmi \
types/ident.cmo types/intervals.cmi runtime/load_xml.cmi \
parser/location.cmi misc/ns.cmi compile/operators.cmi \
runtime/print_xml.cmi types/sequence.cmi typing/typer.cmi types/types.cmi \
runtime/value.cmi types/builtin.cmi
parser/ulexer.cmi parser/url.cmi
runtime/value.cmi types/builtin.cmi
types/builtin.cmx: types/atoms.cmx types/builtin_defs.cmx types/chars.cmx \
types/ident.cmx types/intervals.cmx runtime/load_xml.cmx \
parser/location.cmx misc/ns.cmx compile/operators.cmx \
runtime/print_xml.cmx types/sequence.cmx typing/typer.cmx types/types.cmx \
runtime/value.cmx types/builtin.cmi
parser/ulexer.cmx parser/url.cmx
runtime/value.cmx types/builtin.cmi
driver/librarian.cmo: types/builtin.cmi compile/compile.cmi \
misc/encodings.cmi runtime/eval.cmi types/externals.cmi types/ident.cmo \
compile/lambda.cmi parser/location.cmi parser/parser.cmi \
...
...
@@ -239,10 +239,10 @@ driver/cduce.cmx: parser/ast.cmx types/builtin.cmx compile/compile.cmx \
misc/state.cmx typing/typer.cmx types/types.cmx parser/ulexer.cmx \
runtime/value.cmx driver/cduce.cmi
ocamliface/mltypes.cmo: ocamliface/asttypes.cmo driver/config.cmi \
types/ident.cmo driver/librarian.cmi types/types.cmi \
types/ident.cmo driver/librarian.cmi
parser/location.cmi
types/types.cmi \
ocamliface/mltypes.cmi
ocamliface/mltypes.cmx: ocamliface/asttypes.cmx driver/config.cmx \
types/ident.cmx driver/librarian.cmx types/types.cmx \
types/ident.cmx driver/librarian.cmx
parser/location.cmx
types/types.cmx \
ocamliface/mltypes.cmi
ocamliface/mlstub.cmo: types/atoms.cmi types/builtin_defs.cmi \
compile/compile.cmi driver/config.cmi types/externals.cmi types/ident.cmo \
...
...
@@ -291,10 +291,10 @@ tools/validate.cmo: schema/schema_common.cmi schema/schema_parser.cmi \
tools/validate.cmx: schema/schema_common.cmx schema/schema_parser.cmx \
schema/schema_types.cmx
ocamliface/mltypes.cmo: ocamliface/asttypes.cmo driver/config.cmi \
types/ident.cmo driver/librarian.cmi types/types.cmi \
types/ident.cmo driver/librarian.cmi
parser/location.cmi
types/types.cmi \
ocamliface/mltypes.cmi
ocamliface/mltypes.cmx: ocamliface/asttypes.cmx driver/config.cmx \
types/ident.cmx driver/librarian.cmx types/types.cmx \
types/ident.cmx driver/librarian.cmx
parser/location.cmx
types/types.cmx \
ocamliface/mltypes.cmi
ocamliface/mlstub.cmo: types/atoms.cmi types/builtin_defs.cmi \
compile/compile.cmi driver/config.cmi types/externals.cmi types/ident.cmo \
...
...
@@ -367,6 +367,7 @@ compile/operators.cmi: misc/custom.cmo parser/location.cmi misc/serialize.cmi \
types/builtin.cmi: typing/typer.cmi runtime/value.cmi
driver/librarian.cmi: compile/compile.cmi types/ident.cmo typing/typer.cmi \
types/types.cmi runtime/value.cmi
driver/cduce.cmi: misc/encodings.cmi runtime/value.cmi
ocamliface/mltypes.cmi: ocamliface/asttypes.cmo types/types.cmi
query/query.cmi: parser/ast.cmo
ocamliface/mltypes.cmi: ocamliface/asttypes.cmo types/types.cmi
...
...
driver/cduce.ml
View file @
0659f7bc
...
...
@@ -315,3 +315,33 @@ let run obj =
let
dump_env
ppf
=
dump_env
ppf
!
typing_env
!
compile_env
let
eval
s
=
let
st
=
Stream
.
of_string
s
in
let
phs
=
parse
Parser
.
prog
st
in
let
vals
=
ref
[]
in
let
show
id
t
v
=
match
id
,
v
with
|
Some
id
,
Some
v
->
let
id
=
Id
.
value
id
in
vals
:=
(
Some
id
,
v
)
::
!
vals
|
None
,
Some
v
->
vals
:=
(
None
,
v
)
::
!
vals
|
_
->
assert
false
in
let
r
()
=
ignore
(
Compile
.
comp_unit
~
run
:
true
~
show
Builtin
.
env
Compile
.
empty_toplevel
phs
)
in
Eval
.
new_stack
r
()
;
List
.
rev
!
vals
let
eval
s
=
try
eval
s
with
exn
->
let
b
=
Buffer
.
create
1024
in
let
ppf
=
Format
.
formatter_of_buffer
b
in
print_exn
ppf
exn
;
Format
.
fprintf
ppf
"@."
;
raise
(
Value
.
CDuceExn
(
Value
.
ocaml2cduce_string
(
Buffer
.
contents
b
)))
driver/cduce.mli
View file @
0659f7bc
...
...
@@ -11,3 +11,7 @@ val compile_run: string -> unit
val
run
:
string
->
unit
val
print_exn
:
Format
.
formatter
->
exn
->
unit
val
eval
:
string
->
(
Encodings
.
Utf8
.
t
option
*
Value
.
t
)
list
(* Can be used from CDuce units *)
ocamliface/mlstub.ml
View file @
0659f7bc
...
...
@@ -50,6 +50,7 @@ and typ_descr = function
|
Builtin
(
"array"
,
[
t
])
->
Types
.
descr
(
Sequence
.
star_node
(
typ
t
))
|
Builtin
(
"Pervasives.ref"
,
[
t
])
->
Builtin_defs
.
ref_type
(
typ
t
)
|
Builtin
(
"Cduce_lib.Value.t"
,
[]
)
->
Types
.
any
|
Builtin
(
"Cduce_lib.Encodings.Utf8.t"
,
[]
)
->
Builtin_defs
.
string
|
Builtin
(
"unit"
,
[]
)
->
Sequence
.
nil_type
|
Var
i
->
Types
.
descr
(
!
vars
)
.
(
i
)
|
_
->
assert
false
...
...
@@ -272,6 +273,8 @@ and to_cd_descr e = function
)
|
Builtin
(
"Cduce_lib.Value.t"
,
[]
)
->
e
|
Builtin
(
"Cduce_lib.Encodings.Utf8.t"
,
[]
)
->
<:
expr
<
Value
.
ocaml2cduce_string_utf8
$
e
$
>>
|
Builtin
(
"unit"
,
[]
)
->
<:
expr
<
do
{
$
e
$;
Value
.
nil
}
>>
|
Var
_
->
e
|
_
->
assert
false
...
...
@@ -393,6 +396,8 @@ and to_ml_descr e = function
let
e
=
<:
expr
<
Eval
.
eval_apply
$
e
$
Value
.
nil
>>
in
<:
expr
<
Pervasives
.
ref
$
to_ml
e
t
$
>>
|
Builtin
(
"Cduce_lib.Value.t"
,
[]
)
->
e
|
Builtin
(
"Cduce_lib.Encodings.Utf8.t"
,
[]
)
->
<:
expr
<
Value
.
cduce2ocaml_string_utf8
$
e
$
>>
|
Builtin
(
"unit"
,
[]
)
->
<:
expr
<
ignore
$
e
$
>>
|
Var
_
->
e
|
_
->
assert
false
...
...
ocamliface/mltypes.ml
View file @
0659f7bc
...
...
@@ -80,7 +80,11 @@ let new_slot () =
let
builtins
=
List
.
fold_left
(
fun
m
x
->
StringMap
.
add
x
()
m
)
StringMap
.
empty
[
"list"
;
"Pervasives.ref"
;
"CDuce_all.Value.t"
;
"unit"
;
"array"
]
[
"list"
;
"Pervasives.ref"
;
"unit"
;
"array"
;
"Cduce_lib.Value.t"
;
"Cduce_lib.Encodings.Utf8.t"
]
let
vars
=
ref
[]
...
...
@@ -203,6 +207,16 @@ let read_cmi name =
)
sg
;
(
Buffer
.
contents
buf
,
!
values
)
let
read_cmi
name
=
try
read_cmi
name
with
Env
.
Error
e
->
Env
.
report_error
Format
.
str_formatter
e
;
let
s
=
Format
.
flush_str_formatter
()
in
let
s
=
Printf
.
sprintf
"Error while reading OCaml interface %s: %s"
name
s
in
raise
(
Location
.
Generic
s
)
let
print_ocaml
=
Printtyp
.
type_expr
...
...
runtime/eval.ml
View file @
0659f7bc
...
...
@@ -334,3 +334,12 @@ let code_items =
protect_eval
(
List
.
iter
eval
)
let
new_stack
f
x
=
let
old_stack
=
!
stack
and
old_frame
=
!
frame
and
old_sp
=
!
sp
in
stack
:=
Array
.
create
1024
Value
.
Absent
;
frame
:=
0
;
sp
:=
0
;
let
restore
()
=
stack
:=
old_stack
;
frame
:=
old_frame
;
sp
:=
old_sp
in
try
let
v
=
f
x
in
restore
()
;
v
with
exn
->
restore
()
;
raise
exn
runtime/eval.mli
View file @
0659f7bc
...
...
@@ -22,3 +22,6 @@ val eval_apply: t -> t -> t
val
code_items
:
code_item
list
->
unit
val
stack
:
t
array
ref
val
new_stack
:
(
'
a
->
'
b
)
->
'
a
->
'
b
runtime/value.ml
View file @
0659f7bc
...
...
@@ -601,9 +601,18 @@ let ocaml2cduce_string = string_latin1
let
cduce2ocaml_string
=
get_string_latin1
let
ocaml2cduce_string_utf8
=
string_utf8
let
cduce2ocaml_string_utf8
s
=
fst
(
get_string_utf8
s
)
let
ocaml2cduce_char
c
=
Char
(
Chars
.
V
.
mk_char
c
)
let
cduce2ocaml_char
=
function
|
Char
c
->
Chars
.
V
.
to_char
c
|
_
->
assert
false
let
print_utf8
v
=
print_string
(
U
.
get_str
v
);
flush
stdout
runtime/value.mli
View file @
0659f7bc
...
...
@@ -108,5 +108,10 @@ val ocaml2cduce_int : int -> t
val
cduce2ocaml_int
:
t
->
int
val
ocaml2cduce_string
:
string
->
t
val
cduce2ocaml_string
:
t
->
string
val
ocaml2cduce_string_utf8
:
U
.
t
->
t
val
cduce2ocaml_string_utf8
:
t
->
U
.
t
val
ocaml2cduce_char
:
char
->
t
val
cduce2ocaml_char
:
t
->
char
val
print_utf8
:
U
.
t
->
unit
tests/ocaml/Makefile
View file @
0659f7bc
...
...
@@ -31,5 +31,13 @@ cdmysql:
./
$@
.PHONY
:
eval
eval
:
$(CDUCE)
--compile
$@
.cd
-I
`
ocamlfind query cduce
`
ocamlfind
$(CAML)
-o
$@
-pp
"
$(CDO2ML)
-static"
-impl
$@
.cdo
-package
cduce
-linkpkg
./
$@
clean
:
rm
-f
*
.cmo
*
.cmx
*
.o
*
.cdo
*
.cmi a.ml
*
~ a
tests/ocaml/eval.cd
0 → 100644
View file @
0659f7bc
let pr = Cduce_lib.Value.print_utf8
try
let l = Cduce_lib.Cduce.eval
"let fun f (x : Int) : Int = x + 1;;
let fun g (x : Int) : Int = 2 * x;;
let x = Sys.getenv ['HOME'];;
f;; g;;
let a = g (f 10);;
"
in
transform l with
| ((`Some,id),v) ->
pr [ !id ' = ' !(string_of v) '\n' ]
| (`None, f & (Int -> Int)) ->
pr [ !(string_of (f 100)) '\n' ]
| (`None,v) ->
pr [ !(string_of v) '\n' ]
with (exn & Latin1) ->
print [ 'Exception: ' !exn '\n' ]
\ No newline at end of file
types/builtin.ml
View file @
0659f7bc
open
Builtin_defs
let
eval
=
ref
(
fun
ppf
err
s
->
assert
false
)
(* Types *)
let
types
=
...
...
@@ -337,4 +339,5 @@ unary_op_gen "flatten"
unary_op_cst
"raise"
any
Types
.
empty
(
fun
v
->
raise
(
Value
.
CDuceExn
v
))
(
fun
v
->
raise
(
Value
.
CDuceExn
v
));;
types/builtin.mli
View file @
0659f7bc
...
...
@@ -3,3 +3,4 @@ val env: Typer.t
val
argv
:
Value
.
t
ref
typing/typer.ml
View file @
0659f7bc
...
...
@@ -500,21 +500,7 @@ module SlotTable = Hashtbl.Make(
let
rec
derecurs
env
p
=
match
p
.
descr
with
|
PatVar
v
->
(
match
Ns
.
split_qname
v
with
|
""
,
v
->
let
v
=
ident
v
in
(
try
PAlias
(
Env
.
find
v
env
.
penv_derec
)
with
Not_found
->
try
PType
(
find_type
v
env
.
penv_tenv
)
with
Not_found
->
PCapture
v
)
|
cu
,
v
->
try
let
cu
=
U
.
mk
cu
in
PType
(
find_type_global
p
.
loc
cu
(
ident
v
)
env
.
penv_tenv
)
with
Not_found
->
raise_loc_generic
p
.
loc
(
"Unbound external type "
^
cu
^
":"
^
(
U
.
to_string
v
)))
|
PatVar
v
->
derecurs_var
env
p
.
loc
v
|
SchemaVar
(
kind
,
schema_name
,
component_name
)
->
PType
(
find_schema_descr
env
.
penv_tenv
kind
schema_name
component_name
)
|
Recurs
(
p
,
b
)
->
derecurs
(
derecurs_def
env
b
)
p
...
...
@@ -553,6 +539,23 @@ and derecurs_regexp vars env = function
|
SeqCapture
(
x
,
p
)
->
derecurs_regexp
(
fun
p
->
PAnd
(
vars
p
,
PCapture
x
))
env
p
and
derecurs_var
env
loc
v
=
match
Ns
.
split_qname
v
with
|
""
,
v
->
let
v
=
ident
v
in
(
try
PAlias
(
Env
.
find
v
env
.
penv_derec
)
with
Not_found
->
try
PType
(
find_type
v
env
.
penv_tenv
)
with
Not_found
->
PCapture
v
)
|
cu
,
v
->
try
let
cu
=
U
.
mk
cu
in
PType
(
find_type_global
loc
cu
(
ident
v
)
env
.
penv_tenv
)
with
Not_found
->
raise_loc_generic
loc
(
"Unbound external type "
^
cu
^
":"
^
(
U
.
to_string
v
))
and
derecurs_def
env
b
=
let
b
=
List
.
map
(
fun
(
v
,
p
)
->
(
v
,
p
,
mk_derecurs_slot
p
.
loc
))
b
in
...
...
@@ -834,6 +837,7 @@ let pat env p =
type
type_fun
=
Types
.
t
->
bool
->
Types
.
t
let
typ_cst
=
ref
(
fun
_
->
assert
false
)
let
mk_unary_op
=
ref
(
fun
_
_
->
assert
false
)
let
typ_unary_op
=
ref
(
fun
_
_
_
->
assert
false
)
let
mk_binary_op
=
ref
(
fun
_
_
->
assert
false
)
...
...
@@ -859,18 +863,7 @@ let rec expr env loc = function
|
Forget
(
e
,
t
)
->
let
(
fv
,
e
)
=
expr
env
loc
e
and
t
=
typ
env
t
in
exp
loc
fv
(
Typed
.
Forget
(
e
,
t
))
|
Var
s
->
(
match
Ns
.
split_qname
s
with
|
""
,
id
->
let
s
=
U
.
get_str
id
in
if
String
.
contains
s
'.'
then
extern
loc
env
s
[]
else
let
id
=
ident
id
in
exp
loc
(
Fv
.
singleton
id
)
(
Typed
.
Var
id
)
|
cu
,
id
->
let
cu
=
find_cu
(
U
.
mk
cu
)
env
in
exp
loc
Fv
.
empty
(
Typed
.
ExtVar
(
cu
,
ident
id
)))
|
Var
s
->
var
env
loc
s
|
Apply
(
e1
,
e2
)
->
let
(
fv1
,
e1
)
=
expr
env
loc
e1
and
(
fv2
,
e2
)
=
expr
env
loc
e2
in
exp
loc
(
Fv
.
cup
fv1
fv2
)
(
Typed
.
Apply
(
e1
,
e2
))
...
...
@@ -969,6 +962,19 @@ let rec expr env loc = function
let
(
i
,
t
)
=
Externals
.
resolve
s
args
in
exp
loc
Fv
.
empty
(
Typed
.
External
(
t
,
i
))
with
exn
->
raise_loc
loc
exn
and
var
env
loc
s
=
match
Ns
.
split_qname
s
with
|
""
,
id
->
let
s
=
U
.
get_str
id
in
if
String
.
contains
s
'.'
then
extern
loc
env
s
[]
else
let
id
=
ident
id
in
exp
loc
(
Fv
.
singleton
id
)
(
Typed
.
Var
id
)
|
cu
,
id
->
let
cu
=
find_cu
(
U
.
mk
cu
)
env
in
exp
loc
Fv
.
empty
(
Typed
.
ExtVar
(
cu
,
ident
id
))
and
branches
env
b
=
let
fv
=
ref
Fv
.
empty
in
...
...
typing/typer.mli
View file @
0659f7bc
...
...
@@ -73,9 +73,9 @@ val get_schema_names: t -> U.t list (** registered schema names *)
(* Operators *)
type
type_fun
=
Types
.
t
->
bool
->
Types
.
t
val
mk_unary_op
:
(
string
->
t
->
int
)
ref
val
typ_unary_op
:
(
int
->
loc
->
type_fun
->
type_fun
)
ref
val
mk_binary_op
:
(
string
->
t
->
int
)
ref
val
typ_binary_op
:
(
int
->
loc
->
type_fun
->
type_fun
->
type_fun
)
ref
web/manual/interface.xml
View file @
0659f7bc
...
...
@@ -102,6 +102,8 @@ The type <code>Cduce_lib.Value.t</code> is translated to the CDuce
type
<code>
Any
</code>
. The corresponding translation functions are the
identity. This can be used to avoid multiple copies when translating
a complex value back and forth between CDuce and OCaml.
The type
<code>
Cduce_lib.Encodings.Utf8.t
</code>
is translated to the CDuce
type
<code>
String
</code>
.
</li>
<li>
...
...
@@ -154,6 +156,7 @@ The canonical translation is summarized in the following box:
<td><tt>
ref T(
<i>
t
</i>
)
</tt></td></tr>
<tr><td><tt>
Cduce_lib.Value.t
</tt></td><td><tt>
Any
</tt></td></tr>
<tr><td><tt>
Cduce_lib.Encodings.Utf8.t
</tt></td><td><tt>
String
</tt></td></tr>
</table>
<p>
...
...
@@ -378,7 +381,7 @@ compile and link it with:
<sample>
cduce --compile cdsdl.cd -I `ocamlfind query ocamlsdl`
ocamlfind ocamlc -o cdsdl -pp "cdo2ml -static" -impl cdsdl.cdo \
-package cduce,ocamlsdl -linkpkg
-package cduce,ocamlsdl -linkpkg
</sample>
...
...
@@ -413,7 +416,53 @@ compile and link it with:
<sample>
cduce --compile cdmysql.cd -I `ocamlfind query mysql`
ocamlfind ocamlc -o cdmysql -pp "cdo2ml -static" -impl cdmysql.cdo \
-package cduce,mysql -linkpkg
-package cduce,mysql -linkpkg
</sample>
</section>
<section
title=
"Evaluating CDuce expressions"
>
<p>
This example demonstrates how to dynamically compile
and evaluate CDuce programs contained in a string.
</p>
<sample>
<![CDATA[
let pr = Cduce_lib.Value.print_utf8
try
let l = Cduce_lib.Cduce.eval
"let fun f (x : Int) : Int = x + 1;;
let fun g (x : Int) : Int = 2 * x;;
f;; g;;
let a = g (f 10);;
"
in
transform l with
| ((`Some,id),v) ->
pr [ !id ' = ' !(string_of v) '\n' ]
| (`None, f
&
(Int -> Int)) ->
pr [ !(string_of (f 100)) '\n' ]
| (`None,v) ->
pr [ !(string_of v) '\n' ]
with (exn
&
Latin1) ->
print [ 'Exception: ' !exn '\n' ]
]]>
</sample>
<p>
If you put these lines in a file
<code>
cdmysql.cd
</code>
, you can
compile and link it with:
</p>
<sample>
cduce --compile eval.cd -I `ocamlfind query cduce`
ocamlfind ocamlc -o eval -pp "cdo2ml -static" -impl eval.cdo \
-package cduce -linkpkg
</sample>
</section>
...
...
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