Changeset 3918 for src/Pugs/Embed/Perl5.hs
- Timestamp:
- 05/26/05 17:22:54 (4 years ago)
- svk:copy_cache_prev:
- 5482
- Files:
-
- 1 modified
-
src/Pugs/Embed/Perl5.hs (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
src/Pugs/Embed/Perl5.hs
r3911 r3918 23 23 svToVStr = constFail 24 24 25 svToVInt :: (Num a) => PerlSV -> IO a 26 svToVInt = constFail 27 28 svToVNum :: (Fractional a) => PerlSV -> IO a 29 svToVNum = constFail 30 25 31 svToVBool :: PerlSV -> IO Bool 26 32 svToVBool = constFail 27 33 28 svTo Any:: PerlSV -> IO (Maybe a)29 svTo Any= constFail34 svToVal :: PerlSV -> IO (Maybe a) 35 svToVal = constFail 30 36 31 anyToSV :: a -> IO PerlSV32 anyToSV = constFail37 valToSV :: a -> IO PerlSV 38 valToSV = constFail 33 39 34 40 vstrToSV :: String -> IO PerlSV … … 47 53 48 54 {-# INCLUDE <perl5.h> #-} 55 {-# INCLUDE <pugsembed.h> #-} 49 56 50 57 module Pugs.Embed.Perl5 where … … 55 62 type PerlInterpreter = Ptr () 56 63 type PerlSV = Ptr () 64 type PugsVal = Ptr () 57 65 58 66 foreign import ccall "perl.h perl_alloc" … … 70 78 foreign import ccall "perl5.h perl5_SvPV" 71 79 perl5_SvPV :: PerlSV -> IO CString 80 foreign import ccall "perl5.h perl5_SvIV" 81 perl5_SvIV :: PerlSV -> IO CInt 82 foreign import ccall "perl5.h perl5_SvNV" 83 perl5_SvNV :: PerlSV -> IO CDouble 72 84 foreign import ccall "perl5.h perl5_SvTRUE" 73 85 perl5_SvTRUE :: PerlSV -> IO Bool 74 foreign import ccall "perl5.h perl5_SvPtr"75 perl5_SvPtr :: PerlSV -> IO (Ptr ())76 86 foreign import ccall "perl5.h perl5_newSVpv" 77 87 perl5_newSVpv :: CString -> IO PerlSV 78 88 foreign import ccall "perl5.h perl5_newSViv" 79 89 perl5_newSViv :: CInt -> IO PerlSV 80 foreign import ccall "perl5.h perl5_newSVptr"81 perl5_newSVptr :: Ptr () -> IO PerlSV82 90 foreign import ccall "perl5.h perl5_call" 83 91 perl5_call :: CString -> CInt -> Ptr PerlSV -> CInt -> IO PerlSV … … 88 96 foreign import ccall "perl5.h perl5_init" 89 97 perl5_init :: CInt -> Ptr CString -> IO PerlInterpreter 98 99 foreign import ccall "pugsembed.h pugs_SvToVal" 100 pugs_SvToVal :: PerlSV -> IO PugsVal 101 foreign import ccall "pugsembed.h pugs_MkValRef" 102 pugs_MkValRef :: PugsVal -> IO PerlSV 90 103 91 104 initPerl5 :: String -> IO PerlInterpreter … … 98 111 svToVStr sv = peekCString =<< perl5_SvPV sv 99 112 113 svToVInt :: (Num a) => PerlSV -> IO a 114 svToVInt sv = fmap fromIntegral $ perl5_SvIV sv 115 116 svToVNum :: (Fractional a) => PerlSV -> IO a 117 svToVNum sv = fmap realToFrac $ perl5_SvNV sv 118 100 119 svToVBool :: PerlSV -> IO Bool 101 120 svToVBool = perl5_SvTRUE 102 121 103 anyToSV :: a -> IO PerlSV 104 anyToSV x = do 105 ptr <- fmap castStablePtrToPtr $ newStablePtr x 106 perl5_newSVptr ptr 107 108 svToAny :: PerlSV -> IO (Maybe a) 109 svToAny sv = do 110 ptr <- perl5_SvPtr sv 122 svToVal :: PerlSV -> IO (Maybe a) 123 svToVal sv = do 124 ptr <- pugs_SvToVal sv 111 125 if ptr == nullPtr 112 126 then return Nothing 113 else fmap Just . deRefStablePtr $ castPtrToStablePtr ptr 127 else fmap Just $ deRefStablePtr (castPtrToStablePtr ptr) 128 129 valToSV :: a -> IO PerlSV 130 valToSV x = do 131 ptr <- fmap castStablePtrToPtr $ newStablePtr x 132 pugs_MkValRef ptr 114 133 115 134 vstrToSV :: String -> IO PerlSV
