Pugs 6.2.13.5 → 6.2.13.6
raw patch · 7 files changed
+63/−46 lines, 7 files
Files
- Pugs.cabal +1/−1
- cbits/Prelude_pm.c too large to diff
- cbits/Test_pm.c too large to diff
- src/Pugs/AST/Internals/Instances.hs +51/−40
- src/Pugs/Prim/Eval.hs +7/−2
- src/Pugs/Types/Hash.hs +1/−0
- src/Pugs/Version.hs +3/−3
Pugs.cabal view
@@ -1,5 +1,5 @@ Name : Pugs-Version : 6.2.13.5+Version : 6.2.13.6 license : BSD3 license-file : LICENSE cabal-version : >= 1.2
cbits/Prelude_pm.c view
file too large to diff
cbits/Test_pm.c view
file too large to diff
src/Pugs/AST/Internals/Instances.hs view
@@ -51,6 +51,8 @@ import qualified Data.HashTable as H import Data.Binary+import GHC.Exts (unsafeCoerce#)+ {-# NOINLINE _FakeEnv #-} _FakeEnv :: Env _FakeEnv = unsafePerformIO $ stm $ do@@ -1195,16 +1197,6 @@ get = case 0 of 0 -> ap (return MkInitDat) get -instance Binary Pad- where put (MkPad x1) = return () >> put x1- get = case 0 of- 0 -> ap (return MkPad) get--instance Binary EntryFlags- where put (MkEntryFlags x1) = return () >> put x1- get = case 0 of- 0 -> ap (return MkEntryFlags) get- instance Binary PadEntry where put (PELexical x1 x2@@ -1371,8 +1363,12 @@ 0 -> ap (ap (return MkPrag) get) get instance Binary IHash where- put = put . unsafePerformIO . H.toList- get = fmap (unsafePerformIO . H.fromList H.hashString) get+ put x = do+ let kvs = unsafePerformIO (H.toList x)+ length kvs `seq` put (kvs :: [(VStr, IVar VScalar)])+ get = do+ (ins :: [(VStr, IVar VScalar)]) <- get+ length ins `seq` return (unsafePerformIO $ H.fromList H.hashString ins) instance Binary JuncType where put (JAny) = putWord8 0@@ -1389,6 +1385,9 @@ instance Typeable a => Binary (IVar a) where put = put . MkRef+ get = do+ MkRef iv <- get+ return (unsafeCoerce# iv) instance Binary ([Val] -> Eval Val) where put _ = put ()@@ -1405,52 +1404,56 @@ instance Binary VRef where put (MkRef (ICode cv)) | Just (mc :: VMultiCode) <- fromTypeable cv = do- putWord8 0+ putWord8 0x30 put (mc :: VMultiCode) | otherwise = do- putWord8 1+ putWord8 0x31 let VCode vsub = unsafePerformIO (fakeEval $ fmap VCode (code_fetch cv)) put vsub put (MkRef (IScalar sv)) = do putWord8 $ if scalar_iType sv == mkType "Scalar::Const"- then 2 else 3+ then 0x32 else 0x33 put $ unsafePerformIO (fakeEval $ scalar_fetch sv) put (MkRef (IArray av)) = do- putWord8 4+ putWord8 0x34 let VList vals = unsafePerformIO (fakeEval $ fmap VList (array_fetch av)) put vals+ put (MkRef (IPair pv)) = do+ putWord8 0x35+ let VList [k, v] = unsafePerformIO (fakeEval $ fmap (\(k, v) -> VList [k, v]) (pair_fetch pv))+ put (k, v) put (MkRef (IHash hv))--- | Just (vh :: VHash) <- fromTypeable hv = do--- putWord8 5--- put vh--- | Just (ih :: IHash) <- fromTypeable hv = do--- putWord8 5--- put $ unsafePerformIO (H.toList ih)+ | hash_iType hv == mkType "Hash" = do+ putWord8 0x36+ let hv' = ((unsafeCoerce# hv) :: IHash)+ put hv'+ | hash_iType hv == mkType "Hash::Env" = do+ putWord8 0x37+ | hash_iType hv == mkType "Hash::Const" = do+ putWord8 0xFF+ let hv' = ((unsafeCoerce# hv) :: VHash)+ put hv' | otherwise = do- putWord8 5+ putWord8 0xFF+ -- put (show (typeOf hv)) -- let VMatch MkMatch{ matchSubNamed = hv } = unsafePerformIO -- ( fakeEval $ fmap (VMatch . MkMatch False 0 0 "" []) (hash_fetch hv) )- put ([] :: [(VStr, Val)])- put (MkRef (IPair pv)) = do- putWord8 6- let VList [k, v] = unsafePerformIO (fakeEval $ fmap (\(k, v) -> VList [k, v]) (pair_fetch pv))- put (k, v)+ put (Map.empty :: VHash) put ref = fail ("Not implemented: asYAML \"" ++ showType (refType ref) ++ "\"") get = do tag_ <- getWord8 case tag_ of- 0 -> fmap (MkRef . ICode) (get :: Get VMultiCode)- 1 -> fmap (MkRef . ICode) (get :: Get VCode)- 2 -> fmap (MkRef . IScalar) (get :: Get VScalar)- 3 -> fmap (MkRef . unsafePerformIO . newScalar') get- 4 -> fmap (MkRef . unsafePerformIO . newArray') get- 5 -> fmap (MkRef . unsafePerformIO . newHash') get- 6 -> fmap pairRef (get :: Get VPair)--newHash' :: VHash -> IO (IVar VHash)-newHash' hash = do- ihash <- H.fromList H.hashString (map (\(a,b) -> (a, lazyScalar b)) (Map.toList hash))- return $ IHash ihash+ 0x30 -> fmap codeRef (get :: Get VMultiCode)+ 0x31 -> fmap codeRef (get :: Get VCode)+ 0x32 -> fmap scalarRef (get :: Get VScalar)+ 0x33 -> fmap (MkRef . unsafePerformIO . newScalar') get+ 0x34 -> fmap (MkRef . unsafePerformIO . newArray') get+ 0x35 -> fmap pairRef (get :: Get VPair)+ 0x36 -> do+ iHash <- get+ return $ hashRef (iHash :: IHash)+ 0x37 -> return $ hashRef MkHashEnv+ _ -> fmap hashRef (get :: Get VHash) newScalar' :: VScalar -> IO (IVar VScalar) newScalar' = (fmap IScalar) . newTVarIO@@ -1461,3 +1464,11 @@ iv <- newTVarIO (toP tvs) return $ IArray (MkIArray iv) +instance Binary Pad where+ put = put . Map.toList . padEntries+ get = liftM (MkPad . Map.fromList) get++instance Binary EntryFlags where+ put (MkEntryFlags x) = put x+ get = fmap MkEntryFlags get+
src/Pugs/Prim/Eval.hs view
@@ -51,7 +51,9 @@ loaded <- existsFromRef seen v let file | '.' `elem` mod = mod | otherwise = (concat $ intersperse (getConfig "file_sep") $ split "::" mod) ++ ".pm"- pathName <- requireInc incs file (errMsg file incs)+ pathName <- case mod of+ "Test" -> return "Test.pm"+ _ -> requireInc incs file (errMsg file incs) if loaded then opEval style pathName "" else do -- %*INC{mod} = { relname => file, pathname => pathName } evalExp $ Syn "="@@ -67,7 +69,7 @@ ends <- fromVal =<< readRef endAV clearRef endAV rv <- case mod of--- "Test" -> shortcutToTestPM+ "Test" -> shortcutToTestPM _ -> tryFastEval pathName (pathName ++ ".yml") endAV' <- findSymRef (cast "@*END") glob doArray (VRef endAV') (`array_unshift` ends)@@ -80,9 +82,12 @@ stm $ do glob' <- readMPad globTVar writeMPad globTVar (glob `unionPads` glob')++ -- | PEStatic { pe_type :: !Type, pe_proto :: !VRef, pe_flags :: !EntryFlags, pe_store :: !(TVar VRef) } evl <- asks envEval evl ast tryFastEval pathName pathNameYml = do+ io $ print pathNameYml ok <- io $ doesFileExist pathNameYml if not ok then slowEval pathName else do isYamlStale <- tryIO False $ do
src/Pugs/Types/Hash.hs view
@@ -102,6 +102,7 @@ decodeKey x = x instance HashClass IHash where+ hash_iType = const $ mkType "Hash" hash_clone hv = do ps <- unsafeIOToSTM $ H.toList hv ps' <- forM ps $ \(k, sv) -> do
src/Pugs/Version.hs view
@@ -14,10 +14,10 @@ -- #include "pugs_version.h" #ifndef PUGS_VERSION-#define PUGS_VERSION "6.2.13.1"+#define PUGS_VERSION "6.2.13.6" #endif #ifndef PUGS_DATE-#define PUGS_DATE "June 22, 2008"+#define PUGS_DATE "June 29, 2008" #endif #ifndef PUGS_SVN_REVISION #define PUGS_SVN_REVISION 0@@ -33,7 +33,7 @@ versnum = PUGS_VERSION date = PUGS_DATE version = name ++ ", version " ++ versnum ++ ", " ++ date ++ revision-copyright = "Copyright 2005-2007, The Pugs Contributors"+copyright = "Copyright 2005-2008, The Pugs Contributors" revnum = show (PUGS_SVN_REVISION :: Integer) revision | rev <- revnum