packages feed

trifecta 0.47 → 0.49

raw patch · 18 files changed

+543/−164 lines, 18 filesdep +deepseqdep ~kan-extensionsdep ~paralleldep ~reducers

Dependencies added: deepseq

Dependency ranges changed: kan-extensions, parallel, reducers

Files

− Text/Trifecta/ByteSet.hs 
@@ -1,64 +0,0 @@-{-# LANGUAGE BangPatterns, MagicHash #-}--------------------------------------------------------------------------------- |--- Module      :  Text.Trifecta.ByteSet--- Copyright   :  Edward Kmett 2011---                Bryan O'Sullivan 2008--- License     :  BSD3--- --- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  unknown------ Fast set membership tests for byte values, The set representation is --- unboxed for efficiency and uses a lookup table. This is a fairly minimal--- API. You probably want to use CharSet.-------------------------------------------------------------------------------module Text.Trifecta.ByteSet-    (-    -- * Data type-      ByteSet(..)-    -- * Construction-    , fromList-    -- * Lookup-    , member-    ) where--import Data.Bits ((.&.), (.|.))-import Foreign.Storable (peekByteOff, pokeByteOff)-import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#)-import GHC.Word (Word8(W8#))-import qualified Data.ByteString as B-import qualified Data.ByteString.Internal as I-import qualified Data.ByteString.Unsafe as U--newtype ByteSet = ByteSet B.ByteString deriving (Eq, Ord, Show)--data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8--shiftR :: Int -> Int -> Int-shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)--shiftL :: Word8 -> Int -> Word8-shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#))--index :: Int -> I-index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7))-{-# INLINE index #-}--fromList :: [Word8] -> ByteSet-fromList s0 = ByteSet $ I.unsafeCreate 32 $ \t -> do-  _ <- I.memset t 0 32-  let go [] = return ()-      go (c:cs) = do-        prev <- peekByteOff t byte :: IO Word8-        pokeByteOff t byte (prev .|. bit)-        go cs-        where I byte bit = index (fromIntegral c)-  go s0      ---- | Check the set for membership.-member :: Word8 -> ByteSet -> Bool-member w (ByteSet t) = U.unsafeIndex t byte .&. bit /= 0-  where -    I byte bit = index (fromIntegral w)
Text/Trifecta/CharSet.hs view
@@ -25,7 +25,7 @@ -------------------------------------------------------------------------------  module Text.Trifecta.CharSet-    ( +    (     -- * Set type       CharSet(..)     -- * Operators@@ -36,7 +36,7 @@     , member     , notMember     , overlaps, isSubsetOf-    , isComplemented +    , isComplemented     -- * Construction     , build     , empty@@ -76,8 +76,8 @@ import Data.Data import Data.Function (on) import Data.IntSet (IntSet)-import Text.Trifecta.ByteSet (ByteSet)-import qualified Text.Trifecta.ByteSet as ByteSet+import Text.Trifecta.Util.ByteSet (ByteSet)+import qualified Text.Trifecta.Util.ByteSet as ByteSet import Data.Bits hiding (complement) import Data.Word import Data.ByteString.Internal (c2w)
Text/Trifecta/Diagnostic/Class.hs view
@@ -26,8 +26,6 @@ import Control.Monad.Trans.Identity import Data.Monoid import Text.Trifecta.Diagnostic.Prim-import Text.Trifecta.Diagnostic.Level-import Text.Trifecta.Diagnostic.Rendering.Prim  class Monad m => MonadDiagnostic e m | m -> e where   throwDiagnostic :: Diagnostic e -> m a
Text/Trifecta/Diagnostic/Prim.hs view
@@ -19,13 +19,11 @@ import Control.Comonad import Control.Monad (guard) import Control.Exception-import Control.Monad.Writer.Class import Data.Functor.Apply import Data.Foldable import Data.Traversable import Data.List.NonEmpty hiding (map) import Data.Semigroup-import Data.Semigroup.Reducer import Data.Semigroup.Foldable import Data.Semigroup.Traversable import Text.Trifecta.Rope.Bytes
Text/Trifecta/Diagnostic/Rendering/Fixit.hs view
@@ -28,7 +28,7 @@ import Text.Trifecta.Diagnostic.Rendering.Prim import Text.Trifecta.Diagnostic.Rendering.Span import Text.Trifecta.Parser.Class-import Text.Trifecta.Util+import Text.Trifecta.Util.Combinators import System.Console.Terminfo.Color import System.Console.Terminfo.PrettyPrint import Prelude hiding (span)
Text/Trifecta/Diagnostic/Rendering/Span.hs view
@@ -35,7 +35,7 @@ import Text.Trifecta.Rope.Bytes import Text.Trifecta.Rope.Delta import Text.Trifecta.Diagnostic.Rendering.Prim-import Text.Trifecta.Util+import Text.Trifecta.Util.Combinators import Text.Trifecta.Parser.Class import Data.Array import System.Console.Terminfo.Color
Text/Trifecta/Parser/ByteString.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, Rank2Types #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- |@@ -47,7 +47,7 @@ -- >     Nothing -> return () -- >     Just a  -> print $ sum a -parseFromFile :: Show a => Parser String a -> String -> IO (Maybe a)+parseFromFile :: Show a => (forall r. Parser r String a) -> String -> IO (Maybe a) parseFromFile p fn = do   result <- parseFromFileEx p fn   case result of@@ -67,7 +67,7 @@ -- >       print $ sum a -- > -parseFromFileEx :: Show a => Parser String a -> String -> IO (Result TermDoc a)+parseFromFileEx :: Show a => (forall r. Parser r String a) -> String -> IO (Result TermDoc a) parseFromFileEx p fn = k <$> B.readFile fn where   k i = starve       $ feed (rope (F.fromList [LineDirective (UTF8.fromString fn) 0, strand i]))
Text/Trifecta/Parser/Char.hs view
@@ -42,7 +42,7 @@ import qualified Data.IntSet as IntSet import Text.Trifecta.CharSet (CharSet(..)) import qualified Text.Trifecta.CharSet as CharSet-import qualified Text.Trifecta.ByteSet as ByteSet+import qualified Text.Trifecta.Util.ByteSet as ByteSet import qualified Data.ByteString as Strict import Data.ByteString.Internal (w2c,c2w) import Data.ByteString.UTF8 as UTF8
Text/Trifecta/Parser/Char8.hs view
@@ -49,8 +49,8 @@ import Control.Monad (guard) import Text.Trifecta.Parser.Class hiding (satisfy) import Text.Trifecta.Rope.Delta-import Text.Trifecta.ByteSet (ByteSet(..))-import qualified Text.Trifecta.ByteSet as ByteSet+import Text.Trifecta.Util.ByteSet (ByteSet(..))+import qualified Text.Trifecta.Util.ByteSet as ByteSet import qualified Data.ByteString as Strict import Data.ByteString.Internal (w2c,c2w) import qualified Data.ByteString.Char8 as Char8
Text/Trifecta/Parser/Combinators.hs view
@@ -177,7 +177,7 @@ -- --    Note the overlapping parsers @anyChar@ and @string \"-->\"@, and --    therefore the use of the 'try' combinator.-manyTill :: (Alternative m, MonadPlus m) => m a -> m end -> m [a]+manyTill :: Alternative m => m a -> m end -> m [a] manyTill p end = go where go = ([] <$ end) <|> ((:) <$> p <*> go)  -- * MonadParsers
Text/Trifecta/Parser/It.hs view
@@ -37,7 +37,7 @@ import Text.Trifecta.Rope.Delta import Text.Trifecta.Rope.Bytes import Text.Trifecta.Parser.Step-import Text.Trifecta.Util as Util+import Text.Trifecta.Util.Combinators as Util  data It r a   = Pure a
Text/Trifecta/Parser/Prim.hs view
@@ -22,6 +22,7 @@ import Control.Applicative import Control.Monad.Error.Class import Control.Monad.Writer.Class+import Control.Monad.Cont.Class import Control.Monad import Control.Comonad import qualified Data.Functor.Plus as Plus@@ -56,8 +57,8 @@ import Text.Trifecta.Rope.Bytes import System.Console.Terminfo.PrettyPrint -data Parser e a = Parser-  { unparser :: forall r.+data Parser r e a = Parser+  { unparser ::     (a -> ErrState e -> ErrLog e -> Bool -> Delta -> ByteString -> It Rope r) -> -- uncommitted ok     (     ErrState e -> ErrLog e -> Bool -> Delta -> ByteString -> It Rope r) -> -- uncommitted err     (a -> ErrState e -> ErrLog e -> Bool -> Delta -> ByteString -> It Rope r) -> -- committed ok@@ -65,14 +66,14 @@                         ErrLog e -> Bool -> Delta -> ByteString -> It Rope r   } -instance Functor (Parser e) where+instance Functor (Parser r e) where   fmap f (Parser m) = Parser $ \ eo ee co -> m (eo . f) ee (co . f)   {-# INLINE fmap #-}   a <$ Parser m = Parser $ \ eo ee co -> m (\_ -> eo a) ee (\_ -> co a)   {-# INLINE (<$) #-} -instance Apply (Parser e) where (<.>) = (<*>)-instance Applicative (Parser e) where+instance Apply (Parser r e) where (<.>) = (<*>)+instance Applicative (Parser r e) where   pure a = Parser $ \ eo _ _ _ -> eo a mempty   {-# INLINE pure #-}   (<*>) = ap@@ -92,12 +93,12 @@   {-# INLINE (*>) #-} -} -instance Alt (Parser e) where+instance Alt (Parser r e) where   (<!>) = (<|>)   many p = Prelude.reverse <$> manyAccum (:) p   some p = p *> many p-instance Plus (Parser e) where zero = empty-instance Alternative (Parser e) where+instance Plus (Parser r e) where zero = empty+instance Alternative (Parser r e) where   empty = Parser $ \_ ee _ _ -> ee mempty   {-# INLINE empty #-}   Parser m <|> Parser n = Parser $ \ eo ee co ce ->@@ -108,15 +109,15 @@   {-# INLINE many #-}   some p = (:) <$> p <*> many p -instance Semigroup (Parser e a) where+instance Semigroup (Parser r e a) where   (<>) = (<|>) -instance Monoid (Parser e a) where+instance Monoid (Parser r e a) where   mappend = (<|>)   mempty = empty -instance Bind (Parser e) where (>>-) = (>>=)-instance Monad (Parser e) where+instance Bind (Parser r e) where (>>-) = (>>=)+instance Monad (Parser r e) where   return a = Parser $ \ eo _ _ _ -> eo a mempty   {-# INLINE return #-}   Parser m >>= k = Parser $ \ eo ee co ce ->@@ -129,11 +130,11 @@   {-# INLINE fail #-}  -instance MonadPlus (Parser e) where+instance MonadPlus (Parser r e) where   mzero = empty   mplus = (<|>) -instance MonadWriter (ErrLog e) (Parser e) where+instance MonadWriter (ErrLog e) (Parser r e) where   tell w = Parser $ \eo _ _ _ l -> eo () mempty (l <> w)   {-# INLINE tell #-}   listen (Parser m) = Parser $ \eo ee co ce l ->@@ -151,19 +152,19 @@       mempty   {-# INLINE pass #-} -manyAccum :: (a -> [a] -> [a]) -> Parser e a -> Parser e [a]+manyAccum :: (a -> [a] -> [a]) -> Parser r e a -> Parser r e [a] manyAccum acc (Parser p) = Parser $ \eo _ co ce ->   let walk xs x _ = p manyErr (\_ -> co (acc x xs) mempty) (walk (acc x xs)) ce       manyErr _ e l b8 d bs = ce e { errMessage = PanicErr (renderingCaret d bs) "'many' applied to a parser that accepted an empty string" } l b8 d bs   in p manyErr (eo []) (walk []) ce -instance MonadDiagnostic e (Parser e) where+instance MonadDiagnostic e (Parser r e) where   throwDiagnostic e@(Diagnostic _ l _ _)     | l == Fatal || l == Panic = Parser $ \_ _ _ ce -> ce mempty { errMessage = Err e }     | otherwise                = Parser $ \_ ee _ _ -> ee mempty { errMessage = Err e }   logDiagnostic d = Parser $ \eo _ _ _ l -> eo () mempty l { errLog = errLog l |> d } -instance MonadError (ErrState e) (Parser e) where+instance MonadError (ErrState e) (Parser r e) where   throwError m = Parser $ \_ ee _ _ -> ee m   {-# INLINE throwError #-}   catchError (Parser m) k = Parser $ \ eo ee co ce ->@@ -173,13 +174,13 @@ ascii :: ByteString -> Bool ascii = Strict.all (<=0x7f) -liftIt :: It Rope a -> Parser e a+liftIt :: It Rope a -> Parser r e a liftIt m = Parser $ \ eo _ _ _ l b8 d bs -> do   a <- m   eo a mempty l b8 d bs {-# INLINE liftIt #-} -instance MonadParser (Parser e) where+instance MonadParser (Parser r e) where   try (Parser m) = Parser $ \ eo ee co ce l b8 d bs -> m eo ee co (\e l' _ _ _ ->      if fatalErr (errMessage e)      then ce e (l <> l') b8 d bs@@ -258,7 +259,10 @@     m eo ee (\a e l' _ _ _ -> eo a e (l <> l') b8 d bs) ce l b8 d bs   {-# INLINE lookAhead #-} -instance MonadMark Delta (Parser e) where+instance MonadCont (Parser r e) where+  callCC f = Parser $ \ eo ee co ce l b8 d bs -> unparser (f (\a -> Parser $ \_ _ _ _ l' _ _ _ -> eo a mempty l' b8 d bs)) eo ee co ce l b8 d bs++instance MonadMark Delta (Parser r e) where   mark = position   {-# INLINE mark #-}   release d' = Parser $ \_ ee co _ l b8 d bs -> do@@ -276,7 +280,7 @@  stepParser :: (Diagnostic e -> Diagnostic t) ->               (ErrState e -> Highlights -> Bool -> Delta -> ByteString -> Diagnostic t) ->-              Parser e a -> ErrLog e -> Bool -> Delta -> ByteString -> Step t a+              (forall r. Parser r e a) -> ErrLog e -> Bool -> Delta -> ByteString -> Step t a stepParser yl y (Parser p) l0 b80 d0 bs0 =   go mempty $ p ju no ju no l0 b80 d0 bs0   where@@ -318,9 +322,8 @@     errLoc (PanicErr r _) = Just $ delta r     errLoc (Err (Diagnostic (Left _)  _ _ _)) = Nothing     errLoc (Err (Diagnostic (Right r)  _ _ _)) =  Just $ delta r-  -parseTest :: Show a => Parser String a -> String -> IO ()+parseTest :: Show a => (forall r. Parser r String a) -> String -> IO () parseTest p s = case starve                    $ feed (UTF8.fromString s)                    $ stepParser (fmap prettyTerm) (why prettyTerm) (release mempty *> p) mempty True mempty mempty of
Text/Trifecta/Rope/Prim.hs view
@@ -30,7 +30,7 @@ import Data.Foldable (toList) import Data.Hashable import Data.Int (Int64)-import Text.Trifecta.Util as Util+import Text.Trifecta.Util.Combinators as Util import Text.Trifecta.Rope.Bytes import Text.Trifecta.Rope.Delta
− Text/Trifecta/Util.hs 
@@ -1,52 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Trifecta.Util--- Copyright   :  (C) 2011 Edward Kmett,--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  non-portable---------------------------------------------------------------------------------module Text.Trifecta.Util -  ( argmin-  , argmax-  -- * ByteString conversions-  , fromLazy-  , toLazy-  , takeLine-  , (<$!>) -  ) where--import Data.ByteString.Lazy as Lazy-import Data.ByteString as Strict--argmin :: Ord b => (a -> b) -> a -> a -> a-argmin f a b-  | f a <= f b = a-  | otherwise = b-{-# INLINE argmin #-}--argmax :: Ord b => (a -> b) -> a -> a -> a-argmax f a b-  | f a > f b = a-  | otherwise = b-{-# INLINE argmax #-}--fromLazy :: Lazy.ByteString -> Strict.ByteString-fromLazy = Strict.concat . Lazy.toChunks-     -toLazy :: Strict.ByteString -> Lazy.ByteString-toLazy = Lazy.fromChunks . return--takeLine :: Lazy.ByteString -> Lazy.ByteString-takeLine s = case Lazy.elemIndex 10 s of-  Just i -> Lazy.take (i + 1) s-  Nothing -> s--infixl 4 <$!>-(<$!>) :: Monad m => (a -> b) -> m a -> m b-f <$!> m = do-  a <- m -  return $! f a
+ Text/Trifecta/Util/Array.hs view
@@ -0,0 +1,378 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Util.Array+-- Copyright   :  Edward Kmett 2011+--                Johan Tibell 2011+-- License     :  BSD3+--+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  unknown+--+-- Fast zero based arrays, based on the implementation in the HAMT-branch of+-- unordered-containers+-----------------------------------------------------------------------------+module Text.Trifecta.Util.Array+  ( Array+  , MArray++    -- * Creation+  , new+  , new_+  , empty+  , singleton++    -- * Basic interface+  , length+  , lengthM+  , read+  , write+  , index+  , index_+  , indexM_+  , update+  , insert+  , delete++  , unsafeFreeze+  , run+  , run2+  , copy+  , copyM++    -- * Folds+  , foldl'+  , foldr++  , thaw+  , map+  , map'+  , traverse+  , filter+  ) where++import qualified Data.Traversable as Traversable+import Control.Applicative (Applicative)+import Control.DeepSeq+import Control.Monad.ST+import GHC.Exts+import GHC.ST (ST(..))+import Prelude hiding (filter, foldr, length, map, read)++------------------------------------------------------------------------++#if defined(ASSERTS)+-- This fugly hack is brought by GHC's apparent reluctance to deal+-- with MagicHash and UnboxedTuples when inferring types. Eek!+# define CHECK_BOUNDS(_func_,_len_,_k_) \+if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.HashMap.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else+# define CHECK_OP(_func_,_op_,_lhs_,_rhs_) \+if not ((_lhs_) _op_ (_rhs_)) then error ("Data.HashMap.Array." ++ (_func_) ++ ": Check failed: _lhs_ _op_ _rhs_ (" ++ show (_lhs_) ++ " vs. " ++ show (_rhs_) ++ ")") else+# define CHECK_GT(_func_,_lhs_,_rhs_) CHECK_OP(_func_,>,_lhs_,_rhs_)+# define CHECK_LE(_func_,_lhs_,_rhs_) CHECK_OP(_func_,<=,_lhs_,_rhs_)+#else+# define CHECK_BOUNDS(_func_,_len_,_k_)+# define CHECK_OP(_func_,_op_,_lhs_,_rhs_)+# define CHECK_GT(_func_,_lhs_,_rhs_)+# define CHECK_LE(_func_,_lhs_,_rhs_)+#endif++data Array a = Array {+  unArray :: !(Array# a)+#if __GLASGOW_HASKELL__ < 702+  , length :: {-# UNPACK #-} !Int+#endif+  }++#if __GLASGOW_HASKELL__ >= 702+length :: Array a -> Int+length ary = I# (sizeofArray# (unArray ary))+{-# INLINE length #-}+#endif++-- | Smart constructor+array :: Array# a -> Int -> Array a+#if __GLASGOW_HASKELL__ >= 702+array ary _n = Array ary+#else+array = Array+#endif+{-# INLINE array #-}++data MArray s a = MArray {+  unMArray :: !(MutableArray# s a)+#if __GLASGOW_HASKELL__ < 702+  , lengthM :: {-# UNPACK #-} !Int+#endif+  }++#if __GLASGOW_HASKELL__ >= 702+lengthM :: MArray s a -> Int+lengthM mary = I# (sizeofMutableArray# (unMArray mary))+{-# INLINE lengthM #-}+#endif++-- | Smart constructor+marray :: MutableArray# s a -> Int -> MArray s a+#if __GLASGOW_HASKELL__ >= 702+marray mary _n = MArray mary+#else+marray = MArray+#endif+{-# INLINE marray #-}++------------------------------------------------------------------------++instance NFData a => NFData (Array a) where+  rnf = rnfArray++rnfArray :: NFData a => Array a -> ()+rnfArray ary0 = go ary0 n0 0 where+  n0 = length ary0+  go !ary !n !i+    | i >= n = ()+    | otherwise = rnf (index ary i) `seq` go ary n (i+1)+{-# INLINE rnfArray #-}++-- | Create a new mutable array of specified size, in the specified+-- state thread, with each element containing the specified initial+-- value.+new :: Int -> a -> ST s (MArray s a)+new n@(I# n#) b =+  CHECK_GT("new",n,(0 :: Int))+  ST $ \s -> case newArray# n# b s of+    (# s', ary #) -> (# s', marray ary n #)+{-# INLINE new #-}++new_ :: Int -> ST s (MArray s a)+new_ n = new n undefinedElem++empty :: Array a+empty = run (new_ 0)++singleton :: a -> Array a+singleton x = run (new 1 x)+{-# INLINE singleton #-}++read :: MArray s a -> Int -> ST s a+read ary _i@(I# i#) = ST $ \ s ->+  CHECK_BOUNDS("read", lengthM ary, _i)+  readArray# (unMArray ary) i# s+{-# INLINE read #-}++write :: MArray s a -> Int -> a -> ST s ()+write ary _i@(I# i#) b = ST $ \ s ->+  CHECK_BOUNDS("write", lengthM ary, _i)+  case writeArray# (unMArray ary) i# b s of+    s' -> (# s' , () #)+{-# INLINE write #-}++index :: Array a -> Int -> a+index ary _i@(I# i#) =+  CHECK_BOUNDS("index", length ary, _i)+  case indexArray# (unArray ary) i# of (# b #) -> b+{-# INLINE index #-}++index_ :: Array a -> Int -> ST s a+index_ ary _i@(I# i#) =+  CHECK_BOUNDS("index_", length ary, _i)+  case indexArray# (unArray ary) i# of (# b #) -> return b+{-# INLINE index_ #-}++indexM_ :: MArray s a -> Int -> ST s a+indexM_ ary _i@(I# i#) =+  CHECK_BOUNDS("index_", lengthM ary, _i)+  ST $ \ s# -> readArray# (unMArray ary) i# s#+{-# INLINE indexM_ #-}++unsafeFreeze :: MArray s a -> ST s (Array a)+unsafeFreeze mary = +  ST $ \s -> case unsafeFreezeArray# (unMArray mary) s of+    (# s', ary #) -> (# s', array ary (lengthM mary) #)+{-# INLINE unsafeFreeze #-}++run :: (forall s . ST s (MArray s e)) -> Array e+run act = runST $ act >>= unsafeFreeze+{-# INLINE run #-}++run2 :: (forall s. ST s (MArray s e, a)) -> (Array e, a)+run2 k = runST $ do+  (marr,b) <- k+  arr <- unsafeFreeze marr+  return (arr,b)++-- | Unsafely copy the elements of an array. Array bounds are not checked.+copy :: Array e -> Int -> MArray s e -> Int -> Int -> ST s ()+#if __GLASGOW_HASKELL__ >= 702+copy !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =+  CHECK_LE("copy", _sidx + _n, length src)+  CHECK_LE("copy", _didx + _n, lengthM dst)+  ST $ \ s# -> case copyArray# (unArray src) sidx# (unMArray dst) didx# n# s# of+    s2 -> (# s2, () #)+#else+copy !src !sidx !dst !didx n =+  CHECK_LE("copy", sidx + n, length src)+  CHECK_LE("copy", didx + n, lengthM dst)+  copy_loop sidx didx 0 where+  copy_loop !i !j !c+    | c >= n = return ()+    | otherwise = do+      b <- index_ src i+      write dst j b+      copy_loop (i+1) (j+1) (c+1)+#endif++-- | Unsafely copy the elements of an array. Array bounds are not checked.+copyM :: MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()+#if __GLASGOW_HASKELL__ >= 702+copyM !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =+  CHECK_BOUNDS("copyM: src", lengthM src, _sidx + _n - 1)+  CHECK_BOUNDS("copyM: dst", lengthM dst, _didx + _n - 1)+  ST $ \ s# -> case copyMutableArray# (unMArray src) sidx# (unMArray dst) didx# n# s# of+    s2 -> (# s2, () #)+#else+copyM !src !sidx !dst !didx n =+  CHECK_BOUNDS("copyM: src", lengthM src, sidx + n - 1)+  CHECK_BOUNDS("copyM: dst", lengthM dst, didx + n - 1)+  copy_loop sidx didx 0 where+  copy_loop !i !j !c+    | c >= n = return ()+    | otherwise = do +      b <- indexM_ src i+      write dst j b+      copy_loop (i+1) (j+1) (c+1)+#endif++-- | /O(n)/ Insert an element at the given position in this array,+-- increasing its size by one.+insert :: Array e -> Int -> e -> Array e+insert ary idx b =+  CHECK_BOUNDS("insert", count + 1, idx)+  run $ do+    mary <- new_ (count+1)+    copy ary 0 mary 0 idx+    write mary idx b+    copy ary idx mary (idx+1) (count-idx)+    return mary +  where !count = length ary+{-# INLINE insert #-}++-- | /O(n)/ Update the element at the given position in this array.+update :: Array e -> Int -> e -> Array e+update ary idx b =+  CHECK_BOUNDS("update", count, idx)+  run $ do+    mary <- thaw ary 0 count+    write mary idx b+    return mary+  where !count = length ary+{-# INLINE update #-}++foldl' :: (b -> a -> b) -> b -> Array a -> b+foldl' f = \ z0 ary0 -> go ary0 (length ary0) 0 z0 where+  go ary n i !z+    | i >= n    = z+    | otherwise = go ary n (i+1) (f z (index ary i))+{-# INLINE foldl' #-}++foldr :: (a -> b -> b) -> b -> Array a -> b+foldr f = \ z0 ary0 -> go ary0 (length ary0) 0 z0 where+  go ary n i z+    | i >= n    = z+    | otherwise = f (index ary i) (go ary n (i+1) z)+{-# INLINE foldr #-}++undefinedElem :: a+undefinedElem = error "Undefined element"++thaw :: Array e -> Int -> Int -> ST s (MArray s e)+#if __GLASGOW_HASKELL__ >= 702+thaw !ary !_o@(I# o#) !n@(I# n#) =+  CHECK_LE("thaw", _o + n, length ary)+  ST $ \ s -> case thawArray# (unArray ary) o# n# s of+    (# s2, mary# #) -> (# s2, marray mary# n #)+#else+thaw !ary !o !n =+  CHECK_LE("thaw", o + n, length ary)+  do mary <- new_ n+     copy ary o mary 0 n+     return mary+#endif+{-# INLINE thaw #-}++-- | /O(n)/ Delete an element at the given position in this array,+-- decreasing its size by one.+delete :: Array e -> Int -> Array e+delete ary idx = run $ do+    mary <- new_ (count-1)+    copy ary 0 mary 0 idx+    copy ary (idx+1) mary idx (count-(idx+1))+    return mary+  where !count = length ary+{-# INLINE delete #-}++map :: (a -> b) -> Array a -> Array b+map f = \ ary ->+  let !n = length ary+  in run $ do+    mary <- new_ n+    go ary mary 0 n+  where+    go ary mary i n+        | i >= n    = return mary+        | otherwise = do+             write mary i $ f (index ary i)+             go ary mary (i+1) n+{-# INLINE map #-}++-- | Strict version of 'map'.+map' :: (a -> b) -> Array a -> Array b+map' f = \ ary ->+  let !n = length ary+  in run $ do+    mary <- new_ n+    go ary mary 0 n+  where+    go ary mary i n+      | i >= n    = return mary+      | otherwise = do+        write mary i $! f (index ary i)+        go ary mary (i+1) n+{-# INLINE map' #-}++fromList :: Int -> [a] -> Array a+fromList n xs0 = run $ do+  mary <- new_ n+  go xs0 mary 0+  where+    go [] !mary !_   = return mary+    go (x:xs) mary i = do write mary i x+                          go xs mary (i+1)++toList :: Array a -> [a]+toList = foldr (:) []++traverse :: Applicative f => (a -> f b) -> Array a -> f (Array b)+traverse f = \ ary ->+  fromList (length ary) `fmap`+  Traversable.traverse f (toList ary)+{-# INLINE traverse #-}++filter :: (a -> Bool) -> Array a -> Array a+filter p = \ ary ->+  let !n = length ary+  in run $ do+    mary <- new_ n+    go ary mary 0 0 n+  where+    go ary mary i j n+      | i >= n    = if i == j+                    then return mary+                    else do mary2 <- new_ j+                            copyM mary 0 mary2 0 j+                            return mary2+      | p el      = write mary j el >> go ary mary (i+1) (j+1) n+      | otherwise = go ary mary (i+1) j n+      where el = index ary i+{-# INLINE filter #-}
+ Text/Trifecta/Util/ByteSet.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE BangPatterns, MagicHash #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Util.ByteSet+-- Copyright   :  Edward Kmett 2011+--                Bryan O'Sullivan 2008+-- License     :  BSD3+-- +-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  unknown+--+-- Fast set membership tests for byte values, The set representation is +-- unboxed for efficiency and uses a lookup table. This is a fairly minimal+-- API. You probably want to use CharSet.+-----------------------------------------------------------------------------+module Text.Trifecta.Util.ByteSet+    (+    -- * Data type+      ByteSet(..)+    -- * Construction+    , fromList+    -- * Lookup+    , member+    ) where++import Data.Bits ((.&.), (.|.))+import Foreign.Storable (peekByteOff, pokeByteOff)+import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#)+import GHC.Word (Word8(W8#))+import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as I+import qualified Data.ByteString.Unsafe as U++newtype ByteSet = ByteSet B.ByteString deriving (Eq, Ord, Show)++data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8++shiftR :: Int -> Int -> Int+shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)++shiftL :: Word8 -> Int -> Word8+shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#))++index :: Int -> I+index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7))+{-# INLINE index #-}++fromList :: [Word8] -> ByteSet+fromList s0 = ByteSet $ I.unsafeCreate 32 $ \t -> do+  _ <- I.memset t 0 32+  let go [] = return ()+      go (c:cs) = do+        prev <- peekByteOff t byte :: IO Word8+        pokeByteOff t byte (prev .|. bit)+        go cs+        where I byte bit = index (fromIntegral c)+  go s0      ++-- | Check the set for membership.+member :: Word8 -> ByteSet -> Bool+member w (ByteSet t) = U.unsafeIndex t byte .&. bit /= 0+  where +    I byte bit = index (fromIntegral w)
+ Text/Trifecta/Util/Combinators.hs view
@@ -0,0 +1,52 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Util.Combinators+-- Copyright   :  (C) 2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable+--+----------------------------------------------------------------------------+module Text.Trifecta.Util.Combinators+  ( argmin+  , argmax+  -- * ByteString conversions+  , fromLazy+  , toLazy+  , takeLine+  , (<$!>)+  ) where++import Data.ByteString.Lazy as Lazy+import Data.ByteString as Strict++argmin :: Ord b => (a -> b) -> a -> a -> a+argmin f a b+  | f a <= f b = a+  | otherwise = b+{-# INLINE argmin #-}++argmax :: Ord b => (a -> b) -> a -> a -> a+argmax f a b+  | f a > f b = a+  | otherwise = b+{-# INLINE argmax #-}++fromLazy :: Lazy.ByteString -> Strict.ByteString+fromLazy = Strict.concat . Lazy.toChunks+     +toLazy :: Strict.ByteString -> Lazy.ByteString+toLazy = Lazy.fromChunks . return++takeLine :: Lazy.ByteString -> Lazy.ByteString+takeLine s = case Lazy.elemIndex 10 s of+  Just i -> Lazy.take (i + 1) s+  Nothing -> s++infixl 4 <$!>+(<$!>) :: Monad m => (a -> b) -> m a -> m b+f <$!> m = do+  a <- m +  return $! f a
trifecta.cabal view
@@ -1,6 +1,6 @@ name:          trifecta category:      Text, Parsing, Diagnostics, Pretty Printer, Logging-version:       0.47+version:       0.49 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -24,7 +24,6 @@ library   exposed-modules:     Text.Trifecta-    Text.Trifecta.ByteSet     Text.Trifecta.CharSet     Text.Trifecta.CharSet.Common     Text.Trifecta.CharSet.Posix@@ -93,9 +92,11 @@     Text.Trifecta.Parser.Token.Style     Text.Trifecta.Parser.Identifier     Text.Trifecta.Parser.Identifier.Style+    Text.Trifecta.Util.Array+    Text.Trifecta.Util.ByteSet    other-modules:-    Text.Trifecta.Util+    Text.Trifecta.Util.Combinators    ghc-options: -Wall @@ -109,19 +110,20 @@     bifunctors           >= 0.1.2   && < 0.2,     data-lens            >= 2.0.1   && < 2.1,     data-lens-fd         >= 2.0     && < 2.1,+    deepseq              >= 1.2.0.1 && < 1.3,     hashable             >= 1.1.2.1 && < 1.2,     bytestring           >= 0.9.1   && < 0.10,     mtl                  >= 2.0.1   && < 2.1,     semigroups           >= 0.8     && < 0.9,     fingertree           >= 0.0.1   && < 0.1,-    reducers             >= 0.1.6   && < 0.2,+    reducers             >= 0.1.7   && < 0.2,     profunctors          >= 0.1.1   && < 0.2,     utf8-string          >= 0.3.6   && < 0.4,     semigroupoids        >= 1.2.4   && < 1.3,-    parallel             >= 3.1.0.1 && < 3.2,+    parallel             >= 3.2     && < 3.3,     pointed              >= 2.0.2   && < 2.1,     transformers         >= 0.2.2   && < 0.3,-    kan-extensions       >= 2.0.1   && < 2.1,+    kan-extensions       >= 2.0.4   && < 2.1,     comonad              >= 1.1.1.1 && < 1.2,     terminfo             >= 0.3.2   && < 0.4,     keys                 >= 2.1.1.1 && < 2.2,