Changeset 3919

Timestamp:

05/26/05 23:10:37 (3 years ago)

Author:

autrijus

svk:copy_cache_prev:

5482

Message:

* marshall pugs execution environment into $pugs::env.

Location:

src

Files:

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

src/Pugs/AST/Internals.hs

@@ -213 +213 @@
     fromSV sv = do
         str <- liftIO $ svToVStr sv
-        fail $ "cannot cast from SV (" ++ str ++ " to " ++ errType (undefined :: n)
+        fail $ "cannot cast from SV (" ++ str ++ ") to " ++ errType (undefined :: n)
     vCast :: Val -> n
     vCast v@(VRef _)    = castFail v

src/Pugs/Embed.hs

@@ -30 +30 @@
 evalEmbedded "Perl5" code = do
     interp <- initPerl5 ""
-    evalPerl5 code 0
+    evalPerl5 code nullSV 0
     freePerl5 interp
 evalEmbedded s _ = fail $ "Cannot evaluate in " ++ s

src/Pugs/Embed/Perl5.hs

@@ -17 +17 @@
 freePerl5 _ = return ()
 
-evalPerl5 :: String -> CInt -> IO PerlSV
-evalPerl5 _ = constFail
+evalPerl5 :: String -> PerlSV -> CInt -> IO PerlSV
+evalPerl5 _ _ = constFail
 
 svToVStr :: PerlSV -> IO String
@@ -49 +49 @@
 canPerl5 :: PerlSV -> String -> IO Bool
 canPerl5 _ = constFail
+
+nullSV :: PerlSV
+nullSV = error "perl5 not embedded"
 
 #else
@@ -93 +96 @@
     perl5_can :: PerlSV -> CString -> IO Bool
 foreign import ccall "perl.h perl5_eval"
-    perl5_eval :: CString -> CInt -> IO PerlSV
+    perl5_eval :: CString -> PerlSV -> CInt -> IO PerlSV
 foreign import ccall "perl5.h perl5_init"
     perl5_init :: CInt -> Ptr CString -> IO PerlInterpreter
@@ -147 +150 @@
 canPerl5 sv meth = withCString meth $ \cstr -> perl5_can sv cstr
 
-evalPerl5 :: String -> CInt -> IO PerlSV
-evalPerl5 str cxt = withCString str $ \cstr -> perl5_eval cstr cxt
+evalPerl5 :: String -> PerlSV -> CInt -> IO PerlSV
+evalPerl5 str env cxt = withCString str $ \cstr -> perl5_eval cstr env cxt
 
 freePerl5 :: PerlInterpreter -> IO ()
@@ -155 +158 @@
     return ()
 
+nullSV :: PerlSV
+nullSV = nullPtr
+
 #endif
 

src/Pugs/Prim.hs

@@ -243 +243 @@
 op1 "eval_perl5" = \v -> do
     str <- fromVal v
-    cxt <- asks envContext
+    env <- ask
     tryIO undef $ do
-        sv <- evalPerl5 str $ enumCxt cxt
+        envSV <- valToSV (VControl $ ControlEnv env)
+        sv <- evalPerl5 str envSV $ enumCxt (envContext env)
         return $ PerlSV sv
 op1 "eval_haskell" = op1EvalHaskell

src/perl5/perl5.c

@@ -190 +190 @@
 
 SV *
-perl5_eval(char *code, int cxt)
+perl5_eval(char *code, SV *env, int cxt)
 {
     dSP;
-    SV* sv = newSVpv(code, 0);
-
+    SV* sv;
+
+    ENTER;
+
+    if (env != NULL) {
+        sv = get_sv("pugs::env", 1);
+        save_item(sv);
+        sv_setsv(sv, env);
+    }
+
+    sv = newSVpv(code, 0);
     eval_sv(sv, cxt);
     SvREFCNT_dec(sv);
@@ -200 +209 @@
     SPAGAIN;
     sv = POPs;
-    PUTBACK;
+    SvREFCNT_inc(sv);
+    PUTBACK;
+
+    FREETMPS;
+    LEAVE;
 
     return sv;

src/perl5/perl5.h

@@ -12 +12 @@
 SV * perl5_call(char *subname, int argc, SV** args, int cxt);
 bool perl5_can(SV *inv, char *subname);
-SV * perl5_eval(char *code, int cxt);
+SV * perl5_eval(char *code, SV *env, int cxt);