X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=perl_c.c;h=7970a815e338cf7186ddfe4937302f201c11aa0c;hb=95d760554441dac36fb77011c0c875490f873d68;hp=11d1cc60d2bbc21b5a86f500291f866c7c8e32a3;hpb=0b407a0c622e181699f5d3984332c5c76f21cdd1;p=perl4caml.git

diff --git a/perl_c.c b/perl_c.c
index 11d1cc6..7970a81 100644
--- a/perl_c.c
+++ b/perl_c.c
@@ -1,6 +1,22 @@
 /* Interface to Perl from OCaml.
- * Copyright (C) 2003 Merjis Ltd.
- * $Id: perl_c.c,v 1.22 2005-02-13 16:33:27 rich Exp $
+   Copyright (C) 2003 Merjis Ltd.
+
+   This library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Library General Public
+   License as published by the Free Software Foundation; either
+   version 2 of the License, or (at your option) any later version.
+
+   This library is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Library General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this library; see the file COPYING.  If not, write to
+   the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+   Boston, MA 02111-1307, USA.
+
+   $Id: perl_c.c,v 1.25 2008-03-01 13:02:21 rich Exp $
  */
 
 #include <stdio.h>
@@ -117,7 +133,7 @@ CAMLprim value
 perl4caml_sv_of_float (value fv)
 {
   CAMLparam1 (fv);
-  CAMLreturn (Val_sv (newSViv (Double_val (fv))));
+  CAMLreturn (Val_sv (newSVnv (Double_val (fv))));
 }
 
 CAMLprim value
@@ -180,25 +196,31 @@ perl4caml_sv_no (value unit)
   CAMLreturn (Val_sv (&PL_sv_no));
 }
 
+static int
+sv_type (SV *sv)
+{
+  switch (SvTYPE (sv))
+    {
+    case SVt_IV: return 1;
+    case SVt_NV: return 2;
+    case SVt_PV: return 3;
+    case SVt_RV: return 4;
+    case SVt_PVAV: return 5;
+    case SVt_PVHV: return 6;
+    case SVt_PVCV: return 7;
+    case SVt_PVGV: return 8;
+    case SVt_PVMG: return 9;
+    default: return 0;
+    }
+}
+
 CAMLprim value
 perl4caml_sv_type (value svv)
 {
   CAMLparam1 (svv);
   SV *sv = Sv_val (svv);
 
-  switch (SvTYPE (sv))
-    {
-    case SVt_IV: CAMLreturn (Val_int (1));
-    case SVt_NV: CAMLreturn (Val_int (2));
-    case SVt_PV: CAMLreturn (Val_int (3));
-    case SVt_RV: CAMLreturn (Val_int (4));
-    case SVt_PVAV: CAMLreturn (Val_int (5));
-    case SVt_PVHV: CAMLreturn (Val_int (6));
-    case SVt_PVCV: CAMLreturn (Val_int (7));
-    case SVt_PVGV: CAMLreturn (Val_int (8));
-    case SVt_PVMG: CAMLreturn (Val_int (9));
-    default: CAMLreturn (Val_int (0));
-    }
+  CAMLreturn (Val_int (sv_type (sv)));
 }
 
 CAMLprim value
@@ -256,6 +278,18 @@ perl4caml_hashref (value hvv)
 }
 
 CAMLprim value
+perl4caml_reftype (value svv)
+{
+  CAMLparam1 (svv);
+  SV *sv = Sv_val (svv);
+
+  if (!SvROK (sv))
+    caml_invalid_argument ("reftype: SV is not a reference");
+
+  CAMLreturn (Val_int (sv_type (SvRV (sv))));
+}
+
+CAMLprim value
 perl4caml_deref (value svv)
 {
   CAMLparam1 (svv);