Commit 700afce7 authored by Pietro Abate's avatar Pietro Abate

[r2005-04-15 15:03:12 by afrisch] Empty log message

Original author: afrisch
Date: 2005-04-15 15:03:13+00:00
parent 2ee074f0
......@@ -159,12 +159,17 @@ module G = struct
let constr chunk i vs =
Value.ocaml2cduce_constr (constr_const chunk i) vs
let dconstr chunk i v =
Value.cduce2ocaml_constr (TAGA.get
let taga chunk i =
TAGA.get
(fun x ->
let x = Array.map (fun (t,i) ->
Atoms.atom t, i) x in
Atoms.mk_map (Array.to_list x))
chunk.taga i) v
chunk.taga i
let dconstr chunk i v =
Value.cduce2ocaml_constr (taga chunk i) v
let dvariant chunk i v =
Value.cduce2ocaml_variant (taga chunk i) v
end
......@@ -26,6 +26,7 @@ module G : sig
val constr: chunk -> int -> Value.t array -> Value.t
val constr_const: chunk -> int -> Value.t
val dconstr: chunk -> int -> Value.t -> Obj.t
val dvariant: chunk -> int -> Value.t -> Obj.t
end
......@@ -658,13 +658,13 @@ let cduce2ocaml_int64 = function
| Integer i -> Intervals.V.to_int64 i
| _ -> assert false
let ocaml2cduce_string = string_latin1
let ocaml2cduce_string s = string_latin1 (String.copy s)
let cduce2ocaml_string = get_string_latin1
let cduce2ocaml_string = get_string_latin1 (* Result is already fresh *)
let ocaml2cduce_string_utf8 = string_utf8
let ocaml2cduce_string_utf8 s = string_utf8 (U.mk (String.copy (U.get_str s)))
let cduce2ocaml_string_utf8 s = fst (get_string_utf8 s)
let cduce2ocaml_string_utf8 s = fst (get_string_utf8 s) (* Result is already fresh *)
let ocaml2cduce_char c =
Char (Chars.V.mk_char c)
......@@ -803,4 +803,23 @@ let rec cduce2ocaml_constr m = function
x
| _ -> assert false
let rec cduce2ocaml_variant m = function
| Atom v ->
Obj.repr (Atoms.get_map v m)
| Xml (Atom v,_,f) | XmlNs (Atom v,_,f,_) ->
let tag = Atoms.get_map v m in
let (x,_) = get_pair f in
Obj.repr (tag,x)
| _ -> assert false
let ocaml2cduce_fun farg fres f =
Abstraction (None, fun x -> fres (f (farg x)))
let cduce2ocaml_fun farg fres = function
| Abstraction (_, f) -> (fun x -> fres (f (farg x)))
| _ -> assert false
let apply f arg = match f with
| Abstraction (_,f) -> f arg
| _ -> assert false
......@@ -130,10 +130,13 @@ 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 cduce2ocaml_variant: 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 ocaml2cduce_fun: (t -> 'a) -> ('b -> t) -> ('a -> 'b) -> t
val cduce2ocaml_fun: ('a -> t) -> (t -> 'b) -> t -> ('a -> 'b)
val print_utf8: U.t -> unit
......@@ -145,6 +148,7 @@ val div: t -> t -> t
val modulo: t -> t -> t
val pair: t -> t -> t
val xml: t -> t -> t -> t
val apply: t -> t -> t
val mk_record: label array -> t array -> t
val transform: (t -> t) -> t -> t
......
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