diff --git a/library/Ptr/PokeIO.hs b/library/Ptr/PokeIO.hs --- a/library/Ptr/PokeIO.hs +++ b/library/Ptr/PokeIO.hs @@ -5,6 +5,7 @@ where import Ptr.Prelude +import qualified Ptr.IO as IO type PokeIO = @@ -25,3 +26,15 @@ putMVar lock () action2 (plusPtr ptr space1) takeMVar lock + +{-| Unsigned ASCII integral -} +{-# INLINE asciiUnsignedIntegral #-} +asciiUnsignedIntegral :: (Integral a) => Int -> a -> PokeIO +asciiUnsignedIntegral = let + loop ptr x = case quotRem x 10 of + (quot, rem) -> do + IO.pokeWord8 ptr (48 + fromIntegral rem) + case quot of + 0 -> return () + _ -> loop (plusPtr ptr (-1)) quot + in \ lastIndex x ptr -> loop (plusPtr ptr lastIndex) x diff --git a/library/Ptr/Poking.hs b/library/Ptr/Poking.hs --- a/library/Ptr/Poking.hs +++ b/library/Ptr/Poking.hs @@ -113,21 +113,14 @@ Poking space (\ptr -> poke ptr input) {-| Unsigned ASCII integral -} -{-# INLINABLE asciiIntegral #-} +{-# INLINE asciiIntegral #-} asciiIntegral :: (Integral a) => a -> Poking asciiIntegral = \ case 0 -> word8 48 x -> let lastIndex = (floor . logBase 10 . fromIntegral) x size = succ lastIndex - action = let - loop ptr x = case quotRem x 10 of - (quot, rem) -> do - A.pokeWord8 ptr (48 + fromIntegral rem) - case quot of - 0 -> return () - _ -> loop (plusPtr ptr (-1)) quot - in \ ptr -> loop (plusPtr ptr lastIndex) x + action = E.asciiUnsignedIntegral lastIndex x in Poking size action {-# INLINE asciiChar #-} diff --git a/library/Ptr/Prelude.hs b/library/Ptr/Prelude.hs --- a/library/Ptr/Prelude.hs +++ b/library/Ptr/Prelude.hs @@ -5,32 +5,77 @@ where --- base-prelude -------------------------- -import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, (<>), First(..), Last(..), ProtocolError, traceEvent, traceEventIO, traceMarker, traceMarkerIO) - -- base ------------------------- -import Foreign as Exports hiding (void) - --- transformers -------------------------- +import Control.Applicative as Exports +import Control.Arrow as Exports hiding (first, second) +import Control.Category as Exports +import Control.Concurrent as Exports +import Control.Exception as Exports +import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM) import Control.Monad.IO.Class as Exports -import Control.Monad.Trans.Class as Exports -import Control.Monad.Trans.Cont as Exports hiding (shift, callCC) -import Control.Monad.Trans.Except as Exports (ExceptT(ExceptT), Except, except, runExcept, runExceptT, mapExcept, mapExceptT, withExcept, withExceptT, throwE, catchE) -import Control.Monad.Trans.Maybe as Exports -import Control.Monad.Trans.Reader as Exports (Reader, runReader, mapReader, withReader, ReaderT(ReaderT), runReaderT, mapReaderT, withReaderT) -import Control.Monad.Trans.State.Strict as Exports (State, runState, evalState, execState, mapState, withState, StateT(StateT), runStateT, evalStateT, execStateT, mapStateT, withStateT) -import Control.Monad.Trans.Writer.Strict as Exports (Writer, runWriter, execWriter, mapWriter, WriterT(..), execWriterT, mapWriterT) - --- mtl -------------------------- -import Control.Monad.Cont.Class as Exports -import Control.Monad.Error.Class as Exports hiding (Error(..)) -import Control.Monad.Reader.Class as Exports -import Control.Monad.State.Class as Exports -import Control.Monad.Writer.Class as Exports +import Control.Monad.Fail as Exports +import Control.Monad.Fix as Exports hiding (fix) +import Control.Monad.ST as Exports +import Data.Bifunctor as Exports +import Data.Bits as Exports +import Data.Bool as Exports +import Data.Char as Exports +import Data.Coerce as Exports +import Data.Complex as Exports +import Data.Data as Exports +import Data.Dynamic as Exports +import Data.Either as Exports +import Data.Fixed as Exports +import Data.Foldable as Exports +import Data.Function as Exports hiding (id, (.)) +import Data.Functor as Exports +import Data.Functor.Compose as Exports +import Data.Functor.Contravariant as Exports +import Data.Int as Exports +import Data.IORef as Exports +import Data.Ix as Exports +import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl') +import Data.List.NonEmpty as Exports (NonEmpty(..)) +import Data.Maybe as Exports +import Data.Monoid as Exports hiding (Alt, Last(..), First(..)) +import Data.Ord as Exports +import Data.Proxy as Exports +import Data.Ratio as Exports +import Data.Semigroup as Exports +import Data.STRef as Exports +import Data.String as Exports +import Data.Traversable as Exports +import Data.Tuple as Exports +import Data.Unique as Exports +import Data.Version as Exports +import Data.Void as Exports +import Data.Word as Exports +import Debug.Trace as Exports +import Foreign as Exports hiding (void) +import Foreign.ForeignPtr as Exports +import Foreign.Ptr as Exports +import Foreign.StablePtr as Exports +import Foreign.Storable as Exports +import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead) +import GHC.Exts as Exports (lazy, inline, sortWith, groupWith) +import GHC.Generics as Exports (Generic) +import GHC.IO.Exception as Exports +import Numeric as Exports +import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) +import System.Environment as Exports +import System.Exit as Exports +import System.IO as Exports (Handle, hClose) +import System.IO.Error as Exports +import System.IO.Unsafe as Exports +import System.Mem as Exports +import System.Mem.StableName as Exports +import System.Timeout as Exports +import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P) +import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec) +import Text.Printf as Exports (printf, hPrintf) +import Text.Read as Exports (Read(..), readMaybe, readEither) +import Unsafe.Coerce as Exports -- contravariant ------------------------- @@ -42,10 +87,6 @@ import Data.Profunctor.Unsafe as Exports import Data.Profunctor as Exports hiding (WrappedArrow, WrapArrow, unwrapArrow) --- semigroups -------------------------- -import Data.Semigroup as Exports - -- bytestring ------------------------- import Data.ByteString as Exports (ByteString) @@ -58,7 +99,3 @@ -- time ------------------------- import Data.Time as Exports - --- bug -------------------------- -import Bug as Exports diff --git a/ptr.cabal b/ptr.cabal --- a/ptr.cabal +++ b/ptr.cabal @@ -1,91 +1,56 @@ -name: - ptr -version: - 0.16.6.1 -category: - Ptr, Data -synopsis: - Abstractions for operations on pointers -homepage: - https://github.com/nikita-volkov/ptr -bug-reports: - https://github.com/nikita-volkov/ptr/issues -author: - Nikita Volkov -maintainer: - Nikita Volkov -copyright: - (c) 2017, Nikita Volkov -license: - MIT -license-file: - LICENSE -build-type: - Simple -cabal-version: - >=1.10 +name: ptr +version: 0.16.6.2 +category: Ptr, Data +synopsis: Abstractions for operations on pointers +homepage: https://github.com/nikita-volkov/ptr +bug-reports: https://github.com/nikita-volkov/ptr/issues +author: Nikita Volkov +maintainer: Nikita Volkov +copyright: (c) 2017, Nikita Volkov +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >=1.10 source-repository head - type: - git - location: - git://github.com/nikita-volkov/ptr.git + type: git + location: git://github.com/nikita-volkov/ptr.git library - hs-source-dirs: - library - default-extensions: - Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 + hs-source-dirs: library + default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples + default-language: Haskell2010 exposed-modules: - Ptr.Peek + Ptr.ByteString Ptr.Parse Ptr.ParseUnbound + Ptr.Peek Ptr.Poke Ptr.PokeAndPeek - Ptr.Receive Ptr.Poking - Ptr.ByteString + Ptr.Receive other-modules: - Ptr.Receive.Core Ptr.IO Ptr.PokeIO - Ptr.UncheckedShifting Ptr.Prelude + Ptr.Receive.Core + Ptr.UncheckedShifting build-depends: - -- data: - text == 1.*, - bytestring >= 0.10 && < 0.11, - time >= 1 && < 2, - vector >= 0.12 && < 0.13, - -- control: - semigroups >= 0.18 && < 0.20, - profunctors >= 5.1 && < 6, - contravariant >= 1.3 && < 2, - mtl >= 2 && < 3, - transformers >= 0.3 && < 0.6, - -- errors: - bug == 1.*, - -- general: - base-prelude >= 1 && < 2, - base >= 4.8 && < 5 + base >=4.9 && <5, + bytestring >=0.10 && <0.11, + contravariant >=1.3 && <2, + profunctors >=5.1 && <6, + text ==1.*, + time >=1 && <2, + vector >=0.12 && <0.13 test-suite tests - type: - exitcode-stdio-1.0 - hs-source-dirs: - tests - main-is: - Main.hs - ghc-options: - -O2 - -threaded - "-with-rtsopts=-N" - default-extensions: - Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Main.hs + ghc-options: -O2 -threaded "-with-rtsopts=-N" + default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples + default-language: Haskell2010 build-depends: ptr, QuickCheck >=2.8.1 && <3, diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -22,7 +22,7 @@ [ testProperty "ASCII Numbers ByteString Roundtrip" $ \ (numbers :: [Word64]) -> let expected = foldMap (fromString . show) numbers - actual = A.poking (foldMap F.asciiUnsignedIntegral numbers) + actual = A.poking (foldMap F.asciiIntegral numbers) in expected === actual , testProperty "Poke and peek (bytes)" $ \input -> input === fromJust (pokeThenPeek (B.bytes (D.length input)) (C.bytes (D.length input))) input