X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=perl.ml;h=95d1629a53247ff488dc782dd8910b4fee50abef;hb=0b407a0c622e181699f5d3984332c5c76f21cdd1;hp=cdbfa7cbca8e989918924e13f888396d75260b0d;hpb=7f82a6f31e40e596a43939ab18d685a8f0b78d7b;p=perl4caml.git diff --git a/perl.ml b/perl.ml index cdbfa7c..95d1629 100644 --- a/perl.ml +++ b/perl.ml @@ -1,6 +1,6 @@ (* Interface to Perl from OCaml. * Copyright (C) 2003 Merjis Ltd. - * $Id: perl.ml,v 1.12 2004-11-25 22:16:17 rich Exp $ + * $Id: perl.ml,v 1.14 2005-01-29 12:22:49 rich Exp $ *) type sv @@ -61,6 +61,10 @@ let string_of_sv_t = function | SVt_PVGV -> "SVt_PVGV" | SVt_PVMG -> "SVt_PVMG" +external address_of_sv : sv -> Nativeint.t = "perl4caml_address_of_sv" +external address_of_av : av -> Nativeint.t = "perl4caml_address_of_av" +external address_of_hv : hv -> Nativeint.t = "perl4caml_address_of_hv" + external scalarref : sv -> sv = "perl4caml_scalarref" external arrayref : av -> sv = "perl4caml_arrayref" external hashref : hv -> sv = "perl4caml_hashref" @@ -107,6 +111,53 @@ external hv_delete : hv -> string -> unit = "perl4caml_hv_delete" external hv_clear : hv -> unit = "perl4caml_hv_clear" external hv_undef : hv -> unit = "perl4caml_hv_undef" +type he +external hv_iterinit : hv -> Int32.t = "perl4caml_hv_iterinit" +external hv_iternext : hv -> he = "perl4caml_hv_iternext" +external hv_iterkey : he -> string = "perl4caml_hv_iterkey" +external hv_iterval : hv -> he -> sv = "perl4caml_hv_iterval" +external hv_iternextsv : hv -> string * sv = "perl4caml_hv_iternextsv" + +let hv_of_assoc xs = + let hv = hv_empty () in + List.iter (fun (k, v) -> hv_set hv k v) xs; + hv +let assoc_of_hv hv = + ignore (hv_iterinit hv); + (* Someone please rewrite this to make it tail-rec! - Rich. XXX *) + let rec loop acc = + try + let k, v = hv_iternextsv hv in + loop ((k, v) :: acc) + with + Not_found -> acc + in + loop [] +let hv_keys hv = + ignore (hv_iterinit hv); + (* Someone please rewrite this to make it tail-rec! - Rich. XXX *) + let rec loop acc = + try + let he = hv_iternext hv in + let k = hv_iterkey he in + loop (k :: acc) + with + Not_found -> acc + in + loop [] +let hv_values hv = + ignore (hv_iterinit hv); + (* Someone please rewrite this to make it tail-rec! - Rich. XXX *) + let rec loop acc = + try + let he = hv_iternext hv in + let v = hv_iterval hv he in + loop (v :: acc) + with + Not_found -> acc + in + loop [] + external get_sv : ?create:bool -> string -> sv = "perl4caml_get_sv" external get_av : ?create:bool -> string -> av = "perl4caml_get_av" external get_hv : ?create:bool -> string -> hv = "perl4caml_get_hv"