Changeset 14466 for src/Pugs/Prim.hs

Timestamp:

10/22/06 01:37:43 (2 years ago)

Author:

audreyt

Message:

* Pugs.Prim: Make ++ and -- atomic.

Files:

• src/Pugs/Prim.hs (modified) (4 diffs)

src/Pugs/Prim.hs

@@ -22 +22 @@
     -- used Pugs.Eval
     op1Return, op1Yield,
-    foldParam, op2Hyper, op1HyperPrefix, op1HyperPostfix, retSeq
+    foldParam, op2Hyper, op1HyperPrefix, op1HyperPostfix, retSeq, atomicEval
 ) where
 import Pugs.Internals
@@ -156 +156 @@
 op1 "sqrt" = op1Floating sqrt
 op1 "atan" = op1Floating atan
-op1 "post:++" = \x -> do
+op1 "post:++" = \x -> atomicEval $ do
+    ref <- fromVal x
     val <- fromVal x
-    ref <- fromVal x
     val' <- case val of
         (VStr str)  -> return (VStr $ strInc str)
@@ -169 +169 @@
     op1 "post:++" mv
     fromVal mv
-op1 "post:--"   = \x -> do
+op1 "post:--"   = \x -> atomicEval $ do
+    ref <- fromVal x
     val <- fromVal x
-    ref <- fromVal x
     writeRef ref =<< op1Numeric (\x -> x - 1) val
     return val
@@ -1551 +1551 @@
     runInvokePerl5 subSV nullSV argsSV
 
+atomicEval :: Eval Val -> Eval Val
+atomicEval action = do
+    env <- ask
+    if envAtomic env then action else guardSTM (runEvalSTM env action)
 
 {-| Assert that a list of Vals is all defined.