chessIO 0.7.0.0 → 0.8.0.0

raw patch · 21 files changed

+1095/−816 lines, 21 filesdep +HUnitdep +th-compatdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, th-compat

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +0/−50
• ChangeLog.md +58/−0
• README.md +2/−0
• app/cboard.hs +2/−2
• app/cbookview.hs +6/−6
• book/twic-9g.bin too large to diff
• chessIO.cabal +83/−10
• src/Game/Chess.hs +4/−4
• src/Game/Chess/Internal.hs +242/−241
• src/Game/Chess/Internal/ECO.hs +54/−53
• src/Game/Chess/Internal/QuadBitboard.hs +8/−5
• src/Game/Chess/Internal/Square.hs +4/−4
• src/Game/Chess/PGN.hs +146/−79
• src/Game/Chess/Polyglot.hs +114/−52
• src/Game/Chess/Polyglot/Hash.hs +173/−162
• src/Game/Chess/SAN.hs +46/−39
• src/Game/Chess/Tree.hs +1/−2
• src/Game/Chess/UCI.hs +49/−20
• test/Perft.hs +0/−87
• test/perft/Perft.hs +87/−0
• test/polyglot/Polyglot.hs +16/−0

@@ -1,50 +0,0 @@-# Releases--## chessIO 0.7.0.0--- Remove IsSquare class and add three newtye'd Ints: Square, Rank, File (inspired by [issue 5](https://github.com/mlang/chessIO/issues/5))-- Add HasCallStack to partial doPly and toSAN (thanks Oleg Grenrus)-- instance IsString Position based on fromFEN-- instance Binary Position-- instance Hashable Position-- instance Binary Ply-- instance Unbox Ply-- New functions: rank, file, rankChar, fileChar, toCoord-- New module: Game.Chess.ECO-- Chess.Game.UCI: PV is now an unboxed vector--## chessIO 0.6.1.1--- Fix [half-move counter not being reset on pawn push or capture](https://github.com/mlang/chessIO/issues/2) (Thanks to Oleg Grenrus)-- Fix [toFEN not emitting a dash when only king moved](https://github.com/mlang/chessIO/issues/3) (Thanks to Oleg Grenrus)--## chessIO 0.6.1.0--- Add enPassantSquare (thanks Tochi Obudulu).-- cbookview:-  - piece styles-  - Key End now moves to the final position of the most popular game-  - FEN string display--## chessIO 0.6.0.0--- Optimize `foldBits`.-- Avoid cycles in `bookForest`.-- Don't reexport tree related functions from Game.Chess.-- Split SAN functions into new exposed module Chess.Game.SAN.-- Rename `Game.Chess.Polyglot.Book` to `Game.Chess.Polyglot`.-- New functions `plySource` and `plyTarget`.-- New tool `cbookview`: terminal chess book opening explorer.--## chessIO 0.5.0.0--- Split SAN parsing code into a separate module.-- Adapt to VisualStream change in Megaparsec >= 9.-- Use Maybe to indicate that bestmove in UCI can be empty.-- instance Storable QuadBitboard--## chessIO 0.4.0.0--- Support for letting UCI engines ponder.-- Avoid a branch to further speed up move generation.-

@@ -0,0 +1,58 @@+# Releases++## chessIO 0.8.0.0++- Speedup of about 1.4 compared to previous release+- PGN: Replace nested tuples with records+- Export mkFile, unFile, mkRank, unRank+- Unexport fromPolyglot and toPolyglot which always should have been internal functions+- Use th-compat to work around compatibility issues++## chessIO 0.7.0.0++- Remove IsSquare class and add three newtye'd Ints: Square, Rank, File (inspired by [issue 5](https://github.com/mlang/chessIO/issues/5))+- Add HasCallStack to partial doPly and toSAN (thanks Oleg Grenrus)+- instance IsString Position based on fromFEN+- instance Binary Position+- instance Hashable Position+- instance Binary Ply+- instance Unbox Ply+- New functions: rank, file, rankChar, fileChar, toCoord+- New module: Game.Chess.ECO+- Chess.Game.UCI: PV is now an unboxed vector++## chessIO 0.6.1.1++- Fix [half-move counter not being reset on pawn push or capture](https://github.com/mlang/chessIO/issues/2) (Thanks to Oleg Grenrus)+- Fix [toFEN not emitting a dash when only king moved](https://github.com/mlang/chessIO/issues/3) (Thanks to Oleg Grenrus)++## chessIO 0.6.1.0++- Add enPassantSquare (thanks Tochi Obudulu).+- cbookview:+  - piece styles+  - Key End now moves to the final position of the most popular game+  - FEN string display++## chessIO 0.6.0.0++- Optimize `foldBits`.+- Avoid cycles in `bookForest`.+- Don't reexport tree related functions from Game.Chess.+- Split SAN functions into new exposed module Chess.Game.SAN.+- Rename `Game.Chess.Polyglot.Book` to `Game.Chess.Polyglot`.+- New functions `plySource` and `plyTarget`.+- New tool `cbookview`: terminal chess book opening explorer.++## chessIO 0.5.0.0++- Split SAN parsing code into a separate module.+- Adapt to VisualStream change in Megaparsec >= 9.+- Use Maybe to indicate that bestmove in UCI can be empty.+- instance Storable QuadBitboard++## chessIO 0.4.0.0++- Support for letting UCI engines ponder.+- Avoid a branch to further speed up move generation.+

@@ -1,5 +1,7 @@ # A Haskell chess library and console UCI frontend program +[![Build status](https://github.com/mlang/chessIO/actions/workflows/ci.yml/badge.svg)](https://github.com/mlang/chessIO/actions/workflows/ci.yml)+ `chessIO` is a Haskell library for working with chess positions and moves, and a console frontend program (cboard) to work with UCI compatible chess engines.

@@ -19,7 +19,7 @@       PieceType(King, Pawn, Knight, Bishop, Rook, Queen),       Ply, Position, Square(H8, A1) ) import Game.Chess.Polyglot-    ( PolyglotBook, defaultBook, readPolyglotFile, bookPlies, bookPly )+    ( PolyglotBook, _bePly, defaultBook, readPolyglotFile, bookPlies, bookPly ) import Game.Chess.SAN ( fromSAN, toSAN, unsafeToSAN, varToSAN ) import Game.Chess.UCI     ( addPly,@@ -173,7 +173,7 @@       | "book" == input -> do         b <- lift $ gets book         pos <- currentPosition e-        let plies = bookPlies b pos+        let plies = _bePly <$> bookPlies b pos         if not . null $ plies           then do             addPly e (head plies)

@@ -10,7 +10,7 @@ import           Data.Maybe           (fromJust, fromMaybe) import           Data.Tree            (Forest, Tree (..), foldTree) import           Data.Tree.Zipper     (Full, TreePos, forest, fromForest, label,-                                       nextTree, prevTree)+                                       nextTree) import qualified Data.Tree.Zipper     as TreePos import qualified Data.Vector          as Vec import           Game.Chess           (Color (..), PieceType (..), Ply,@@ -96,11 +96,11 @@           | otherwise  -> str " "  styles :: [(String, Style a)]-styles = map where-  map = [ ("English",  english)-        , ("Deutsch",  german)-        , ("Figurine", figurine)-        ]+styles = [ ("English",  english)+         , ("Deutsch",  german)+         , ("Figurine", figurine)+         ]+ where   german pos sq = case pieceAt pos sq of     Just piece           -> str . pure $ "bsltdkBSLTDK" !! index allPieces piece     Nothing | isDark sq  -> str "+"

file too large to diff

@@ -3,11 +3,9 @@ -- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: 58ed029b69d3e53603aa5e6f7cdac0fb58c1971595e47e3aba37cb0cfc6ac07f  name:           chessIO-version:        0.7.0.0+version:        0.8.0.0 synopsis:       Basic chess library description:    A simple and fast library for generating legal chess moves. Also includes a module for communication with external processes that speak the UCI (Universal Chess Interface) protocol, a PGN parser/pretty printer, and Polyglot opening book support. On top of that, provides a console frontend program (cboard) that can be used to interactively play against UCI engines, and a terminal program (cbookview) to explore commonly played chess openings. category:       Game@@ -19,9 +17,13 @@ license:        BSD3 license-file:   LICENSE build-type:     Simple+tested-with:+    GHC==8.6.5+  , GHC==8.8.4+  , GHC==8.10.5 extra-source-files:     README.md-    CHANGELOG.md+    ChangeLog.md     book/eco.pgn     book/twic-9g.bin @@ -51,6 +53,7 @@       BangPatterns       BinaryLiterals       BlockArguments+      DeriveFunctor       DeriveGeneric       DeriveLift       FlexibleContexts@@ -88,8 +91,9 @@     , process     , random     , stm-    , template-haskell+    , template-haskell >=2.9.0.0     , text+    , th-compat >=0.1.2     , th-lift-instances     , unordered-containers     , vector@@ -107,6 +111,7 @@       BangPatterns       BinaryLiterals       BlockArguments+      DeriveFunctor       DeriveGeneric       DeriveLift       FlexibleContexts@@ -147,8 +152,9 @@     , process     , random     , stm-    , template-haskell+    , template-haskell >=2.9.0.0     , text+    , th-compat >=0.1.2     , th-lift-instances     , unordered-containers     , vector@@ -166,6 +172,7 @@       BangPatterns       BinaryLiterals       BlockArguments+      DeriveFunctor       DeriveGeneric       DeriveLift       FlexibleContexts@@ -207,8 +214,9 @@     , random     , rosezipper     , stm-    , template-haskell+    , template-haskell >=2.9.0.0     , text+    , th-compat >=0.1.2     , th-lift-instances     , unordered-containers     , vector@@ -227,6 +235,7 @@       BangPatterns       BinaryLiterals       BlockArguments+      DeriveFunctor       DeriveGeneric       DeriveLift       FlexibleContexts@@ -266,8 +275,9 @@     , process     , random     , stm-    , template-haskell+    , template-haskell >=2.9.0.0     , text+    , th-compat >=0.1.2     , th-lift-instances     , time     , unordered-containers@@ -282,11 +292,12 @@   other-modules:       Paths_chessIO   hs-source-dirs:-      test+      test/perft   default-extensions:       BangPatterns       BinaryLiterals       BlockArguments+      DeriveFunctor       DeriveGeneric       DeriveLift       FlexibleContexts@@ -327,10 +338,72 @@     , process     , random     , stm-    , template-haskell+    , template-haskell >=2.9.0.0     , text+    , th-compat >=0.1.2     , th-lift-instances     , time+    , unordered-containers+    , vector+    , vector-binary-instances+    , vector-instances+  default-language: Haskell2010++test-suite polyglot+  type: exitcode-stdio-1.0+  main-is: Polyglot.hs+  other-modules:+      Paths_chessIO+  hs-source-dirs:+      test/polyglot+  default-extensions:+      BangPatterns+      BinaryLiterals+      BlockArguments+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      FlexibleContexts+      FlexibleInstances+      GeneralizedNewtypeDeriving+      LambdaCase+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      NumericUnderscores+      RecordWildCards+      OverloadedStrings+      PatternSynonyms+      TupleSections+      TypeApplications+      TypeFamilies+      ViewPatterns+  ghc-options: -O2+  build-depends:+      HUnit+    , MonadRandom+    , attoparsec+    , base >=4.10 && <5+    , binary+    , bytestring+    , chessIO+    , containers+    , deepseq+    , extra+    , file-embed+    , hashable+    , lens+    , megaparsec >=9.0+    , mono-traversable+    , o-clock+    , prettyprinter+    , process+    , random+    , stm+    , template-haskell >=2.9.0.0+    , text+    , th-compat >=0.1.2+    , th-lift-instances     , unordered-containers     , vector     , vector-binary-instances

@@ -36,11 +36,11 @@          F1, F2, F3, F4, F5, F6, F7, F8,          G1, G2, G3, G4, G5, G6, G7, G8,          H1, H2, H3, H4, H5, H6, H7, H8)-, rank, Rank(Rank1, Rank2, Rank3, Rank4, Rank5, Rank6, Rank7, Rank8)-, file, File(FileA, FileB, FileC, FileD, FileE, FileF, FileG, FileH)+, rank, Rank(Rank1, Rank2, Rank3, Rank4, Rank5, Rank6, Rank7, Rank8), mkRank, unRank+, file, File(FileA, FileB, FileC, FileD, FileE, FileF, FileG, FileH), mkFile, unFile , rankFile, isLight, isDark , rankChar, fileChar, toCoord-, PieceType(..), Castle(..)+, PieceType(Pawn, Knight, Bishop, Rook, Queen, King), Castle(..) , Position, startpos, color, moveNumber, halfMoveClock, pieceAt, inCheck , castlingRights, canCastleKingside, canCastleQueenside , insufficientMaterial, repetitions, enPassantSquare@@ -49,7 +49,7 @@   -- * Chess moves , Ply, plySource, plyTarget, plyPromotion   -- ** Convertion-, fromUCI, toUCI, fromPolyglot, toPolyglot+, fromUCI, toUCI   -- ** Move generation , legalPlies   -- ** Executing moves

