diff --git a/Pugs.cabal b/Pugs.cabal --- a/Pugs.cabal +++ b/Pugs.cabal @@ -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 diff --git a/cbits/Prelude_pm.c b/cbits/Prelude_pm.c # file too large to diff: cbits/Prelude_pm.c diff --git a/cbits/Test_pm.c b/cbits/Test_pm.c # file too large to diff: cbits/Test_pm.c diff --git a/src/Pugs/AST/Internals/Instances.hs b/src/Pugs/AST/Internals/Instances.hs --- a/src/Pugs/AST/Internals/Instances.hs +++ b/src/Pugs/AST/Internals/Instances.hs @@ -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 + diff --git a/src/Pugs/Prim/Eval.hs b/src/Pugs/Prim/Eval.hs --- a/src/Pugs/Prim/Eval.hs +++ b/src/Pugs/Prim/Eval.hs @@ -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 diff --git a/src/Pugs/Types/Hash.hs b/src/Pugs/Types/Hash.hs --- a/src/Pugs/Types/Hash.hs +++ b/src/Pugs/Types/Hash.hs @@ -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 diff --git a/src/Pugs/Version.hs b/src/Pugs/Version.hs --- a/src/Pugs/Version.hs +++ b/src/Pugs/Version.hs @@ -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