Changeset 5167

Timestamp:

07/04/05 00:34:05 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

6965

Message:

* AST.Internals, CodeGen?.PIR - deal with the fallout of

not deriving from Read. also introduce newHash for incHV.

Location:

src/Pugs

Files:

• AST/Internals.hs (modified) (2 diffs)
• CodeGen/PIR.hs (modified) (2 diffs)

src/Pugs/AST/Internals.hs

@@ -52 +52 @@
     ifListContext, ifValTypeIsa, evalValType, fromVal',
     scalarRef, codeRef, arrayRef, hashRef, thunkRef, pairRef,
-    newScalar, newArray, newHandle, newObject,
+    newScalar, newArray, newHash, newHandle, newObject,
     proxyScalar, constScalar, lazyScalar, lazyUndef, constArray,
     retError, retControl, retEmpty, retIVar, readIVar, writeIVar,
@@ -1562 +1562 @@
     return $ IArray av
 
+newHash :: (MonadSTM m) => VHash -> m (IVar VHash)
+newHash hash = do
+    ihash <- liftSTM (newTVar $ Map.map lazyScalar hash)
+    return $ IHash ihash
+
 newHandle :: (MonadSTM m) => VHandle -> m (IVar VHandle)
 newHandle = return . IHandle

src/Pugs/CodeGen/PIR.hs

@@ -18 +18 @@
 import Pugs.AST
 import Pugs.AST.Internals
+import Pugs.Eval.Var
 import Emit.Common
 import Emit.PIR
@@ -311 +312 @@
     let var = render $ varText name
     tellIns $ InsLocal RegPMC var
-    tellIns $ InsNew (VAR var) (read $ render $ varInit name)
+    tellIns $ InsNew (VAR var) (varInit name)
     return $ reg (VAR var)
 
-varInit :: String -> Doc
-varInit ('$':_) = text $ "PerlScalar"
-varInit ('@':_) = text $ "PerlArray"
-varInit ('%':_) = text $ "PerlHash"
-varInit ('&':_) = text $ "PerlScalar"
-varInit x       = error $ "invalid name: " ++ x
+varInit :: String -> ObjType
+varInit ('$':_) = PerlScalar
+varInit ('@':_) = PerlArray
+varInit ('%':_) = PerlHash
+varInit ('&':_) = PerlScalar
+varInit x       = internalError $ "Invalid name: " ++ x
 
 {-| Compiles the current environment to PIR code. -}