Changeset 3924

Timestamp:

05/26/05 23:54:07 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

5515

Message:

* iv/nv/pv two-way casting all done.

Location:

src

Files:

• Pugs/AST/Internals.hs (modified) (1 diff)
• Pugs/Embed/Perl5.hs (modified) (4 diffs)
• Pugs/Prim.hs (modified) (1 diff)
• Pugs/Run/Perl5.hs (modified) (2 diffs)
• perl5/perl5.c (modified) (1 diff)
• perl5/perl5.h (modified) (1 diff)
• perl5/pugsembed.c (modified) (1 diff)
• perl5/pugsembed.h (modified) (1 diff)

src/Pugs/AST/Internals.hs

@@ -437 +437 @@
     fromVal (VStr str) = liftIO $ vstrToSV str
     fromVal (VInt int) = liftIO $ vintToSV int
-    fromVal v = liftIO $ valToSV v
+    fromVal (VRat int) = liftIO $ vnumToSV int
+    fromVal (VNum int) = liftIO $ vnumToSV int
+    fromVal v = liftIO $ mkValRef v
 
 showNum :: Show a => a -> String

src/Pugs/Embed/Perl5.hs

@@ -35 +35 @@
 svToVal = constFail
 
-valToSV :: a -> IO PerlSV
-valToSV = constFail
+mkValRef :: a -> IO PerlSV
+mkValRef = constFail
 
 vstrToSV :: String -> IO PerlSV
 vstrToSV = constFail
 
-vintToSV :: Integer -> IO PerlSV
+vintToSV :: (Integral a) => a -> IO PerlSV
 vintToSV = constFail
+
+vnumToSV :: (Real a) => a -> IO PerlSV
+vnumToSV = constFail
 
 callPerl5 :: String -> [PerlSV] -> CInt -> IO PerlSV
@@ -91 +94 @@
 foreign import ccall "perl5.h perl5_newSViv"
     perl5_newSViv :: CInt -> IO PerlSV
+foreign import ccall "perl5.h perl5_newSVnv"
+    perl5_newSVnv :: CDouble -> IO PerlSV
 foreign import ccall "perl5.h perl5_call"
     perl5_call :: CString -> CInt -> Ptr PerlSV -> CInt -> IO PerlSV
@@ -128 +133 @@
     deRefStablePtr (castPtrToStablePtr ptr)
 
-valToSV :: a -> IO PerlSV
-valToSV x = do
+mkValRef :: a -> IO PerlSV
+mkValRef x = do
     ptr <- fmap castStablePtrToPtr $ newStablePtr x
     pugs_MkValRef ptr
@@ -136 +141 @@
 vstrToSV str = withCString str perl5_newSVpv 
 
-vintToSV :: Integer -> IO PerlSV
+vintToSV :: (Integral a) => a -> IO PerlSV
 vintToSV int = perl5_newSViv (fromIntegral int)
+
+vnumToSV :: (Real a) => a -> IO PerlSV
+vnumToSV int = perl5_newSVnv (realToFrac int)
 
 callPerl5 :: String -> [PerlSV] -> CInt -> IO PerlSV

src/Pugs/Prim.hs

@@ -245 +245 @@
     env <- ask
     tryIO undef $ do
-        envSV <- valToSV (VControl $ ControlEnv env)
+        envSV <- mkValRef (VControl $ ControlEnv env)
         sv <- evalPerl5 str envSV $ enumCxt (envContext env)
         return $ PerlSV sv

src/Pugs/Run/Perl5.hs

@@ -11 +11 @@
 import Foreign.C.Types
 import Foreign.C.String
+
+foreign export ccall "pugs_ValToSv"
+    valToSv :: PugsVal -> IO PerlSV
 
 foreign export ccall "pugs_MkSvRef"
@@ -27 +30 @@
 mkVal val = fmap castStablePtrToPtr $ newStablePtr val
 
+deVal :: PugsVal -> IO Val
+deVal ptr = deRefStablePtr (castPtrToStablePtr ptr)
+
+valToSv :: PugsVal -> IO PerlSV
+valToSv ptr = do
+    val <- deVal ptr
+    case val of
+        PerlSV sv   -> return sv
+        _           -> mkValRef val
+
 mkSvRef :: PerlSV -> IO PugsVal
 mkSvRef = mkVal . PerlSV

src/perl5/perl5.c

@@ -160 +160 @@
 
 SV *
+perl5_newSVnv ( double iv )
+{
+    return(newSVnv(iv));
+}
+
+SV *
 perl5_call(char *subname, int argc, SV** args, int cxt)
 {

src/perl5/perl5.h

@@ -10 +10 @@
 SV * perl5_newSVpv ( char * pv );
 SV * perl5_newSViv ( int iv );
+SV * perl5_newSVnv ( double iv );
 SV * perl5_call(char *subname, int argc, SV** args, int cxt);
 bool perl5_can(SV *inv, char *subname);

src/perl5/pugsembed.c

@@ -20 +20 @@
 
 Val *pugs_Eval ( char *code ) { return NULL; }
-
 Val *pugs_Apply ( Val *sub, Val *inv, Val **args ) { return NULL; }
-
-SV  *pugs_ValToSv ( Val *val ) { return NULL; }

src/perl5/pugsembed.h

@@ -16 +16 @@
 extern Val *pugs_PvToVal ( char *pv );
 
-PUGS_EXTERN SV  *pugs_ValToSv ( Val *val );
-
 Val *pugs_SvToVal ( SV *sv );
 SV  *pugs_MkValRef ( Val *val );
 
 extern Val *pugs_MkSvRef  ( SV *sv );
+extern SV  *pugs_ValToSv ( Val *val );
+