Changeset 3925 for src/Pugs/Run/Perl5.hs
- Timestamp:
- 05/27/05 00:14:36 (4 years ago)
- svk:copy_cache_prev:
- 5515
- Files:
-
- 1 modified
-
src/Pugs/Run/Perl5.hs (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
src/Pugs/Run/Perl5.hs
r3924 r3925 7 7 import Pugs.Internals 8 8 import Pugs.AST 9 import Pugs.Prim.Eval 9 10 import Pugs.Embed.Perl5 10 11 import Foreign 11 12 import Foreign.C.Types 12 13 import Foreign.C.String 14 import Foreign.Marshal.Array 15 16 foreign export ccall "pugs_Eval" 17 pugs_eval :: CString -> IO PugsVal 18 19 foreign export ccall "pugs_Apply" 20 pugs_apply :: PugsVal -> PugsVal -> Ptr PugsVal -> IO PugsVal 13 21 14 22 foreign export ccall "pugs_ValToSv" … … 27 35 pvToVal :: CString -> IO PugsVal 28 36 37 askPerl5Env :: IO Env 38 askPerl5Env = do 39 sv <- withCString "pugs::env" perl5_get_sv 40 val <- svToVal sv 41 case val of 42 VControl (ControlEnv env) -> return env 43 _ -> fail "cannot fetch $pugs::env" 44 45 pugs_eval :: CString -> IO PugsVal 46 pugs_eval cstr = do 47 str <- peekCString cstr 48 env <- askPerl5Env 49 val <- runEvalIO env $ opEval Nothing "<eval>" str 50 mkVal val 51 52 pugs_apply :: PugsVal -> PugsVal -> Ptr PugsVal -> IO PugsVal 53 pugs_apply subPtr invPtr argsPtr = do 54 env <- askPerl5Env 55 sub <- deVal subPtr 56 inv <- deValMaybe invPtr 57 args <- mapM deVal =<< peekArray0 nullPtr argsPtr 58 let subExp = case sub of 59 VStr name -> Var name 60 _ -> Val sub 61 val <- runEvalIO env $ evalExp (App subExp (fmap Val inv) (map Val args)) 62 mkVal val 63 29 64 mkVal :: Val -> IO PugsVal 30 65 mkVal val = fmap castStablePtrToPtr $ newStablePtr val … … 32 67 deVal :: PugsVal -> IO Val 33 68 deVal ptr = deRefStablePtr (castPtrToStablePtr ptr) 69 70 deValMaybe :: PugsVal -> IO (Maybe Val) 71 deValMaybe ptr | ptr == nullPtr = return Nothing 72 deValMaybe ptr = fmap Just (deVal ptr) 34 73 35 74 valToSv :: PugsVal -> IO PerlSV
