Changeset 3927

Timestamp:

05/27/05 00:30:24 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

5515

Message:

* pv/nv/iv caster from Val.

Location:

src

Files:

• Pugs/Run/Perl5.hs (modified) (2 diffs)
• perl5/pugsembed.h (modified) (1 diff)

src/Pugs/Run/Perl5.hs

@@ -22 +22 @@
 foreign export ccall "pugs_ValToSv"
     valToSv :: PugsVal -> IO PerlSV
+
+foreign export ccall "pugs_ValToIv"
+    valToIv :: PugsVal -> IO CInt
+
+foreign export ccall "pugs_ValToNv"
+    valToNv :: PugsVal -> IO CDouble
+
+foreign export ccall "pugs_ValToPv"
+    valToPv :: PugsVal -> IO CString
 
 foreign export ccall "pugs_MkSvRef"
@@ -79 +88 @@
         _           -> mkValRef val
 
+valToIv :: PugsVal -> IO CInt
+valToIv ptr = do
+    val <- deVal ptr
+    fmap fromInteger (fromVal'' val)
+
+valToNv :: PugsVal -> IO CDouble
+valToNv ptr = do
+    val <- deVal ptr
+    fmap fromRational (fromVal'' val)
+
+valToPv :: PugsVal -> IO CString
+valToPv ptr = do
+    val <- deVal ptr
+    newCString =<< (fromVal'' val)
+
+fromVal'' :: (Value a) => Val -> IO a
+fromVal'' = return . vCast
+
 mkSvRef :: PerlSV -> IO PugsVal
 mkSvRef = mkVal . PerlSV

src/perl5/pugsembed.h

@@ -16 +16 @@
 extern Val *pugs_MkSvRef  ( SV *sv );
 extern SV  *pugs_ValToSv ( Val *val );
+extern IV   pugs_ValToIv ( Val *val );
+extern NV   pugs_ValToNv ( Val *val );
+extern char *pugs_ValToSv ( Val *val );
 
 Val *pugs_SvToVal ( SV *sv );