inline-asm 0.3.1.0 → 0.4.0.0
raw patch · 8 files changed
+374/−77 lines, 8 filesdep +hspec-coredep +parser-combinators
Dependencies added: hspec-core, parser-combinators
Files
- ChangeLog.md +6/−0
- README.md +152/−12
- app/Main.hs +4/−4
- inline-asm.cabal +6/−2
- src/Language/Asm/Inline.hs +8/−7
- src/Language/Asm/Inline/QQ.hs +83/−21
- src/Language/Asm/Inline/Util.hs +15/−4
- test/Spec.hs +100/−27
ChangeLog.md view
@@ -1,5 +1,11 @@ # Changelog for inline-asm +## v0.4.0.0++* Add helpers (`unroll`/`unrolls`) for compile-time loop unrolling.+* Add `move` remapping command.+* Use `{}` for escaping instead of `${}` to improve readability.+ ## v0.3.1.0 * Support passing `ByteString`s to the assembly.
README.md view
@@ -7,26 +7,166 @@ Did you try `inline-c`, but it's not enough? You need more? Nothing seems to satisfy? `inline-asm` to the rescue! -For now the usage is pretty straightforward: use `defineAsmFun` to define the-corresponding function, like+And, since the inline assembly is just a usual Haskell value (even if manipulated at compile-time),+there's a lot of pretty cool stuff one can do, like, for instance, explicit compile-time loop unrolling.++## Examples++Swapping two `Int`s and also incrementing one of them by two: ```haskell-defineAsmFun "timesTwo" [t| Word -> Word |] "add %rbx, %rbx"-````-and then use the function `timesTwo` as any other function of type `Word -> Word`:+defineAsmFun "swap2p1"+ [asmTy| (a : Int) (b : Int) | (_ : Int) (_ : Int)]+ [asm|+ xchg {a}, {b}+ add $2, {b}+ |]+```+(note the `{a}`, `{b}` antiquoters)++Getting the last character of a `ByteString`, or a default character if it's empty: ```haskell-main = print $ timesTwo 21+defineAsmFun "lastChar"+ [asmTy| (bs : ByteString) (def : Word) | (w : Word) |]+ [asm|+ test {bs:len}, {bs:len}+ jz is_zero+ movzbq -1({bs:ptr},{bs:len}), {w}+ RET_HASK+is_zero:+ mov {def}, {w}+ |] ```+(note the special `{bs:ptr}` and `{bs:len}` antiquoters, as well as `RET_HASK` command to return early) -There is also an alternative notation allowing named arguments to avoid remembering-which arguments are passed in which registers:+SIMD-accelerated character occurrences count in a string: ```haskell-defineAsmFun "swap2p1"- [asmTy| (a : Int) (b : Int) | (_ : Int) (_ : Int)]+defineAsmFun "countCharSSE42"+ [asmTy| (ch : Word8) (ptr : Ptr Word8) (len : Int) | (cnt : Int) |] $+ unroll "i" [12..15] [asm|- xchg ${a}, ${b}- add $1, ${b}+ push %r{i}|] <> [asm|+ vmovd {ch}, %xmm15+ vpxor %xmm0, %xmm0, %xmm0+ vpshufb %xmm0, %xmm15, %xmm15++ shr $7, {len}++ mov $16, %eax+ mov $16, %edx++ xor {cnt}, {cnt}++ {move ptr rdi}+loop: |] <> unrolls "i" [1..8] [+ [asm|+ vmovdqa {(i - 1) * 0x10}({ptr}), %xmm{i}+ |], [asm|+ vpcmpestrm $10, %xmm15, %xmm{i}+ vmovdqa %xmm0, %xmm{i}+ |], [asm|+ vmovq %xmm{i}, %r{i + 7}+ |], [asm|+ popcnt %r{i + 7}, %r{i + 7}+ |], [asm|+ add %r{i + 7}, {cnt} |]+ ] <>+ [asm|+ add $128, {ptr}+ dec {len}+ jnz loop|] <> unroll "i" [15,14..12] [asm|+ pop %r{i} |] ```+(note the `unroll`/`unrolls` Haskell function for compile-time code generation and loop unrolling+with arithmetic expressions in the templates)++## Basic usage++The entry point is the `defineAsmFun` function from `Language.Asm.Inline`+as well as the `asm` and `asmTy` quasiquoters from `Language.Asm.Inline.QQ`.++First, enable some extensions required for Template Haskell and for the unlifted FFI marshalling stuff:+```haskell+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}+{-# LANGUAGE GHCForeignImportPrim, UnliftedFFITypes, UnboxedTuples #-}+```++then one can just do+```haskell+defineAsmFun "funName"+ [asmTy| (someInt : Int) (somePtr : Ptr Word) (someStr : BS.ByteString) | (len : Int) (count : Int) |]+ [asm|+ ; your asm code follows+ |]+```+to define a function `funName` of the type `Int -> Ptr Word -> BS.ByteString -> (Int, Int)`.++### Antiquotation++Good news: it's not necessary to memorize the GHC calling convention+to access the arguments and the output values slots!+Instead, one can use the `{someInt}` syntax to refer to the argument or the return slot named `someInt`.++**NB**: despite that, be careful to not accidentally overwrite an input parameter for now+by picking a wrong register for temporary computations.+We might introduce some syntax to pick unused registers in a future version, but for now care must be taken.++`ByteString` parameters are supported, but, being composite objects, they are a bit special:+an input parameter++Sometimes it might be handy to reassociate an input parameter with another register.+For this, the `{move argName newReg}` antiquoter can be used (for instance, `{move someInt rdi}`).+This will both update the mapping from argument names to register names+as well as issue an assembly `mov` command.++In case you need to return early to Haskell-land, just write `RET_HASK`,+which gets substituted by the actual command to return to Haskell.++### Explicit loop unrolling++The `asm` quasiquoter basically produces a string,+so it can be manipulated at compile-time with arbitrary Haskell functions.+In particular, a string template can be replicated at compile time.++The `unroll` function unrolls a single `asm` code block,+calculating arithmetic expressions involving the unroll variable, so+```haskell+unroll "i" [1..8] [asm|vmovdqa {(i - 1) * 0x10}({ptr}), %xmm{i}|]+```+is equivalent to+```assembly+vmovdqa 0x0({ptr}), %xmm1+vmovdqa 0x10({ptr}), %xmm2+vmovdqa 0x20({ptr}), %xmm3+vmovdqa 0x30({ptr}), %xmm4+vmovdqa 0x40({ptr}), %xmm5+vmovdqa 0x50({ptr}), %xmm6+vmovdqa 0x60({ptr}), %xmm7+vmovdqa 0x70({ptr}), %xmm8+```++`unrolls` works analogously, but it takes a list of `asm` code blocks (instead of a single block),+unrolls each of them and then concatenates the results. Equationally,+```haskell+unrolls var ints codes = foldMap (unroll var ints) codes+```++The `countCharSSE42` function above might be a pretty good example.+++## Safety and notes++* First of all, all this is utterly unsafe.+* The compiler sees the generated functions as pure, so if a function calls,+ say, `RDRAND` and is itself called more than once to get several random numbers,+ care must be taken to ensure the compiler doesn't elide extra calls.+ We might introduce some shortcuts to allow wrapping such impure functions+ in an `IO` or `PrimMonad` or soemthing similar.+* Each function is compiled in its own `.S` file,+ so one can freely pick arbitrary naming for the labels and so on,+ but, on the other hand, one cannot access labels in other functions.+ This can be remedied somewhat easily — consider throwing up an issue if that's actually desired.+* Finally, all this is utterly unsafe. [travis]: <https://travis-ci.org/0xd34df00d/inline-asm> [travis-badge]: <https://travis-ci.org/0xd34df00d/inline-asm.svg?branch=master>
app/Main.hs view
@@ -11,16 +11,16 @@ defineAsmFun "swap2p1" [asmTy| (a : Int) (b : Int) | (a : Int) (b : Int) |] [asm|- xchg ${a}, ${b}- add $1, ${b}+ xchg {a}, {b}+ add $1, {b} |] {- defineAsmFun "swap2p1" [t| Int -> Int -> (Int, Int) |] [asm| a b |- xchg ${a}, ${b}- add $1, ${b}+ xchg {a}, {b}+ add $1, {b} |] defineAsmFun "testInt" [t| Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int |] "int $3"
inline-asm.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 7cf75cf1921021ab02ccd85a363e971578c52fb35a1ce1a35575ea001544b62c+-- hash: f683958e05ac6942c4577cd9ff973a4bb40eed75491ff79902ed77b42389b28a name: inline-asm-version: 0.3.1.0+version: 0.4.0.0 synopsis: Inline some Assembly in ur Haskell! description: Please see the README on GitHub at <https://github.com/0xd34df00d/inline-asm#readme> category: FFI@@ -46,6 +46,7 @@ , ghc-prim , megaparsec , mtl+ , parser-combinators , template-haskell >=2.15.0.0 , uniplate default-language: Haskell2010@@ -66,6 +67,7 @@ , inline-asm , megaparsec , mtl+ , parser-combinators , template-haskell >=2.15.0.0 , uniplate default-language: Haskell2010@@ -86,9 +88,11 @@ , either , ghc-prim , hspec+ , hspec-core , inline-asm , megaparsec , mtl+ , parser-combinators , template-haskell >=2.15.0.0 , uniplate default-language: Haskell2010
src/Language/Asm/Inline.hs view
@@ -6,12 +6,10 @@ module Language.Asm.Inline(defineAsmFun) where import qualified Data.ByteString as BS-import qualified Data.ByteString.Internal as BS import Control.Monad import Data.Generics.Uniplate.Data import Data.List import Foreign.Ptr-import Foreign.ForeignPtr.Unsafe import GHC.Prim import GHC.Ptr import GHC.Types hiding (Type)@@ -35,6 +33,10 @@ unbox (W# w) = w rebox = W# +instance AsmArg Word8 'WordRep Word# where+ unbox (W8# w) = w+ rebox = W8#+ instance AsmArg Double 'DoubleRep Double# where unbox (D# d) = d rebox = D#@@ -75,11 +77,6 @@ asmName = name <> "_unlifted" retToHask = "jmp *(%rbp)" -getBSAddr :: BS.ByteString -> Ptr Word8-getBSAddr bs = unsafeForeignPtrToPtr ptr `plusPtr` offset- where- (ptr, offset, _) = BS.toForeignPtr bs- mkFunD :: String -> Name -> Type -> Q Dec mkFunD funName importedName funTy = do argNames <- replicateM (countArgs funTy) $ newName "arg"@@ -107,6 +104,7 @@ . transformBi unliftBS where unliftBaseTy x | x == ''Word = ''Word#+ | x == ''Word8 = ''Word# | x == ''Int = ''Int# | x == ''Double = ''Double# | x == ''Float = ''Float#@@ -129,3 +127,6 @@ getArgs :: Type -> [Type] getArgs ty = [ argTy | AppT ArrowT argTy <- universeBi ty ]++countArgs :: Type -> Int+countArgs ty = length $ filter (== ArrowT) $ universeBi ty
src/Language/Asm/Inline/QQ.hs view
@@ -1,18 +1,30 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings, RecordWildCards, MultiWayIf #-}+{-# LANGUAGE OverloadedStrings, RecordWildCards, MultiWayIf, ViewPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} -module Language.Asm.Inline.QQ(asm, asmTy) where+module Language.Asm.Inline.QQ+( asm+, asmTy +, substitute+, unroll+, unrolls+) where+ import qualified Data.Map as M+import Control.Applicative(ZipList(..))+import Control.Monad.Combinators.Expr as CE import Control.Monad.Except+import Control.Monad.State.Strict import Data.Bifunctor import Data.Char import Data.Either.Combinators import Data.Foldable+import Data.Functor+import Data.List import Data.String import Data.Void import Foreign.Ptr@@ -28,7 +40,7 @@ instance AsmCode AsmQQType AsmQQCode where codeToString ty code = case substituteArgs ty code of Left e -> error e- Right s -> s+ Right s -> asmCode s toTypeQ = unreflectTy asm :: QuasiQuoter@@ -39,24 +51,72 @@ newtype AsmQQCode = AsmQQCode { asmCode :: String } -substituteArgs :: AsmQQType -> AsmQQCode -> Either String String-substituteArgs AsmQQType { .. } AsmQQCode { .. } = do+instance Semigroup AsmQQCode where+ c1 <> c2 = AsmQQCode $ asmCode c1 <> "\n" <> asmCode c2++instance Monoid AsmQQCode where+ mempty = AsmQQCode ""+++parseExpr :: MonadError String m => String -> Int -> String -> m Int+parseExpr var num inputStr = liftEither $ first showParseError $ runParser (expr <* eof) "" inputStr+ where+ expr = makeExprParser term table <?> "expr"+ term = parens expr <|> ML.signed lexSpace (string "0x" *> ML.hexadecimal <|> ML.decimal) <|> (lexeme (string var) $> num) <?> "term"+ table = [ [ binary "*" (*) ]+ , [ binary "+" (+)+ , binary "-" (-)+ ]+ ]+ binary name fun = CE.InfixL $ symbol name $> fun+ symbol = ML.symbol lexSpace+ parens = between (symbol "(") (symbol ")")+ lexeme = ML.lexeme lexSpace+ lexSpace = ML.space space1 empty empty++unroll :: String -> [Int] -> AsmQQCode -> AsmQQCode+unroll var ints code = case substitute sub code of+ Left err -> error err+ Right codes -> mconcat $ getZipList codes+ where+ sub str = case traverse (\n -> parseExpr var n str) ints of+ Right results -> show <$> ZipList results+ Left _ -> pure $ "{" <> str <> "}"++unrolls :: String -> [Int] -> [AsmQQCode] -> AsmQQCode+unrolls var ints = foldMap $ unroll var ints++substitute :: Applicative f => (String -> f String) -> AsmQQCode -> Either String (f AsmQQCode)+substitute subst AsmQQCode { .. } = fmap AsmQQCode <$> go asmCode+ where+ go ('{' : rest)+ | (argStr, '}' : rest') <- break (== '}') rest+ , not $ null argStr = ((<>) <$> subst (trim argStr) <*>) <$> go rest'+ | otherwise = Left $ "Unable to parse argument: " <> take 20 rest <> "..."+ go (x : xs) = fmap (x :) <$> go xs+ go [] = pure $ pure []++substituteArgs :: AsmQQType -> AsmQQCode -> Either String AsmQQCode+substituteArgs AsmQQType { .. } asmCode = do argRegs <- computeRegisters args retRegs <- computeRegisters rets- go' argRegs retRegs asmCode+ res <- substitute subst asmCode+ evalStateT res $ M.fromList $ retRegs <> argRegs where- go' argRegs retRegs = go- where- go ('$' : '{' : rest)- | (argStr, '}' : rest') <- break (== '}') rest- , not $ null argStr = do- let arg = AsmVarName $ trim argStr- RegName reg <- maybeToRight ("Unknown argument: `" <> show arg <> "`") $ msum [lookup arg argRegs, lookup arg retRegs]- (('%' : reg) <>) <$> go rest'- | otherwise = throwError $ "Unable to parse argument: " <> take 20 rest <> "..."- go (x : xs) = (x :) <$> go xs- go [] = pure []+ subst arg | "move" `isPrefixOf` arg = moveReg arg+ | otherwise = do+ let var = AsmVarName arg+ maybeReg <- gets $ \regMap -> M.lookup var regMap+ RegName reg <- liftEither $ maybeToRight ("Unknown argument: `" <> show var <> "`") maybeReg+ pure $ '%' : reg + moveReg (words -> ["move", regName, reg]) = do+ oldReg <- subst regName+ let mov = "mov " <> oldReg <> ", %" <> reg+ modify' $ M.insert (AsmVarName regName) (RegName reg)+ pure mov+ moveReg s = throwError $ "Unable to parse move command `" <> s <> "`"+ newtype RegName = RegName { regName :: String } deriving (Show, IsString) computeRegisters :: [(AsmVarName, AsmVarType)] -> Either String [(AsmVarName, RegName)]@@ -77,6 +137,7 @@ categorize :: AsmVarName -> AsmVarType -> Either String [(AsmVarName, VarTyCat)] categorize name (AsmVarType "Int") = pure [(name, Integer)] categorize name (AsmVarType "Word") = pure [(name, Integer)]+categorize name (AsmVarType "Word8") = pure [(name, Integer)] categorize name (AsmVarType "Ptr") = pure [(name, Integer)] categorize name (AsmVarType "Float") = pure [(name, Other)] categorize name (AsmVarType "Double") = pure [(name, Other)]@@ -116,8 +177,8 @@ Left err -> error err Right parsed -> [e| parsed |] -newtype AsmVarName = AsmVarName { varName :: String } deriving (Show, Eq, Lift, Semigroup, IsString)-newtype AsmVarType = AsmVarType { varType :: String } deriving (Show, Eq, Lift)+newtype AsmVarName = AsmVarName { varName :: String } deriving (Show, Eq, Ord, Lift, Semigroup, IsString)+newtype AsmVarType = AsmVarType { varType :: String } deriving (Show, Eq, Ord, Lift) data AsmQQType = AsmQQType { args :: [(AsmVarName, AsmVarType)]@@ -130,8 +191,9 @@ args <- first showParseError $ runParser (parseInTypes <* eof) "" inputStr rets <- first showParseError $ runParser (parseInTypes <* eof) "" outputStr pure AsmQQType { .. }- where- showParseError = errorBundlePretty :: ParseErrorBundle String Void -> String++showParseError :: ParseErrorBundle String Void -> String+showParseError = errorBundlePretty parseInTypes :: forall m e. MonadParsec e String m => m [(AsmVarName, AsmVarType)] parseInTypes = space *> many parseType
src/Language/Asm/Inline/Util.hs view
@@ -1,7 +1,18 @@ module Language.Asm.Inline.Util where -import Data.Generics.Uniplate.Data-import Language.Haskell.TH.Syntax+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS+import Foreign.ForeignPtr+import Foreign.ForeignPtr.Unsafe+import Foreign.Ptr+import GHC.Word -countArgs :: Type -> Int-countArgs ty = length $ filter (== ArrowT) $ universeBi ty+getBSAddr :: BS.ByteString -> Ptr Word8+getBSAddr bs = unsafeForeignPtrToPtr ptr `plusPtr` offset+ where+ (ptr, offset, _) = BS.toForeignPtr bs++withBS :: BS.ByteString -> IO a -> IO a+withBS str action = withForeignPtr ptr $ const action+ where+ (ptr, _, _) = BS.toForeignPtr str
test/Spec.hs view
@@ -1,14 +1,19 @@ {-# LANGUAGE TemplateHaskell, QuasiQuotes #-} {-# LANGUAGE GHCForeignImportPrim, UnliftedFFITypes, UnboxedTuples #-}+{-# LANGUAGE ViewPatterns #-} -import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8 import Data.ByteString(ByteString) import Foreign.Ptr+import GHC.Word import Test.Hspec+import Test.Hspec.Core.QuickCheck import Test.QuickCheck import Language.Asm.Inline import Language.Asm.Inline.QQ+import Language.Asm.Inline.Util defineAsmFun "timesTwoInt" [t| Int -> Int |] "add %rbx, %rbx" defineAsmFun "plusInt" [t| Int -> Int -> Int |] "add %r14, %rbx"@@ -17,89 +22,151 @@ defineAsmFun "timesTwoIntQQ" [asmTy| (a : Int) | (_ : Int) |]- [asm| add ${a}, ${a} |]+ [asm| add {a}, {a} |] defineAsmFun "plusIntQQ" [asmTy| (a : Int) (b : Int) | (_ : Int) |]- [asm| add ${b}, ${a} |]+ [asm| add {b}, {a} |] +defineAsmFun "plus3IntQQ"+ [asmTy| (a : Int) (b : Int) (c : Int) | (_ : Int) |]+ [asm|+ add {b}, {a}+ add {c}, {a}+ |]+ defineAsmFun "swap2p1QQ" [asmTy| (a : Int) (b : Int) | (a : Int) (b : Int) |] [asm|- xchg ${a}, ${b}- add $1, ${b}+ xchg {a}, {b}+ add $1, {b} |] defineAsmFun "timesTwoFloatQQ" [asmTy| (a : Float) | (_ : Float) |]- [asm| addss ${a}, ${a} |]+ [asm| addss {a}, {a} |] defineAsmFun "plusFloatQQ" [asmTy| (a : Float) (b : Float) | (_ : Float) |]- [asm| addss ${b}, ${a} |]+ [asm| addss {b}, {a} |] defineAsmFun "timesTwoDoubleQQ" [asmTy| (a : Double) | (_ : Double) |]- [asm| addsd ${a}, ${a} |]+ [asm| addsd {a}, {a} |] defineAsmFun "plusDoubleQQ" [asmTy| (a : Double) (b : Double) | (_ : Double) |]- [asm| addsd ${b}, ${a} |]+ [asm| addsd {b}, {a} |] defineAsmFun "timesTwoEverything" [asmTy| (d : Double) (n : Int) (f : Float) (w : Word) | (_ : Double) (_ : Int) (_ : Float) (_ : Word) |] [asm|- addsd ${d}, ${d}- addss ${f}, ${f}- add ${n}, ${n}- add ${w}, ${w}+ addsd {d}, {d}+ addss {f}, {f}+ add {n}, {n}+ add {w}, {w} |] defineAsmFun "addPtr" [asmTy| (ptr : Ptr Int) (shift : Int) | (_ : Ptr Int) |] [asm|- add ${shift}, ${ptr}+ add {shift}, {ptr} |] defineAsmFun "swapPtrs" [asmTy| (a : Ptr Int) (b : Ptr Int) | (_ : Ptr Int) (_ : Ptr Int) |] [asm|- xchg ${a}, ${b}+ xchg {a}, {b} |] defineAsmFun "lastChar" [asmTy| (bs : ByteString) (def : Word) | (w : Word) |] [asm|- test ${bs:len}, ${bs:len}+ test {bs:len}, {bs:len} jz is_zero- movzbq -1(${bs:ptr},${bs:len}), ${w}+ movzbq -1({bs:ptr},{bs:len}), {w} RET_HASK is_zero:- mov ${def}, ${w}+ mov {def}, {w} |] +defineAsmFun "countCharsSSE42"+ [asmTy| (ch : Word8) (ptr : Ptr Word8) (len : Int) | (cnt : Int) |] $+ unroll "i" [12..15]+ [asm|+ push %r{i}|] <> [asm|+ vmovd {ch}, %xmm15+ vpxor %xmm0, %xmm0, %xmm0+ vpshufb %xmm0, %xmm15, %xmm15 + shr $7, {len}++ mov $16, %eax+ mov $16, %edx++ xor {cnt}, {cnt}++ {move ptr rdi}+loop: |] <> unrolls "i" [1..8] [+ [asm|+ vmovdqa {(i - 1) * 0x10}({ptr}), %xmm{i}+ |], [asm|+ vpcmpestrm $10, %xmm15, %xmm{i}+ vmovdqa %xmm0, %xmm{i}+ |], [asm|+ vmovq %xmm{i}, %r{i + 7}+ |], [asm|+ popcnt %r{i + 7}, %r{i + 7}+ |], [asm|+ add %r{i + 7}, {cnt}+ |]+ ] <>+ [asm|+ add $128, {ptr}+ dec {len}+ jnz loop|] <> unroll "i" [15,14..12] [asm|+ pop %r{i} |]++countChars :: Word8 -> BS.ByteString -> Int+countChars ch bs | BS.length bs <= 256 = BS.count ch bs+ | otherwise = BS.count ch (substr 0 startLen bs)+ + countCharsSSE42 ch (castPtr alignedPtr) alignedLen+ + BS.count ch (substr endPos endLen bs)+ where+ basePtr = getBSAddr bs+ alignedPtr = alignPtr basePtr alignment+ startLen = alignedPtr `minusPtr` basePtr+ (alignedLen, endLen) = let remLen = BS.length bs - startLen+ remainder = remLen `rem` alignment+ in (remLen - remainder, remainder)+ endPos = startLen + alignedLen+ alignment = 128++asBS :: ASCIIString -> BS.ByteString+asBS (ASCIIString str) = BS8.pack str+ main :: IO ()-main = hspec $ do+main = hspec $ modifyMaxSuccess (const 1000) $ do describe "Works with Ints (the non-QQ version)" $ do it "timesTwo" $ property $ \num -> timesTwoInt num `shouldBe` num * 2- it "plusWord" $ property $ \n1 n2 -> plusInt n1 n2 `shouldBe` n1 + n2+ it "plusInt" $ property $ \n1 n2 -> plusInt n1 n2 `shouldBe` n1 + n2 it "swap returns a tuple properly" $ property $ \n1 n2 -> swapInts n1 n2 `shouldBe` (n2, n1) describe "Works on Ints" $ do it "timesTwo" $ property $ \num -> timesTwoIntQQ num `shouldBe` num * 2- it "plusWord" $ property $ \n1 n2 -> plusIntQQ n1 n2 `shouldBe` n1 + n2+ it "plusInt" $ property $ \n1 n2 -> plusIntQQ n1 n2 `shouldBe` n1 + n2+ it "plus3Int" $ property $ \n1 n2 n3 -> plus3IntQQ n1 n2 n3 `shouldBe` n1 + n2 + n3 it "swap returns a tuple properly" $ property $ \n1 n2 -> swap2p1QQ n1 n2 `shouldBe` (n2, n1 + 1) describe "Works on Floats" $ do it "timesTwo" $ property $ \num -> timesTwoFloatQQ num `shouldBe` num * 2- it "plusWord" $ property $ \n1 n2 -> plusFloatQQ n1 n2 `shouldBe` n1 + n2+ it "plusFloat" $ property $ \n1 n2 -> plusFloatQQ n1 n2 `shouldBe` n1 + n2 describe "Works on Doubles" $ do it "timesTwo" $ property $ \num -> timesTwoDoubleQQ num `shouldBe` num * 2- it "plusWord" $ property $ \n1 n2 -> plusDoubleQQ n1 n2 `shouldBe` n1 + n2+ it "plusDouble" $ property $ \n1 n2 -> plusDoubleQQ n1 n2 `shouldBe` n1 + n2 describe "Works on Ptrs" $ do it "addPtr" $ property $ \int num -> let ptr = intToPtr int in addPtr ptr num `shouldBe` (ptr `plusPtr` num)@@ -109,10 +176,16 @@ describe "Works on mixed types" $ it "timesTwoEverything" $ property $ \d n f w -> timesTwoEverything d n f w `shouldBe` (d + d, n * 2, f + f, w * 2) describe "Works on ByteString" $- it "lastChar" $ property $ \(ASCIIString str) def -> let bs = BS.pack str- in lastChar bs def `shouldBe` if BS.null bs- then def- else fromIntegral $ fromEnum $ BS.last bs+ it "lastChar" $ property $ \(asBS -> bs) def -> lastChar bs def `shouldBe` if BS.null bs+ then def+ else fromIntegral $ fromEnum $ BS.last bs+ describe "More examples" $+ it "counting chars" $ property $ \(InfiniteList infList _) len needle ->+ let bs = BS.pack $ take (len * 100) infList+ in countChars needle bs `shouldBe` BS.count needle bs intToPtr :: Int -> Ptr a intToPtr = intPtrToPtr . IntPtr++substr :: Int -> Int -> BS.ByteString -> BS.ByteString+substr start len = BS.take len . BS.drop start