Commit 41703588 authored by Pietro Abate's avatar Pietro Abate

[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
......@@ -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
......
......@@ -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
......
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]
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......@@ -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
......@@ -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
......@@ -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
......
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment