pugs-DrIFT 2.2.3.20130611 → 2.2.3.20150815

raw patch · 5 files changed

+53/−22 lines, 5 filesdep +hashabledep +hashtablesdep +pugs-DrIFTPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hashable, hashtables, pugs-DrIFT

API changes (from Hackage documentation)

Files

• pugs-DrIFT.cabal +7/−3
• src/ChaseImports.hs +2/−3
• src/DrIFT/YAML.hs +32/−14
• src/GenUtil.hs +3/−2
• src/ParseLib2.hs +9/−0

@@ -1,5 +1,5 @@ name:                pugs-DrIFT-version:             2.2.3.20130611+version:             2.2.3.20150815 synopsis:            DrIFT with pugs-specific rules. description:         DrIFT is a type sensitive preprocessor for Haskell. It extracts type declarations                      and directives from modules. The directives cause rules to be fired on the parsed@@ -11,7 +11,7 @@                      This allows instances to be derived for a type after the original module has been compiled.                      As a bonus, simple utility functions can also be produced from a type. category:            Pugs-cabal-version:       >= 1.2.3+cabal-version:       >= 1.8 license:             BSD3 license-file:        LICENSE -- For contributors & what they did, see AUTHORS@@ -19,6 +19,7 @@ maintainer:          Audrey Tang <audreyt@audreyt.org> homepage:            http://pugscode.org/ build-type:          Simple+Tested-With:         GHC==7.10.2 data-files:          AUTHORS, ChangeLog, README, README.old                      -- , PArr extra-source-files:@@ -34,6 +35,9 @@  executable          pugs-DrIFT     build-depends:       base >= 4 && < 5, old-time, random, bytestring, utf8-string, pretty, containers, mtl >= 2.0.0.0, stm, HsSyck+                       , hashtables+                       , hashable+                       , pugs-DrIFT     main-is:             DrIFT.hs     -- ghc-options:         -fparr     hs-source-dirs:      src@@ -44,7 +48,7 @@                          IncoherentInstances  library-    build-depends:       base >= 4 && < 5, old-time, random, bytestring, utf8-string, pretty, containers, mtl >= 2.0.0.0, stm, HsSyck+    build-depends:       base >= 4 && < 5, old-time, random, bytestring, utf8-string, pretty, containers, mtl >= 2.0.0.0, stm, HsSyck, hashtables, hashable     hs-source-dirs:      src     -- ghc-options:         -fparr     extensions:          ParallelListComp, ScopedTypeVariables,

@@ -29,9 +29,9 @@ import qualified Unlit import Control.Monad import GenUtil-import Control.Exception hiding (try)+import Control.Exception(catch, SomeException) -try x = catch (x >>= return . Right) (return . Left)+try x = catch (x >>= return . Right) (\e -> return $ Left (e :: SomeException))  --- Split up input --------------------------------------------------------- splitString :: String -> String -> (String,String)@@ -91,7 +91,6 @@ -- search though paths, using try findModule :: [String] -> String -> IO String findModule paths modname = let-	action :: FilePath -> IO (Either SomeException (String,FilePath,Bool)) 	action p = try $ do 			    h <- readFile p  	                    return (h,p,".lhs" `isSuffixOf` p)

@@ -1,7 +1,8 @@+{-# LANGUAGE BangPatterns #-} module DrIFT.YAML where import Data.Yaml.Syck import Data.Ratio-import GHC.Exts+import GHC.Exts hiding (toList) import Data.Typeable import Data.Char import Control.Exception@@ -18,13 +19,14 @@ import Data.Int		( Int32, Int64 ) import Codec.Binary.UTF8.String (encodeString, decodeString) -- import Pugs.Internals (addressOf, safeMode)-import Data.HashTable (HashTable)+import Data.HashTable.IO (BasicHashTable) import qualified Data.IntSet as IntSet-import qualified Data.HashTable as Hash+import qualified Data.HashTable.IO as Hash import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Sequence as Seq+import Data.Hashable (Hashable(..))  type Buf = S.ByteString @@ -296,7 +298,7 @@     where     {-# INLINE addressOf #-}     addressOf :: a -> Word-    addressOf x = W# (unsafeCoerce# x)+    addressOf !x = W# (unsafeCoerce# x)  asYAMLwith :: (YAML a, YAML b) => (a -> EmitAs b) -> a -> EmitAs YamlNode asYAMLwith f x = asYAMLanchor x (asYAML =<< f x)@@ -308,8 +310,8 @@     typ = typeOf (undefined :: a)  -type SeenHash = HashTable SYMID (Maybe YamlNode)-type DuplHash = HashTable YamlNode Int+type SeenHash = BasicHashTable SYMID (Maybe YamlNode)+type DuplHash = BasicHashTable YamlNode Int  -- Compress a YAML tree by finding common subexpressions. compressYamlNode :: YamlNode -> IO YamlNode@@ -318,8 +320,8 @@     --          First time a SYMID is seen, firstTime (Hash from SYMID to (Maybe YamlNode))     --          is inserted.  Next time, both YamlNodes are written to the dupNode     --          hash (Hash from YamlNode to Int), and firstTime now contains Nothing.-    seen    <- Hash.new (==) fromIntegral-    dupl    <- Hash.new eqNode (fromIntegral . n_id)+    seen    <- Hash.new+    dupl    <- Hash.new     count   <- newIORef 1      let ?seenHash = seen@@ -351,7 +353,7 @@     case rv of         Just 0  -> do             i   <- readIORef ?countRef-            Hash.update ?duplHash node i +            hashUpdate ?duplHash node i              writeIORef ?countRef (i+1)             elem'   <- visitElem (n_elem node)             return node{ n_anchor = AAnchor i, n_elem = elem' }@@ -379,11 +381,11 @@     rv  <- Hash.lookup ?seenHash symid     case rv of         Just (Just prevNode)   -> do-            Hash.update ?duplHash node' 0-            Hash.update ?duplHash prevNode 0-            Hash.update ?seenHash symid Nothing-        Just _  -> Hash.update ?duplHash node' 0-        _       -> Hash.update ?seenHash symid (Just node')+            hashUpdate ?duplHash node' 0+            hashUpdate ?duplHash prevNode 0+            hashUpdate ?seenHash symid Nothing+        Just _  -> hashUpdate ?duplHash node' 0+        _       -> hashUpdate ?seenHash symid (Just node')     return node'{ n_elem = elem' }  markElem :: (?seenHash :: SeenHash, ?duplHash :: DuplHash) => YamlElem -> IO (Int32, YamlElem)@@ -432,3 +434,19 @@         where         r :: Int64         r = fromIntegral a * fromIntegral b++hashUpdate :: (Eq k, Hashable k) => BasicHashTable k v -> k -> v -> IO Bool+hashUpdate h k v = do+    v' <- Hash.lookup h k+    Hash.insert h k v+    case v' of+        Just _ -> return True+        Nothing -> return False++instance Hashable YamlNode where+    hashWithSalt salt i = let i' = fromIntegral . n_id $ i :: Int+                           in hashWithSalt salt i'++instance Hashable SYMID where+    hashWithSalt salt i = let i' = fromIntegral i :: Int+                           in hashWithSalt salt i'

@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-}  --  $Id: GenUtil.hs,v 1.30 2004/12/01 23:58:27 john Exp $ -- arch-tag: 835e46b7-8ffd-40a0-aaf9-326b7e347760@@ -287,10 +288,10 @@ lefts xs = [x | Left x <- xs]  ioM :: Monad m => IO a -> IO (m a)-ioM action = catch (fmap return action) (\e -> return (fail (show (e :: SomeException))))+ioM action = catch (fmap return action) (\(e :: SomeException) -> return (fail (show e)))  ioMp :: MonadPlus m => IO a -> IO (m a)-ioMp action = catch (fmap return action) (\e -> let _ = e :: SomeException in return mzero)+ioMp action = catch (fmap return action) (\(_ :: SomeException) -> return mzero)  -- | reformat a string to not be wider than a given width, breaking it up -- between words.

@@ -32,6 +32,7 @@     opt, skipUntil, skipUntilOff,skipUntilParse,skipNest) where  import Data.Char+import qualified Control.Applicative as AP import Control.Monad  infixr 5 +++@@ -61,6 +62,14 @@    mzero                = P (\pos inp -> [])    -- mplus            :: Parser a -> Parser a -> Parser a    (P p) `mplus` (P q)    = P (\pos inp -> (p pos inp ++ q pos inp))++instance AP.Applicative Parser where+    pure = return+    (<*>) = ap++instance AP.Alternative Parser where+    (<|>) = mplus+    empty = mzero  -- bits which donn't fit into Haskell's type classes just yet :-(