Version 0.9.1.
test/100-sv.ml
test/110-av.ml
test/120-hv.ml
+test/130-hv-iter.ml
test/140-ref.ml
wrappers/.cvsignore
wrappers/pl_Date_Calc.ml
# perl4caml configuration -*- Makefile -*-
-# $Id: Makefile.config,v 1.22 2005-01-28 23:11:03 rich Exp $
+# $Id: Makefile.config,v 1.23 2005-01-29 12:22:49 rich Exp $
# PERLINCDIR
# Directory containing the Perl include files, eg. <EXTERN.h>.
# PACKAGE and VERSION
PACKAGE := perl4caml
-VERSION := 0.9.0
+VERSION := 0.9.1
(* Interface to Perl from OCaml.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: perl.ml,v 1.13 2005-01-28 23:09:31 rich Exp $
+ * $Id: perl.ml,v 1.14 2005-01-29 12:22:49 rich Exp $
*)
type sv
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"
*
* Copyright (C) 2003 Merjis Ltd.
*
- * $Id: perl.mli,v 1.13 2005-01-28 23:09:32 rich Exp $
+ * $Id: perl.mli,v 1.14 2005-01-29 12:22:49 rich Exp $
*)
type sv
(** Remove all elements from the [HV]. Same as Perl [%av = ()]. *)
val hv_undef : hv -> unit
(** Delete the [HV] (and all elements in it). Same as Perl [undef %hv]. *)
+val hv_of_assoc : (string * sv) list -> hv
+(** Create an [HV] directly from an assoc list. Perl hashes cannot
+ * support multiple values attached to the same key, so if you try
+ * to provide an assoc list with multiple identical keys, the results
+ * will be undefined.
+ *)
+val assoc_of_hv : hv -> (string * sv) list
+(** Take an [HV] and return an assoc list. *)
+val hv_keys : hv -> string list
+(** Return all the keys of an [HV]. *)
+val hv_values : hv -> sv list
+(** Return all the values of an [HV]. *)
+
+(* The following are the low-level iteration interface to hashes,
+ * which you probably shouldn't use directly. Use {!hv_keys},
+ * {!assoc_of_hv}, etc. instead. See [perlguts(3)] if you really
+ * want to use this interface.
+ *)
+type he
+val hv_iterinit : hv -> Int32.t
+val hv_iternext : hv -> he
+val hv_iterkey : he -> string
+val hv_iterval : hv -> he -> sv
+val hv_iternextsv : hv -> string * sv
val get_sv : ?create:bool -> string -> sv
-(** Return a scalar value by name. For example, if you have a symbol
- * called [$a] in Perl, then [get_sv "a"] will return its value.
- *
- * If the symbol does not exist, this throws [Not_found].
- *
- * If the optional [?create] argument is set to true and the symbol does
- * not exist, then Perl will create the symbol (with value [undef]) and
- * this function will return the [SV] for [undef].
+ (** Return a scalar value by name. For example, if you have a symbol
+ * called [$a] in Perl, then [get_sv "a"] will return its value.
+ *
+ * If the symbol does not exist, this throws [Not_found].
+ *
+ * If the optional [?create] argument is set to true and the symbol does
+ * not exist, then Perl will create the symbol (with value [undef]) and
+ * this function will return the [SV] for [undef].
*)
val get_av : ?create:bool -> string -> av
(** Same as {!Perl.get_sv} except will return and/or create [\@a]. *)
/* Interface to Perl from OCaml.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: perl_c.c,v 1.20 2005-01-28 23:09:32 rich Exp $
+ * $Id: perl_c.c,v 1.21 2005-01-29 12:22:49 rich Exp $
*/
#include <stdio.h>
#define Av_val(avv) ((AV *) Xv_val (avv))
#define Val_hv(hv) (Val_xv ((SV *)(hv)))
#define Hv_val(hvv) ((HV *) Xv_val (hvv))
+#define Val_he(he) (Val_voidptr ((he)))
+#define He_val(hev) (Voidptr_val (HE, (hev)))
static void
xs_init (pTHX)
}
CAMLprim value
+perl4caml_hv_iterinit (value hvv)
+{
+ CAMLparam1 (hvv);
+ HV *hv = Hv_val (hvv);
+ int i = hv_iterinit (hv);
+ CAMLreturn (caml_copy_int32 (i));
+}
+
+CAMLprim value
+perl4caml_hv_iternext (value hvv)
+{
+ CAMLparam1 (hvv);
+ CAMLlocal1 (hev);
+ HV *hv = Hv_val (hvv);
+ HE *he = hv_iternext (hv);
+ if (he == NULL) caml_raise_not_found ();
+ hev = Val_he (he);
+ CAMLreturn (hev);
+}
+
+CAMLprim value
+perl4caml_hv_iterkey (value hev)
+{
+ CAMLparam1 (hev);
+ CAMLlocal1 (strv);
+ HE *he = He_val (hev);
+ I32 len;
+ char *str = hv_iterkey (he, &len);
+ strv = caml_alloc_string (len);
+ memcpy (String_val (strv), str, len);
+ CAMLreturn (strv);
+}
+
+CAMLprim value
+perl4caml_hv_iterval (value hvv, value hev)
+{
+ CAMLparam2 (hvv, hev);
+ CAMLlocal1 (svv);
+ HV *hv = Hv_val (hvv);
+ HE *he = He_val (hev);
+ SV *sv = hv_iterval (hv, he);
+ SvREFCNT_inc (sv);
+ svv = Val_sv (sv);
+ CAMLreturn (svv);
+}
+
+CAMLprim value
+perl4caml_hv_iternextsv (value hvv)
+{
+ CAMLparam1 (hvv);
+ CAMLlocal3 (strv, svv, rv);
+ HV *hv = Hv_val (hvv);
+ char *str; I32 len;
+ SV *sv = hv_iternextsv (hv, &str, &len);
+ if (sv == NULL) caml_raise_not_found ();
+ SvREFCNT_inc (sv);
+ svv = Val_sv (sv);
+ strv = caml_alloc_string (len);
+ memcpy (String_val (strv), str, len);
+ /* Construct a tuple (strv, svv). */
+ rv = caml_alloc_tuple (2);
+ Field (rv, 0) = strv;
+ Field (rv, 1) = svv;
+ CAMLreturn (rv);
+}
+
+CAMLprim value
perl4caml_get_sv (value optcreate, value name)
{
CAMLparam2 (optcreate, name);
--- /dev/null
+(* Thoroughly test HV iteration functions.
+ * $Id: 130-hv-iter.ml,v 1.1 2005-01-29 12:22:50 rich Exp $
+ *)
+
+open Perl
+
+let () =
+ let xs = [ "foo", sv_of_int 1;
+ "bar", sv_of_int 2;
+ "baz", sv_of_int 3;
+ "a", sv_of_int 4 ] in
+
+ let hv = hv_of_assoc xs in
+ assert (1 = int_of_sv (hv_get hv "foo"));
+ assert (2 = int_of_sv (hv_get hv "bar"));
+ assert (3 = int_of_sv (hv_get hv "baz"));
+ assert (4 = int_of_sv (hv_get hv "a"));
+ assert (not (hv_exists hv "b"));
+ assert (not (hv_exists hv "c"));
+
+ let keys = List.sort compare (hv_keys hv) in
+ assert (4 = List.length keys);
+ assert (["a"; "bar"; "baz"; "foo"] = keys);
+
+ let values = List.sort compare (List.map int_of_sv (hv_values hv)) in
+ assert (4 = List.length values);
+ assert ([1; 2; 3; 4] = values);
+
+ let xs = assoc_of_hv hv in
+ let xs = List.map (fun (k, sv) -> k, int_of_sv sv) xs in
+ let xs = List.sort compare xs in
+ assert (4 = List.length xs);
+ assert ([ "a", 4; "bar", 2; "baz", 3; "foo", 1 ] = xs)
+;;
+Gc.full_major ()
git.annexia.org / perl4caml.git / commitdiff