Changeset 3961 for src/Pugs/Types

Timestamp:

05/27/05 05:22:52 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

5515

Message:

* Perl 5 Array and Hash are now accessible from Perl 6.

Location:

src/Pugs/Types

Files:

• Array.hs (modified) (1 diff)
• Hash.hs (modified) (1 diff)

src/Pugs/Types/Array.hs

@@ -251 +251 @@
     array_deleteElem _ _   = retConstError undef
 
+evalPerl5Sub :: String -> [PerlSV] -> Eval Val
+evalPerl5Sub code args = do
+    env   <- ask
+    fmap PerlSV . liftIO $ do
+        envSV <- mkVal env
+        subSV <- evalPerl5 code envSV (enumCxt cxtItemAny)
+        callPerl5 subSV nullSV args envSV (enumCxt cxtItemAny)
+
 instance ArrayClass PerlSV where
     array_iType = const $ mkType "Array::Perl"
-    array_fetchVal _  _    = return undef
-    array_storeVal _ _ _   = retConstError undef
+    array_fetchVal sv idx = do
+        idxSV   <- fromVal $ castV idx
+        evalPerl5Sub "sub { $_[0]->[$_[1]] }" [sv, idxSV]
+    array_storeVal sv idx val = do
+        idxSV   <- fromVal $ castV idx
+        valSV   <- fromVal val
+        evalPerl5Sub "sub { $_[0]->[$_[1]] = $_[2] }" [sv, idxSV, valSV]
+        return ()
     array_storeElem _ _ _  = retConstError undef
     array_deleteElem _ _   = retConstError undef

src/Pugs/Types/Hash.hs

@@ -120 +120 @@
 instance HashClass PerlSV where
     hash_iType = const $ mkType "Hash::Perl"
+    hash_fetchVal sv key = do
+        keySV   <- fromVal $ castV key
+        evalPerl5Sub "sub { $_[0]->{$_[1]} }" [sv, keySV]
     hash_clear _ = retConstError undef
     hash_store _ _ = retConstError undef
-    hash_storeVal _ _ _ = retConstError undef
+    hash_storeVal sv key val = do
+        keySV   <- fromVal $ castV key
+        valSV   <- fromVal val
+        evalPerl5Sub "sub { $_[0]->{$_[1]} = $_[2] }" [sv, keySV, valSV]
+        return ()
     hash_storeElem _ _ _ = retConstError undef
     hash_deleteElem _ _ = retConstError undef