@@ -1,3 +1,4 @@+{-# LANGUAGE UnboxedTuples #-} {-| Module      : Game.Chess Description : Basic data types and functions related to the game of chess@@ -26,15 +27,13 @@ import           Data.Hashable import           Data.Ix                          (Ix (inRange)) import           Data.List                        (nub, sortOn)-import           Data.Maybe                       (fromJust, isJust,-                                                   listToMaybe)+import           Data.Maybe                       (fromJust, listToMaybe) import           Data.Ord                         (Down (..)) import           Data.String                      (IsString (..)) import qualified Data.Vector.Generic              as G import qualified Data.Vector.Generic.Mutable      as M-import           Data.Vector.Unboxed              (MVector, Unbox, Vector, (!))+import           Data.Vector.Unboxed              (MVector, Unbox, Vector, unsafeIndex) import qualified Data.Vector.Unboxed              as Vector-import           Data.Word                        (Word16, Word64) import           Foreign.Storable import           GHC.Generics                     (Generic) import           GHC.Stack                        (HasCallStack)@@ -44,15 +43,34 @@ import           Language.Haskell.TH.Syntax       (Lift) import           Text.Read                        (readMaybe) +ep :: Word64 -> Word64+ep flags = flags .&. 0x0000ff0000ff0000++{-# INLINE ep #-}++type Bitboard = Word64++testSquare :: Bitboard -> Square -> Bool+testSquare bb (Sq sq) = 1 `unsafeShiftL` sq .&. bb /= 0++{-# INLINE testSquare #-}+ capturing :: Position -> Ply -> Maybe PieceType capturing pos@Position{flags} (plyTarget -> to)-  | (flags .&. epMask) `testBit` unSquare to = Just Pawn+  | ep flags `testSquare` to = Just Pawn   | otherwise = snd <$> pieceAt pos to  isCapture :: Position -> Ply -> Bool isCapture Position{qbb, flags} =-  testBit (QBB.occupied qbb .|. (flags .&. epMask)) . unSquare . plyTarget+  testSquare (QBB.occupied qbb .|. ep flags) . plyTarget +{-# INLINE isCapture #-}++isPawnPush :: Position -> Ply -> Bool+isPawnPush Position{qbb} = testSquare (QBB.pawns qbb) . plySource++{-# INLINE isPawnPush #-}+ -- | The starting position as given by the FEN string --   "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1". startpos :: Position@@ -60,39 +78,43 @@  instance IsString Position where fromString = fromJust . fromFEN -data PieceType = Pawn | Knight | Bishop | Rook | Queen | King deriving (Eq, Ix, Ord, Show)+newtype PieceType = PieceType Int deriving (Eq, Ix, Lift, Ord) +pattern Pawn = PieceType 0+pattern Knight = PieceType 1+pattern Bishop = PieceType 2+pattern Rook = PieceType 3+pattern Queen = PieceType 4+pattern King = PieceType 5++instance Show PieceType where+  show = \case+    Pawn   -> "Pawn"+    Knight -> "Knight"+    Bishop -> "Bishop"+    Rook   -> "Rook"+    Queen  -> "Queen"+    King   -> "King"+    n      -> "PieceType n"+ data Color = Black | White deriving (Eq, Generic, Ix, Ord, Lift, Show)  instance Binary Color instance NFData Color--instance Hashable Color where-  hashWithSalt s Black = s `hashWithSalt` (0 :: Int)-  hashWithSalt s White = s `hashWithSalt` (1 :: Int)+instance Hashable Color  pieceAt :: Position -> Square -> Maybe (Color, PieceType) pieceAt Position{qbb} sq = case qbb QBB.! sq of-  QBB.WhitePawn   -> Just (White, Pawn)-  QBB.WhiteKnight -> Just (White, Knight)-  QBB.WhiteBishop -> Just (White, Bishop)-  QBB.WhiteRook   -> Just (White, Rook)-  QBB.WhiteQueen  -> Just (White, Queen)-  QBB.WhiteKing   -> Just (White, King)-  QBB.BlackPawn   -> Just (Black, Pawn)-  QBB.BlackKnight -> Just (Black, Knight)-  QBB.BlackBishop -> Just (Black, Bishop)-  QBB.BlackRook   -> Just (Black, Rook)-  QBB.BlackQueen  -> Just (Black, Queen)-  QBB.BlackKing   -> Just (Black, King)-  _               -> Nothing+  QBB.NoPiece -> Nothing+  nb          -> Just+    ( if testBit nb 0 then Black else White+    , PieceType . fromIntegral $ nb `div` 2 - 1+    )  opponent :: Color -> Color opponent White = Black opponent Black = White -data Piece = Piece !Color !PieceType deriving (Eq, Show)- data Position = Position {   qbb           :: {-# UNPACK #-} !QuadBitboard , color         :: !Color@@ -114,14 +136,20 @@ instance Eq Position where   a == b = qbb a == qbb b && color a == color b && flags a == flags b +instance Ord Position where+  a `compare` b = qbb a `compare` qbb b+             <> color a `compare` color b+             <> flags a `compare` flags b+ instance Hashable Position where-  hashWithSalt s Position{qbb, color, flags} =-    s `hashWithSalt` qbb `hashWithSalt` color `hashWithSalt` flags+  hashWithSalt s Position{qbb, color, flags} = s+    `hashWithSalt` qbb+    `hashWithSalt` color+    `hashWithSalt` flags  repetitions :: [Position] -> Maybe (Int, Position)-repetitions p = listToMaybe . sortOn (Down . fst) . fmap f $ nub p where-  f x = (count x p, x)-  count x = length . filter (== x)+repetitions xs = listToMaybe . sortOn (Down . fst) $ f <$> nub xs where+  f x = (length . filter (== x) $ xs, x)  instance Show Position where   show p = '"' : toFEN p <> ['"']@@ -132,14 +160,19 @@ -- | Construct a position from Forsyth-Edwards-Notation. fromFEN :: String -> Maybe Position fromFEN fen-  | length parts /= 6-  = Nothing-  | otherwise =-    Position <$> Just (fromString (parts !! 0))+  | length parts == 6+  = Position <$> pure (fromString (parts !! 0))              <*> readColor (parts !! 1)              <*> readFlags (parts !! 2) (parts !! 3)              <*> readMaybe (parts !! 4)              <*> readMaybe (parts !! 5)+  | length parts == 4+  = Position <$> pure (fromString (parts !! 0))+             <*> readColor (parts !! 1)+             <*> readFlags (parts !! 2) (parts !! 3)+             <*> pure 0+             <*> pure 1+  | otherwise = Nothing  where   parts = words fen   readColor "w" = Just White@@ -147,13 +180,13 @@   readColor _   = Nothing    readFlags cst ep = (.|.) <$> readCst cst <*> readEP ep where-    readCst "-" = Just 0+    readCst "-" = pure 0     readCst x = go x where       go ('K':xs) = (crwKs .|.) <$> go xs       go ('Q':xs) = (crwQs .|.) <$> go xs       go ('k':xs) = (crbKs .|.) <$> go xs       go ('q':xs) = (crbQs .|.) <$> go xs-      go []       = Just 0+      go []       = pure 0       go _        = Nothing     readEP "-" = Just 0     readEP [f,r]@@ -167,7 +200,7 @@   [ QBB.toString qbb   , showColor color   , showCst (flags `clearMask` epMask)-  , showEP (flags .&. epMask)+  , showEP (ep flags)   , show halfMoveClock   , show moveNumber   ]@@ -200,17 +233,20 @@ foldBits :: (a -> Int -> a) -> a -> Word64 -> a foldBits f = go where   go a 0 = a-  go a n = go (f a $ countTrailingZeros n) $! n .&. pred n+  go a n = go (f a $ countTrailingZeros n) $! n .&. (n - 1)  bitScanForward, bitScanReverse :: Word64 -> Int bitScanForward = countTrailingZeros-bitScanReverse = (63 -) . countLeadingZeros+bitScanReverse bb = 63 - countLeadingZeros bb -newtype Ply = Ply Word16 deriving (Binary, Eq, Hashable, Lift, Storable)+{-# INLINE bitScanForward #-}+{-# INLINE bitScanReverse #-} +newtype Ply = Ply { unPly :: Word16 } deriving (Binary, Eq, Hashable, Ord, Lift, Storable)+ instance Show Ply where-  show (unpack -> (from, to, promo)) = "move " <> show from <> " " <> show to <> p where-    p = case promo of+  show (unpack -> (f, t, p)) = "move " <> show f <> " " <> show t <> p' where+    p' = case p of       Just piece -> " `promoteTo` " <> show piece       Nothing    -> "" @@ -245,80 +281,27 @@ instance Unbox Ply  move :: Square -> Square -> Ply-move (Sq from) (Sq to) =-  Ply $ fromIntegral to .|. fromIntegral from `unsafeShiftL` 6+move (Sq src) (Sq dst) =+  Ply $ fromIntegral dst .|. fromIntegral src `unsafeShiftL` 6  promoteTo :: Ply -> PieceType -> Ply promoteTo (Ply x) = Ply . set where-  set Knight = x .&. 0xfff .|. 0x1000-  set Bishop = x .&. 0xfff .|. 0x2000-  set Rook   = x .&. 0xfff .|. 0x3000-  set Queen  = x .&. 0xfff .|. 0x4000-  set _      = x+  set Pawn   = x+  set King   = x+  set (PieceType v) = x .&. 0xfff .|. fromIntegral (v `unsafeShiftL` 12)  plySource, plyTarget :: Ply -> Square plySource (Ply x) = Sq $ fromIntegral ((x `unsafeShiftR` 6) .&. 0b111111) plyTarget (Ply x) = Sq $ fromIntegral (x .&. 0b111111)  plyPromotion :: Ply -> Maybe PieceType-plyPromotion (Ply x) = case x `unsafeShiftR` 12 of-  1 -> Just Knight-  2 -> Just Bishop-  3 -> Just Rook-  4 -> Just Queen-  _ -> Nothing+plyPromotion (Ply x) = case fromIntegral $ (x `unsafeShiftR` 12) .&. 0b111 of+  0 -> Nothing+  n -> Just . PieceType $ n -unpack :: Ply -> (Square, Square, Maybe PieceType)-unpack (Ply x) = ( Sq $ fromIntegral ((x `unsafeShiftR` 6) .&. 0b111111)-                 , Sq $ fromIntegral (x .&. 0b111111)-                 , piece)- where-  !piece = case x `unsafeShiftR` 12 of-    1 -> Just Knight-    2 -> Just Bishop-    3 -> Just Rook-    4 -> Just Queen-    _ -> Nothing -fromPolyglot :: Position -> Ply -> Ply-fromPolyglot pos pl@(unpack -> (from, to, _)) = case color pos of-  White | from == E1-        , canCastleKingside pos-        , to == H1-        -> wKscm-        | from == E1-        , canCastleQueenside pos-        , to == A1-        -> wQscm-  Black | from == E8-        , canCastleKingside pos-        , to == H8-        -> bKscm-        | from == E8-        , canCastleQueenside pos-        , to == A8-        -> bQscm-  _ -> pl--toPolyglot :: Position -> Ply -> Ply-toPolyglot pos pl@(unpack -> (from, to, _)) = case color pos of-  White | from == E1-        , canCastleKingside pos-        , to == G1-        -> from `move` H1-        | from == E1-        , canCastleQueenside pos-        , to == C1-        -> from `move` A1-  Black | from == E8-        , canCastleKingside pos-        , to == G8-        -> from `move` H8-        | from == E8-        , canCastleQueenside pos-        , to == C8-        -> from `move` A8-  _ -> pl+unpack :: Ply -> (Square, Square, Maybe PieceType)+unpack pl = ( plySource pl, plyTarget pl, plyPromotion pl)  -- | Parse a move in the format used by the Universal Chess Interface protocol. fromUCI :: Position -> String -> Maybe Ply@@ -343,7 +326,7 @@  -- | Convert a move to the format used by the Universal Chess Interface protocol. toUCI :: Ply -> String-toUCI (unpack -> (from, to, promo)) = coord from <> coord to <> p where+toUCI (unpack -> (src, dst, promo)) = coord src <> coord dst <> p where   coord x = let (r,f) = view rankFile x in             chr (unFile f + ord 'a') : [chr (unRank r + ord '1')]   p = case promo of@@ -358,8 +341,9 @@ relativeTo pos m | m `elem` legalPlies pos = Just m                  | otherwise = Nothing -shiftN, shiftNNE, shiftNE, shiftENE, shiftE, shiftESE, shiftSE, shiftSSE, shiftS, shiftSSW, shiftSW, shiftWSW, shiftW, shiftWNW, shiftNW, shiftNNW :: Word64 -> Word64+shiftN, shiftNN, shiftNNE, shiftNE, shiftENE, shiftE, shiftESE, shiftSE, shiftSSE, shiftS, shiftSS, shiftSSW, shiftSW, shiftWSW, shiftW, shiftWNW, shiftNW, shiftNNW :: Word64 -> Word64 shiftN   w = w `unsafeShiftL` 8+shiftNN   w = w `unsafeShiftL` 16 shiftNNE w = w `unsafeShiftL` 17 .&. notAFile shiftNE  w = w `unsafeShiftL` 9 .&. notAFile shiftENE w = w `unsafeShiftL` 10 .&. notABFile@@ -368,6 +352,7 @@ shiftSE  w = w `unsafeShiftR` 7 .&. notAFile shiftSSE w = w `unsafeShiftR` 15 .&. notAFile shiftS   w = w `unsafeShiftR` 8+shiftSS   w = w `unsafeShiftR` 16 shiftSSW w = w `unsafeShiftR` 17 .&. notHFile shiftSW  w = w `unsafeShiftR` 9 .&. notHFile shiftWSW w = w `unsafeShiftR` 10 .&. notGHFile@@ -376,6 +361,11 @@ shiftNW  w = w `unsafeShiftL` 7 .&. notHFile shiftNNW w = w `unsafeShiftL` 15 .&. notHFile +{-# INLINE shiftN #-}+{-# INLINE shiftNN #-}+{-# INLINE shiftS #-}+{-# INLINE shiftSS #-}+ -- | Apply a move to the given position. -- -- This function checks if the move is actually legal and throws and error@@ -389,23 +379,19 @@ -- can be applied to the position.  This is useful if the move has been generated -- by the 'legalPlies' function. unsafeDoPly :: Position -> Ply -> Position-unsafeDoPly pos@Position{color, halfMoveClock, moveNumber} m =-  pos' { color = opponent color-       , halfMoveClock = if isCapture pos m || isPawnPush pos m-                         then 0-                         else succ halfMoveClock-       , moveNumber = if color == Black-                      then succ moveNumber-                      else moveNumber-       }- where-  pos' = unsafeDoPly' pos m-  isPawnPush p m = case pieceAt p (plySource m) of-    Just (_, Pawn) -> True-    _              -> False+unsafeDoPly pos@Position{qbb, color, halfMoveClock, moveNumber} m =+  (unsafeDoPly' pos m)+  { color = opponent color+  , halfMoveClock = if isCapture pos m || isPawnPush pos m+                    then 0+                    else halfMoveClock + 1+  , moveNumber = if color == Black+                 then moveNumber + 1+                 else moveNumber+  }  unsafeDoPly' :: Position -> Ply -> Position-unsafeDoPly' pos@Position{qbb, flags} m@(unpack -> (from, to, promo))+unsafeDoPly' pos@Position{qbb, flags} m@(unpack -> (src, dst, promo))   | m == wKscm && flags `testMask` crwKs   = pos { qbb = qbb <> QBB.whiteKingsideCastle         , flags = flags `clearMask` (rank1 .|. epMask)@@ -425,52 +411,53 @@   | Just piece <- promo   = case color pos of       White -> case piece of-        Queen -> pos { qbb = QBB.whitePromotion qbb from to QBB.WhiteQueen-                     , flags = flags `clearMask` (epMask .|. bit (unSquare to))+        Queen -> pos { qbb = QBB.whitePromotion qbb src dst QBB.WhiteQueen+                     , flags = flags `clearMask` (epMask .|. bit (unSquare dst))                      }-        Rook  -> pos { qbb = QBB.whitePromotion qbb from to QBB.WhiteRook-                     , flags = flags `clearMask` (epMask .|. bit (unSquare to))+        Rook  -> pos { qbb = QBB.whitePromotion qbb src dst QBB.WhiteRook+                     , flags = flags `clearMask` (epMask .|. bit (unSquare dst))                      }-        Bishop -> pos { qbb = QBB.whitePromotion qbb from to QBB.WhiteBishop-                      , flags = flags `clearMask` (epMask .|. bit (unSquare to))+        Bishop -> pos { qbb = QBB.whitePromotion qbb src dst QBB.WhiteBishop+                      , flags = flags `clearMask` (epMask .|. bit (unSquare dst))                       }-        Knight -> pos { qbb = QBB.whitePromotion qbb from to QBB.WhiteKnight-                      , flags = flags `clearMask` (epMask .|. bit (unSquare to))+        Knight -> pos { qbb = QBB.whitePromotion qbb src dst QBB.WhiteKnight+                      , flags = flags `clearMask` (epMask .|. bit (unSquare dst))                       }         _ -> error "Impossible: White tried to promote to Pawn"       Black -> case piece of-        Queen -> pos { qbb = QBB.blackPromotion qbb from to QBB.BlackQueen-                     , flags = flags `clearMask` (epMask .|. bit (unSquare to))+        Queen -> pos { qbb = QBB.blackPromotion qbb src dst QBB.BlackQueen+                     , flags = flags `clearMask` (epMask .|. bit (unSquare dst))                      }-        Rook   -> pos { qbb = QBB.blackPromotion qbb from to QBB.BlackRook-                      , flags = flags `clearMask` (epMask .|. bit (unSquare to))+        Rook   -> pos { qbb = QBB.blackPromotion qbb src dst QBB.BlackRook+                      , flags = flags `clearMask` (epMask .|. bit (unSquare dst))                       }-        Bishop -> pos { qbb = QBB.blackPromotion qbb from to QBB.BlackBishop-                      , flags = flags `clearMask` (epMask .|. bit (unSquare to))+        Bishop -> pos { qbb = QBB.blackPromotion qbb src dst QBB.BlackBishop+                      , flags = flags `clearMask` (epMask .|. bit (unSquare dst))                       }-        Knight -> pos { qbb = QBB.blackPromotion qbb from to QBB.BlackKnight-                      , flags = flags `clearMask` (epMask .|. bit (unSquare to))+        Knight -> pos { qbb = QBB.blackPromotion qbb src dst QBB.BlackKnight+                      , flags = flags `clearMask` (epMask .|. bit (unSquare dst))                       }         _ -> error "Impossible: Black tried to promote to Pawn"-  | QBB.pawns qbb `testMask` fromMask-  , toMask .&. (rank3 .|. rank6) .&. flags /= 0-  = pos { qbb = qbb <> QBB.enPassant from to+  | pawns `testMask` fromMask+  , ep flags `testMask` toMask+  = pos { qbb = qbb <> QBB.enPassant src dst         , flags = flags `clearMask` toMask         }   | otherwise-  = pos { qbb = QBB.move qbb from to-        , flags = (flags `clearMask` (epMask .|. mask)) .|. dpp+  = pos { qbb = QBB.move qbb src dst+        , flags = flags `clearMask` (epMask .|. mask) .|. dpp         }  where-  !fromMask = 1 `unsafeShiftL` unSquare from-  !toMask = 1 `unsafeShiftL` unSquare to+  !fromMask = 1 `unsafeShiftL` unSquare src+  !toMask = 1 `unsafeShiftL` unSquare dst   !mask = fromMask .|. toMask-  dpp = case color pos of-    White | fromMask .&. rank2 .&. QBB.wPawns qbb /= 0-          , unSquare from + 16 == unSquare to -> shiftN fromMask-    Black | fromMask .&. rank7 .&. QBB.bPawns qbb /= 0-          , unSquare from - 16 == unSquare to -> shiftS fromMask-    _                                                            -> 0+  !pawns = QBB.pawns qbb+  !dpp+    | (pawns .&. (rank2 .|. rank7)) `testMask` fromMask+    = if | shiftNN fromMask == toMask -> shiftN fromMask+         | shiftSS fromMask == toMask -> shiftS fromMask+         | otherwise                          -> 0+    | otherwise = 0  -- | Generate a list of possible moves for the given position. legalPlies :: Position -> [Ply]@@ -485,37 +472,43 @@  where   legalPly = not . inCheck color . unsafeDoPly' pos   !ours = occupiedBy color qbb-  !them = occupiedBy (opponent color) qbb+  !them = ours `xor` QBB.occupied qbb   !notOurs = complement ours   !occ = ours .|. them-  (!pawnMoves, !knightMoves, !kingMoves) = case color of+  (# pawnMoves, knightMoves, kingMoves #) = case color of     White ->-      ( wPawnMoves (QBB.wPawns qbb) (complement occ) (them .|. (flags .&. epMask))-      , flip (foldBits genNMoves) (QBB.wKnights qbb)-      , flip (foldBits genKMoves) (QBB.wKings qbb) . wShort . wLong)+      (#+       wPawnMoves (QBB.wPawns qbb) (complement occ) (them .|. ep flags),+       flip (foldBits genNMoves) (QBB.wKnights qbb),+       flip (foldBits genKMoves) (QBB.wKings qbb) . wShort . wLong+       #)     Black ->-      ( bPawnMoves (QBB.bPawns qbb) (complement occ) (them .|. (flags .&. epMask))-      , flip (foldBits genNMoves) (QBB.bKnights qbb)-      , flip (foldBits genKMoves) (QBB.bKings qbb) . bShort . bLong)-  genNMoves ms sq = foldBits (mkM sq) ms ((knightAttacks ! sq) .&. notOurs)-  genKMoves ms sq = foldBits (mkM sq) ms ((kingAttacks ! sq) .&. notOurs)-  wShort ml | canCastleKingside' pos occ = wKscm : ml+      (#+       bPawnMoves (QBB.bPawns qbb) (complement occ) (them .|. ep flags),+       flip (foldBits genNMoves) (QBB.bKnights qbb),+       flip (foldBits genKMoves) (QBB.bKings qbb) . bShort . bLong+       #)+  genNMoves ms sq = foldBits (mkM sq) ms ((unsafeIndex knightAttacks sq) .&. notOurs)+  genKMoves ms sq = foldBits (mkM sq) ms ((unsafeIndex kingAttacks sq) .&. notOurs)+  wShort ml | canWhiteCastleKingside pos occ = wKscm : ml             | otherwise             = ml-  wLong ml  | canCastleQueenside' pos occ = wQscm : ml+  wLong ml  | canWhiteCastleQueenside pos occ = wQscm : ml             | otherwise                   = ml-  bShort ml | canCastleKingside' pos occ = bKscm : ml+  bShort ml | canBlackCastleKingside pos occ = bKscm : ml             | otherwise                  = ml-  bLong ml  | canCastleQueenside' pos occ = bQscm : ml+  bLong ml  | canBlackCastleQueenside pos occ = bQscm : ml             | otherwise              = ml-  mkM !from ms !to = move (Sq from) (Sq to) : ms+  mkM !src ms !dst = move (Sq src) (Sq dst) : ms  -- | Returns 'True' if 'Color' is in check in the given position. inCheck :: Color -> Position -> Bool inCheck White Position{qbb} =-  attackedBy Black qbb (occupied qbb) (Sq (bitScanForward (QBB.wKings qbb)))+  attackedBy Black qbb (QBB.occupied qbb) (Sq (bitScanForward (QBB.wKings qbb))) inCheck Black Position{qbb} =-  attackedBy White qbb (occupied qbb) (Sq (bitScanForward (QBB.bKings qbb)))+  attackedBy White qbb (QBB.occupied qbb) (Sq (bitScanForward (QBB.bKings qbb))) +{-# INLINE inCheck #-}+ wPawnMoves :: Word64 -> Word64 -> Word64 -> [Ply] -> [Ply] wPawnMoves !pawns !emptySquares !opponentPieces =     flip (foldBits $ mkPly 9) eastCaptureTargets@@ -523,10 +516,10 @@   . flip (foldBits $ mkPly 8) singlePushTargets   . flip (foldBits $ mkPly 16) doublePushTargets  where-  doublePushTargets = shiftN singlePushTargets .&. emptySquares .&. rank4-  singlePushTargets = shiftN pawns .&. emptySquares-  eastCaptureTargets = shiftNE pawns .&. opponentPieces-  westCaptureTargets = shiftNW pawns .&. opponentPieces+  !doublePushTargets = shiftN singlePushTargets .&. emptySquares .&. rank4+  !singlePushTargets = shiftN pawns .&. emptySquares+  !eastCaptureTargets = shiftNE pawns .&. opponentPieces+  !westCaptureTargets = shiftNW pawns .&. opponentPieces   mkPly diff ms tsq     | tsq >= 56 = (promoteTo m <$> [Queen, Rook, Bishop, Knight]) <> ms     | otherwise = m : ms@@ -539,34 +532,29 @@   . flip (foldBits $ mkPly 8) singlePushTargets   . flip (foldBits $ mkPly 16) doublePushTargets  where-  doublePushTargets = shiftS singlePushTargets .&. emptySquares .&. rank5-  singlePushTargets = shiftS pawns .&. emptySquares-  eastCaptureTargets = shiftSE pawns .&. opponentPieces-  westCaptureTargets = shiftSW pawns .&. opponentPieces+  !doublePushTargets = shiftS singlePushTargets .&. emptySquares .&. rank5+  !singlePushTargets = shiftS pawns .&. emptySquares+  !eastCaptureTargets = shiftSE pawns .&. opponentPieces+  !westCaptureTargets = shiftSW pawns .&. opponentPieces   mkPly diff ms tsq     | tsq <= 7  = (promoteTo m <$> [Queen, Rook, Bishop, Knight]) <> ms     | otherwise = m : ms-   where m = move (Sq (tsq + diff)) (Sq  tsq)+   where m = move (Sq (tsq + diff)) (Sq tsq)  slideMoves :: PieceType -> Position -> Word64 -> Word64 -> [Ply] -> [Ply]-slideMoves piece (Position bb c _ _ _) !notOurs !occ =-  flip (foldBits gen) pieces+slideMoves piece Position{qbb, color} !notOurs !occ =+  flip (foldBits gen) (pieces qbb)  where-  gen ms from = foldBits (mkPly from) ms (targets from)-  mkPly from ms to = move (Sq from) (Sq to) : ms-  targets sq = case piece of-    Rook   -> rookTargets sq occ .&. notOurs-    Bishop -> bishopTargets sq occ .&. notOurs-    Queen  -> queenTargets sq occ .&. notOurs-    _      -> error "Not a sliding piece"-  pieces = case (c, piece) of-    (White, Bishop) -> QBB.wBishops bb-    (Black, Bishop) -> QBB.bBishops bb-    (White, Rook)   -> QBB.wRooks bb-    (Black, Rook)   -> QBB.bRooks bb-    (White, Queen)  -> QBB.wQueens bb-    (Black, Queen)  -> QBB.bQueens bb-    _               -> 0+  gen ms src = foldBits (mkPly src) ms (targets src occ .&. notOurs)+  mkPly src ms dst = move (Sq src) (Sq dst) : ms+  (# targets, pieces #) = case (# color, piece #) of+    (# White, Bishop #) -> (# bishopTargets, QBB.wBishops #)+    (# Black, Bishop #) -> (# bishopTargets, QBB.bBishops #)+    (# White, Rook #)   -> (# rookTargets, QBB.wRooks #)+    (# Black, Rook #)   -> (# rookTargets, QBB.bRooks #)+    (# White, Queen #)  -> (# queenTargets, QBB.wQueens #)+    (# Black, Queen #)  -> (# queenTargets, QBB.bQueens #)+    _                   -> error "Not a sliding piece"  data Castle = Kingside | Queenside deriving (Eq, Ix, Ord, Show) @@ -582,25 +570,31 @@          | otherwise              = xs  enPassantSquare :: Position -> Maybe Square-enPassantSquare Position{flags} = case flags .&. epMask of+enPassantSquare Position{flags} = case ep flags of   0 -> Nothing   x -> Just . Sq . bitScanForward $ x  canCastleKingside, canCastleQueenside :: Position -> Bool-canCastleKingside pos@Position{qbb} = canCastleKingside' pos (occupied qbb)-canCastleQueenside pos@Position{qbb} = canCastleQueenside' pos (occupied qbb)+canCastleKingside pos@Position{qbb, color = White} =+  canWhiteCastleKingside pos (occupied qbb)+canCastleKingside pos@Position{qbb, color = Black} =+  canBlackCastleKingside pos (occupied qbb)+canCastleQueenside pos@Position{qbb, color = White} =+  canWhiteCastleQueenside pos (occupied qbb)+canCastleQueenside pos@Position{qbb, color = Black} =+  canBlackCastleQueenside pos (occupied qbb) -canCastleKingside', canCastleQueenside' :: Position -> Word64 -> Bool-canCastleKingside' Position{qbb, color = White, flags} !occ =+canWhiteCastleKingside, canBlackCastleKingside, canWhiteCastleQueenside, canBlackCastleQueenside :: Position -> Word64 -> Bool+canWhiteCastleKingside Position{qbb, flags} !occ =   flags `testMask` crwKs && occ .&. crwKe == 0 &&   not (any (attackedBy Black qbb occ) [E1, F1, G1])-canCastleKingside' Position{qbb, color = Black, flags} !occ =+canBlackCastleKingside Position{qbb, flags} !occ =   flags `testMask` crbKs && occ .&. crbKe == 0 &&   not (any (attackedBy White qbb occ) [E8, F8, G8])-canCastleQueenside' Position{qbb, color = White, flags} !occ =+canWhiteCastleQueenside Position{qbb, flags} !occ =   flags `testMask` crwQs && occ .&. crwQe == 0 &&   not (any (attackedBy Black qbb occ) [E1, D1, C1])-canCastleQueenside' Position{qbb, color = Black, flags} !occ =+canBlackCastleQueenside Position{qbb, flags} !occ =   flags `testMask` crbQs && occ .&. crbQe == 0 &&   not (any (attackedBy White qbb occ) [E8, D8, C8]) @@ -611,23 +605,30 @@ bQscm = move E8 C8  attackedBy :: Color -> QuadBitboard -> Word64 -> Square -> Bool-attackedBy White qbb !occ (unSquare -> sq)-  | (wPawnAttacks ! sq) .&. QBB.wPawns qbb /= 0 = True-  | (knightAttacks ! sq) .&. QBB.wKnights qbb /= 0 = True+attackedBy White !qbb !occ (Sq sq)+  | unsafeIndex wPawnAttacks sq .&. QBB.wPawns qbb /= 0 = True+  | unsafeIndex knightAttacks sq .&. QBB.wKnights qbb /= 0 = True   | bishopTargets sq occ .&. QBB.wBishops qbb /= 0 = True   | rookTargets sq occ .&.   QBB.wRooks qbb /= 0 = True   | queenTargets sq occ .&. QBB.wQueens qbb /= 0 = True-  | (kingAttacks ! sq) .&. QBB.wKings qbb /= 0   = True+  | unsafeIndex kingAttacks sq .&. QBB.wKings qbb /= 0   = True   | otherwise                        = False-attackedBy Black qbb !occ (unSquare -> sq)-  | (bPawnAttacks ! sq) .&. QBB.bPawns qbb /= 0 = True-  | (knightAttacks ! sq) .&. QBB.bKnights qbb /= 0 = True+attackedBy Black !qbb !occ (Sq sq)+  | unsafeIndex bPawnAttacks sq .&. QBB.bPawns qbb /= 0 = True+  | unsafeIndex knightAttacks sq .&. QBB.bKnights qbb /= 0 = True   | bishopTargets sq occ .&. QBB.bBishops qbb /= 0 = True   | rookTargets sq occ .&.   QBB.bRooks qbb /= 0 = True   | queenTargets sq occ .&.  QBB.bQueens qbb /= 0 = True-  | (kingAttacks ! sq) .&. QBB.bKings qbb /= 0   = True+  | unsafeIndex kingAttacks sq .&. QBB.bKings qbb /= 0   = True   | otherwise                        = False +{-# INLINE attackedBy #-}++attackedByPawn :: Square -> Position -> Bool+attackedByPawn (Sq sq) Position{qbb, color} = case color of+  White -> unsafeIndex wPawnAttacks sq .&. QBB.wPawns qbb /= 0+  Black -> unsafeIndex bPawnAttacks sq .&. QBB.bPawns qbb /= 0+ notAFile, notABFile, notGHFile, notHFile, rank1, rank2, rank3, rank4, rank5, rank6, rank7, rank8 :: Word64 notAFile = 0xfefefefefefefefe notABFile = 0xfcfcfcfcfcfcfcfc@@ -667,30 +668,39 @@ bPawnAttacks = Vector.generate 64 $ \sq -> let b = bit sq in   shiftNE b .|. shiftNW b -data Direction = N | NE | E | SE | S | SW | W | NW deriving (Eq, Show)- rookTargets, bishopTargets, queenTargets :: Int -> Word64 -> Word64-rookTargets !sq !occ = getRayTargets sq N occ .|. getRayTargets sq E occ-                   .|. getRayTargets sq S occ .|. getRayTargets sq W occ-bishopTargets !sq !occ = getRayTargets sq NW occ .|. getRayTargets sq NE occ-                     .|. getRayTargets sq SE occ .|. getRayTargets sq SW occ-queenTargets sq occ = rookTargets sq occ .|. bishopTargets sq occ+rookTargets !sq !occ = rayN occ sq .|. rayE occ sq+                   .|. rayS occ sq .|. rayW occ sq+bishopTargets !sq !occ = rayNW occ sq .|. rayNE occ sq+                     .|. raySE occ sq .|. raySW occ sq+queenTargets !sq !occ = rookTargets sq occ .|. bishopTargets sq occ -getRayTargets :: Int -> Direction -> Word64 -> Word64-getRayTargets sq dir occ = blocked $ attacks .&. occ where-  blocked 0  = attacks-  blocked bb = attacks `xor` (ray ! bitScan bb)-  attacks = ray ! sq-  (bitScan, ray) = case dir of-    NW -> (bitScanForward, attackNW)-    N  -> (bitScanForward, attackN)-    NE -> (bitScanForward, attackNE)-    E  -> (bitScanForward, attackE)-    SE -> (bitScanReverse, attackSE)-    S  -> (bitScanReverse, attackS)-    SW -> (bitScanReverse, attackSW)-    W  -> (bitScanReverse, attackW)+rayTargets :: Vector Word64 -> (Word64 -> Int) -> Word64 -> Int -> Word64+rayTargets !ray !bitScan !occ (unsafeIndex ray -> a) = case a .&. occ of+  0               -> a+  (bitScan -> sq) -> a `xor` unsafeIndex ray sq +{-# INLINE rayTargets #-}++rayNW, rayN, rayNE, rayE, raySE, rayS, raySW, rayW :: Word64 -> Int -> Word64+rayNW = rayTargets attackNW bitScanForward +rayN  = rayTargets attackN  bitScanForward +rayNE = rayTargets attackNE bitScanForward +rayE  = rayTargets attackE  bitScanForward +raySE = rayTargets attackSE bitScanReverse+rayS  = rayTargets attackS  bitScanReverse+raySW = rayTargets attackSW bitScanReverse+rayW  = rayTargets attackW  bitScanReverse++{-# INLINE rayNW #-}+{-# INLINE rayN #-}+{-# INLINE rayNE #-}+{-# INLINE rayE #-}+{-# INLINE raySE #-}+{-# INLINE rayS #-}+{-# INLINE raySW #-}+{-# INLINE rayW #-}+ attackDir :: (Word64 -> Word64) -> Vector Word64 attackDir s = Vector.generate 64 $ \sq ->   foldr (.|.) 0 $ take 7 $ tail $ iterate s (bit sq)@@ -711,13 +721,4 @@ testMask :: Bits a => a -> a -> Bool testMask a b = a .&. b == b -{-# INLINE clearMask #-} {-# INLINE testMask #-}-{-# INLINE attackedBy #-}-{-# INLINE slideMoves #-}-{-# INLINE wPawnMoves #-}-{-# INLINE bPawnMoves #-}-{-# INLINE unpack #-}-{-# INLINE foldBits #-}-{-# INLINE bitScanForward #-}-{-# INLINE bitScanReverse #-}

@@ -3,50 +3,50 @@ {-# LANGUAGE TemplateHaskell #-} module Game.Chess.Internal.ECO where -import           Control.DeepSeq-import           Control.Exception          (Exception (displayException),-                                             throwIO)-import           Control.Monad-import           Control.Monad.IO.Class-import           Data.Bifunctor-import           Data.Binary-import           Data.ByteString.Char8      (ByteString)-import qualified Data.ByteString.Char8      as BS-import qualified Data.ByteString.Lazy.Char8 as Lazy-import           Data.Char-import           Data.Data-import           Data.Either                (fromRight)-import           Data.FileEmbed             (embedFile)-import           Data.Foldable              (fold)-import           Data.Functor-import           Data.HashMap.Strict        (HashMap)-import qualified Data.HashMap.Strict        as HashMap-import           Data.Hashable              (Hashable)-import           Data.Maybe-import           Data.MonoTraversable       (MonoFoldable (ofoldl'))-import           Data.Ord-import           Data.Ratio-import           Data.Text                  (Text)-import qualified Data.Text                  as T-import           Data.Tree                  (foldTree)-import           Data.Typeable              (Typeable)-import           Data.Vector.Binary-import           Data.Vector.Instances-import qualified Data.Vector.Unboxed        as Unboxed-import           Data.Void-import           Data.Word                  (Word8)-import           GHC.Generics               (Generic)-import           Game.Chess-import           Game.Chess.PGN-import           Game.Chess.SAN-import           Instances.TH.Lift-import           Language.Haskell.TH.Syntax (Lift, Q, TExp, liftTyped)-import           Prelude                    hiding (lookup)+import           Control.DeepSeq                   (NFData)+import           Control.Monad.IO.Class            (MonadIO (..))+import           Data.Bifunctor                    (Bifunctor (first))+import           Data.Binary                       (Binary (get, put))+import           Data.ByteString.Char8             (ByteString)+import qualified Data.ByteString.Char8             as BS+import           Data.Char                         (chr, ord)+import           Data.Data                         ()+import           Data.Foldable                     (fold)+import           Data.Functor                      (($>))+import           Data.HashMap.Strict               (HashMap)+import qualified Data.HashMap.Strict               as HashMap+import           Data.Hashable                     (Hashable)+import           Data.Maybe                        (fromMaybe)+import           Data.MonoTraversable              (MonoFoldable (ofoldl'))+import           Data.Text                         (Text)+import qualified Data.Text                         as T+import           Data.Tree                         (foldTree)+import           Data.Vector.Binary                ()+import           Data.Vector.Instances             ()+import qualified Data.Vector.Unboxed               as Unboxed+import           Data.Void                         (Void)+import           Data.Word                         (Word8)+import           GHC.Generics                      (Generic)+import           Game.Chess.Internal               (Ply, Position (moveNumber),+                                                    startpos, unsafeDoPly)+import           Game.Chess.PGN                    (Annotated (_annPly),+                                                    Game (CG, _cgForest, _cgOutcome, _cgTags),+                                                    PGN (..), readPGNFile)+import           Game.Chess.SAN                    (relaxedSAN)+import           Instances.TH.Lift                 ()+import           Language.Haskell.TH.Syntax        (Lift)+import           Language.Haskell.TH.Syntax.Compat (IsCode (fromCode), SpliceQ,+                                                    liftTypedQuote)+import           Prelude                           hiding (lookup) import qualified Prelude-import           System.IO-import           Text.Megaparsec-import           Text.Megaparsec.Byte-import qualified Text.Megaparsec.Byte.Lexer as L+import           Text.Megaparsec                   (MonadParsec (eof), Parsec,+                                                    anySingleBut,+                                                    errorBundlePretty, many,+                                                    optional, parse, single,+                                                    (<?>), (<|>))+import           Text.Megaparsec.Byte              (alphaNumChar, digitChar,+                                                    space, space1, string)+import qualified Text.Megaparsec.Byte.Lexer        as L  -- | A Chess Opening data Opening = CO {@@ -78,9 +78,9 @@   put = put . toList   get = fromList <$> get -embedECO :: FileReader -> FilePath -> Q (TExp ECO)-embedECO load fp = (fmap.fmap) liftTyped (load fp) >>= \case-  Right xs -> [|| fromList $$(xs) ||]+embedECO :: FileReader -> FilePath -> SpliceQ ECO+embedECO load fp = (fmap.fmap) liftTypedQuote (load fp) >>= \case+  Right xs -> [|| fromList $$(fromCode xs) ||]   Left err -> fail err  toList :: ECO -> [Opening]@@ -97,13 +97,14 @@  fromPGN' :: PGN -> [Opening] fromPGN' (PGN games) = map mkCO games where-  mkCO (tags, (_, forest)) = CO { .. } where-    coCode = fromMaybe "" $ Prelude.lookup "ECO" tags-    coName = fromMaybe "" $ Prelude.lookup "Opening" tags-    coVariation = Prelude.lookup "Variation" tags-    coPlies = Unboxed.fromList . head . concatMap (foldTree g) $ forest where-      g a [] = [[pgnPly a]]-      g a xs = (pgnPly a :) <$> fold xs+  mkCO CG { .. } = CO { .. } where+    lt = (`Prelude.lookup` _cgTags)+    coCode = fromMaybe "" $ lt "ECO"+    coName = fromMaybe "" $ lt "Opening"+    coVariation = lt "Variation"+    coPlies = Unboxed.fromList . head . concatMap (foldTree g) $ _cgForest where+      g a [] = [[_annPly a]]+      g a xs = (_annPly a :) <$> fold xs  opening :: Parser Opening opening = CO <$> lexeme code <*> lexeme var <*> pure Nothing <*> lexeme (plies startpos)

@@ -34,8 +34,7 @@ import           Control.DeepSeq import           Control.Lens                (view, (^.)) import           Control.Lens.Iso            (from)-import           Data.Bifunctor              (first)-import           Data.Binary                 (Binary (get, put))+import           Data.Binary                 (Binary) import           Data.Bits                   (Bits (clearBit, complement, popCount, setBit, testBit, unsafeShiftL, unsafeShiftR, xor, (.&.), (.|.)),                                               FiniteBits (..)) import           Data.Char                   (ord, toLower)@@ -59,7 +58,7 @@ import           Numeric                     (showHex)  data QuadBitboard = QBB { black, pbq, nbk, rqk :: {-# UNPACK #-} !Word64 }-                    deriving (Eq, Generic, Lift)+                    deriving (Eq, Generic, Lift, Ord)  instance NFData QuadBitboard @@ -272,6 +271,8 @@ (!) QBB{..} (Sq sq) = fromIntegral $ f black 0 .|. f pbq 1 .|. f nbk 2 .|. f rqk 3 where   f !bb !n = ((bb `unsafeShiftR` sq) .&. 1) `unsafeShiftL` n +{-# INLINE (!) #-}+ setNibble :: Bits nibble => QuadBitboard -> Int -> nibble -> QuadBitboard setNibble QBB{..} sq nb = QBB (f 0 black) (f 1 pbq) (f 2 nbk) (f 3 rqk) where   f n | nb `testBit` n = (`setBit` sq)@@ -314,8 +315,8 @@     (", rqk = 0x" <> showHex rqk "}")))  toString :: QuadBitboard -> String-toString qbb = intercalate "/" $ rank <$> [Rank8, Rank7 .. Rank1] where-  rank r = concatMap countEmpty . groupBy spaces $ charAt r <$> [FileA .. FileH]+toString qbb = intercalate "/" $ rnk <$> [Rank8, Rank7 .. Rank1] where+  rnk r = concatMap countEmpty . groupBy spaces $ charAt r <$> [FileA .. FileH]   countEmpty xs | head xs == spc = show $ length xs                 | otherwise      = xs   spaces x y = x == spc && x == y@@ -332,6 +333,8 @@ move' :: Square -> Word4 -> Square -> Word4 -> QuadBitboard move' fromSq fromCode toSq toCode =   singleton fromSq fromCode <> singleton toSq (fromCode `xor` toCode)++{-# INLINE move' #-}  whiteKingsideCastle, whiteQueensideCastle, blackKingsideCastle, blackQueensideCastle   :: QuadBitboard

@@ -1,6 +1,6 @@ module Game.Chess.Internal.Square where -import           Control.Lens.Iso+import           Control.Lens.Iso (Iso', iso) import           Data.Bits        (Bits (testBit)) import           Data.Char        (chr, ord) import           Data.Coerce      (coerce)@@ -216,9 +216,9 @@ file = File . (`mod` 8) . coerce  rankFile :: Iso' Square (Rank, File)-rankFile = iso f g where-  f (Sq i) = case i `divMod` 8 of (r, f) -> (Rank r, File f)-  g (Rank r, File f) = Sq $ r*8 + f+rankFile = iso from to where+  from (Sq i) = case i `divMod` 8 of (r, f) -> (Rank r, File f)+  to (Rank r, File f) = Sq $ r*8 + f  fileChar, rankChar :: Square -> Char fileChar = chr . (ord 'a' +) . unFile . file

@@ -1,4 +1,5 @@-{-# LANGUAGE GADTs #-}+{-# LANGUAGE GADTs           #-}+{-# LANGUAGE TemplateHaskell #-} {-| Module      : Game.Chess.PGN Description : Portable Game Notation@@ -11,66 +12,125 @@ Each game consists of a tag list, the outcome, and a forest of rosetrees. -} module Game.Chess.PGN (-  readPGNFile, gameFromForest, pgnForest, PGN(..), Game(..), Outcome(..), PlyData(..)+  PGN(..)+, Game(..), cgTags, cgOutcome, cgForest+, Outcome(..), _Win, _Draw, _Undecided+, Annotated(..), annPrefixNAG, annPly, annSuffixNAG+, readPGNFile, gameFromForest, pgnForest+  -- * A PGN parser , pgn+  -- * Prettyprinting , hPutPGN, pgnDoc, RAVOrder, breadthFirst, depthFirst, gameDoc , weightedForest ) where -import           Control.Monad-import           Control.Monad.IO.Class-import           Data.Bifunctor+import           Control.Lens                          (makeLenses, makePrisms,+                                                        makeWrapped)+import           Control.Monad                         (void)+import           Control.Monad.IO.Class                (MonadIO (..))+import           Data.Bifunctor                        (Bifunctor (first)) import           Data.ByteString.Char8                 (ByteString) import qualified Data.ByteString.Char8                 as BS-import           Data.Char-import           Data.Foldable-import           Data.Functor-import           Data.List-import           Data.Maybe-import           Data.Ord-import           Data.Ratio+import           Data.Char                             (chr, ord)+import           Data.Foldable                         (for_)+import           Data.Functor                          (($>))+import           Data.Hashable                         (Hashable(..))+import           Data.List                             (partition, sortOn)+import           Data.Maybe                            (fromJust, isNothing)+import           Data.Ord                              (Down (Down))+import           Data.Ratio                            ((%)) import           Data.Text                             (Text) import qualified Data.Text                             as T-import           Data.Text.Prettyprint.Doc             hiding (space)-import           Data.Text.Prettyprint.Doc.Render.Text-import           Data.Tree-import           Data.Void-import           Data.Word-import           Game.Chess-import           Game.Chess.SAN-import           System.IO-import           Text.Megaparsec-import           Text.Megaparsec.Byte+import           Data.Text.Encoding                    as T (decodeUtf8)+import           Data.Text.Prettyprint.Doc             (Doc,+                                                        FusionDepth (Shallow),+                                                        Pretty (pretty),+                                                        brackets, dquotes,+                                                        fillSep, fuse, line,+                                                        parens, vsep, (<+>))+import           Data.Text.Prettyprint.Doc.Render.Text (hPutDoc)+import           Data.Tree                             (Tree (..), foldTree)+import           Data.Void                             (Void)+import           Data.Word                             (Word8)+import           GHC.Generics                          (Generic)+import           Game.Chess.Internal                   (Color (..), Ply,+                                                        Position (color, moveNumber),+                                                        fromFEN, startpos,+                                                        unsafeDoPly)+import           Game.Chess.SAN                        (relaxedSAN, unsafeToSAN)+import           Language.Haskell.TH.Syntax            (Lift)+import           System.IO                             (Handle, hPutStrLn)+import           Text.Megaparsec                       (MonadParsec (eof),+                                                        Parsec, anySingleBut,+                                                        errorBundlePretty, many,+                                                        match, oneOf, optional,+                                                        parse, single, (<?>),+                                                        (<|>))+import           Text.Megaparsec.Byte                  (alphaNumChar, space,+                                                        space1, string) import qualified Text.Megaparsec.Byte.Lexer            as L -gameFromForest :: [(ByteString, Text)] -> Forest Ply -> Outcome -> Game-gameFromForest tags forest o = (("Result", r):tags, (o, (fmap . fmap) f forest)) where-  f pl = PlyData [] pl []-  r = case o of-    Win White -> "1-0"-    Win Black -> "0-1"-    Draw      -> "1/2-1/2"-    Undecided -> "*"+data Annotated a = Ann {+  _annPrefixNAG :: ![Int]+, _annPly       :: !a+, _annSuffixNAG :: ![Int]+} deriving (Eq, Functor, Generic, Lift, Show) -newtype PGN = PGN [Game] deriving (Eq, Monoid, Semigroup)-type Game = ([(ByteString, Text)], (Outcome, Forest PlyData))+instance Applicative Annotated where+  pure a = Ann [] a []+  Ann pn1 f sn1 <*> Ann pn2 a sn2 = Ann (pn1 <> pn2) (f a) (sn1 <> sn2)++makeLenses ''Annotated++instance Hashable a => Hashable (Annotated a)+ data Outcome = Win Color              | Draw              | Undecided-             deriving (Eq, Show)+             deriving (Eq, Generic, Lift, Show) -pgnForest :: PGN -> Forest Ply-pgnForest (PGN gs) = merge $ concatMap ((fmap . fmap) pgnPly . snd . snd) gs+instance Hashable Outcome -merge :: Eq a => Forest a -> Forest a-merge = foldl mergeTree [] where-  merge' l r = l { subForest = foldl mergeTree (subForest l) (subForest r) }-  mergeTree [] y = [y]-  mergeTree (x:xs) y-    | rootLabel x == rootLabel y = x `merge'` y : xs-    | otherwise = x : xs `mergeTree` y+makePrisms ''Outcome +data Game = CG {+  _cgTags    :: ![(Text, Text)]+, _cgForest  :: ![Tree (Annotated Ply)]+, _cgOutcome :: !Outcome+} deriving (Eq, Generic, Show) +instance Hashable Game where+  hashWithSalt s CG { .. } = s+    `hashWithSalt` _cgTags+    `hashWithSalt` foldTree (hashWithSalt . hash) <$> _cgForest+    `hashWithSalt` _cgOutcome++makeLenses ''Game++newtype PGN = PGN [Game] deriving (Eq, Monoid, Semigroup)++makeWrapped ''PGN++gameFromForest :: [(Text, Text)] -> [Tree Ply] -> Outcome -> Game+gameFromForest tags forest _cgOutcome = CG { .. } where+  _cgTags = ("Result", r):tags+  _cgForest = (fmap . fmap) pure forest+  r = case _cgOutcome of+    Win White -> "1-0"+    Win Black -> "0-1"+    Draw      -> "1/2-1/2"+    Undecided -> "*"++pgnForest :: PGN -> [Tree Ply]+pgnForest (PGN gs) = merge $ concatMap ((fmap . fmap) _annPly . _cgForest) gs where+  merge :: Eq a => [Tree a] -> [Tree a]+  merge = foldl mergeTree [] where+    merge' l r = l { subForest = foldl mergeTree (subForest l) (subForest r) }+    mergeTree [] y = [y]+    mergeTree (x:xs) y+      | rootLabel x == rootLabel y = x `merge'` y : xs+      | otherwise = x : xs `mergeTree` y+ instance Ord Outcome where   Win _ `compare` Win _         = EQ   Win _ `compare` _             = GT@@ -86,15 +146,18 @@   pretty Draw        = "1/2-1/2"   pretty Undecided   = "*" -data PlyData = PlyData {-  prefixNAG :: ![Int]-, pgnPly    :: !Ply-, suffixNAG :: ![Int]-} deriving (Eq, Show)- readPGNFile :: MonadIO m => FilePath -> m (Either String PGN)-readPGNFile fp = liftIO $ first errorBundlePretty . parse pgn fp <$> BS.readFile fp+readPGNFile fp = liftIO $+  first errorBundlePretty . parse pgn fp . stripBOM <$> BS.readFile fp +bom :: ByteString+bom = "\xEF\xBB\xBF"++stripBOM :: ByteString -> ByteString+stripBOM bs+  | bom `BS.isPrefixOf` bs = BS.drop (BS.length bom) bs+  | otherwise              = bs+ hPutPGN :: Handle -> RAVOrder (Doc ann) -> PGN -> IO () hPutPGN h ro (PGN games) = for_ games $ \g -> do   hPutDoc h $ gameDoc ro g@@ -115,8 +178,8 @@             <|> string "1/2-1/2" $> Draw             <|> string "*" $> Undecided -sym :: Parser ByteString-sym = lexeme . fmap fst . match $ do+sym :: Parser Text+sym = lexeme . fmap (T.decodeUtf8 . fst) . match $ do   void alphaNumChar   many $ alphaNumChar <|> oneOf [35,43,45,58,61,95] @@ -141,7 +204,7 @@             <|> string "!"  $> 1             <|> string "?"  $> 2 -tagPair :: Parser (ByteString, Text)+tagPair :: Parser (Text, Text) tagPair = lexeme $ do   lbracketP   k <- sym@@ -149,10 +212,10 @@   rbracketP   pure (k, v) -tagList :: Parser [(ByteString, Text)]+tagList :: Parser [(Text, Text)] tagList = many tagPair -movetext :: Position -> Parser (Outcome, Forest PlyData)+movetext :: Position -> Parser (Outcome, [Tree (Annotated Ply)]) movetext pos = (,[]) <$> eog <|> main pos where   main p = ply p >>= \(m, n) -> fmap n <$> movetext (unsafeDoPly p m)   var p = ply p >>= \(m, n) -> n <$> (rparenP $> [] <|> var (unsafeDoPly p m))@@ -162,7 +225,7 @@     m <- lexeme $ relaxedSAN p     snags <- many nag     rav <- concat <$> many (lparenP *> var p)-    pure (m, \xs -> Node (PlyData pnags m snags) xs:rav)+    pure (m, \xs -> Node (Ann pnags m snags) xs:rav)   validateMoveNumber p =     optional (lexeme $ L.decimal <* space <* many (single periodChar)) >>= \case       Just n | moveNumber p /= n ->@@ -174,13 +237,14 @@  game :: Parser Game game = do-  tl <- tagList-  pos <- case lookup "FEN" tl of+  _cgTags <- tagList+  pos <- case lookup "FEN" _cgTags of     Nothing -> pure startpos     Just fen -> case fromFEN (T.unpack fen) of       Just p  -> pure p       Nothing -> fail "Invalid FEN"-  (tl,) <$> movetext pos+  (_cgOutcome, _cgForest) <- movetext pos+  pure $ CG { .. }  str :: Parser Text str = p <?> "string" where@@ -190,7 +254,7 @@                                )     <|> anySingleBut quoteChar -type RAVOrder a = (Forest PlyData -> a) -> Forest PlyData -> [a]+type RAVOrder a = ([Tree (Annotated Ply)] -> a) -> [Tree (Annotated Ply)] -> [a]  breadthFirst, depthFirst :: RAVOrder a breadthFirst _ [] = []@@ -201,22 +265,23 @@ pgnDoc ro (PGN games) = vsep $ gameDoc ro <$> games  gameDoc :: RAVOrder (Doc ann) -> Game -> Doc ann-gameDoc ro (tl, mt)-  | null tl = moveDoc ro pos mt-  | otherwise = tagsDoc tl <> line <> line <> moveDoc ro pos mt+gameDoc ro CG { .. }+  | null _cgTags = moveDoc ro pos (_cgOutcome, _cgForest)+  | otherwise = tagsDoc _cgTags <> line <> line <> moveDoc ro pos (_cgOutcome, _cgForest)  where-  pos | Just fen <- lookup "FEN" tl = fromJust $ fromFEN (T.unpack fen)+  pos | Just fen <- lookup "FEN" _cgTags = fromJust $ fromFEN (T.unpack fen)       | otherwise = startpos -tagsDoc :: [(ByteString, Text)] -> Doc ann+tagsDoc :: [(Text, Text)] -> Doc ann tagsDoc = fuse Shallow . vsep . fmap tagpair where-  tagpair (k, esc -> v) = brackets $ pretty (BS.unpack k) <+> dquotes (pretty v)+  tagpair (k, esc -> v) = brackets $ pretty k <+> dquotes (pretty v)   esc = T.concatMap e where     e '\\' = T.pack "\\\\"     e '"'  = T.pack "\\\""     e c    = T.singleton c -moveDoc :: RAVOrder (Doc ann) -> Position -> (Outcome, Forest PlyData) -> Doc ann+moveDoc :: RAVOrder (Doc ann) -> Position -> (Outcome, [Tree (Annotated Ply)])+        -> Doc ann moveDoc ro p (o,f) = fillSep (go p True f <> [pretty o]) <> line where   go _ _ [] = []   go pos pmn (t:ts)@@ -225,25 +290,26 @@     | otherwise     = pnag <> (san:snag) <> rav <> go pos' (not . null $ rav) (subForest t)    where-    pl = pgnPly . rootLabel $ t+    pl = _annPly . rootLabel $ t     san = pretty $ unsafeToSAN pos pl     pos' = unsafeDoPly pos pl-    pnag = prettynag <$> prefixNAG (rootLabel t)+    pnag = prettynag <$> _annPrefixNAG (rootLabel t)     mn = pretty (moveNumber pos) <> if color pos == White then "." else "..."     rav = ro (parens . fillSep . go pos True) ts-    snag = prettynag <$> suffixNAG (rootLabel t)+    snag = prettynag <$> _annSuffixNAG (rootLabel t)   prettynag n = "$" <> pretty n -weightedForest :: PGN -> Forest (Rational, Ply)-weightedForest (PGN games) = merge . concatMap rate $ snd <$> filter ok games where-  ok (tags, (o, _)) = isNothing (lookup "FEN" tags) && o /= Undecided-  rate (o, ts) = f startpos <$> trunk ts where-    w c | o == Win c = 1-        | o == Win (opponent c) = -1-        | o == Draw = 1 % 2-        | otherwise = 0-    f pos (Node a ts') = Node (w (color pos), pgnPly a) $-      f (unsafeDoPly pos (pgnPly a)) <$> ts'+weightedForest :: PGN -> [Tree (Rational, Ply)]+weightedForest (PGN games) = merge . concatMap rate $ filter ok games where+  ok CG { .. } = isNothing (lookup "FEN" _cgTags) && _cgOutcome /= Undecided+  rate CG { .. } = f startpos <$> trunk _cgForest where+    w c = case _cgOutcome of+      Win c' | c == c' -> 1+             | otherwise -> -1+      Draw -> 1 % 2+      Undecided -> 0+    f pos (Node a ts') = Node (w (color pos), _annPly a) $+      f (unsafeDoPly pos (_annPly a)) <$> ts'   trunk []    = []   trunk (x:_) = [x { subForest = trunk (subForest x)}]   merge [] = []@@ -253,3 +319,4 @@    where     (good, bad) = partition (eq a . rootLabel) xs where eq x y = snd x == snd y     w = fst a + sum (fst . rootLabel <$> good)+

@@ -2,7 +2,7 @@ {-# LANGUAGE TemplateHaskell     #-} module Game.Chess.Polyglot (   -- * Data type-  PolyglotBook+  PolyglotBook, BookEntry(..), beKey, bePly, beWeight, beLearn   -- * Built-in books , defaultBook, twic   -- * Load and save@@ -14,55 +14,68 @@ , bookPlies , bookForest , variations-, findPosition+, findPosition, hashPosition ) where -import           Control.Arrow+import           Control.Arrow            (Arrow ((&&&)))+import           Control.Lens             (makeLenses, (%~))+import           Control.Monad.ST (ST, runST) import           Control.Monad.Random     (Rand) import qualified Control.Monad.Random     as Rand-import           Data.Bits+import           Data.Bits                (Bits (shiftL, shiftR, (.|.))) import           Data.ByteString          (ByteString) import qualified Data.ByteString          as BS import qualified Data.ByteString.Internal as BS-import           Data.FileEmbed+import           Data.FileEmbed           (embedFile) import           Data.Foldable            (fold)-import           Data.List-import           Data.Ord+import           Data.Hashable            (Hashable)+import           Data.List                (sort)+import           Data.Ord                 (Down (Down)) import           Data.String              (IsString (fromString))-import           Data.Tree+import           Data.Tree                (Tree (Node), foldTree)+import           Data.Vector.Instances    () import qualified Data.Vector.Storable     as VS-import           Data.Word+import           Data.Word                (Word16, Word32, Word64, Word8) import           Foreign.ForeignPtr       (castForeignPtr, plusForeignPtr)-import           Foreign.Storable+import           Foreign.Storable         (Storable (alignment, peek, poke, pokeElemOff, sizeOf))+import           GHC.Generics             (Generic) import           GHC.Ptr                  (Ptr, castPtr, plusPtr)-import           Game.Chess.Internal-import           Game.Chess.PGN-import           Game.Chess.Polyglot.Hash+import           Game.Chess.Internal      (Ply (..), unpack, move, Color(..), Position (color, halfMoveClock), canCastleQueenside, canCastleKingside, wKscm, bKscm, wQscm, bQscm, +                                           doPly, startpos, toFEN,+                                           unsafeDoPly)+import           Game.Chess.Internal.Square+import           Game.Chess.PGN           (Outcome (Undecided), PGN (..),+                                           gameFromForest, weightedForest)+import           Game.Chess.Polyglot.Hash (hashPosition) import           System.Random            (RandomGen) -data BookEntry = BookEntry {-  key    :: {-# UNPACK #-} !Word64-, ply    :: {-# UNPACK #-} !Ply-, weight :: {-# UNPACK #-} !Word16-, learn  :: {-# UNPACK #-} !Word32-} deriving (Eq, Show)+data BookEntry a = BE {+  _beKey    :: {-# UNPACK #-} !Word64+, _bePly    :: !a+, _beWeight :: {-# UNPACK #-} !Word16+, _beLearn  :: {-# UNPACK #-} !Word32+} deriving (Eq, Functor, Generic, Show) -instance Ord BookEntry where-  compare (BookEntry k1 _ w1 _) (BookEntry k2 _ w2 _) =-    compare k1 k2 <> compare (Down w1) (Down w2)+instance Hashable a => Hashable (BookEntry a) -instance Storable BookEntry where+makeLenses ''BookEntry++instance Ord a => Ord (BookEntry a) where+  compare (BE k1 p1 w1 _) (BE k2 p2 w2 _) =+    k1 `compare` k2 <> Down w1 `compare` Down w2 <> p1 `compare` p2++instance Storable (BookEntry Word16) where   sizeOf _ = 16   alignment _ = alignment (undefined :: Word64)-  peek ptr = BookEntry <$> peekBE (castPtr ptr)-                       <*> (Ply <$> peekBE (castPtr ptr `plusPtr` 8))-                       <*> peekBE (castPtr ptr `plusPtr` 10)-                       <*> peekBE (castPtr ptr `plusPtr` 12)-  poke ptr (BookEntry key (Ply ply) weight learn) = do-    pokeBE (castPtr ptr) key-    pokeBE (castPtr ptr `plusPtr` 8) ply-    pokeBE (castPtr ptr `plusPtr` 10) weight-    pokeBE (castPtr ptr `plusPtr` 12) learn+  peek ptr = BE <$> peekBE (castPtr ptr)+                <*> peekBE (castPtr ptr `plusPtr` 8)+                <*> peekBE (castPtr ptr `plusPtr` 10)+                <*> peekBE (castPtr ptr `plusPtr` 12)+  poke ptr BE { .. } = do+    pokeBE (castPtr ptr) _beKey+    pokeBE (castPtr ptr `plusPtr` 8) _bePly+    pokeBE (castPtr ptr `plusPtr` 10) _beWeight+    pokeBE (castPtr ptr `plusPtr` 12) _beLearn  peekBE :: forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a peekBE ptr = go ptr 0 (sizeOf (undefined :: a)) where@@ -80,8 +93,14 @@ twic = fromByteString $(embedFile "book/twic-9g.bin")  -- | A Polyglot opening book.-newtype PolyglotBook = Book (VS.Vector BookEntry) deriving (Eq)+newtype PolyglotBook = Book (VS.Vector (BookEntry Word16)) deriving (Eq, Hashable) +instance Semigroup PolyglotBook where+  Book a <> Book b = fromList . VS.toList $ a <> b++instance Monoid PolyglotBook where+  mempty = Book mempty+ -- | Create a PolyglotBook from a ByteString. fromByteString :: ByteString -> PolyglotBook fromByteString bs = Book v where@@ -101,10 +120,10 @@ writePolyglotFile :: FilePath -> PolyglotBook -> IO () writePolyglotFile fp = BS.writeFile fp . toByteString -fromList :: [BookEntry] -> PolyglotBook+fromList :: [BookEntry Word16] -> PolyglotBook fromList = Book . VS.fromList . sort ---toList :: PolyglotBook -> [BookEntry]+--toList :: PolyglotBook -> [BookEntry Word16] --toList (Book v) = VS.toList v  toPGN :: PolyglotBook -> Position -> PGN@@ -119,28 +138,28 @@     Node (pos, a) $ annot (unsafeDoPly pos (snd a)) <$> ts   f (pos, (w, pl)) xs     | w > 0-    = BookEntry (hashPosition pos) (toPolyglot pos pl) (floor w) 0 : concat xs+    = BE (hashPosition pos) (fromPly pos pl) (floor w) 0 : concat xs     | otherwise     = concat xs -bookForest :: PolyglotBook -> Position -> Forest Ply+bookForest :: PolyglotBook -> Position -> [Tree Ply] bookForest b = (fmap . fmap) (snd . head) . forest [] where   forest pls p = tree pls p <$> filter (not . seen pls) (plies p)   tree pls p (pl, p') = Node pls' $ forest pls' p' where pls' = (p, pl) : pls-  plies p = f <$> bookPlies b p where f pl = (pl, doPly p pl)+  plies p = f <$> bookPlies b p where f (_bePly -> pl) = (pl, doPly p pl)   seen pls (_, p') = p' `elem` map fst pls  -- | Pick a random ply from the book. bookPly :: RandomGen g => PolyglotBook -> Position -> Maybe (Rand g Ply) bookPly b pos = case findPosition b pos of   [] -> Nothing-  l  -> Just . Rand.fromList $ map (ply &&& fromIntegral . weight) l+  l  -> Just . Rand.fromList $ map (_bePly &&& fromIntegral . _beWeight) l  -- | Probe the book for all plies known for the given position.-bookPlies :: PolyglotBook -> Position -> [Ply]+bookPlies :: PolyglotBook -> Position -> [BookEntry Ply] bookPlies b pos   | halfMoveClock pos > 150 = []-  | otherwise = ply <$> findPosition b pos+  | otherwise = findPosition b pos  -- | Predicted Variations.  Return the most popular game. variations :: PolyglotBook -> Position -> [[Ply]]@@ -148,16 +167,59 @@   f a [] = [[a]]   f a xs = (a :) <$> fold xs -findPosition :: PolyglotBook -> Position -> [BookEntry]-findPosition (Book v) pos = fmap conv . VS.toList .-  VS.takeWhile ((hash ==) . key) . VS.unsafeDrop (lowerBound hash) $ v+findPosition :: PolyglotBook -> Position -> [BookEntry Ply]+findPosition (Book v) pos =+  (fmap . fmap) (toPly pos) .+  VS.toList .+  VS.takeWhile ((hash ==) . _beKey) .+  VS.unsafeDrop (lowerBound hash) $ v  where-  conv be@BookEntry{ply} = be { ply = fromPolyglot pos ply }   hash = hashPosition pos-  lowerBound = bsearch (key . VS.unsafeIndex v) (0, VS.length v - 1)-  bsearch :: (Integral a, Ord b) => (a -> b) -> (a, a) -> b -> a-  bsearch f (lo, hi) x-    | lo >= hi   = lo-    | x <= f mid = bsearch f (lo, mid) x-    | otherwise  = bsearch f (mid + 1, hi) x-   where mid = lo + ((hi - lo) `div` 2)+  lowerBound = bsearch (_beKey . VS.unsafeIndex v) (0, VS.length v - 1)++bsearch :: (Integral a, Ord b) => (a -> b) -> (a, a) -> b -> a+bsearch f (lo, hi) x+  | lo >= hi   = lo+  | x <= f mid = bsearch f (lo, mid) x+  | otherwise  = bsearch f (mid + 1, hi) x+ where mid = lo + ((hi - lo) `div` 2)++toPly :: Position -> Word16 -> Ply+toPly pos pl@(unpack . Ply -> (src, dst, _)) = case color pos of+  White | src == E1+        , canCastleKingside pos+        , dst == H1+        -> wKscm+        | src == E1+        , canCastleQueenside pos+        , dst == A1+        -> wQscm+  Black | src == E8+        , canCastleKingside pos+        , dst == H8+        -> bKscm+        | src == E8+        , canCastleQueenside pos+        , dst == A8+        -> bQscm+  _ -> Ply pl++fromPly :: Position -> Ply -> Word16+fromPly pos pl@(unpack -> (src, dst, _)) = unPly $ case color pos of+  White | src == E1+        , canCastleKingside pos+        , dst == G1+        -> src `move` H1+        | src == E1+        , canCastleQueenside pos+        , dst == C1+        -> src `move` A1+  Black | src == E8+        , canCastleKingside pos+        , dst == G8+        -> src `move` H8+        | src == E8+        , canCastleQueenside pos+        , dst == C8+        -> src `move` A8+  _ -> pl

@@ -1,33 +1,44 @@-module Game.Chess.Polyglot.Hash (-  hashPosition, pieceKey, castleKey, epKeys, turnKey-) where+module Game.Chess.Polyglot.Hash (hashPosition) where -import           Data.Bits-import           Data.Ix-import           Data.Maybe-import qualified Data.Vector.Unboxed as Unboxed-import           Data.Word-import           Game.Chess+import           Data.Bits                  (Bits (xor))+import           Data.Coerce                (coerce)+import           Data.Ix                    (Ix (index))+import           Data.Maybe                 (mapMaybe)+import           Data.Vector.Unboxed        (Vector, fromList, unsafeIndex)+import           Data.Word                  (Word64)+import           Game.Chess.Internal        (Castle (..), Color (..), PieceType,+                                             Position (color), attackedByPawn,+                                             castlingRights, enPassantSquare,+                                             opponent, pattern King,+                                             pattern Pawn, pieceAt)+import           Game.Chess.Internal.Square (File (..), Square, file,+                                             pattern A1, pattern H8) + hashPosition :: Position -> Word64 hashPosition pos = piece `xor` castling `xor` ep `xor` turn where   piece = foldr xor 0 $ mapMaybe f [A1 .. H8] where     f sq = (\(c, p) -> pieceKey (p, c, sq)) <$> pieceAt pos sq   castling = foldr (xor . castleKey) 0 $ castlingRights pos-  ep = 0 -- TODO+  ep = case enPassantSquare pos of+    Just sq | attackedByPawn sq pos -> epKey (file sq)+    _                               -> 0   turn = case color pos of     White -> turnKey     Black -> 0  pieceKey :: (PieceType, Color, Square) -> Word64-pieceKey = Unboxed.unsafeIndex pieceKeys . index ((Pawn,Black,A1),(King,White,H8))+pieceKey = unsafeIndex pieceKeys . index ((Pawn,Black,A1),(King,White,H8))  castleKey :: (Color, Castle) -> Word64-castleKey (c, s) = Unboxed.unsafeIndex castleKeys $+castleKey (c, s) = unsafeIndex castleKeys $   index ((Black, Kingside), (White, Queenside)) (opponent c, s) -pieceKeys, castleKeys, epKeys :: Unboxed.Vector Word64-pieceKeys = Unboxed.fromList+epKey :: File -> Word64+epKey = unsafeIndex epKeys . coerce++pieceKeys, castleKeys, epKeys :: Vector Word64+pieceKeys = fromList   [0x9D39247E33776D41,0x2AF7398005AAA5C7,0x44DB015024623547,0x9C15F73E62A76AE2   ,0x75834465489C0C89,0x3290AC3A203001BF,0x0FBBAD1F61042279,0xE83A908FF2FB60CA   ,0x0D7E765D58755C10,0x1A083822CEAFE02D,0x9605D5F0E25EC3B0,0xD021FF5CD13A2ED5@@ -76,158 +87,158 @@   ,0x4850E73E03EB6064,0xCFC447F1E53C8E1B,0xB05CA3F564268D99,0x9AE182C8BC9474E8   ,0xA4FC4BD4FC5558CA,0xE755178D58FC4E76,0x69B97DB1A4C03DFE,0xF9B5B7C4ACC67C96   ,0xFC6A82D64B8655FB,0x9C684CB6C4D24417,0x8EC97D2917456ED0,0x6703DF9D2924E97E-  ,0xC547F57E42A7444E,0x78E37644E7CAD29E,0xFE9A44E9362F05FA,0x08BD35CC38336615,-   0x9315E5EB3A129ACE, 0x94061B871E04DF75, 0xDF1D9F9D784BA010, 0x3BBA57B68871B59D,-   0xD2B7ADEEDED1F73F, 0xF7A255D83BC373F8, 0xD7F4F2448C0CEB81, 0xD95BE88CD210FFA7,-   0x336F52F8FF4728E7, 0xA74049DAC312AC71, 0xA2F61BB6E437FDB5, 0x4F2A5CB07F6A35B3,-   0x87D380BDA5BF7859, 0x16B9F7E06C453A21, 0x7BA2484C8A0FD54E, 0xF3A678CAD9A2E38C,-   0x39B0BF7DDE437BA2, 0xFCAF55C1BF8A4424, 0x18FCF680573FA594, 0x4C0563B89F495AC3,-   0x40E087931A00930D, 0x8CFFA9412EB642C1, 0x68CA39053261169F, 0x7A1EE967D27579E2,-   0x9D1D60E5076F5B6F, 0x3810E399B6F65BA2, 0x32095B6D4AB5F9B1, 0x35CAB62109DD038A,-   0xA90B24499FCFAFB1, 0x77A225A07CC2C6BD, 0x513E5E634C70E331, 0x4361C0CA3F692F12,-   0xD941ACA44B20A45B, 0x528F7C8602C5807B, 0x52AB92BEB9613989, 0x9D1DFA2EFC557F73,-   0x722FF175F572C348, 0x1D1260A51107FE97, 0x7A249A57EC0C9BA2, 0x04208FE9E8F7F2D6,-   0x5A110C6058B920A0, 0x0CD9A497658A5698, 0x56FD23C8F9715A4C, 0x284C847B9D887AAE,-   0x04FEABFBBDB619CB, 0x742E1E651C60BA83, 0x9A9632E65904AD3C, 0x881B82A13B51B9E2,-   0x506E6744CD974924, 0xB0183DB56FFC6A79, 0x0ED9B915C66ED37E, 0x5E11E86D5873D484,-   0xF678647E3519AC6E, 0x1B85D488D0F20CC5, 0xDAB9FE6525D89021, 0x0D151D86ADB73615,-   0xA865A54EDCC0F019, 0x93C42566AEF98FFB, 0x99E7AFEABE000731, 0x48CBFF086DDF285A,-   0x7F9B6AF1EBF78BAF, 0x58627E1A149BBA21, 0x2CD16E2ABD791E33, 0xD363EFF5F0977996,-   0x0CE2A38C344A6EED, 0x1A804AADB9CFA741, 0x907F30421D78C5DE, 0x501F65EDB3034D07,-   0x37624AE5A48FA6E9, 0x957BAF61700CFF4E, 0x3A6C27934E31188A, 0xD49503536ABCA345,-   0x088E049589C432E0, 0xF943AEE7FEBF21B8, 0x6C3B8E3E336139D3, 0x364F6FFA464EE52E,-   0xD60F6DCEDC314222, 0x56963B0DCA418FC0, 0x16F50EDF91E513AF, 0xEF1955914B609F93,-   0x565601C0364E3228, 0xECB53939887E8175, 0xBAC7A9A18531294B, 0xB344C470397BBA52,-   0x65D34954DAF3CEBD, 0xB4B81B3FA97511E2, 0xB422061193D6F6A7, 0x071582401C38434D,-   0x7A13F18BBEDC4FF5, 0xBC4097B116C524D2, 0x59B97885E2F2EA28, 0x99170A5DC3115544,-   0x6F423357E7C6A9F9, 0x325928EE6E6F8794, 0xD0E4366228B03343, 0x565C31F7DE89EA27,-   0x30F5611484119414, 0xD873DB391292ED4F, 0x7BD94E1D8E17DEBC, 0xC7D9F16864A76E94,-   0x947AE053EE56E63C, 0xC8C93882F9475F5F, 0x3A9BF55BA91F81CA, 0xD9A11FBB3D9808E4,-   0x0FD22063EDC29FCA, 0xB3F256D8ACA0B0B9, 0xB03031A8B4516E84, 0x35DD37D5871448AF,-   0xE9F6082B05542E4E, 0xEBFAFA33D7254B59, 0x9255ABB50D532280, 0xB9AB4CE57F2D34F3,-   0x693501D628297551, 0xC62C58F97DD949BF, 0xCD454F8F19C5126A, 0xBBE83F4ECC2BDECB,-   0xDC842B7E2819E230, 0xBA89142E007503B8, 0xA3BC941D0A5061CB, 0xE9F6760E32CD8021,-   0x09C7E552BC76492F, 0x852F54934DA55CC9, 0x8107FCCF064FCF56, 0x098954D51FFF6580,-   0x23B70EDB1955C4BF, 0xC330DE426430F69D, 0x4715ED43E8A45C0A, 0xA8D7E4DAB780A08D,-   0x0572B974F03CE0BB, 0xB57D2E985E1419C7, 0xE8D9ECBE2CF3D73F, 0x2FE4B17170E59750,-   0x11317BA87905E790, 0x7FBF21EC8A1F45EC, 0x1725CABFCB045B00, 0x964E915CD5E2B207,-   0x3E2B8BCBF016D66D, 0xBE7444E39328A0AC, 0xF85B2B4FBCDE44B7, 0x49353FEA39BA63B1,-   0x1DD01AAFCD53486A, 0x1FCA8A92FD719F85, 0xFC7C95D827357AFA, 0x18A6A990C8B35EBD,-   0xCCCB7005C6B9C28D, 0x3BDBB92C43B17F26, 0xAA70B5B4F89695A2, 0xE94C39A54A98307F,-   0xB7A0B174CFF6F36E, 0xD4DBA84729AF48AD, 0x2E18BC1AD9704A68, 0x2DE0966DAF2F8B1C,-   0xB9C11D5B1E43A07E, 0x64972D68DEE33360, 0x94628D38D0C20584, 0xDBC0D2B6AB90A559,-   0xD2733C4335C6A72F, 0x7E75D99D94A70F4D, 0x6CED1983376FA72B, 0x97FCAACBF030BC24,-   0x7B77497B32503B12, 0x8547EDDFB81CCB94, 0x79999CDFF70902CB, 0xCFFE1939438E9B24,-   0x829626E3892D95D7, 0x92FAE24291F2B3F1, 0x63E22C147B9C3403, 0xC678B6D860284A1C,-   0x5873888850659AE7, 0x0981DCD296A8736D, 0x9F65789A6509A440, 0x9FF38FED72E9052F,-   0xE479EE5B9930578C, 0xE7F28ECD2D49EECD, 0x56C074A581EA17FE, 0x5544F7D774B14AEF,-   0x7B3F0195FC6F290F, 0x12153635B2C0CF57, 0x7F5126DBBA5E0CA7, 0x7A76956C3EAFB413,-   0x3D5774A11D31AB39, 0x8A1B083821F40CB4, 0x7B4A38E32537DF62, 0x950113646D1D6E03,-   0x4DA8979A0041E8A9, 0x3BC36E078F7515D7, 0x5D0A12F27AD310D1, 0x7F9D1A2E1EBE1327,-   0xDA3A361B1C5157B1, 0xDCDD7D20903D0C25, 0x36833336D068F707, 0xCE68341F79893389,-   0xAB9090168DD05F34, 0x43954B3252DC25E5, 0xB438C2B67F98E5E9, 0x10DCD78E3851A492,-   0xDBC27AB5447822BF, 0x9B3CDB65F82CA382, 0xB67B7896167B4C84, 0xBFCED1B0048EAC50,-   0xA9119B60369FFEBD, 0x1FFF7AC80904BF45, 0xAC12FB171817EEE7, 0xAF08DA9177DDA93D,-   0x1B0CAB936E65C744, 0xB559EB1D04E5E932, 0xC37B45B3F8D6F2BA, 0xC3A9DC228CAAC9E9,-   0xF3B8B6675A6507FF, 0x9FC477DE4ED681DA, 0x67378D8ECCEF96CB, 0x6DD856D94D259236,-   0xA319CE15B0B4DB31, 0x073973751F12DD5E, 0x8A8E849EB32781A5, 0xE1925C71285279F5,-   0x74C04BF1790C0EFE, 0x4DDA48153C94938A, 0x9D266D6A1CC0542C, 0x7440FB816508C4FE,-   0x13328503DF48229F, 0xD6BF7BAEE43CAC40, 0x4838D65F6EF6748F, 0x1E152328F3318DEA,-   0x8F8419A348F296BF, 0x72C8834A5957B511, 0xD7A023A73260B45C, 0x94EBC8ABCFB56DAE,-   0x9FC10D0F989993E0, 0xDE68A2355B93CAE6, 0xA44CFE79AE538BBE, 0x9D1D84FCCE371425,-   0x51D2B1AB2DDFB636, 0x2FD7E4B9E72CD38C, 0x65CA5B96B7552210, 0xDD69A0D8AB3B546D,-   0x604D51B25FBF70E2, 0x73AA8A564FB7AC9E, 0x1A8C1E992B941148, 0xAAC40A2703D9BEA0,-   0x764DBEAE7FA4F3A6, 0x1E99B96E70A9BE8B, 0x2C5E9DEB57EF4743, 0x3A938FEE32D29981,-   0x26E6DB8FFDF5ADFE, 0x469356C504EC9F9D, 0xC8763C5B08D1908C, 0x3F6C6AF859D80055,-   0x7F7CC39420A3A545, 0x9BFB227EBDF4C5CE, 0x89039D79D6FC5C5C, 0x8FE88B57305E2AB6,-   0xA09E8C8C35AB96DE, 0xFA7E393983325753, 0xD6B6D0ECC617C699, 0xDFEA21EA9E7557E3,-   0xB67C1FA481680AF8, 0xCA1E3785A9E724E5, 0x1CFC8BED0D681639, 0xD18D8549D140CAEA,-   0x4ED0FE7E9DC91335, 0xE4DBF0634473F5D2, 0x1761F93A44D5AEFE, 0x53898E4C3910DA55,-   0x734DE8181F6EC39A, 0x2680B122BAA28D97, 0x298AF231C85BAFAB, 0x7983EED3740847D5,-   0x66C1A2A1A60CD889, 0x9E17E49642A3E4C1, 0xEDB454E7BADC0805, 0x50B704CAB602C329,-   0x4CC317FB9CDDD023, 0x66B4835D9EAFEA22, 0x219B97E26FFC81BD, 0x261E4E4C0A333A9D,-   0x1FE2CCA76517DB90, 0xD7504DFA8816EDBB, 0xB9571FA04DC089C8, 0x1DDC0325259B27DE,-   0xCF3F4688801EB9AA, 0xF4F5D05C10CAB243, 0x38B6525C21A42B0E, 0x36F60E2BA4FA6800,-   0xEB3593803173E0CE, 0x9C4CD6257C5A3603, 0xAF0C317D32ADAA8A, 0x258E5A80C7204C4B,-   0x8B889D624D44885D, 0xF4D14597E660F855, 0xD4347F66EC8941C3, 0xE699ED85B0DFB40D,-   0x2472F6207C2D0484, 0xC2A1E7B5B459AEB5, 0xAB4F6451CC1D45EC, 0x63767572AE3D6174,-   0xA59E0BD101731A28, 0x116D0016CB948F09, 0x2CF9C8CA052F6E9F, 0x0B090A7560A968E3,-   0xABEEDDB2DDE06FF1, 0x58EFC10B06A2068D, 0xC6E57A78FBD986E0, 0x2EAB8CA63CE802D7,-   0x14A195640116F336, 0x7C0828DD624EC390, 0xD74BBE77E6116AC7, 0x804456AF10F5FB53,-   0xEBE9EA2ADF4321C7, 0x03219A39EE587A30, 0x49787FEF17AF9924, 0xA1E9300CD8520548,-   0x5B45E522E4B1B4EF, 0xB49C3B3995091A36, 0xD4490AD526F14431, 0x12A8F216AF9418C2,-   0x001F837CC7350524, 0x1877B51E57A764D5, 0xA2853B80F17F58EE, 0x993E1DE72D36D310,-   0xB3598080CE64A656, 0x252F59CF0D9F04BB, 0xD23C8E176D113600, 0x1BDA0492E7E4586E,-   0x21E0BD5026C619BF, 0x3B097ADAF088F94E, 0x8D14DEDB30BE846E, 0xF95CFFA23AF5F6F4,-   0x3871700761B3F743, 0xCA672B91E9E4FA16, 0x64C8E531BFF53B55, 0x241260ED4AD1E87D,-   0x106C09B972D2E822, 0x7FBA195410E5CA30, 0x7884D9BC6CB569D8, 0x0647DFEDCD894A29,-   0x63573FF03E224774, 0x4FC8E9560F91B123, 0x1DB956E450275779, 0xB8D91274B9E9D4FB,-   0xA2EBEE47E2FBFCE1, 0xD9F1F30CCD97FB09, 0xEFED53D75FD64E6B, 0x2E6D02C36017F67F,-   0xA9AA4D20DB084E9B, 0xB64BE8D8B25396C1, 0x70CB6AF7C2D5BCF0, 0x98F076A4F7A2322E,-   0xBF84470805E69B5F, 0x94C3251F06F90CF3, 0x3E003E616A6591E9, 0xB925A6CD0421AFF3,-   0x61BDD1307C66E300, 0xBF8D5108E27E0D48, 0x240AB57A8B888B20, 0xFC87614BAF287E07,-   0xEF02CDD06FFDB432, 0xA1082C0466DF6C0A, 0x8215E577001332C8, 0xD39BB9C3A48DB6CF,-   0x2738259634305C14, 0x61CF4F94C97DF93D, 0x1B6BACA2AE4E125B, 0x758F450C88572E0B,-   0x959F587D507A8359, 0xB063E962E045F54D, 0x60E8ED72C0DFF5D1, 0x7B64978555326F9F,-   0xFD080D236DA814BA, 0x8C90FD9B083F4558, 0x106F72FE81E2C590, 0x7976033A39F7D952,-   0xA4EC0132764CA04B, 0x733EA705FAE4FA77, 0xB4D8F77BC3E56167, 0x9E21F4F903B33FD9,-   0x9D765E419FB69F6D, 0xD30C088BA61EA5EF, 0x5D94337FBFAF7F5B, 0x1A4E4822EB4D7A59,-   0x6FFE73E81B637FB3, 0xDDF957BC36D8B9CA, 0x64D0E29EEA8838B3, 0x08DD9BDFD96B9F63,-   0x087E79E5A57D1D13, 0xE328E230E3E2B3FB, 0x1C2559E30F0946BE, 0x720BF5F26F4D2EAA,-   0xB0774D261CC609DB, 0x443F64EC5A371195, 0x4112CF68649A260E, 0xD813F2FAB7F5C5CA,-   0x660D3257380841EE, 0x59AC2C7873F910A3, 0xE846963877671A17, 0x93B633ABFA3469F8,-   0xC0C0F5A60EF4CDCF, 0xCAF21ECD4377B28C, 0x57277707199B8175, 0x506C11B9D90E8B1D,-   0xD83CC2687A19255F, 0x4A29C6465A314CD1, 0xED2DF21216235097, 0xB5635C95FF7296E2,-   0x22AF003AB672E811, 0x52E762596BF68235, 0x9AEBA33AC6ECC6B0, 0x944F6DE09134DFB6,-   0x6C47BEC883A7DE39, 0x6AD047C430A12104, 0xA5B1CFDBA0AB4067, 0x7C45D833AFF07862,-   0x5092EF950A16DA0B, 0x9338E69C052B8E7B, 0x455A4B4CFE30E3F5, 0x6B02E63195AD0CF8,-   0x6B17B224BAD6BF27, 0xD1E0CCD25BB9C169, 0xDE0C89A556B9AE70, 0x50065E535A213CF6,-   0x9C1169FA2777B874, 0x78EDEFD694AF1EED, 0x6DC93D9526A50E68, 0xEE97F453F06791ED,-   0x32AB0EDB696703D3, 0x3A6853C7E70757A7, 0x31865CED6120F37D, 0x67FEF95D92607890,-   0x1F2B1D1F15F6DC9C, 0xB69E38A8965C6B65, 0xAA9119FF184CCCF4, 0xF43C732873F24C13,-   0xFB4A3D794A9A80D2, 0x3550C2321FD6109C, 0x371F77E76BB8417E, 0x6BFA9AAE5EC05779,-   0xCD04F3FF001A4778, 0xE3273522064480CA, 0x9F91508BFFCFC14A, 0x049A7F41061A9E60,-   0xFCB6BE43A9F2FE9B, 0x08DE8A1C7797DA9B, 0x8F9887E6078735A1, 0xB5B4071DBFC73A66,-   0x230E343DFBA08D33, 0x43ED7F5A0FAE657D, 0x3A88A0FBBCB05C63, 0x21874B8B4D2DBC4F,-   0x1BDEA12E35F6A8C9, 0x53C065C6C8E63528, 0xE34A1D250E7A8D6B, 0xD6B04D3B7651DD7E,-   0x5E90277E7CB39E2D, 0x2C046F22062DC67D, 0xB10BB459132D0A26, 0x3FA9DDFB67E2F199,-   0x0E09B88E1914F7AF, 0x10E8B35AF3EEAB37, 0x9EEDECA8E272B933, 0xD4C718BC4AE8AE5F,-   0x81536D601170FC20, 0x91B534F885818A06, 0xEC8177F83F900978, 0x190E714FADA5156E,-   0xB592BF39B0364963, 0x89C350C893AE7DC1, 0xAC042E70F8B383F2, 0xB49B52E587A1EE60,-   0xFB152FE3FF26DA89, 0x3E666E6F69AE2C15, 0x3B544EBE544C19F9, 0xE805A1E290CF2456,-   0x24B33C9D7ED25117, 0xE74733427B72F0C1, 0x0A804D18B7097475, 0x57E3306D881EDB4F,-   0x4AE7D6A36EB5DBCB, 0x2D8D5432157064C8, 0xD1E649DE1E7F268B, 0x8A328A1CEDFE552C,-   0x07A3AEC79624C7DA, 0x84547DDC3E203C94, 0x990A98FD5071D263, 0x1A4FF12616EEFC89,-   0xF6F7FD1431714200, 0x30C05B1BA332F41C, 0x8D2636B81555A786, 0x46C9FEB55D120902,-   0xCCEC0A73B49C9921, 0x4E9D2827355FC492, 0x19EBB029435DCB0F, 0x4659D2B743848A2C,-   0x963EF2C96B33BE31, 0x74F85198B05A2E7D, 0x5A0F544DD2B1FB18, 0x03727073C2E134B1,-   0xC7F6AA2DE59AEA61, 0x352787BAA0D7C22F, 0x9853EAB63B5E0B35, 0xABBDCDD7ED5C0860,-   0xCF05DAF5AC8D77B0, 0x49CAD48CEBF4A71E, 0x7A4C10EC2158C4A6, 0xD9E92AA246BF719E,-   0x13AE978D09FE5557, 0x730499AF921549FF, 0x4E4B705B92903BA4, 0xFF577222C14F0A3A,-   0x55B6344CF97AAFAE, 0xB862225B055B6960, 0xCAC09AFBDDD2CDB4, 0xDAF8E9829FE96B5F,-   0xB5FDFC5D3132C498, 0x310CB380DB6F7503, 0xE87FBB46217A360E, 0x2102AE466EBB1148,-   0xF8549E1A3AA5E00D, 0x07A69AFDCC42261A, 0xC4C118BFE78FEAAE, 0xF9F4892ED96BD438,-   0x1AF3DBE25D8F45DA, 0xF5B4B0B0D2DEEEB4, 0x962ACEEFA82E1C84, 0x046E3ECAAF453CE9,-   0xF05D129681949A4C, 0x964781CE734B3C84, 0x9C2ED44081CE5FBD, 0x522E23F3925E319E,-   0x177E00F9FC32F791, 0x2BC60A63A6F3B3F2, 0x222BBFAE61725606, 0x486289DDCC3D6780,-   0x7DC7785B8EFDFC80, 0x8AF38731C02BA980, 0x1FAB64EA29A2DDF7, 0xE4D9429322CD065A,-   0x9DA058C67844F20C, 0x24C0E332B70019B0, 0x233003B5A6CFE6AD, 0xD586BD01C5C217F6,-   0x5E5637885F29BC2B, 0x7EBA726D8C94094B, 0x0A56A5F0BFE39272, 0xD79476A84EE20D06,-   0x9E4C1269BAA4BF37, 0x17EFEE45B0DEE640, 0x1D95B0A5FCF90BC6, 0x93CBE0B699C2585D,-   0x65FA4F227A2B6D79, 0xD5F9E858292504D5, 0xC2B5A03F71471A6F, 0x59300222B4561E00,-   0xCE2F8642CA0712DC, 0x7CA9723FBB2E8988, 0x2785338347F2BA08, 0xC61BB3A141E50E8C,-   0x150F361DAB9DEC26, 0x9F6A419D382595F4, 0x64A53DC924FE7AC9, 0x142DE49FFF7A7C3D,-   0x0C335248857FA9E7, 0x0A9C32D5EAE45305, 0xE6C42178C4BBB92E, 0x71F1CE2490D20B07,-   0xF1BCC3D275AFE51A, 0xE728E8C83C334074, 0x96FBF83A12884624, 0x81A1549FD6573DA5,-   0x5FA7867CAF35E149, 0x56986E2EF3ED091B, 0x917F1DD5F8886C61, 0xD20D8C88C8FFE65F+  ,0xC547F57E42A7444E,0x78E37644E7CAD29E,0xFE9A44E9362F05FA,0x08BD35CC38336615+  ,0x9315E5EB3A129ACE,0x94061B871E04DF75,0xDF1D9F9D784BA010,0x3BBA57B68871B59D+  ,0xD2B7ADEEDED1F73F,0xF7A255D83BC373F8,0xD7F4F2448C0CEB81,0xD95BE88CD210FFA7+  ,0x336F52F8FF4728E7,0xA74049DAC312AC71,0xA2F61BB6E437FDB5,0x4F2A5CB07F6A35B3+  ,0x87D380BDA5BF7859,0x16B9F7E06C453A21,0x7BA2484C8A0FD54E,0xF3A678CAD9A2E38C+  ,0x39B0BF7DDE437BA2,0xFCAF55C1BF8A4424,0x18FCF680573FA594,0x4C0563B89F495AC3+  ,0x40E087931A00930D,0x8CFFA9412EB642C1,0x68CA39053261169F,0x7A1EE967D27579E2+  ,0x9D1D60E5076F5B6F,0x3810E399B6F65BA2,0x32095B6D4AB5F9B1,0x35CAB62109DD038A+  ,0xA90B24499FCFAFB1,0x77A225A07CC2C6BD,0x513E5E634C70E331,0x4361C0CA3F692F12+  ,0xD941ACA44B20A45B,0x528F7C8602C5807B,0x52AB92BEB9613989,0x9D1DFA2EFC557F73+  ,0x722FF175F572C348,0x1D1260A51107FE97,0x7A249A57EC0C9BA2,0x04208FE9E8F7F2D6+  ,0x5A110C6058B920A0,0x0CD9A497658A5698,0x56FD23C8F9715A4C,0x284C847B9D887AAE+  ,0x04FEABFBBDB619CB,0x742E1E651C60BA83,0x9A9632E65904AD3C,0x881B82A13B51B9E2+  ,0x506E6744CD974924,0xB0183DB56FFC6A79,0x0ED9B915C66ED37E,0x5E11E86D5873D484+  ,0xF678647E3519AC6E,0x1B85D488D0F20CC5,0xDAB9FE6525D89021,0x0D151D86ADB73615+  ,0xA865A54EDCC0F019,0x93C42566AEF98FFB,0x99E7AFEABE000731,0x48CBFF086DDF285A+  ,0x7F9B6AF1EBF78BAF,0x58627E1A149BBA21,0x2CD16E2ABD791E33,0xD363EFF5F0977996+  ,0x0CE2A38C344A6EED,0x1A804AADB9CFA741,0x907F30421D78C5DE,0x501F65EDB3034D07+  ,0x37624AE5A48FA6E9,0x957BAF61700CFF4E,0x3A6C27934E31188A,0xD49503536ABCA345+  ,0x088E049589C432E0,0xF943AEE7FEBF21B8,0x6C3B8E3E336139D3,0x364F6FFA464EE52E+  ,0xD60F6DCEDC314222,0x56963B0DCA418FC0,0x16F50EDF91E513AF,0xEF1955914B609F93+  ,0x565601C0364E3228,0xECB53939887E8175,0xBAC7A9A18531294B,0xB344C470397BBA52+  ,0x65D34954DAF3CEBD,0xB4B81B3FA97511E2,0xB422061193D6F6A7,0x071582401C38434D+  ,0x7A13F18BBEDC4FF5,0xBC4097B116C524D2,0x59B97885E2F2EA28,0x99170A5DC3115544+  ,0x6F423357E7C6A9F9,0x325928EE6E6F8794,0xD0E4366228B03343,0x565C31F7DE89EA27+  ,0x30F5611484119414,0xD873DB391292ED4F,0x7BD94E1D8E17DEBC,0xC7D9F16864A76E94+  ,0x947AE053EE56E63C,0xC8C93882F9475F5F,0x3A9BF55BA91F81CA,0xD9A11FBB3D9808E4+  ,0x0FD22063EDC29FCA,0xB3F256D8ACA0B0B9,0xB03031A8B4516E84,0x35DD37D5871448AF+  ,0xE9F6082B05542E4E,0xEBFAFA33D7254B59,0x9255ABB50D532280,0xB9AB4CE57F2D34F3+  ,0x693501D628297551,0xC62C58F97DD949BF,0xCD454F8F19C5126A,0xBBE83F4ECC2BDECB+  ,0xDC842B7E2819E230,0xBA89142E007503B8,0xA3BC941D0A5061CB,0xE9F6760E32CD8021+  ,0x09C7E552BC76492F,0x852F54934DA55CC9,0x8107FCCF064FCF56,0x098954D51FFF6580+  ,0x23B70EDB1955C4BF,0xC330DE426430F69D,0x4715ED43E8A45C0A,0xA8D7E4DAB780A08D+  ,0x0572B974F03CE0BB,0xB57D2E985E1419C7,0xE8D9ECBE2CF3D73F,0x2FE4B17170E59750+  ,0x11317BA87905E790,0x7FBF21EC8A1F45EC,0x1725CABFCB045B00,0x964E915CD5E2B207+  ,0x3E2B8BCBF016D66D,0xBE7444E39328A0AC,0xF85B2B4FBCDE44B7,0x49353FEA39BA63B1+  ,0x1DD01AAFCD53486A,0x1FCA8A92FD719F85,0xFC7C95D827357AFA,0x18A6A990C8B35EBD+  ,0xCCCB7005C6B9C28D,0x3BDBB92C43B17F26,0xAA70B5B4F89695A2,0xE94C39A54A98307F+  ,0xB7A0B174CFF6F36E,0xD4DBA84729AF48AD,0x2E18BC1AD9704A68,0x2DE0966DAF2F8B1C+  ,0xB9C11D5B1E43A07E,0x64972D68DEE33360,0x94628D38D0C20584,0xDBC0D2B6AB90A559+  ,0xD2733C4335C6A72F,0x7E75D99D94A70F4D,0x6CED1983376FA72B,0x97FCAACBF030BC24+  ,0x7B77497B32503B12,0x8547EDDFB81CCB94,0x79999CDFF70902CB,0xCFFE1939438E9B24+  ,0x829626E3892D95D7,0x92FAE24291F2B3F1,0x63E22C147B9C3403,0xC678B6D860284A1C+  ,0x5873888850659AE7,0x0981DCD296A8736D,0x9F65789A6509A440,0x9FF38FED72E9052F+  ,0xE479EE5B9930578C,0xE7F28ECD2D49EECD,0x56C074A581EA17FE,0x5544F7D774B14AEF+  ,0x7B3F0195FC6F290F,0x12153635B2C0CF57,0x7F5126DBBA5E0CA7,0x7A76956C3EAFB413+  ,0x3D5774A11D31AB39,0x8A1B083821F40CB4,0x7B4A38E32537DF62,0x950113646D1D6E03+  ,0x4DA8979A0041E8A9,0x3BC36E078F7515D7,0x5D0A12F27AD310D1,0x7F9D1A2E1EBE1327+  ,0xDA3A361B1C5157B1,0xDCDD7D20903D0C25,0x36833336D068F707,0xCE68341F79893389+  ,0xAB9090168DD05F34,0x43954B3252DC25E5,0xB438C2B67F98E5E9,0x10DCD78E3851A492+  ,0xDBC27AB5447822BF,0x9B3CDB65F82CA382,0xB67B7896167B4C84,0xBFCED1B0048EAC50+  ,0xA9119B60369FFEBD,0x1FFF7AC80904BF45,0xAC12FB171817EEE7,0xAF08DA9177DDA93D+  ,0x1B0CAB936E65C744,0xB559EB1D04E5E932,0xC37B45B3F8D6F2BA,0xC3A9DC228CAAC9E9+  ,0xF3B8B6675A6507FF,0x9FC477DE4ED681DA,0x67378D8ECCEF96CB,0x6DD856D94D259236+  ,0xA319CE15B0B4DB31,0x073973751F12DD5E,0x8A8E849EB32781A5,0xE1925C71285279F5+  ,0x74C04BF1790C0EFE,0x4DDA48153C94938A,0x9D266D6A1CC0542C,0x7440FB816508C4FE+  ,0x13328503DF48229F,0xD6BF7BAEE43CAC40,0x4838D65F6EF6748F,0x1E152328F3318DEA+  ,0x8F8419A348F296BF,0x72C8834A5957B511,0xD7A023A73260B45C,0x94EBC8ABCFB56DAE+  ,0x9FC10D0F989993E0,0xDE68A2355B93CAE6,0xA44CFE79AE538BBE,0x9D1D84FCCE371425+  ,0x51D2B1AB2DDFB636,0x2FD7E4B9E72CD38C,0x65CA5B96B7552210,0xDD69A0D8AB3B546D+  ,0x604D51B25FBF70E2,0x73AA8A564FB7AC9E,0x1A8C1E992B941148,0xAAC40A2703D9BEA0+  ,0x764DBEAE7FA4F3A6,0x1E99B96E70A9BE8B,0x2C5E9DEB57EF4743,0x3A938FEE32D29981+  ,0x26E6DB8FFDF5ADFE,0x469356C504EC9F9D,0xC8763C5B08D1908C,0x3F6C6AF859D80055+  ,0x7F7CC39420A3A545,0x9BFB227EBDF4C5CE,0x89039D79D6FC5C5C,0x8FE88B57305E2AB6+  ,0xA09E8C8C35AB96DE,0xFA7E393983325753,0xD6B6D0ECC617C699,0xDFEA21EA9E7557E3+  ,0xB67C1FA481680AF8,0xCA1E3785A9E724E5,0x1CFC8BED0D681639,0xD18D8549D140CAEA+  ,0x4ED0FE7E9DC91335,0xE4DBF0634473F5D2,0x1761F93A44D5AEFE,0x53898E4C3910DA55+  ,0x734DE8181F6EC39A,0x2680B122BAA28D97,0x298AF231C85BAFAB,0x7983EED3740847D5+  ,0x66C1A2A1A60CD889,0x9E17E49642A3E4C1,0xEDB454E7BADC0805,0x50B704CAB602C329+  ,0x4CC317FB9CDDD023,0x66B4835D9EAFEA22,0x219B97E26FFC81BD,0x261E4E4C0A333A9D+  ,0x1FE2CCA76517DB90,0xD7504DFA8816EDBB,0xB9571FA04DC089C8,0x1DDC0325259B27DE+  ,0xCF3F4688801EB9AA,0xF4F5D05C10CAB243,0x38B6525C21A42B0E,0x36F60E2BA4FA6800+  ,0xEB3593803173E0CE,0x9C4CD6257C5A3603,0xAF0C317D32ADAA8A,0x258E5A80C7204C4B+  ,0x8B889D624D44885D,0xF4D14597E660F855,0xD4347F66EC8941C3,0xE699ED85B0DFB40D+  ,0x2472F6207C2D0484,0xC2A1E7B5B459AEB5,0xAB4F6451CC1D45EC,0x63767572AE3D6174+  ,0xA59E0BD101731A28,0x116D0016CB948F09,0x2CF9C8CA052F6E9F,0x0B090A7560A968E3+  ,0xABEEDDB2DDE06FF1,0x58EFC10B06A2068D,0xC6E57A78FBD986E0,0x2EAB8CA63CE802D7+  ,0x14A195640116F336,0x7C0828DD624EC390,0xD74BBE77E6116AC7,0x804456AF10F5FB53+  ,0xEBE9EA2ADF4321C7,0x03219A39EE587A30,0x49787FEF17AF9924,0xA1E9300CD8520548+  ,0x5B45E522E4B1B4EF,0xB49C3B3995091A36,0xD4490AD526F14431,0x12A8F216AF9418C2+  ,0x001F837CC7350524,0x1877B51E57A764D5,0xA2853B80F17F58EE,0x993E1DE72D36D310+  ,0xB3598080CE64A656,0x252F59CF0D9F04BB,0xD23C8E176D113600,0x1BDA0492E7E4586E+  ,0x21E0BD5026C619BF,0x3B097ADAF088F94E,0x8D14DEDB30BE846E,0xF95CFFA23AF5F6F4+  ,0x3871700761B3F743,0xCA672B91E9E4FA16,0x64C8E531BFF53B55,0x241260ED4AD1E87D+  ,0x106C09B972D2E822,0x7FBA195410E5CA30,0x7884D9BC6CB569D8,0x0647DFEDCD894A29+  ,0x63573FF03E224774,0x4FC8E9560F91B123,0x1DB956E450275779,0xB8D91274B9E9D4FB+  ,0xA2EBEE47E2FBFCE1,0xD9F1F30CCD97FB09,0xEFED53D75FD64E6B,0x2E6D02C36017F67F+  ,0xA9AA4D20DB084E9B,0xB64BE8D8B25396C1,0x70CB6AF7C2D5BCF0,0x98F076A4F7A2322E+  ,0xBF84470805E69B5F,0x94C3251F06F90CF3,0x3E003E616A6591E9,0xB925A6CD0421AFF3+  ,0x61BDD1307C66E300,0xBF8D5108E27E0D48,0x240AB57A8B888B20,0xFC87614BAF287E07+  ,0xEF02CDD06FFDB432,0xA1082C0466DF6C0A,0x8215E577001332C8,0xD39BB9C3A48DB6CF+  ,0x2738259634305C14,0x61CF4F94C97DF93D,0x1B6BACA2AE4E125B,0x758F450C88572E0B+  ,0x959F587D507A8359,0xB063E962E045F54D,0x60E8ED72C0DFF5D1,0x7B64978555326F9F+  ,0xFD080D236DA814BA,0x8C90FD9B083F4558,0x106F72FE81E2C590,0x7976033A39F7D952+  ,0xA4EC0132764CA04B,0x733EA705FAE4FA77,0xB4D8F77BC3E56167,0x9E21F4F903B33FD9+  ,0x9D765E419FB69F6D,0xD30C088BA61EA5EF,0x5D94337FBFAF7F5B,0x1A4E4822EB4D7A59+  ,0x6FFE73E81B637FB3,0xDDF957BC36D8B9CA,0x64D0E29EEA8838B3,0x08DD9BDFD96B9F63+  ,0x087E79E5A57D1D13,0xE328E230E3E2B3FB,0x1C2559E30F0946BE,0x720BF5F26F4D2EAA+  ,0xB0774D261CC609DB,0x443F64EC5A371195,0x4112CF68649A260E,0xD813F2FAB7F5C5CA+  ,0x660D3257380841EE,0x59AC2C7873F910A3,0xE846963877671A17,0x93B633ABFA3469F8+  ,0xC0C0F5A60EF4CDCF,0xCAF21ECD4377B28C,0x57277707199B8175,0x506C11B9D90E8B1D+  ,0xD83CC2687A19255F,0x4A29C6465A314CD1,0xED2DF21216235097,0xB5635C95FF7296E2+  ,0x22AF003AB672E811,0x52E762596BF68235,0x9AEBA33AC6ECC6B0,0x944F6DE09134DFB6+  ,0x6C47BEC883A7DE39,0x6AD047C430A12104,0xA5B1CFDBA0AB4067,0x7C45D833AFF07862+  ,0x5092EF950A16DA0B,0x9338E69C052B8E7B,0x455A4B4CFE30E3F5,0x6B02E63195AD0CF8+  ,0x6B17B224BAD6BF27,0xD1E0CCD25BB9C169,0xDE0C89A556B9AE70,0x50065E535A213CF6+  ,0x9C1169FA2777B874,0x78EDEFD694AF1EED,0x6DC93D9526A50E68,0xEE97F453F06791ED+  ,0x32AB0EDB696703D3,0x3A6853C7E70757A7,0x31865CED6120F37D,0x67FEF95D92607890+  ,0x1F2B1D1F15F6DC9C,0xB69E38A8965C6B65,0xAA9119FF184CCCF4,0xF43C732873F24C13+  ,0xFB4A3D794A9A80D2,0x3550C2321FD6109C,0x371F77E76BB8417E,0x6BFA9AAE5EC05779+  ,0xCD04F3FF001A4778,0xE3273522064480CA,0x9F91508BFFCFC14A,0x049A7F41061A9E60+  ,0xFCB6BE43A9F2FE9B,0x08DE8A1C7797DA9B,0x8F9887E6078735A1,0xB5B4071DBFC73A66+  ,0x230E343DFBA08D33,0x43ED7F5A0FAE657D,0x3A88A0FBBCB05C63,0x21874B8B4D2DBC4F+  ,0x1BDEA12E35F6A8C9,0x53C065C6C8E63528,0xE34A1D250E7A8D6B,0xD6B04D3B7651DD7E+  ,0x5E90277E7CB39E2D,0x2C046F22062DC67D,0xB10BB459132D0A26,0x3FA9DDFB67E2F199+  ,0x0E09B88E1914F7AF,0x10E8B35AF3EEAB37,0x9EEDECA8E272B933,0xD4C718BC4AE8AE5F+  ,0x81536D601170FC20,0x91B534F885818A06,0xEC8177F83F900978,0x190E714FADA5156E+  ,0xB592BF39B0364963,0x89C350C893AE7DC1,0xAC042E70F8B383F2,0xB49B52E587A1EE60+  ,0xFB152FE3FF26DA89,0x3E666E6F69AE2C15,0x3B544EBE544C19F9,0xE805A1E290CF2456+  ,0x24B33C9D7ED25117,0xE74733427B72F0C1,0x0A804D18B7097475,0x57E3306D881EDB4F+  ,0x4AE7D6A36EB5DBCB,0x2D8D5432157064C8,0xD1E649DE1E7F268B,0x8A328A1CEDFE552C+  ,0x07A3AEC79624C7DA,0x84547DDC3E203C94,0x990A98FD5071D263,0x1A4FF12616EEFC89+  ,0xF6F7FD1431714200,0x30C05B1BA332F41C,0x8D2636B81555A786,0x46C9FEB55D120902+  ,0xCCEC0A73B49C9921,0x4E9D2827355FC492,0x19EBB029435DCB0F,0x4659D2B743848A2C+  ,0x963EF2C96B33BE31,0x74F85198B05A2E7D,0x5A0F544DD2B1FB18,0x03727073C2E134B1+  ,0xC7F6AA2DE59AEA61,0x352787BAA0D7C22F,0x9853EAB63B5E0B35,0xABBDCDD7ED5C0860+  ,0xCF05DAF5AC8D77B0,0x49CAD48CEBF4A71E,0x7A4C10EC2158C4A6,0xD9E92AA246BF719E+  ,0x13AE978D09FE5557,0x730499AF921549FF,0x4E4B705B92903BA4,0xFF577222C14F0A3A+  ,0x55B6344CF97AAFAE,0xB862225B055B6960,0xCAC09AFBDDD2CDB4,0xDAF8E9829FE96B5F+  ,0xB5FDFC5D3132C498,0x310CB380DB6F7503,0xE87FBB46217A360E,0x2102AE466EBB1148+  ,0xF8549E1A3AA5E00D,0x07A69AFDCC42261A,0xC4C118BFE78FEAAE,0xF9F4892ED96BD438+  ,0x1AF3DBE25D8F45DA,0xF5B4B0B0D2DEEEB4,0x962ACEEFA82E1C84,0x046E3ECAAF453CE9+  ,0xF05D129681949A4C,0x964781CE734B3C84,0x9C2ED44081CE5FBD,0x522E23F3925E319E+  ,0x177E00F9FC32F791,0x2BC60A63A6F3B3F2,0x222BBFAE61725606,0x486289DDCC3D6780+  ,0x7DC7785B8EFDFC80,0x8AF38731C02BA980,0x1FAB64EA29A2DDF7,0xE4D9429322CD065A+  ,0x9DA058C67844F20C,0x24C0E332B70019B0,0x233003B5A6CFE6AD,0xD586BD01C5C217F6+  ,0x5E5637885F29BC2B,0x7EBA726D8C94094B,0x0A56A5F0BFE39272,0xD79476A84EE20D06+  ,0x9E4C1269BAA4BF37,0x17EFEE45B0DEE640,0x1D95B0A5FCF90BC6,0x93CBE0B699C2585D+  ,0x65FA4F227A2B6D79,0xD5F9E858292504D5,0xC2B5A03F71471A6F,0x59300222B4561E00+  ,0xCE2F8642CA0712DC,0x7CA9723FBB2E8988,0x2785338347F2BA08,0xC61BB3A141E50E8C+  ,0x150F361DAB9DEC26,0x9F6A419D382595F4,0x64A53DC924FE7AC9,0x142DE49FFF7A7C3D+  ,0x0C335248857FA9E7,0x0A9C32D5EAE45305,0xE6C42178C4BBB92E,0x71F1CE2490D20B07+  ,0xF1BCC3D275AFE51A,0xE728E8C83C334074,0x96FBF83A12884624,0x81A1549FD6573DA5+  ,0x5FA7867CAF35E149,0x56986E2EF3ED091B,0x917F1DD5F8886C61,0xD20D8C88C8FFE65F   ] -castleKeys = Unboxed.fromList-  [ 0x31D71DCE64B2C310, 0xF165B587DF898190-  , 0xA57E6339DD2CF3A0, 0x1EF6E6DBB1961EC9+castleKeys = fromList+  [0x31D71DCE64B2C310,0xF165B587DF898190+  ,0xA57E6339DD2CF3A0,0x1EF6E6DBB1961EC9   ] -epKeys = Unboxed.fromList+epKeys = fromList   [0x70CC73D90BC26E24,0xE21A6B35DF0C3AD7,0x003A93D8B2806962,0x1C99DED33CB890A1   ,0xCF3145DE0ADD4289,0xD0E4427A5514FB72,0x77C621CC9FB3A483,0x67A34DAC4356550B   ]

@@ -28,7 +28,7 @@ import           Data.Bifunctor             (first) import qualified Data.ByteString            as Strict (ByteString) import qualified Data.ByteString.Lazy       as Lazy (ByteString)-import           Data.Char                  (chr, ord)+import           Data.Char                  (ord) import           Data.Functor               (($>)) import           Data.List                  (sortOn) import           Data.List.Extra            (chunksOf)@@ -45,7 +45,14 @@ import           GHC.Stack                  (HasCallStack) import           Game.Chess.Internal        (Castle (Kingside, Queenside),                                              Color (Black, White),-                                             PieceType (..), Ply,+                                             PieceType,+                                             pattern Pawn,+                                             pattern Knight,+                                             pattern Bishop,+                                             pattern Rook,+                                             pattern Queen,+                                             pattern King,+                                             Ply,                                              Position (color, moveNumber),                                              bKscm, bQscm, canCastleKingside,                                              canCastleQueenside, doPly, inCheck,@@ -166,7 +173,7 @@     case filter (pieceFrom p) ms of       [] -> fail $ show (color pos) <> " has no " <> show p <> " which could be moved"       ms' -> target p ms'-  pieceFrom p (plySource -> from) = p == snd (fromJust (pieceAt pos from))+  pieceFrom p (plySource -> src) = p == snd (fromJust (pieceAt pos src))   target p ms = coords p ms >>= \m@(plyTarget -> to) -> case p of     Pawn | lastRank to -> promoteTo m <$> promotion     _                  -> pure m@@ -190,9 +197,9 @@ relaxedSAN pos = (castling pos <|> normal) <* optional sanStatus where   normal = do     pc <- sanPiece <|> pure Pawn-    (from, _, to) <- conv <$> location+    (src, _, dst) <- conv <$> location     prm <- optional $ optional (chunk "=") *> promotionPiece-    case possible pc from to prm of+    case possible pc src dst prm of       [m] -> pure m       []  -> fail "Illegal move"       _   -> fail "Ambiguous move"@@ -207,15 +214,15 @@          <|>      (Nothing,Nothing,,) <$> capture <*> squareP   capture = option False $ chunk "x" $> True   ms = legalPlies pos-  possible pc from to prm = filter (f from) ms where-    f (Just (RF sq)) (unpack -> (from', to', prm')) =-      pAt from' == pc && from' == sq && to' == to && prm' == prm-    f (Just (F ff)) (unpack -> (from', to', prm')) =-      pAt from' == pc && file from' == ff && to == to' && prm == prm'-    f (Just (R fr)) (unpack -> (from', to', prm')) =-      pAt from' == pc && rank from' == fr && to == to' && prm == prm'-    f Nothing (unpack -> (from', to', prm')) =-      pAt from' == pc && to == to' && prm == prm'+  possible pc src dst prm = filter (f src) ms where+    f (Just (RF sq)) (unpack -> (src', dst', prm')) =+      pAt src' == pc && src' == sq && dst' == dst && prm' == prm+    f (Just (F ff)) (unpack -> (src', dst', prm')) =+      pAt src' == pc && file src' == ff && dst == dst' && prm == prm'+    f (Just (R fr)) (unpack -> (src', dst', prm')) =+      pAt src' == pc && rank src' == fr && dst == dst' && prm == prm'+    f Nothing (unpack -> (src', dst', prm')) =+      pAt src' == pc && dst == dst' && prm == prm'   pAt = snd . fromJust . pieceAt pos  fromSAN :: (VisualStream s, TraversableStream s, SANToken (Token s), IsString (Tokens s))@@ -230,7 +237,7 @@ varToSAN :: (MonoFoldable variation, Element variation ~ Ply, IsString string)          => Position -> variation -> string varToSAN p = fromString . go p . otoList where-  go pos [] = ""+  go _ [] = ""   go pos plies     | color pos == Black && length plies == 1     = show (moveNumber pos) <> "..." <> toSAN pos (head plies)@@ -245,31 +252,31 @@   f _ []     = []  sanCoords :: IsString s => Position -> (PieceType, [Ply]) -> Ply -> s-sanCoords pos (pc,lms) m@(unpack -> (from, to, _)) =+sanCoords pos (pc,lms) m@(unpack -> (src, dst, _)) =   fromString $ source <> target  where   capture = isCapture pos m   source-    | pc == Pawn && capture       = [fileChar from]+    | pc == Pawn && capture       = [fileChar src]     | pc == Pawn                  = []     | length ms == 1              = []-    | length (filter fEq ms) == 1 = [fileChar from]-    | length (filter rEq ms) == 1 = [rankChar from]-    | otherwise                   = toCoord from+    | length (filter fEq ms) == 1 = [fileChar src]+    | length (filter rEq ms) == 1 = [rankChar src]+    | otherwise                   = toCoord src   target-    | capture   = "x" <> toCoord to-    | otherwise = toCoord to-  ms = filter ((to ==) . plyTarget) lms-  fEq (file . plySource -> file) = file == fromFile-  rEq (rank . plySource -> rank) = rank == fromRank-  (fromRank, fromFile) = view rankFile from+    | capture   = "x" <> toCoord dst+    | otherwise = toCoord dst+  ms = filter ((dst ==) . plyTarget) lms+  fEq (file . plySource -> fl) = fl == srcFile+  rEq (rank . plySource -> rnk) = rnk == srcRank+  (srcRank, srcFile) = view rankFile src  unsafeToSAN :: Position -> Ply -> String-unsafeToSAN pos m@(unpack -> (from, to, promo)) =+unsafeToSAN pos m@(unpack -> (src, dst, promo)) =   moveStr <> status  where   moveStr = case piece of-    Pawn | capture -> fileChar from : target <> promotion+    Pawn | capture -> fileChar src : target <> promotion          | otherwise -> target <> promotion     King | color pos == White && m == wKscm -> "O-O"          | color pos == White && m == wQscm -> "O-O-O"@@ -280,16 +287,16 @@     Bishop -> 'B' : source <> target     Rook   -> 'R' : source <> target     Queen  -> 'Q' : source <> target-  piece = fromJust $ snd <$> pieceAt pos from+  piece = fromJust $ snd <$> pieceAt pos src   capture = isCapture pos m   source     | length ms == 1              = []-    | length (filter fEq ms) == 1 = [fileChar from]-    | length (filter rEq ms) == 1 = [rankChar from]-    | otherwise                   = toCoord from+    | length (filter fEq ms) == 1 = [fileChar src]+    | length (filter rEq ms) == 1 = [rankChar src]+    | otherwise                   = toCoord src   target-    | capture = "x" <> toCoord to-    | otherwise = toCoord to+    | capture = "x" <> toCoord dst+    | otherwise = toCoord dst   promotion = case promo of     Just Knight -> "N"     Just Bishop -> "B"@@ -301,11 +308,11 @@          | otherwise                                                    = ""   nextPos = unsafeDoPly pos m   ms = filter movesTo $ legalPlies pos-  movesTo (unpack -> (from', to', _)) =-    fmap snd (pieceAt pos from') == Just piece && to' == to-  fEq (file . plySource -> file) = file == fromFile-  rEq (rank . plySource -> rank) = rank == fromRank-  (fromRank, fromFile) = view rankFile from+  movesTo (unpack -> (src', dst', _)) =+    fmap snd (pieceAt pos src') == Just piece && dst' == dst+  fEq (file . plySource -> thisFile) = thisFile == srcFile+  rEq (rank . plySource -> thisRank) = thisRank == srcRank+  (srcRank, srcFile) = view rankFile src  {-# SPECIALISE relaxedSAN :: Position -> Parser Strict.ByteString Ply #-} {-# SPECIALISE relaxedSAN :: Position -> Parser Lazy.ByteString Ply #-}

@@ -1,7 +1,6 @@ module Game.Chess.Tree (positionTree, positionForest, plyTree, plyForest) where -import           Data.List.NonEmpty  (NonEmpty, cons)-import           Data.Tree           (Forest, Tree (Node), foldTree)+import           Data.Tree           (Forest, Tree (Node)) import           Game.Chess.Internal  positionTree :: Position -> Tree Position

@@ -33,36 +33,61 @@ , quit, quit' ) where -import           Control.Applicative-import           Control.Concurrent-import           Control.Concurrent.STM           hiding (check)-import           Control.Exception-import           Control.Monad-import           Control.Monad.IO.Class-import           Data.Attoparsec.ByteString.Char8-import           Data.Attoparsec.Combinator-import           Data.ByteString.Builder+import           Control.Applicative              (Alternative (many, (<|>)),+                                                   optional)+import           Control.Concurrent               (MVar, ThreadId, forkIO,+                                                   killThread, newEmptyMVar,+                                                   putMVar, takeMVar)+import           Control.Concurrent.STM           (TChan, atomically, dupTChan,+                                                   newBroadcastTChanIO,+                                                   writeTChan)+import           Control.Exception                (Exception, handle, throwIO)+import           Control.Monad                    (forM, forever, void)+import           Control.Monad.IO.Class           (MonadIO (..))+import           Data.Attoparsec.ByteString.Char8 (Parser, anyChar, choice,+                                                   decimal, endOfInput,+                                                   manyTill, match, parseOnly,+                                                   satisfy, sepBy, sepBy1,+                                                   signed, skipSpace,+                                                   takeByteString)+import           Data.ByteString.Builder          (Builder, byteString,+                                                   hPutBuilder, intDec,+                                                   integerDec) import           Data.ByteString.Char8            (ByteString) import qualified Data.ByteString.Char8            as BS-import           Data.Foldable-import           Data.Functor+import           Data.Foldable                    (Foldable (fold, foldl'))+import           Data.Functor                     (($>)) import           Data.HashMap.Strict              (HashMap) import qualified Data.HashMap.Strict              as HashMap-import           Data.IORef-import           Data.Ix-import           Data.List+import           Data.IORef                       (IORef, atomicModifyIORef',+                                                   newIORef, readIORef,+                                                   writeIORef)+import           Data.Ix                          (Ix (inRange))+import           Data.List                        (intersperse) import           Data.STRef                       (modifySTRef, newSTRef,                                                    readSTRef, writeSTRef) import           Data.String                      (IsString (..)) import qualified Data.Vector.Unboxed              as Unboxed import qualified Data.Vector.Unboxed.Mutable      as Unboxed-import           Game.Chess-import           Numeric.Natural+import           Game.Chess                       (Color (..), Ply, Position,+                                                   doPly, fromUCI, legalPlies,+                                                   startpos, toFEN, toUCI,+                                                   unsafeDoPly)+import           Numeric.Natural                  (Natural) import           System.Exit                      (ExitCode)-import           System.IO-import           System.Process-import           Time.Rational-import           Time.Units+import           System.IO                        (BufferMode (LineBuffering),+                                                   Handle, hSetBuffering)+import           System.Process                   (CreateProcess (std_in, std_out),+                                                   ProcessHandle,+                                                   StdStream (CreatePipe),+                                                   createProcess,+                                                   getProcessExitCode, proc,+                                                   terminateProcess,+                                                   waitForProcess)+import           Time.Rational                    (KnownDivRat)+import           Time.Units                       (Microsecond, Millisecond,+                                                   Time (unTime), ms, sec,+                                                   timeout, toUnit)  type BestMove = Maybe (Ply, Maybe Ply) @@ -280,6 +305,7 @@     Right (Author a) -> initialise (c { author = Just a })     Right (Option name opt) -> initialise (c { options = HashMap.insert name opt $ options c })     Right UCIOk -> pure c+    Right _ -> initialise c  infoReader :: Engine -> IO () infoReader e@Engine{..} = forever $ do@@ -292,6 +318,7 @@     Right (BestMove bm) -> do       writeIORef isSearching False       atomically $ writeTChan bestMoveChan bm+    Right _ -> pure ()  -- | Wait until the engine is ready to take more commands. isready :: Engine -> IO ()@@ -395,6 +422,8 @@   = liftIO $ do     send c $ "setoption name " <> byteString n <> " value " <> intDec v     pure $ c { options = HashMap.update (set v) n $ options c }+  | otherwise+  = error "No option with that name or value out of range"  where   set val opt@SpinButton{} = Just $ opt { spinButtonValue = val } 

@@ -1,87 +0,0 @@-module Main where--import Control.Parallel.Strategies-import Data.Foldable-import Data.Maybe-import Data.Monoid-import Data.Time.Clock-import Data.Traversable-import Game.Chess-import GHC.Generics (Generic)-import System.Directory-import System.Exit-import System.IO--type Depth = Int-type Testsuite = [(Position, [(Depth, PerftResult)])]--main :: IO ()-main = do-  start <- getCurrentTime-  exists <- doesFileExist "perftsuite.epd"-  result <- if exists-    then do-      suite <- readTestSuite "perftsuite.epd"-      runTestSuite suite-    else do-      fmap (Just . fold) . for [0..6] $ \n -> do-        let r = perft n startpos-        putStrLn $ showResult n r-        hFlush stdout-        pure r-  end <- getCurrentTime-  case result of-    Just PerftResult{nodes} -> putStrLn $-       "nps: " <>-       show (floor (realToFrac (fromIntegral nodes) / realToFrac (diffUTCTime end start)))-    _ -> pure ()-  putStrLn $ "Time: " <> show (diffUTCTime end start)-  exitWith $ if isJust result then ExitSuccess else ExitFailure 1--data PerftResult = PerftResult { nodes :: !Integer } deriving (Eq, Generic, Show)-instance NFData PerftResult--instance Semigroup PerftResult where-  PerftResult n1 <> PerftResult n2 = PerftResult $ n1 + n2--instance Monoid PerftResult where-  mempty = PerftResult 0--showResult :: Depth -> PerftResult -> String-showResult depth PerftResult{nodes} = show depth <> " " <> show nodes--perft :: Depth -> Position -> PerftResult-perft 0 _ = PerftResult 1-perft 1 p = PerftResult . fromIntegral . length $ legalPlies p-perft n p-  | n < 4-  = foldMap (perft (pred n) . unsafeDoPly p) $ legalPlies p-  | otherwise-  = fold . parMap rdeepseq (perft (pred n) . unsafeDoPly p) $ legalPlies p--runTestSuite :: Testsuite -> IO (Maybe PerftResult)-runTestSuite = fmap (getAp . foldMap Ap) . traverse (uncurry (test mempty)) where-  test sum pos ((depth, expected) : more)-    | result == expected-    = do-      putStrLn $ "OK   " <> fen <> " ;D" <> show depth <> " "-              <> show (nodes expected)-      hFlush stdout-      test (sum <> result) pos more-    | otherwise-    = do-      putStrLn $ "FAIL " <> fen <> " ;D" <> show depth <> " "-              <> show (nodes expected) <> " /= " <> show (nodes result)-      pure Nothing-   where result = perft depth pos-         fen = toFEN pos-  test sum _ [] = pure (Just sum)--readTestSuite :: FilePath -> IO Testsuite-readTestSuite fp = do-  epd <- readFile fp-  pure $ fmap readData . (\ws -> (fromJust (fromFEN (unwords $ take 6 ws)), drop 6 ws)) . words <$> lines epd- where-  readData [] = []-  readData ((';':'D':d):v:xs) = (read d, PerftResult $ read v) : readData xs-  readData _ = error "Failed to parse test suite"

@@ -0,0 +1,87 @@+module Main where++import Control.Parallel.Strategies+import Data.Foldable+import Data.Maybe+import Data.Monoid+import Data.Time.Clock+import Data.Traversable+import Game.Chess+import GHC.Generics (Generic)+import System.Directory+import System.Exit+import System.IO++type Depth = Int+type Testsuite = [(Position, [(Depth, PerftResult)])]++main :: IO ()+main = do+  start <- getCurrentTime+  exists <- doesFileExist "test/perft/perftsuite.epd"+  result <- if exists+    then do+      suite <- readTestSuite "test/perft/perftsuite.epd"+      runTestSuite suite+    else do+      fmap (Just . fold) . for [0..6] $ \n -> do+        let r = perft n startpos+        putStrLn $ showResult n r+        hFlush stdout+        pure r+  end <- getCurrentTime+  case result of+    Just PerftResult{nodes} -> putStrLn $+       "nps: " <>+       show (floor (realToFrac (fromIntegral nodes) / realToFrac (diffUTCTime end start)))+    _ -> pure ()+  putStrLn $ "Time: " <> show (diffUTCTime end start)+  exitWith $ if isJust result then ExitSuccess else ExitFailure 1++data PerftResult = PerftResult { nodes :: !Integer } deriving (Eq, Generic, Show)+instance NFData PerftResult++instance Semigroup PerftResult where+  PerftResult n1 <> PerftResult n2 = PerftResult $ n1 + n2++instance Monoid PerftResult where+  mempty = PerftResult 0++showResult :: Depth -> PerftResult -> String+showResult depth PerftResult{nodes} = show depth <> " " <> show nodes++perft :: Depth -> Position -> PerftResult+perft 0 _ = PerftResult 1+perft 1 p = PerftResult . fromIntegral . length $ legalPlies p+perft n p+  | n < 4+  = foldMap (perft (pred n) . unsafeDoPly p) $ legalPlies p+  | otherwise+  = fold . parMap rdeepseq (perft (pred n) . unsafeDoPly p) $ legalPlies p++runTestSuite :: Testsuite -> IO (Maybe PerftResult)+runTestSuite = fmap (getAp . foldMap Ap) . traverse (uncurry (test mempty)) where+  test sum pos ((depth, expected) : more)+    | result == expected+    = do+      putStrLn $ "OK   " <> fen <> " ;D" <> show depth <> " "+              <> show (nodes expected)+      hFlush stdout+      test (sum <> result) pos more+    | otherwise+    = do+      putStrLn $ "FAIL " <> fen <> " ;D" <> show depth <> " "+              <> show (nodes expected) <> " /= " <> show (nodes result)+      pure Nothing+   where result = perft depth pos+         fen = toFEN pos+  test sum _ [] = pure (Just sum)++readTestSuite :: FilePath -> IO Testsuite+readTestSuite fp = do+  epd <- readFile fp+  pure $ fmap readData . (\ws -> (fromJust (fromFEN (unwords $ take 6 ws)), drop 6 ws)) . words <$> lines epd+ where+  readData [] = []+  readData ((';':'D':d):v:xs) = (read d, PerftResult $ read v) : readData xs+  readData _ = error "Failed to parse test suite"

@@ -0,0 +1,16 @@+module Main where++import Test.HUnit+import Game.Chess+import Game.Chess.Polyglot++tests = test+  [ "t1" ~: "start position" ~: hashPosition startpos ~=? 0x463b96181691fc9c+  , "t2" ~: "after e4" ~: hashPosition "rnbqkbnr/pppppppp/8/8/4P3/8/PPPP1PPP/RNBQKBNR b KQkq e3 0 1" ~=? 0x823c9b50fd114196+  , "t3" ~: "after e4 d5" ~: hashPosition "rnbqkbnr/ppp1pppp/8/3p4/4P3/8/PPPP1PPP/RNBQKBNR w KQkq d6 0 2" ~=? 0x0756b94461c50fb0+  , "t4" ~: "after e4 d5 e5" ~: hashPosition "rnbqkbnr/ppp1pppp/8/3pP3/8/8/PPPP1PPP/RNBQKBNR b KQkq - 0 2" ~=? 0x662fafb965db29d4+  , "t5" ~: "after e4 d5 e5 f5" ~: hashPosition "rnbqkbnr/ppp1p1pp/8/3pPp2/8/8/PPPP1PPP/RNBQKBNR w KQkq f6 0 3" ~=? 0x22a48b5a8e47ff78+  , "t6" ~: "after e4 d5 e5 f5 Ke2" ~: hashPosition "rnbqkbnr/ppp1p1pp/8/3pPp2/8/8/PPPPKPPP/RNBQ1BNR b kq - 0 3" ~=? 0x652a607ca3f242c1+  ]++main = runTestTTAndExit tests