Changeset 4102

Timestamp:

05/29/05 18:05:01 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

5515

Message:

* Perl5Embed: .kv, .keys, .values, .pairs etc now works on Perl hashrefs.

Location:

src/Pugs

Files:

• Prim/Keyed.hs (modified) (3 diffs)
• Types/Array.hs (modified) (2 diffs)
• Types/Hash.hs (modified) (2 diffs)

src/Pugs/Prim/Keyed.hs

@@ -16 +16 @@
 
 pairsFromVal :: Val -> Eval [Val]
+pairsFromVal (PerlSV sv) = do
+    keys    <- hash_fetchKeys sv
+    return $ VList (map castV keys)
+    elems   <- mapM (hash_fetchElem sv) keys
+    return $ map (VRef . MkRef . IPair) (keys `zip` elems)
 pairsFromVal v = do
     ref  <- fromVal v
@@ -22 +27 @@
 
 keysFromVal :: Val -> Eval Val
+keysFromVal (PerlSV sv) = do
+    keys    <- hash_fetchKeys sv
+    return $ VList (map castV keys)
 keysFromVal (VList vs) = return . VList $ map VInt [0 .. (genericLength vs) - 1]
 keysFromVal (VRef ref) = do
     vals <- keysFromRef ref
     return $ VList vals
-keysFromVal (PerlSV sv) = do
-    keys    <- hash_fetchKeys sv
-    return $ VList (map castV keys)
 keysFromVal v = retError "Not a keyed reference" v
 
@@ -37 +42 @@
     vals <- valuesFromRef ref
     return $ VList vals
+valuesFromVal (PerlSV sv) = do
+    pairs <- hash_fetch sv
+    return . VList $ Map.elems pairs
 valuesFromVal v = retError "Not a keyed reference" v
 

src/Pugs/Types/Array.hs

@@ -264 +264 @@
         idxSV   <- fromVal $ castV idx
         evalPerl5Sub "sub { $_[0]->[$_[1]] }" [sv, idxSV]
+    array_clear sv = do
+        evalPerl5Sub "sub { undef @{$_[0]} }" [sv]
+        return ()
     array_storeVal sv idx val = do
         idxSV   <- fromVal $ castV idx
@@ -269 +272 @@
         evalPerl5Sub "sub { $_[0]->[$_[1]] = $_[2] }" [sv, idxSV, valSV]
         return ()
-    array_storeElem _ _ _  = retConstError undef
-    array_deleteElem _ _   = retConstError undef
+    array_deleteElem sv idx = do
+        idxSV   <- fromVal $ castV idx
+        evalPerl5Sub "sub { delete $_[0]->[$_[1]] }" [sv, idxSV]
+        return ()

src/Pugs/Types/Hash.hs

@@ -123 +123 @@
         keySV   <- fromVal $ castV key
         evalPerl5Sub "sub { $_[0]->{$_[1]} }" [sv, keySV]
-    hash_clear _ = retConstError undef
-    hash_store _ _ = retConstError undef
+    hash_clear sv = do
+        evalPerl5Sub "sub { undef %{$_[0]} }" [sv]
+        return ()
     hash_storeVal sv key val = do
         keySV   <- fromVal $ castV key
@@ -134 +135 @@
         keysStr <- fromVal keysSV
         return $ lines keysStr
-    hash_storeElem _ _ _ = retConstError undef
-    hash_deleteElem _ _ = retConstError undef
+    hash_deleteElem sv key = do
+        keySV   <- fromVal $ castV key
+        evalPerl5Sub "sub { delete $_[0]->{$_[1]} }" [sv, keySV]
+        return ()
+    hash_isEmpty sv = do
+        fromVal =<< evalPerl5Sub "sub { !!%{$_[0]} }" [sv]