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
41703588
Commit
41703588
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2005-04-03 16:50:58 by afrisch] Empty log message
Original author: afrisch Date: 2005-04-03 16:50:59+00:00
parent
87c26eb4
Changes
12
Hide whitespace changes
Inline
Side-by-side
Makefile.types
View file @
41703588
...
...
@@ -49,6 +49,8 @@ SRC= \
cduce/runtime/value.ml
\
cduce/runtime/run_dispatch.mli
\
cduce/runtime/run_dispatch.ml
\
cduce/runtime/explain.mli
\
cduce/runtime/explain.ml
\
cduce/runtime/serial.mli
\
cduce/runtime/serial.ml
...
...
runtime/explain.ml
View file @
41703588
...
...
@@ -13,8 +13,16 @@ let rec print ppf = function
Format
.
fprintf
ppf
"Value @[%a@] does not match type @[%a@]@."
Value
.
print
v
Types
.
Print
.
print
(
Lazy
.
force
t
)
;
Types
.
Print
.
print
(
Lazy
.
force
t
)
let
print_to_string
f
x
=
let
b
=
Buffer
.
create
1024
in
let
ppf
=
Format
.
formatter_of_buffer
b
in
f
ppf
x
;
Buffer
.
contents
b
let
to_string
e
=
print_to_string
print
e
exception
Path
of
t
...
...
runtime/explain.mli
View file @
41703588
type
t
val
print
:
Format
.
formatter
->
t
->
unit
val
to_string
:
t
->
string
val
explain
:
Types
.
t
->
Types
.
t
->
Value
.
t
->
t
option
(** [explain t0 t v]
...
...
runtime/serial.ml
View file @
41703588
...
...
@@ -141,6 +141,13 @@ module G = struct
let
typ
chunk
i
=
T
.
get
(
fun
x
->
x
)
chunk
.
typ
i
let
check
chunk
t0
t
v
=
let
t0
=
typ
chunk
t0
and
t
=
typ
chunk
t
in
match
Explain
.
explain
t0
t
v
with
|
None
->
v
|
Some
p
->
failwith
(
Explain
.
to_string
p
)
let
record
chunk
i
vs
=
Value
.
mk_record
(
LABA
.
get
(
fun
x
->
x
)
chunk
.
laba
i
)
vs
...
...
runtime/serial.mli
View file @
41703588
...
...
@@ -20,6 +20,7 @@ module G : sig
val
const
:
chunk
->
int
->
Value
.
t
val
remove_label
:
chunk
->
int
->
Value
.
t
->
Value
.
t
val
typ
:
chunk
->
int
->
Types
.
t
val
check
:
chunk
->
int
->
int
->
Value
.
t
->
Value
.
t
val
record
:
chunk
->
int
->
Value
.
t
array
->
Value
.
t
val
constr
:
chunk
->
int
->
Value
.
t
array
->
Value
.
t
val
constr_const
:
chunk
->
int
->
Value
.
t
...
...
runtime/value.ml
View file @
41703588
...
...
@@ -644,6 +644,20 @@ let cduce2ocaml_int = function
|
Integer
i
->
Intervals
.
V
.
get_int
i
|
_
->
assert
false
let
ocaml2cduce_int32
i
=
Integer
(
Intervals
.
V
.
from_int32
i
)
let
cduce2ocaml_int32
=
function
|
Integer
i
->
Intervals
.
V
.
to_int32
i
|
_
->
assert
false
let
ocaml2cduce_int64
i
=
Integer
(
Intervals
.
V
.
from_int64
i
)
let
cduce2ocaml_int64
=
function
|
Integer
i
->
Intervals
.
V
.
to_int64
i
|
_
->
assert
false
let
ocaml2cduce_string
=
string_latin1
let
cduce2ocaml_string
=
get_string_latin1
...
...
runtime/value.mli
View file @
41703588
...
...
@@ -130,6 +130,10 @@ val ocaml2cduce_list : ('a -> t) -> 'a list -> t
val
cduce2ocaml_list
:
(
t
->
'
a
)
->
t
->
'
a
list
val
ocaml2cduce_constr
:
t
->
t
array
->
t
val
cduce2ocaml_constr
:
int
Atoms
.
map
->
t
->
Obj
.
t
val
ocaml2cduce_int32
:
int32
->
t
val
cduce2ocaml_int32
:
t
->
int32
val
ocaml2cduce_int64
:
int64
->
t
val
cduce2ocaml_int64
:
t
->
int64
val
print_utf8
:
U
.
t
->
unit
...
...
types/intervals.ml
View file @
41703588
...
...
@@ -17,6 +17,7 @@ let check i = ()
let
from_int
i
=
big_int_of_int
i
let
from_bigint
i
=
i
(* TODO: better serialization of bigints !!! *)
let
serialize
t
i
=
Serialize
.
Put
.
string
t
(
string_of_big_int
i
)
...
...
@@ -43,6 +44,11 @@ let zero = big_int_of_int 0
let
one
=
big_int_of_int
1
let
minus_one
=
big_int_of_int
(
-
1
)
let
is_zero
=
equal
zero
let
from_int32
i
=
mk
(
Int32
.
to_string
i
)
let
from_int64
i
=
mk
(
Int64
.
to_string
i
)
let
to_int32
i
=
Int32
.
of_string
(
to_string
i
)
let
to_int64
i
=
Int64
.
of_string
(
to_string
i
)
end
type
interval
=
...
...
@@ -414,3 +420,6 @@ let cap i1 i2 =
cap i1 i2
*)
let
int32
=
bounded
(
V
.
from_int32
Int32
.
min_int
)
(
V
.
from_int32
Int32
.
max_int
)
let
int64
=
bounded
(
V
.
from_int64
Int64
.
min_int
)
(
V
.
from_int64
Int64
.
max_int
)
types/intervals.mli
View file @
41703588
...
...
@@ -26,6 +26,11 @@ module V : sig
val
zero
:
t
val
one
:
t
val
minus_one
:
t
val
from_int32
:
Int32
.
t
->
t
val
from_int64
:
Int64
.
t
->
t
val
to_int32
:
t
->
Int32
.
t
val
to_int64
:
t
->
Int64
.
t
end
...
...
@@ -64,3 +69,7 @@ val sub : t -> t -> t
val
div
:
t
->
t
->
t
val
modulo
:
t
->
t
->
t
val
negat
:
t
->
t
val
int32
:
t
val
int64
:
t
types/sequence.ml
View file @
41703588
...
...
@@ -172,3 +172,6 @@ let seq_of_list l =
List
.
fold_right
times'
l
nil_type
let
char_latin1
=
Types
.
char
(
Chars
.
mk_classes
[
(
0
,
255
)
])
let
string_latin1
=
star
char_latin1
types/sequence.mli
View file @
41703588
...
...
@@ -5,6 +5,7 @@ val nil_cst: Types.Const.t
val
any
:
Types
.
t
val
seqseq
:
Types
.
t
val
string
:
Types
.
t
val
string_latin1
:
Types
.
t
val
concat
:
Types
.
t
->
Types
.
t
->
Types
.
t
val
flatten
:
Types
.
t
->
Types
.
t
...
...
types_depend
View file @
41703588
...
...
@@ -169,32 +169,28 @@ cduce/runtime/run_dispatch.cmx: cduce/runtime/value.cmx cduce/types/types.cmx \
string.cmx cduce/types/patterns.cmx cduce/types/ident.cmx format.cmx \
cduce/misc/encodings.cmx cduce/types/chars.cmx cduce/types/atoms.cmx \
array.cmx cduce/runtime/run_dispatch.cmi
cduce/runtime/explain.cmi: cduce/runtime/value.cmi cduce/types/types.cmi \
format.cmi
cduce/runtime/explain.cmo: cduce/runtime/value.cmi cduce/types/types.cmi \
cduce/runtime/run_dispatch.cmi cduce/types/patterns.cmi list.cmi lazy.cmi \
cduce/types/ident.cmo format.cmi cduce/misc/encodings.cmi \
cduce/types/chars.cmi buffer.cmi cduce/types/atoms.cmi array.cmi \
cduce/runtime/explain.cmi
cduce/runtime/explain.cmx: cduce/runtime/value.cmx cduce/types/types.cmx \
cduce/runtime/run_dispatch.cmx cduce/types/patterns.cmx list.cmx lazy.cmx \
cduce/types/ident.cmx format.cmx cduce/misc/encodings.cmx \
cduce/types/chars.cmx buffer.cmx cduce/types/atoms.cmx array.cmx \
cduce/runtime/explain.cmi
cduce/runtime/serial.cmi: cduce/runtime/value.cmi cduce/types/types.cmi \
cduce/types/patterns.cmi obj.cmi cduce/types/ident.cmo \
cduce/types/atoms.cmi
cduce/runtime/serial.cmo: cduce/runtime/value.cmi cduce/types/types.cmi \
cduce/misc/serialize.cmi cduce/runtime/run_dispatch.cmi \
cduce/types/patterns.cmi list.cmi cduce/types/ident.cmo \
cduce/misc/encodings.cmi cduce/misc/custom.cmo
cduce/types/atoms.cmi
\
array.cmi cduce/runtime/serial.cmi
cduce/runtime/explain.cmi
cduce/misc/encodings.cmi cduce/misc/custom.cmo \
cduce/types/atoms.cmi
array.cmi cduce/runtime/serial.cmi
cduce/runtime/serial.cmx: cduce/runtime/value.cmx cduce/types/types.cmx \
cduce/misc/serialize.cmx cduce/runtime/run_dispatch.cmx \
cduce/types/patterns.cmx list.cmx cduce/types/ident.cmx \
cduce/misc/encodings.cmx cduce/misc/custom.cmx cduce/types/atoms.cmx \
array.cmx cduce/runtime/serial.cmi
cduce/runtime/xml_loader.cmi: cduce/runtime/value.cmi
cduce/runtime/xml_loader.cmo: cduce/runtime/value.cmi string.cmi \
cduce/misc/ns.cmi list.cmi cduce/types/ident.cmo cduce/misc/encodings.cmi \
cduce/types/atoms.cmi cduce/runtime/xml_loader.cmi
cduce/runtime/xml_loader.cmx: cduce/runtime/value.cmx string.cmx \
cduce/misc/ns.cmx list.cmx cduce/types/ident.cmx cduce/misc/encodings.cmx \
cduce/types/atoms.cmx cduce/runtime/xml_loader.cmi
cduce/runtime/xml_printer.cmi: cduce/runtime/value.cmi cduce/misc/ns.cmi
cduce/runtime/xml_printer.cmo: cduce/runtime/value.cmi \
cduce/types/sequence.cmi cduce/misc/ns.cmi list.cmi cduce/types/ident.cmo \
cduce/misc/encodings.cmi cduce/types/atoms.cmi \
cduce/runtime/xml_printer.cmi
cduce/runtime/xml_printer.cmx: cduce/runtime/value.cmx \
cduce/types/sequence.cmx cduce/misc/ns.cmx list.cmx cduce/types/ident.cmx \
cduce/misc/encodings.cmx cduce/types/atoms.cmx \
cduce/runtime/xml_printer.cmi
cduce/runtime/explain.cmx cduce/misc/encodings.cmx cduce/misc/custom.cmx \
cduce/types/atoms.cmx array.cmx cduce/runtime/serial.cmi
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