Changeset 3925 for src/Pugs/Run

Timestamp:

05/27/05 00:14:36 (3 years ago)

Author:

autrijus

svk:copy_cache_prev:

5515

Message:

* Pugs's eval/apply exported to C space.

Files:

• src/Pugs/Run/Perl5.hs (modified) (3 diffs)

src/Pugs/Run/Perl5.hs

@@ -7 +7 @@
 import Pugs.Internals
 import Pugs.AST
+import Pugs.Prim.Eval
 import Pugs.Embed.Perl5
 import Foreign
 import Foreign.C.Types
 import Foreign.C.String
+import Foreign.Marshal.Array
+
+foreign export ccall "pugs_Eval"
+    pugs_eval :: CString -> IO PugsVal
+
+foreign export ccall "pugs_Apply"
+    pugs_apply :: PugsVal -> PugsVal -> Ptr PugsVal -> IO PugsVal
 
 foreign export ccall "pugs_ValToSv"
@@ -27 +35 @@
     pvToVal :: CString -> IO PugsVal
 
+askPerl5Env :: IO Env
+askPerl5Env = do
+    sv  <- withCString "pugs::env" perl5_get_sv 
+    val <- svToVal sv
+    case val of
+        VControl (ControlEnv env)   -> return env
+        _                           -> fail "cannot fetch $pugs::env"
+
+pugs_eval :: CString -> IO PugsVal
+pugs_eval cstr = do
+    str <- peekCString cstr
+    env <- askPerl5Env
+    val <- runEvalIO env $ opEval Nothing "<eval>" str
+    mkVal val
+
+pugs_apply :: PugsVal -> PugsVal -> Ptr PugsVal -> IO PugsVal
+pugs_apply subPtr invPtr argsPtr = do
+    env     <- askPerl5Env
+    sub     <- deVal subPtr
+    inv     <- deValMaybe invPtr
+    args    <- mapM deVal =<< peekArray0 nullPtr argsPtr
+    let subExp = case sub of
+            VStr name   -> Var name
+            _           -> Val sub
+    val <- runEvalIO env $ evalExp (App subExp (fmap Val inv) (map Val args))
+    mkVal val
+
 mkVal :: Val -> IO PugsVal
 mkVal val = fmap castStablePtrToPtr $ newStablePtr val
@@ -32 +67 @@
 deVal :: PugsVal -> IO Val
 deVal ptr = deRefStablePtr (castPtrToStablePtr ptr)
+
+deValMaybe :: PugsVal -> IO (Maybe Val)
+deValMaybe ptr | ptr == nullPtr = return Nothing
+deValMaybe ptr = fmap Just (deVal ptr)
 
 valToSv :: PugsVal -> IO PerlSV