diff --git a/RELEASE-NOTES b/RELEASE-NOTES
--- a/RELEASE-NOTES
+++ b/RELEASE-NOTES
@@ -1,6 +1,7 @@
-0.9.3 11/03/2013
-- added an command line option to ask for an AI move for
-  a given board configuration
+0.9.4 27/05/2016
+- lots of code optimizations in board & AI search
+- updated .cabal file to pass RTS flag -N automatically;
+  should now run parallel AIs using multiple CPUs by default
 
 0.9.2 30/08/2012
 - removed bogus dependency on haskell98 package
diff --git a/hstzaar.cabal b/hstzaar.cabal
--- a/hstzaar.cabal
+++ b/hstzaar.cabal
@@ -1,5 +1,5 @@
 name:    hstzaar
-version: 0.9.3
+version: 0.9.4
 
 category: Game
 
@@ -25,24 +25,28 @@
 data-files:    hstzaar.glade
 
 extra-source-files:
-  RELEASE-NOTES 
+  RELEASE-NOTES
 
 executable hstzaar
   hs-source-dirs:   src
   main-is:          Main.hs
   other-modules:    GUI Serialize Board AI AI.Gametree AI.Eval AI.Minimax Tournament Tests
   build-depends:
-    base >= 4 && <5,
+    base >= 4.7 && <5,
     filepath >= 1.1,
     directory >= 1.0,
+    array >= 0.5,
     containers,
+    unordered-containers,
+    hashable,
+    mtl >= 2,
+    vector >= 0.10,
     parallel >= 2.0,
-    gtk        >=0.11, 
-    cairo      >= 0.11, 
+    gtk        >=0.11,
+    cairo      >= 0.11,
     glade      >= 0.11,
-    random     >= 1.0.0   && < 1.1,
+    random     >= 1.0.0,
     QuickCheck >= 2.1,
     xml >= 1.3
 
- ghc-options: -threaded -rtsopts 
- ghc-prof-options: -prof -auto-all 
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
diff --git a/src/AI.hs b/src/AI.hs
--- a/src/AI.hs
+++ b/src/AI.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
 --
 -- Library of AI players
 --
@@ -10,68 +11,62 @@
 import Data.Maybe(catMaybes)
 import AI.Gametree
 import AI.Minimax
-import AI.Eval 
+import AI.Eval
 
+import Control.Monad.State
 
--- | instance the gametree class for TZAAR 
-instance Gametree Board where
-  children b = [applyMove m b | m<-nextMoves b]
-  is_terminal b = null (nextMoves b)
 
--- | An AI play strategy 
--- takes a  board and pseudo-random generator 
--- yields evaluation, next move and new random generator
-type Playing = Board -> StdGen -> (Int, Move, StdGen)
+-- | instance the transition system for TZAAR games
+instance Transitions Board Move where
+  actions = nextMoves
+  transition = applyMove
 
+-- | An AI play strategy
+-- allows monad for pseudo-random computations
+-- (current strategies don't need it)
+type Strategy = Board -> State StdGen (Move, Value)
+
 -- | An AI player.
 data AI = AI
   { name :: String          -- ^ Unique name
   , description :: String   -- ^ Brief description of AI.
-  , playing     :: Playing  -- ^ The play strategy.
+  , strategy :: Strategy    -- ^ The AI strategy.
   }
 
 
-
-
+  {-
 aiLevels :: [AI]
 aiLevels = catMaybes [lookupAI label aiPlayers | label<-list]
-  where list = ["nscout_simple_1", 
+  where list = ["nscout_simple_1",
                 "nscout_simple_3",
-                "nscout_full_1", 
-                "nscout_full_3", 
-                "nscout_full_6", 
-                "pscout_full_3", 
+                "nscout_full_1",
+                "nscout_full_3",
+                "nscout_full_6",
+                "pscout_full_3",
                 "pscout_full_6"]
-
+-}
+aiLevels = aiPlayers
 
 lookupAI :: String -> [AI] -> Maybe AI
-lookupAI label ai_list 
-  = case [ai | ai<-ai_list, name ai==label] of  
+lookupAI label ai_list
+  = case [ai | ai<-ai_list, name ai==label] of
     [] -> Nothing
     (ai : _) -> Just ai
 
 
 aiPlayers :: [AI]
-aiPlayers = do (txt0,txt1,strat) <- list
-               (val,txt2) <- zip [simple_val, full_val] ["simple", "full"]
-               ply <- [1..9]
+aiPlayers = do (txt0, txt1, search) <- searches
+               (txt2, valf) <- valuations
+               ply <- [1..6]
                let label = txt0 ++ "_" ++ txt2 ++ "_" ++ show ply
                let desc = txt1 ++ " " ++ txt2 ++ " valuation, ply " ++ show ply
                return AI { name = label
-                         , description  = desc
-                         , playing = play (strat val ply)
+                         , description = desc
+                         , strategy = return . searchMove (search valf) ply
                          }
-   where list = [ ("nmax", "Negamax", negamax_alpha_beta),
-                  ("nscout", "Negascout", negascout),                 
-                  ("pscout", "Parallel negascout", jamboree)
-                ]
-         
-play strat b rndgen 
-    | m `elem` nextMoves b = (score, m, rndgen)
-    | otherwise = error "panic: AI gave invalid move!"
-      where vpos = strat b
-            score = value vpos
-            -- next move in principal variation
-            m = (reverse $ moves $ unvalued vpos) !! move b
-
+   where searches = [ ("nmax", "Negamax", alphaBeta)
+                    , ("nscout", "Negascout", negascout)
+                    , ("pscout", "Parallel Negascout", jamboree)
+                    ]
+         valuations = [ ("simple", simpleVal), ("full", fullVal)]
 
diff --git a/src/AI/Eval.hs b/src/AI/Eval.hs
--- a/src/AI/Eval.hs
+++ b/src/AI/Eval.hs
@@ -1,58 +1,55 @@
-{-# LANGUAGE BangPatterns #-}
 --
 -- Static evaluation functions for board positions
 --
-module AI.Eval (simple_val, full_val) where
-import Board
-import AI.Gametree
+module AI.Eval (
+  simpleVal,
+  fullVal
+  ) where
 
+import           Board
+import           AI.Gametree
+import           AI.Minimax
+import qualified Data.Vector.Unboxed as Vec
 
 -- simple static board valuation (material score only)
-simple_val :: Valuation Board
-simple_val b = if null (nextMoves b) then lost else material b
+simpleVal :: Board -> Value
+simpleVal b = if endGame b then (-maxBound) else material b
 
 -- better static board valuation (material and positional scores)
-full_val :: Valuation Board
-full_val b = if null (nextMoves b) then lost else material b + positional b 
-
+fullVal :: Board -> Value
+fullVal b = if endGame b then (-maxBound) else material b + positional b
 
--- score for a losing position
--- this should be strictly greater than minBound to avoid "boundary" issues
-lost :: Int
-lost = minBound`div`2
-      
 -- | Material score
--- * multiply sum of heights by counts 
+-- * multiply sum of heights by counts
 -- * height weights for kinds with lowest counts
-material :: Board -> Int
+material :: Board -> Value
 {-# INLINE material #-}
-material b = (sum [(30-n)*h | (n,h)<-zip counts heights] -
-              sum [(30-n)*h | (n,h)<-zip counts' heights'])
-  where   
-      -- stacks counts by piece kinds for each player 
+material b = fromIntegral
+              (Vec.sum (Vec.zipWith (\n h -> (30-n)^2*h) counts heights) -
+               Vec.sum (Vec.zipWith (\n h -> (30-n)^2*h) counts' heights'))
+  where
+      -- stacks counts by piece kinds for each player
       counts = activeCounts b
       counts'= inactiveCounts b
       -- sum of heights by piece kinds
       heights = activeHeights b
       heights'= inactiveHeights b
-      
 
+
 -- | Positional score
--- for each kind, count opponent's pieces in each player's zone of control 
-positional :: Board -> Int
+-- for each kind, count opponent's pieces in each player's zone of control
+positional :: Board -> Value
 {-# INLINE positional #-}
-positional b = (sum [pw*m`div`n | (n,m)<-zip counts' zoc_counts] -
-                sum [pw*m`div`n | (n,m)<-zip counts zoc_counts'])
-  where 
+positional b = fromIntegral
+               (Vec.sum (Vec.zipWith (\n m -> pw*m`quot`n) counts' zoc_counts) -
+                Vec.sum (Vec.zipWith (\n m -> pw*m`quot`n) counts zoc_counts'))
+  where
     counts = activeCounts b
     counts'= inactiveCounts b
     -- zone of control of each player
     zoc = zoneOfControl (active b) (pieces b)
     zoc'= zoneOfControl (inactive b) (pieces b)
     -- count pieces in each zone of control
-    zoc_counts= countStacks (inactive b) zoc
-    zoc_counts'= countStacks (active b) zoc'
-    pw = 100
-
-
-
+    zoc_counts = Vec.fromList $ countStacks (inactive b) zoc
+    zoc_counts'= Vec.fromList $ countStacks (active b) zoc'
+    pw = 1000
diff --git a/src/AI/Gametree.hs b/src/AI/Gametree.hs
--- a/src/AI/Gametree.hs
+++ b/src/AI/Gametree.hs
@@ -1,20 +1,35 @@
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+
 --
--- Type class for traversing AI game trees
--- auxiliary definitions for labeling with static valuations 
--- 
+-- Traversing game trees
+-- auxiliary definitions for labeling with static valuations
+--
 module AI.Gametree where
 
--- | a type class for gametrees 
--- parametrized by node type
-class Gametree p where
-  children :: p -> [p]   -- list of move, position
-  is_terminal :: p -> Bool
-  is_terminal = null . children  -- default definition
+import Data.Function (on)
+import Data.List(minimumBy)
 
--- | type for valuation functions 
-type Valuation a = a -> Int
+-- | a type class for labelled transition systems
+-- i.e. game positions and moves
+class Transitions s l | s -> l where
+  actions :: s -> [l]         -- next labels from a state
+  transition :: l -> s -> s   -- transition from a state
 
+-- | check if a state is terminal
+-- i.e. has no actions
+isTerminal :: Transitions s l => s -> Bool
+isTerminal = null . actions
 
+-- | immediate state successors
+successors :: Transitions s l => s -> [s]
+successors s = [transition l s | l <- actions s]
+
+-- | immediate successors labelled by actions
+transitions :: Transitions s l => s -> [(l,s)]
+transitions s = [(l, transition l s) | l <- actions s]
+
+
+{-
 -- | a pair of something with a strict integer valuation
 -- supporting equality, ordering and limited arithmetic on valuation
 data Valued a = Valued { value :: !Int, unvalued :: a } deriving Show
@@ -22,7 +37,7 @@
 instance Functor Valued where
   fmap f (Valued v x) = Valued v (f x)
 
--- | apply a valuation 
+-- | apply a valuation
 valued :: Valuation a -> a -> Valued a
 valued f x = Valued (f x) x
 
@@ -32,11 +47,11 @@
 
 instance Eq (Valued a) where
   x == y = value x==value y
-  
+
 instance Ord (Valued a) where
   compare x y = compare (value x) (value y)
-  
 
+
 -- some instances of numeric type class (only negate and fromInteger)
 instance Num (Valued a) where
   (+) = undefined
@@ -52,5 +67,4 @@
 infix 6 $+
 ($+) :: Int -> Valued a -> Valued a
 k $+ x = revalue (+k) x
-
-
+-}
diff --git a/src/AI/Minimax.hs b/src/AI/Minimax.hs
--- a/src/AI/Minimax.hs
+++ b/src/AI/Minimax.hs
@@ -1,133 +1,138 @@
-{-# LANGUAGE BangPatterns #-}
-module AI.Minimax ( negamax
-                  , negamax_alpha_beta
-                  , negascout
-                  , jamboree
-                  ) where
+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-}
 
-import Board
+module AI.Minimax
+   ( 
+    Value
+   , searchMove
+   , negamax
+   , alphaBeta
+   , negascout
+   , jamboree
+   ) where
+
 import AI.Gametree
-import Control.Parallel.Strategies 
+import Data.List (minimumBy, maximumBy)
+import Data.Function (on)
+import Control.Parallel.Strategies
 
+-- | a type for game position valuations;
+-- simply a wrapper newtype over integers
+newtype Value = Value Int deriving (Eq, Ord, Enum, Bounded,
+                                    Num, Real, Integral, Show, Read)
 
--- | Naive negamax algorithm (no prunning)
--- wrapper
-negamax :: Gametree p => Valuation p -> Int -> p -> Valued p
-negamax node_value depth p = negamax' depth p
+
+
+-- compute best move using some search function
+-- undefined for terminal positions
+searchMove :: Transitions s l =>
+              (Value -> Value -> Int -> s -> Value)
+              -> Int -> s -> (l, Value)
+searchMove abSearch depth s = cmx (minBound+1) first (transitions s)
   where
-    -- worker
-    negamax' d p
-      | d==0 || is_terminal p = valued node_value p
-      | otherwise = negate $ minimum [negamax' d  p' | p'<-children p]
-        where d' = d-1
+    first = head (actions s)
+    cmx !alpha best [] = (best, alpha)
+    cmx !alpha best ((l,s):rest) = cmx alpha' best' rest
+        where !v = - abSearch (-maxBound) (-alpha) (depth-1) s
+              !alpha' = if v>alpha then v else alpha
+              !best' = if v>alpha then l else best
 
--- | Negamax with alpha-beta prunning 
--- wrapper
-negamax_alpha_beta :: Gametree p => Valuation p -> Int -> p -> Valued p
-negamax_alpha_beta node_value depth p
-  = let a = fromIntegral (minBound+1 :: Int) 
-        b = fromIntegral (maxBound :: Int) 
-    in alpha_beta' depth a b p
+
+-- | Naive negamax algorithm (no alpha-beta prunning)
+-- for specification only; use alphaBeta instead
+negamax :: Transitions s l => (s -> Value) -> Int -> s -> Value
+negamax valf = negamaxAux
   where
-    -- worker
-    alpha_beta' d alfa beta p
-        | d==0 || is_terminal p = valued node_value p 
-        | otherwise = cmx alfa (children p)
-          where 
-            d' = d-1
-            cmx alfa [] = alfa
-            cmx alfa (p:ps) 
-              | a'>=beta = a'
-              | otherwise = cmx (max a' alfa) ps
-                where a' = negate $ alpha_beta' d' (negate beta) (negate alfa) p
+    -- recursive worker function
+    negamaxAux d s
+      | d==0 || isTerminal s = valf s
+      | otherwise = - minimum [negamaxAux (d-1) s' | s' <- successors s]
 
 
 
--- | Negascout search
--- wrapper
-negascout :: Gametree p => Valuation p -> Int -> p -> Valued p
-negascout node_value depth p
-  = let a = fromIntegral (minBound+1 :: Int) 
-        b = fromIntegral (maxBound :: Int) 
-    in negascout' node_value depth a b p
+-- compute minimax value using Negamax with alpha-beta prunning
+alphaBeta :: Transitions s l =>
+             (s -> Value) -> Value -> Value -> Int -> s -> Value
+alphaBeta valf alpha beta depth s
+  | depth==0 || isTerminal s = valf s
+  | otherwise = cmx alpha (successors s)
+  where
+    cmx !alpha [] = alpha
+    cmx !alpha (p:ps)
+      | a'>=beta = a'
+      | otherwise = cmx (max a' alpha) ps
+        where a' = - alphaBeta valf (-beta) (-alpha) (depth-1) p
 
--- worker      
-negascout' node_value d alfa beta p
-  | d==0 || is_terminal p = valued node_value p 
-  | d==1  = valued (negate . node_value) p0       -- short-circuit for depth 1
+
+
+
+
+-- Negascout search
+-- worker function
+negascout :: Transitions s l =>
+             (s -> Value) -> Value -> Value -> Int -> s -> Value
+negascout valf alpha beta depth s
+  | depth==0 || isTerminal s = valf s
+  | depth==1  = - valf s0  -- short-circuit for depth 1
   | b >= beta = b
-  | otherwise = scout (max alfa b) b ps
+  | otherwise = scout (max alpha b) b succs
     where
-      d' = d-1
-      ps = children p
-      p0 = unvalued $ minimum $ map (valued node_value) ps
-      -- p0 = estimate_best node_value ps  -- child with best static score
-      b = negate $ negascout' node_value d' (negate beta) (negate alfa) p0 -- full search estimate
-    
-      scout !alfa !b [] = b
-      scout !alfa !b (p:ps)
+      succs = successors s
+      s0 = minimumBy (compare`on`valf) succs
+        -- child with best static score
+      b = - negascout valf (-beta) (-alpha) (depth-1) s0
+        -- full search estimate for the best child
+
+      scout !alpha !b [] = b
+      scout !alpha !b (p:ps)
         | s>=beta = s
-        | otherwise = scout alfa' b' ps
-          where s = negate $ negascout' node_value d' (negate (1$+alfa)) (negate alfa) p
-                s' | s>alfa = negate $ 
-                              negascout' node_value d' (negate beta) (negate alfa) p
+        | otherwise = scout alpha' b' ps
+          where s = - negascout valf (-(1+alpha)) (-alpha) (depth-1) p
+                s' | s>alpha = - negascout valf (-beta) (-alpha) (depth-1) p
                    | otherwise = s
-                alfa' = max alfa s'
+                alpha' = max alpha s'
                 b' = max b s'
-      
 
+
+
 -- | Parallel negascout, aka "Jamboree"
 -- | result of each scout test
 data Result a b = Cutoff a   -- beta cutoff found
                 | Search b   -- do a full search
-                | OK          -- test suceeded
-                      
-                      
-jamboree :: Gametree p => Valuation p -> Int -> p -> Valued p
-jamboree node_value depth p 
-  = let a = fromIntegral (minBound+1 :: Int) 
-        b = fromIntegral (maxBound :: Int) 
-    in jamboree' node_value depth a b p 
+                | OK         -- test suceeded
 
--- worker
-jamboree' node_value d alfa beta p
-  | d<=1  = negascout' node_value d alfa beta p
+
+
+jamboree :: Transitions s l =>
+            (s -> Value) -> Value -> Value -> Int -> s -> Value
+jamboree valf alpha beta depth p
+  | depth<=1 = negascout valf alpha beta depth p
             -- use sequencial version for low depth
-  | is_terminal p = valued node_value p   -- terminal node?
-  | b >= beta = b   -- 1st child failed high
+  | isTerminal p = valf p   -- terminal node?
+  | b >= beta = b           -- 1st child failed high
   | otherwise = cutoff [] (map scout ps `using` parList rseq)
-    where    
-      d' = d-1
-      ps = children p            
-      p0 = unvalued $ minimum $ map (valued node_value) ps -- best child
-    
-      b = negate $ jamboree' node_value d' (negate beta) (negate alfa) p0 -- full search estimate
-      alfa' = max alfa b
+    where
+      ps = successors p
+      p0 = minimumBy (compare`on`valf) ps      -- estimated best child
+      b =  - jamboree valf (-beta) (-alpha) (depth-1) p0  -- full search estimate
+      alpha' = max alpha b
 
-      scout p 
-        | s >= beta = Cutoff s  
-        | s > alfa' = Search p
+      scout p
+        | s >= beta = Cutoff s
+        | s > alpha' = Search p
         | otherwise = OK
-          where s = negate $ jamboree' node_value d' (negate (1$+alfa')) (negate alfa') p
+          where s = - jamboree valf (-(1+alpha')) (-alpha') (depth-1) p
                     -- null window search
 
       -- join results of parallel scouts
       cutoff _  (Cutoff s : rs) = s
       cutoff ps (Search p : rs) = cutoff (p:ps) rs
       cutoff ps (OK : rs)       = cutoff ps rs
-      cutoff ps []              = search alfa' b ps
+      cutoff ps []              = search alpha' b ps
 
       -- sequential full search for scout failures
-      search !alfa !b [] = b
-      search !alfa !b (p : ps) 
+      search !alpha !b [] = b
+      search !alpha !b (p : ps)
         | s >= beta = s
-        | otherwise = search (max s alfa) (max s b) ps
-          where s = negate $ jamboree' node_value d' (negate beta) (negate alfa) p
-
-
-
--- | estimate best move using static evaluation
--- estimate_best :: Valuation p -> [p] -> p            
--- estimate_best node_value = minimumBy cmp 
---  where cmp p p' = compare (node_value p) (node_value p')
+        | otherwise = search (max s alpha) (max s b) ps
+          where s = - jamboree valf (-beta) (-alpha)  (depth-1) p
 
diff --git a/src/Board.hs b/src/Board.hs
--- a/src/Board.hs
+++ b/src/Board.hs
@@ -1,26 +1,26 @@
-{-# LANGUAGE BangPatterns #-}
--- | Board State 
+{-# LANGUAGE BangPatterns, RecordWildCards #-}
+-- | Board State
 module Board
   ( -- * Types
     Board (..)
   , PieceMap
   , Color (..)
   , Kind (..)
-  , Piece
+  , Piece (..)
   , Position (..)
   , Move (..)
   , Game (..)
   , initBoard
   , initGame
-  , color, kind, height   -- attributes of pieces 
+  , color, kind, height   -- attributes of pieces
   , nthTurn, nthMove
   , invert
   , inactive
   , countPieces
   , endGame
   , winner
-  , swapBoard
-  , captureMoves    
+  , swapPlayer
+  , captureMoves
   , stackingMoves
   , nextMoves
   , countStacks
@@ -34,20 +34,28 @@
   , showMove
   , applyMove
   , applyMoveSkip
-  , applyMoveSkip'
   , positions
   , zoneOfControl
   ) where
 
-import Data.List
-import Data.Map (Map, (!))
-import qualified Data.Map as Map
-import System.Random
-import Control.Monad (liftM,mplus)
+import           Data.List (foldl')
+import           Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
 
+import           Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+import           Data.Hashable
 
+import qualified Data.Vector.Unboxed as Vec
+import           Data.Vector.Unboxed(Vector)
+
+import           Data.Array
+
+import           Control.Monad (liftM, mplus)
+import           System.Random
+
 -- | player colors
-data Color = White | Black 
+data Color = White | Black
            deriving (Eq,Show,Enum,Read)
 
 -- | the inverse color
@@ -55,22 +63,23 @@
 invert White = Black
 invert Black = White
 
--- | The three piece types 
+-- | The three piece types
 -- | Each player starts with 6 Tzaars, 9 Tzarras, and 15 Totts.
-data Kind = Tzaar | Tzarra | Tott 
-            deriving (Eq, Ord, Show, Read)
+data Kind = Tzaar | Tzarra | Tott
+            deriving (Eq, Ord, Enum, Show, Read)
 
 -- | A piece stack: color, kind and height (starting at 1).
-type Piece = (Color, Kind, Int)
+data Piece = Piece !Color !Kind !Int
+             deriving (Eq, Show, Read)
 
 color :: Piece -> Color
-color (c, _, _) = c
+color (Piece c _ _) = c
 
 kind :: Piece -> Kind
-kind (_, k, _)= k
+kind (Piece _ k _)= k
 
 height :: Piece -> Int
-height (_, _, h)= h
+height (Piece _ _ h)= h
 
 
 -- | Algebraic board positions.  Letters left to right, numbers bottom to top.
@@ -85,40 +94,44 @@
   | G1 | G2 | G3 | G4 | G5 | G6 | G7
   | H1 | H2 | H3 | H4 | H5 | H6
   | I1 | I2 | I3 | I4 | I5
-  deriving (Eq, Ord, Enum, Bounded, Show, Read)
+  deriving (Ix, Eq, Ord, Enum, Bounded, Show, Read)
 
+instance Hashable Position where
+  hashWithSalt s p = hashWithSalt s (fromEnum p)
+
+
 -- | List of all positions (for enumeration)
 positions :: [Position]
 positions = [minBound .. maxBound]
 
--- | A mapping from positions to pieces 
-type PieceMap = Map Position Piece
+-- | A mapping from positions to pieces
+type PieceMap = HashMap Position Piece
 
--- | The board state
+-- | A TZAAR game board
 -- | current turn, active player pieces, other player pieces
-data Board 
-      = Board { active :: !Color,            -- player to move next 
+data Board
+      = Board { active :: !Color,            -- player to move next
                 move :: !Int,                -- total move count
-                moves :: [Move],             -- all previous moves (in reverse order)
                 pieces :: PieceMap,          -- map positions to pieces
-                activeCounts :: [Int],       -- active player counts
-                inactiveCounts :: [Int],     -- inactive player counts
-                activeHeights :: [Int],
-                inactiveHeights :: [Int]
+                activeCounts :: !(Vector Int),       -- active player counts
+                inactiveCounts :: !(Vector Int),     -- inactive player counts
+                activeHeights :: !(Vector Int),
+                inactiveHeights :: !(Vector Int)
               } deriving (Eq, Show, Read)
 
 
 -- | initialize a board from a list of piece & positions
 initBoard :: [(Position,Piece)] -> Board
-initBoard assocs 
-  = let ps = Map.fromList assocs
-    in Board { active=White, move=0, moves=[], pieces=ps,
-               activeCounts=countStacks White ps,
-               inactiveCounts=countStacks Black ps,
-               activeHeights=sumHeights White ps,
-               inactiveHeights=sumHeights Black ps 
+initBoard assocs
+  = let ps = HashMap.fromList assocs
+    in Board { active=White,  move=0, 
+               pieces=ps,
+               activeCounts=Vec.fromList (countStacks White ps),
+               inactiveCounts=Vec.fromList (countStacks Black ps),
+               activeHeights=Vec.fromList (sumHeights White ps),
+               inactiveHeights=Vec.fromList (sumHeights Black ps)
              }
-       
+
 inactive :: Board -> Color
 inactive = invert . active
 
@@ -127,8 +140,8 @@
 -- | A move is either a capture, a stacking or a pass
 --   "Skip" is a dummy move to alternate players in a turn
 data Move = Capture !Position !Position  -- origin and destination positions
-          | Stack   !Position !Position  
-          | Pass 
+          | Stack   !Position !Position
+          | Pass
           | Skip
             deriving (Eq, Show, Read)
 
@@ -145,9 +158,9 @@
   { human :: Color       -- human plays white or black?
   , initial :: Board     -- initial board
   , board :: Board       -- current board
-  , trail :: [Move]      -- previous moves 
+  , trail :: [Move]      -- previous moves
   , remain :: [Move]     -- future moves
-  } deriving (Eq,Show) 
+  } deriving (Eq,Show)
 
 
 -- | initialize a game state
@@ -156,7 +169,7 @@
 
 
 
--- | Convert number of moves into number of turns 
+-- | Convert number of moves into number of turns
 nthTurn :: Int -> Int
 nthTurn 0 = 1
 nthTurn m | m>0 = 2 + (m-1)`div`3
@@ -169,80 +182,78 @@
 
 -- | number of pieces in a board
 countPieces :: Board -> Int
-countPieces board = Map.size (pieces board) 
+countPieces board = HashMap.size (pieces board)
 
 
 
 
 -- | swap active player
--- this is used to analyse the board from the opponent's prespective
-swapBoard :: Board -> Board
-swapBoard b = b { active= invert (active b), 
-                  activeCounts = inactiveCounts b, 
-                  inactiveCounts = activeCounts b,
-                  activeHeights= inactiveHeights b,
-                  inactiveHeights = activeHeights b
-                }
+swapPlayer :: Board -> Board
+swapPlayer b = b { active = invert (active b),
+                     activeCounts = inactiveCounts b,
+                     inactiveCounts = activeCounts b,
+                     activeHeights = inactiveHeights b,
+                     inactiveHeights = activeHeights b
+                   }
 
 
--- | next moves for the active player
+-- | all available moves for the active player
 nextMoves :: Board -> [Move]
-nextMoves b 
-  | tzaars==0 || tzarras==0 || totts==0 = []
+nextMoves b
+  | Vec.any (==0) (activeCounts b) = []
   | m == 0                              = captureMoves b
-  | otherwise 
+  | otherwise
     = case (m-1)`mod`3 of
         0 -> captureMoves b     -- first move
         1 -> [Skip]             -- dummy opponent move within a turn
         2 -> stackingMoves b ++ captureMoves b ++ [Pass] -- second moves
         _ -> error "nextMoves: invalid board"
-  where -- lostPieces = any (==0) (countStacks (active b) (pieces b)) 
-        tzaars:tzarras:totts:_ = activeCounts b
-        m = move b
+  where m = move b
 
 
 
 -- | next capture moves for the active player
 captureMoves :: Board -> [Move]
-captureMoves board = Map.foldrWithKey forPiece [] (pieces board)
+captureMoves Board{..} = HashMap.foldrWithKey forPiece [] pieces
   where
-    c = active board
     forPiece :: Position -> Piece -> [Move] -> [Move]
-    forPiece !p (!c', _, !i) moves 
-      | c==c'     = foldl' downLine moves (sixLines p)
+    forPiece !p (Piece c _ i) moves
+      | c==active = foldl' downLine moves (sixLines p)
       | otherwise = moves
         where
           downLine :: [Move] -> [Position] -> [Move]
           downLine moves []   = moves
-          downLine moves (q:ps) 
-              = case Map.lookup q (pieces board) of
-                  Nothing -> downLine moves ps 
-                  Just (c', _, j) | c/=c' && i>=j -> (Capture p q):moves
+          downLine moves (q:rest)
+              = case {-# SCC "piece-lookup" #-} HashMap.lookup q pieces of
+                  Nothing -> downLine moves rest
+                  Just (Piece c _ j) | c/=active && i>=j -> (Capture p q):moves
                   _  -> moves
 
 
 
 -- | next stacking moves for the active player
 stackingMoves :: Board -> [Move]
-stackingMoves board = foldl' forPiece [] (Map.assocs (pieces board))
-  where 
+stackingMoves board = HashMap.foldlWithKey' forPiece [] (pieces board)
+  where
     c = active board
-    tzaars:tzarras:totts:_ = activeCounts board
-    forPiece :: [Move] -> (Position,Piece) -> [Move]
-    forPiece moves (p,(c',_,_)) 
+    tzaars = activeCounts board Vec.! fromEnum Tzaar
+    tzarras= activeCounts board Vec.! fromEnum Tzarra
+    totts  = activeCounts board Vec.! fromEnum Tott
+    forPiece :: [Move] -> Position -> Piece -> [Move]
+    forPiece moves p (Piece c' _ _)
       | c==c'     = foldl' downLine moves (sixLines p)
       | otherwise = moves
         where
           downLine :: [Move] -> [Position] -> [Move]
           downLine moves [] = moves
-          downLine moves (q:ps) 
-              = case Map.lookup q (pieces board) of
+          downLine moves (q:ps)
+              = case {-# SCC "piece-lookup" #-} HashMap.lookup q (pieces board) of
                   Nothing  -> downLine moves ps
-                  Just (c', _, _) | c/=c' -> moves
-                  Just (_, Tzaar, _) | tzaars==1  -> moves
-                  Just (_, Tzarra, _) | tzarras==1 -> moves
-                  Just (_, Tott, _) | totts==1  -> moves
-                  Just (_, _, _)  -> (Stack p q) : moves
+                  Just (Piece c' _ _) | c/=c' -> moves
+                  Just (Piece _ Tzaar _) | tzaars==1  -> moves
+                  Just (Piece _ Tzarra _) | tzarras==1 -> moves
+                  Just (Piece _ Tott _) | totts==1  -> moves
+                  Just _  -> (Stack p q) : moves
 
 
 
@@ -250,62 +261,60 @@
 -- | count the number of stacks of each type in a half-board
 countStacks :: Color -> PieceMap -> [Int]
 countStacks c pieces
-    = count 0 0 0 (Map.elems pieces)
+    = count 0 0 0 (HashMap.elems pieces)
     where
       count :: Int -> Int -> Int -> [Piece] -> [Int]
-      count !x !y !z ((c',Tzaar,_) : ps)  | c==c' = count (1+x) y z ps
-      count !x !y !z ((c',Tzarra,_) : ps) | c==c' = count x (1+y) z ps
-      count !x !y !z ((c',Tott,_) : ps)   | c==c' = count x y (1+z) ps
-      count !x !y !z (_ : ps)                     = count x y z ps      
+      count !x !y !z ((Piece c' Tzaar _) : ps)  | c==c' = count (1+x) y z ps
+      count !x !y !z ((Piece c' Tzarra _) : ps) | c==c' = count x (1+y) z ps
+      count !x !y !z ((Piece c' Tott _) : ps)   | c==c' = count x y (1+z) ps
+      count !x !y !z (_ : ps)                     = count x y z ps
       count !x !y !z []              = [x,y,z]
 
 
 -- | sum of heights of stacks for each kind
 sumHeights :: Color -> PieceMap -> [Int]
-sumHeights c pieces = sum 0 0 0 (Map.elems pieces)
+sumHeights c pieces = sum 0 0 0 (HashMap.elems pieces)
   where sum :: Int -> Int -> Int -> [Piece] -> [Int]
-        sum !x !y !z ((c',Tzaar,!h):ps)  | c==c' = sum (x+h) y z ps
-        sum !x !y !z ((c',Tzarra,!h):ps) | c==c' = sum x (y+h) z ps
-        sum !x !y !z ((c',Tott,!h):ps)   | c==c' = sum x y (z+h) ps
+        sum !x !y !z ((Piece c' Tzaar !h):ps)  | c==c' = sum (x+h) y z ps
+        sum !x !y !z ((Piece c' Tzarra !h):ps) | c==c' = sum x (y+h) z ps
+        sum !x !y !z ((Piece c' Tott !h):ps)   | c==c' = sum x y (z+h) ps
         sum !x !y !z (_ : ps)        = sum x y z ps
         sum !x !y !z []              = [x,y,z]
 
 -- | maximum height for each kind
-maxHeights :: Color -> PieceMap -> [Int]        
-maxHeights c pieces = maxh 0 0 0 (Map.elems pieces)
+maxHeights :: Color -> PieceMap -> [Int]
+maxHeights c pieces = maxh 0 0 0 (HashMap.elems pieces)
   where maxh :: Int -> Int -> Int -> [Piece] -> [Int]
-        maxh !x !y !z ((c',Tzaar,!h):ps) | c==c' && h>x = maxh h y z ps
-        maxh !x !y !z ((c',Tzarra,!h):ps) | c==c' && h>y= maxh x h z ps        
-        maxh !x !y !z ((c',Tott,!h):ps) | c==c' && h>z  = maxh x y h ps
+        maxh !x !y !z ((Piece c' Tzaar !h):ps) | c==c' && h>x = maxh h y z ps
+        maxh !x !y !z ((Piece c' Tzarra !h):ps) | c==c' && h>y= maxh x h z ps
+        maxh !x !y !z ((Piece c' Tott !h):ps) | c==c' && h>z  = maxh x y h ps
         maxh !x !y !z (_ : ps) = maxh x y z ps
         maxh !x !y !z []       = [x,y,z]
 
 
--- | The next board state after a move.  
+-- | The next board state after a move.
 -- | Assumes the move is valid.
 applyMove :: Move -> Board -> Board
-applyMove m@(Capture x y) b 
-  = b {active=invert (active b), 
-       move=1+move b, 
-       moves = m:moves b,
-       pieces= pieces', 
+applyMove m@(Capture x y) b
+  = b {active=invert (active b),
+       move=1+move b,
+       pieces= pieces',
        activeCounts = counts',         -- swap counts
        inactiveCounts= activeCounts b,
        activeHeights = heights',       -- swap heights
        inactiveHeights = activeHeights b
       }
     where
-      pX  = pieces b!x      
-      (_, kindY, sizeY) = pieces b!y
-      pieces' = Map.insert y pX (Map.delete x (pieces b))
+      pX  = pieces b HashMap.! x
+      (Piece _ kindY sizeY) = pieces b HashMap.! y
+      pieces' = {-# SCC "piece-insert" #-} HashMap.insert y pX (HashMap.delete x (pieces b))
       counts' = increment kindY (-1)     (inactiveCounts b)
       heights'= increment kindY (-sizeY) (inactiveHeights b)
 
 
-applyMove m@(Stack x y) b 
-  = b {active=invert (active b), 
-       move=1+move b, 
-       moves= m:moves b,
+applyMove m@(Stack x y) b
+  = b {active=invert (active b),
+       move=1+move b,
        pieces=pieces',
        activeCounts = inactiveCounts b,
        inactiveCounts = counts',
@@ -313,19 +322,18 @@
        inactiveHeights= heights'
          }
     where
-      (colorX, kindX, sizeX) = pieces b!x
-      (_,      kindY, sizeY) = pieces b!y
-      pieces' = Map.insert y (colorX,kindX,sizeX+sizeY) (Map.delete x (pieces b))
+      (Piece colorX kindX sizeX) = pieces b HashMap.! x
+      (Piece _     kindY sizeY) = pieces b HashMap.! y
+      pieces' = {-# SCC "piece-ins-del" #-} HashMap.insert y (Piece colorX kindX (sizeX+sizeY)) (HashMap.delete x (pieces b))
       counts' = increment kindY (-1) (activeCounts b)
       heights' | kindX==kindY = activeHeights b
-               | otherwise = increment kindY (-sizeY) $ 
+               | otherwise = increment kindY (-sizeY) $
                              increment kindX sizeY (activeHeights b)
-          
-          
+
+
 -- Pass & Skip have the same effect
-applyMove m b = b {active= invert (active b), 
-                   move=1+move b, 
-                   moves= m:moves b,
+applyMove m b = b {active= invert (active b),
+                   move=1+move b,
                    activeCounts= inactiveCounts b,
                    inactiveCounts= activeCounts b,
                    activeHeights= inactiveHeights b,
@@ -333,35 +341,23 @@
                   }
 
 -- | modify a counter
-increment :: Kind -> Int -> [Int] -> [Int]
-increment Tzaar  i (tzaars:tzarras:totts:_) = (tzaars+i) : tzarras : totts : []
-increment Tzarra i (tzaars:tzarras:totts:_) = tzaars : (tzarras+i) : totts : []
-increment Tott   i (tzaars:tzarras:totts:_) = tzaars : tzarras : (totts+i) : []
+increment :: Kind -> Int -> Vector Int -> Vector Int
+increment !k !n v = v Vec.// [(i, n + v Vec.! i)]
+  where !i = fromEnum k
 
 
 -- | apply one move and subsequent skip move
-applyMoveSkip :: Move -> Board -> Board 
-applyMoveSkip m b 
+applyMoveSkip :: Move -> Board -> Board
+applyMoveSkip m b
   = case nextMoves b' of
-    (Skip:_) -> applyMove Skip b'  -- compulsory move
-    _      -> b'
+      [Skip] -> applyMove Skip b'  -- compulsory move
+      _      -> b'
     where b' = applyMove m b
 
 
--- | apply one move checking for validity
-applyMoveSkip' :: Board -> Move -> Maybe Board
-applyMoveSkip' b m
-  | m`elem`ms = 
-    case nextMoves b' of
-      (Skip:_) -> Just (applyMove Skip b')
-      _ -> Just b'
-  | otherwise = Nothing
-  where ms = nextMoves b
-        b' = applyMove m b
 
-                          
 endGame :: Board -> Bool
-endGame = null . nextMoves 
+endGame = null . nextMoves
 
 winner :: Board -> Color
 winner = invert . active
@@ -389,7 +385,7 @@
   ,     [B6, C6, D6, E5, F5, G4, H3, I2]
   ,         [C7, D7, E6, F6, G5, H4, I3]
   ,             [D8, E7, F7, G6, H5, I4]
-  ,                 [E8, F8, G7, H6, I5]   
+  ,                 [E8, F8, G7, H6, I5]
   ,                 [E1, F1, G1, H1, I1]
   ,             [D1, E2, F2, G2, H2, I2]
   ,         [C1, D2, E3, F3, G3, H3, I3]
@@ -402,39 +398,36 @@
   , [A5, B6, C7, D8, E8]
   ]
 
--- | The three lines that cross at a single board position.
-threeLines :: Position -> [[Position]]
-threeLines p = [ line | line <- connectedPositions, elem p line ]
 
-
 -- | The six lines traveling radially out from a single board position.
--- | optimization: this map should be memoied lazily 
-sixLines_memo :: Map Position [[Position]]  -- Map Position [[Position]]
-sixLines_memo = Map.fromList [(p, radials p) | p<-positions]
+sixLines :: Position -> [[Position]]
+sixLines p = sixLinesArray ! p
+
+-- | global memoied array  
+sixLinesArray :: Array Position [[Position]]
+sixLinesArray = array (minBound,maxBound) [(p, radials p) | p<-positions]
     where radials p = [r | l<-threeLines p, r<-divide p l, not (null r)]
           divide a b = [reverse x, y]
               where (x, _:y) = span (/= a) b
 
-sixLines :: Position -> [[Position]]
-sixLines p = sixLines_memo!p
-
-
-
+-- | The three lines that cross at a single board position.
+threeLines :: Position -> [[Position]]
+threeLines p = [ line | line <- connectedPositions, p `elem` line ]
 
 -- | An empty board
 emptyBoard :: Board
-emptyBoard = initBoard [] 
+emptyBoard = initBoard []
 
 -- | The default (non-randomized, non-tournament) starting position.
 startingBoard :: Board
-startingBoard   = initBoard (whites ++ blacks) 
+startingBoard   = initBoard (whites ++ blacks)
   where
-  whites = [(p, (White,Tzaar,1)) | p<-wTzaars] ++ 
-           [(p, (White,Tzarra,1)) | p<-wTzarras] ++ 
-           [(p, (White,Tott,1)) | p<-wTotts]
-  blacks = [(p, (Black,Tzaar,1)) | p<-bTzaars] ++ 
-           [(p, (Black,Tzarra,1)) | p<-bTzarras] ++ 
-           [(p, (Black,Tott,1)) | p<-bTotts]
+  whites = [(p, (Piece White Tzaar 1)) | p<-wTzaars] ++
+           [(p, (Piece White Tzarra 1)) | p<-wTzarras] ++
+           [(p, (Piece White Tott 1)) | p<-wTotts]
+  blacks = [(p, (Piece Black Tzaar 1)) | p<-bTzaars] ++
+           [(p, (Piece Black Tzarra 1)) | p<-bTzarras] ++
+           [(p, (Piece Black Tott 1)) | p<-bTotts]
   wTzaars  = [D3, E3, G4, G5, C5, D6]
   wTzarras = [C2, D2, E2, H3, H4, H5, B5, C6, D7]
   wTotts   = [B1, C1, D1, E1, I2, I3, I4, I5, D8, C7, B6, A5, E4, F5, D5]
@@ -446,13 +439,13 @@
 -- | A randomized starting position
 randomBoard :: StdGen -> (Board, StdGen)
 randomBoard rnd = (b, rnd')
-    where b = initBoard (whites++blacks) 
-          ws = replicate 6 (White,Tzaar,1) ++
-               replicate 9 (White,Tzarra,1) ++
-               replicate 15 (White,Tott,1)
-          bs = replicate 6 (Black,Tzaar,1) ++
-               replicate 9 (Black,Tzarra,1) ++
-               replicate 15 (Black,Tott,1)
+    where b = initBoard (whites++blacks)
+          ws = replicate 6 (Piece White Tzaar 1) ++
+               replicate 9 (Piece White Tzarra 1) ++
+               replicate 15 (Piece White Tott 1)
+          bs = replicate 6 (Piece Black Tzaar 1) ++
+               replicate 9 (Piece Black Tzarra 1) ++
+               replicate 15 (Piece Black Tott 1)
           (positions',rnd') = shuffle rnd positions
           whites = zip (take 30 positions') ws
           blacks = zip (drop 30 positions') bs
@@ -469,7 +462,7 @@
 shuffle g xs = shuffle' g xs (length xs)
     where
       shuffle' :: RandomGen g => g -> [a] -> Int -> ([a], g)
-      shuffle' g xs n 
+      shuffle' g xs n
           | n>0 = let (k, g') = randomR (0,n-1) g
                       (xs',x:xs'') = splitAt k xs
                       (ys,g'') = shuffle' g' (xs' ++ xs'') (n-1)
@@ -482,37 +475,36 @@
 -- Estimate the zone of control of a player
 -- i.e., the opponents' pieces that can be captured in two moves
 zoneOfControl ::  Color -> PieceMap -> PieceMap
-zoneOfControl c pieces = Map.filterWithKey forPiece1 pieces
+zoneOfControl c pieces = HashMap.filterWithKey forPiece1 pieces
     where
       -- player's pieces that make at least one capture
-      movable = Map.filterWithKey forPiece2 pieces
+      movable = HashMap.filterWithKey forPiece2 pieces
 
       forPiece1, forPiece2 :: Position -> Piece -> Bool
-      forPiece1 p (c', _, i) = c'/=c && or (map (downLine0 i) $ sixLines p)
-      forPiece2 p (c',_, h) = c'==c && or (map (downLine2 h) $ sixLines p)
+      forPiece1 p (Piece c' _ i) = c'/=c && any (downLine0 i) (sixLines p)
+      forPiece2 p (Piece c' _ h) = c'==c && any (downLine2 h) (sixLines p)
 
       downLine0, downLine1, downLine2 :: Int -> [Position] -> Bool
 
-      downLine0 i [] = False
-      downLine0 i (p:ps) 
-          = case Map.lookup p pieces of
+      downLine0 !i [] = False
+      downLine0 !i (p:ps)
+          = case HashMap.lookup p pieces of
               Nothing -> downLine0 i ps
-              Just (c', _, h) | c'==c -> 
-                  h>=i || (p`Map.member`movable && downLine1 i ps)
-              Just (c', _, j) | c'/=c -> 
-                  or $ map (downLine1 (max i j)) $ sixLines p
+              Just (Piece c' _ h) -> if c==c' then
+                    h>=i || (p`HashMap.member`movable && downLine1 i ps)
+                  else
+                    let !h' = max i h
+                    in any (downLine1 h') (sixLines p)
 
-      downLine1 i [] = False
-      downLine1 i (p:ps) 
-          = case Map.lookup p pieces of
+
+      downLine1 !i [] = False
+      downLine1 !i (p:ps)
+          = case HashMap.lookup p pieces of
               Nothing -> downLine1 i ps
-              Just (c', _, h) -> c'==c && h>=i
+              Just (Piece c' _ h) -> c'==c && h>=i
 
-      downLine2 h [] = False
-      downLine2 h (p:ps) 
-          = case Map.lookup p pieces of
+      downLine2 !h [] = False
+      downLine2 !h (p:ps)
+          = case HashMap.lookup p pieces of
               Nothing -> downLine2 h ps
-              Just (c', _, i) -> c'/=c && h>=i
-
-
-
+              Just (Piece c' _ i) -> c'/=c && h>=i
diff --git a/src/GUI.hs b/src/GUI.hs
--- a/src/GUI.hs
+++ b/src/GUI.hs
@@ -10,11 +10,13 @@
 import Graphics.UI.Gtk.Glade
 import Graphics.Rendering.Cairo hiding (version)
 import Data.Function (on)
-import qualified Data.Map as Map
+import qualified Data.Map.Strict as Map
+import qualified Data.HashMap.Strict as HashMap
 import Data.Map (Map, (!))
 import Data.List (minimumBy, sortBy)
 import Control.Concurrent
 import Control.Monad (when, filterM, liftM, mplus, msum)
+import Control.Monad.State (runState)
 import System.IO
 import System.FilePath
 import System.Random hiding (next)
@@ -24,14 +26,14 @@
 --import AI.Eval
 -- import History (History)
 -- import qualified History as History
-import Serialize  -- convert to/from XML 
+import Serialize  -- convert to/from XML
 import Text.XML.Light
 
 
 -- | Selection state
 data State =  Wait0               -- wait for human (1st position)
             | Wait1 Position      -- wait for human (2nd position)
-            | WaitAI (MVar Move)  -- wait for AI 
+            | WaitAI (MVar Move)  -- wait for AI
             | Finish              -- game ended
 
 
@@ -45,11 +47,11 @@
 initGameState gui b White = return (initGame b White, Wait0)
 initGameState gui b Black = do ai <- getAI gui
                                mvar <- newEmptyMVar
-                               forkOS $ runAI ai b mvar 
+                               forkOS $ runAI ai b mvar
                                return (initGame b Black, WaitAI mvar)
 
-                   
 
+
 -- | record to hold references to the GUI widgets
 data GUI = GUI {
       mainwin  :: Window,
@@ -87,9 +89,9 @@
 loadGlade :: FilePath -> IO GUI
 loadGlade path =
     do out <- xmlNew path
-       case out of 
+       case out of
          Nothing -> error ("unable to open glade file " ++ show path)
-         Just xml -> 
+         Just xml ->
              do mw <- xmlGetWidget xml castToWindow "mainwindow"
                 abd <- xmlGetWidget xml castToAboutDialog "aboutdialog"
                 std <- xmlGetWidget xml castToDialog "startdialog"
@@ -111,7 +113,7 @@
                 playb <- xmlGetWidget xml castToRadioButton "playblack"
                 mab<- xmlGetWidget xml castToMenuItem "menu_item_about"
                 -- fill in dynamic parts
-                aboutDialogSetVersion abd (showVersion version)       
+                aboutDialogSetVersion abd (showVersion version)
                 bd <- drawingAreaNew
                 containerAdd fr bd
                 m<- xmlGetWidget xml castToMenu "menu_ai"
@@ -124,18 +126,18 @@
                                           menuAttach m w 0 1 i (i+1)
                                           return w
                                   | (i,ai)<-zip [1..] (tail aiLevels)]
-                -- select default AI: this is hardcoded to be the *second* entry 
+                -- select default AI: this is hardcoded to be the *second* entry
                 checkMenuItemSetActive r1 True
                 tooltipsEnable tips
                 -- open/save file dialogs
-                ff <- fileFilterNew 
+                ff <- fileFilterNew
                 fileFilterSetName ff "Tzaar saved games (*.tza)"
                 fileFilterAddPattern ff "*.tza"
-                opf <- fileChooserDialogNew (Just "Open saved game") Nothing FileChooserActionOpen 
-                       [("Cancel",ResponseCancel),("Open",ResponseOk)] 
+                opf <- fileChooserDialogNew (Just "Open saved game") Nothing FileChooserActionOpen
+                       [("Cancel",ResponseCancel),("Open",ResponseOk)]
                 fileChooserAddFilter opf ff
                 svf <- fileChooserDialogNew (Just "Save game") Nothing FileChooserActionSave
-                       [("Cancel",ResponseCancel),("Save",ResponseOk)] 
+                       [("Cancel",ResponseCancel),("Save",ResponseOk)]
                 fileChooserAddFilter svf ff
                 cid <- statusbarGetContextId sb "status"
                 widgetShowAll mw
@@ -144,47 +146,46 @@
 
 -- | main GUI entry point
 gui :: FilePath -> IO ()
-gui path = 
+gui path =
     do initGUI
        gui <- loadGlade path
-       b <- randomBoardIO 
+       b <- randomBoardIO
        g <- initGameState gui b White  -- human plays white by default
        gamev <- newMVar g
-       connect_events gui gamev 
-       -- timer event for updating the gui 
+       connect_events gui gamev
+       -- timer event for updating the gui
        timeoutAdd (updateGUI gui gamev >> return True) 100
        -- start GTK event loop
        mainGUI
 
 
 -- | connect event handlers for GUI elements
-connect_events gui gamev 
-    = do onExpose (canvas gui) $ \x -> 
+connect_events gui gamev
+    = do onExpose (canvas gui) $ \x ->
              do drawCanvas gui gamev
                 return (eventSent x)
          onButtonPress (canvas gui) $ \x ->
              do mp<-getPosition (canvas gui) (eventX x) (eventY x)
-                case mp of 
+                case mp of
                   Nothing -> return (eventSent x)
                   Just p -> do clickBoard gui gamev p
                                return (eventSent x)
 
          onDestroy (mainwin gui) mainQuit
-         onActivateLeaf (menu_item_about gui) $ 
+         onActivateLeaf (menu_item_about gui) $
                         do { dialogRun (aboutdialog gui)
                            ; widgetHide (aboutdialog gui)
                            }
          onActivateLeaf (menu_item_quit gui) mainQuit
          onActivateLeaf (menu_item_new gui) (newGame gui gamev)
-         onActivateLeaf (menu_item_open gui) $ 
+         onActivateLeaf (menu_item_open gui) $
            do { answer<-fileDialogRun (open_file_chooser gui)
               ; case answer of
-                   Just path -> do ai <- getAI gui 
-                                   openGame ai gamev path
+                   Just path -> do openGame gamev path
                                    redrawCanvas (canvas gui)
                    Nothing -> return ()
               }
-         onActivateLeaf (menu_item_save gui) $ 
+         onActivateLeaf (menu_item_save gui) $
            do { answer<-fileDialogRun (save_file_chooser gui)
               ; case answer of
                    Just path -> saveGame gamev (replaceExtension path ".tza")
@@ -202,7 +203,7 @@
 
 -- | start a new game
 newGame :: GUI -> MVar (Game,State) -> IO ()
-newGame gui gamev 
+newGame gui gamev
     = do answer <- dialogRun (startdialog gui)
          widgetHide (startdialog gui)
          case answer of
@@ -210,7 +211,7 @@
            _              -> return ()
   where startgame = do
          r <- toggleButtonGetActive (fixed_position gui)
-         b <- if r then return startingBoard else randomBoardIO 
+         b <- if r then return startingBoard else randomBoardIO
          r <- toggleButtonGetActive (play_white gui)
          let c = if r then White else Black
          modifyMVar_ gamev (\_ -> initGameState gui b c)
@@ -218,38 +219,28 @@
 
 
 -- | open a saved game
-openGame :: AI -> MVar (Game,State) -> FilePath -> IO ()
-openGame ai gamev filepath
+openGame :: MVar (Game,State) -> FilePath -> IO ()
+openGame gamev filepath
     = withFile filepath ReadMode $ \handle ->
-      do txt <- hGetContents handle       
+      do txt <- hGetContents handle
          case readXML txt of
-           Nothing -> 
-             putStrLn ("ERROR: couldn't parse game file " ++ show filepath)
-           Just g -> 
-             let b = board g
-             in modifyMVar_ gamev $ 
-                \_ -> if endGame b then
-                        return (g,Finish)
-                else if active b == human g then
-                       return (g,Wait0)
-                     else do { mvar <- newEmptyMVar
-                             ; forkOS $ runAI ai b mvar
-                             ; return (g,WaitAI mvar)
-                             }
+           Nothing -> putStrLn ("ERROR: couldn't parse game file " ++ show filepath)
+           Just g -> let s = if endGame (board g) then Finish else Wait0
+                     in modifyMVar_ gamev $ \_ -> return (g,s)
 
 
 -- | write a game file
 saveGame :: MVar (Game,State) -> FilePath -> IO ()
-saveGame gamev filepath 
+saveGame gamev filepath
   = do (g,_) <- readMVar gamev
-       withFile filepath WriteMode $ 
+       withFile filepath WriteMode $
          \handle -> hPutStr handle (showXML g)
 
 
 fileDialogRun :: FileChooserDialog -> IO (Maybe FilePath)
-fileDialogRun w = do { r<-dialogRun w 
+fileDialogRun w = do { r<-dialogRun w
                      ; widgetHide w
-                     ; case r of 
+                     ; case r of
                          ResponseOk -> fileChooserGetFilename w
                          _ -> return Nothing
                      }
@@ -257,29 +248,29 @@
 
 -- | get the selected AI player
 getAI :: GUI -> IO AI
-getAI gui 
+getAI gui
     = do rs<-filterM (checkMenuItemGetActive . fst) (zip (menu_item_ai_levels gui) [0..])
          let i = snd (head rs)
          return (aiLevels !! i)
-             
 
 
+
 -- | periodically update the GUI elements when waiting for AI
 updateGUI :: GUI -> MVar (Game,State) -> IO ()
-updateGUI gui gamev 
-  = modifyMVar_ gamev $ \(g,s) -> 
+updateGUI gui gamev
+  = modifyMVar_ gamev $ \(g,s) ->
   let m = nthMove (move (board g))  -- 1st or 2nd move of turn?
   in do { widgetSetSensitive (menu_item_undo gui) $
           not (waitingAI s) && not (null (trail g))
         ; widgetSetSensitive (menu_item_redo gui) $
           not (waitingAI s) && not (null (remain g))
-        ; widgetSetSensitive (menu_item_pass gui) $ 
+        ; widgetSetSensitive (menu_item_pass gui) $
           not (waitingAI s) && m==2
         ; updateStatus gui (statusText g s)
-        ; case s of 
-          WaitAI mvar -> 
+        ; case s of
+          WaitAI mvar ->
             do { reply <- tryTakeMVar mvar
-               ; case reply of 
+               ; case reply of
                  Nothing -> do { progressBarPulse (progressbar gui)
                                ; return (g,s) }
                  Just m -> do { redrawCanvas (canvas gui)
@@ -294,16 +285,16 @@
 
 statusText :: Game -> State -> String
 statusText g s
-  = let b = board g 
-        n = move b            
-        msg = "Turn " ++ show (nthTurn n) ++ ", move " ++ show (nthMove n)  ++ ": " 
-    in case s of 
+  = let b = board g
+        n = move b
+        msg = "Turn " ++ show (nthTurn n) ++ ", move " ++ show (nthMove n)  ++ ": "
+    in case s of
           Finish -> show (winner b) ++ " wins."
           WaitAI _ -> msg ++ show (active b) ++ " thinking..."
-          _ ->  msg ++ show (active b) ++ " to play." 
-           
+          _ ->  msg ++ show (active b) ++ " to play."
 
 
+
 -- | replace the status message
 updateStatus :: GUI -> String -> IO ()
 updateStatus gui txt
@@ -314,15 +305,15 @@
 
 -- | pass the 2nd move of a turn
 passMove :: GUI -> MVar (Game,State) -> IO ()
-passMove gui gamev 
-  = modifyMVar_ gamev $ 
-    \(g,s) -> 
+passMove gui gamev
+  = modifyMVar_ gamev $
+    \(g,s) ->
     if human g == active (board g) then -- human to play?
       let moves = nextMoves (board g)
       in case s of
-        Wait0 | Pass`elem`moves -> 
+        Wait0 | Pass`elem`moves ->
           do ai <- getAI gui
-             redrawCanvas (canvas gui)           
+             redrawCanvas (canvas gui)
              makeMove ai Pass g
         _ -> return (g,s)
     else return (g,s)
@@ -331,12 +322,12 @@
 
 -- | undo/redo move history navigation
 undoMove :: GUI -> MVar (Game,State) -> IO ()
-undoMove gui gamev 
+undoMove gui gamev
   = modifyMVar_ gamev $ \(g,s) ->
-  let ms = trail g 
-  in case ms of 
+  let ms = trail g
+  in case ms of
     [] -> return (g,s)
-    (m:ms') -> 
+    (m:ms') ->
       let b'= foldr applyMoveSkip (initial g) ms'
           s'= if endGame b' then Finish else Wait0
       in do redrawCanvas (canvas gui)
@@ -344,12 +335,12 @@
 
 
 redoMove :: GUI -> MVar (Game,State) -> IO ()
-redoMove gui gamev 
+redoMove gui gamev
   = modifyMVar_ gamev $ \(g,s) ->
-  let ms = remain g 
-  in case ms of 
+  let ms = remain g
+  in case ms of
     [] -> return (g,s)
-    (m:ms') -> 
+    (m:ms') ->
       let b' = applyMoveSkip m (board g)
           s' = if endGame b' then Finish else Wait0
       in do redrawCanvas (canvas gui)
@@ -360,24 +351,24 @@
 clickBoard :: GUI -> MVar (Game,State) -> Position -> IO ()
 clickBoard gui gamev p
   = do { ai <- getAI gui
-       ; modifyMVar_ gamev $ \(g,s) -> 
+       ; modifyMVar_ gamev $ \(g,s) ->
           if active (board g) == human g -- user's turn to play?
-          then 
-            let moves = nextMoves (board g) 
+          then
+            let moves = nextMoves (board g)
             in case s of
               Wait0 | p`prefix`moves -> return (g, Wait1 p)
               Wait1 p' | p'==p -> return (g, Wait0)
-              Wait1 p' | (Capture p' p)`elem`moves -> 
+              Wait1 p' | (Capture p' p)`elem`moves ->
                 makeMove ai (Capture p' p) g
-              Wait1 p' | (Stack p' p)`elem`moves -> 
+              Wait1 p' | (Stack p' p)`elem`moves ->
                 makeMove ai (Stack p' p) g
               _ -> return (g,s)
           else return (g,s)
        ; redrawCanvas (canvas gui)
        }
-                                       
 
 
+
 -- | check if we can start a move from a position
 prefix :: Position -> [Move] -> Bool
 prefix p moves
@@ -393,24 +384,24 @@
 makeMove ai m g
   | endGame b'           = return (g',Finish)
   | active b' == human g = return (g',Wait0)
-  | otherwise = 
+  | otherwise =
     do { mvar <- newEmptyMVar
-       ; forkOS $ runAI ai b' mvar 
+       ; forkOS $ runAI ai b' mvar
        ; return (g',WaitAI mvar)
        }
    where b' = applyMoveSkip m (board g)
          g' = g {board=b', trail=m:trail g, remain=[]}
-         
-             
 
+
+
 -- | separate thread for the AI opponent
 runAI :: AI -> Board -> MVar Move -> IO ()
 runAI ai b mvar
   = do { threadDelay (200*1000)  -- short delay to allow GUI redraw
        ; rnd <- getStdGen
-       ; let (score, m, rnd') = playing ai b rnd
+       ; let ((m, score), rnd') = runState (strategy ai b) rnd
        ; setStdGen rnd'
-         -- ; putStrLn ("AI move: "++show m ++ " score: " ++ show score)
+       ; putStrLn ("AI move: "++show m ++ "\t" ++ show score)
        ; m `seq` putMVar mvar m
        }
 
@@ -435,8 +426,8 @@
          drawin <- widgetGetDrawWindow (canvas gui)
          (g,s) <- readMVar gamev
          renderWithDrawable drawin $
-          renderWithSimilarSurface ContentColor w h $ 
-            \tmp -> 
+          renderWithSimilarSurface ContentColor w h $
+            \tmp ->
                 do renderWith tmp (setTransform w h >> renderBoard b1 b2 b3 g s)
                    setSourceSurface tmp 0 0
                    paint
@@ -445,7 +436,7 @@
 -- | render the board and pieces
 renderBoard :: Bool -> Bool -> Bool -> Game -> State -> Render ()
 renderBoard showHeights showMoves showStacks g s
-  = do boardBg >> paint -- paint the background 
+  = do boardBg >> paint -- paint the background
        -- paint the playing area light gray
        gray 0.9 >> polyLine [A1, A5, E8, I5, I1, E1] >> closePath >> fill
        -- repaint the center with background color
@@ -456,9 +447,9 @@
        case s of
          Wait0      -> do renderPieces showHeights showStacks b
                           when showMoves $ mapM_ renderMove previous
-         Wait1 p    -> do highlight p 
+         Wait1 p    -> do highlight p
                           renderPieces showHeights showStacks b
-                          when showMoves $ 
+                          when showMoves $
                             do mapM_ renderMove (targets p)
                                mapM_ renderMove previous
          WaitAI _   -> do renderPieces showHeights showStacks b
@@ -469,21 +460,21 @@
           moves = nextMoves b           -- next available moves
           previous = take 2 (trail g)   -- opponent's previous moves
           -- move targets from a position
-          targets p = [m | m@(Capture p1 p2)<-moves, p1==p] ++ 
+          targets p = [m | m@(Capture p1 p2)<-moves, p1==p] ++
                       [m | m@(Stack p1 p2)<-moves, p1==p]
 
 
 renderMove :: Move -> Render ()
-renderMove (Capture p1 p2) 
+renderMove (Capture p1 p2)
   = do { setSourceRGBA 1 0 0 0.7; arrowFromTo p1 p2 }
-renderMove (Stack p1 p2) 
+renderMove (Stack p1 p2)
   = do { setSourceRGBA 0 0 1 0.7; arrowFromTo p1 p2 }
 renderMove Pass = return ()
 renderMove Skip = return ()
 
 arrowFromTo :: Position -> Position -> Render ()
 arrowFromTo p1 p2 = do setLineWidth 10
-                       moveTo xstart ystart 
+                       moveTo xstart ystart
                        lineTo x0 y0
                        stroke
                        setLineWidth 1
@@ -509,13 +500,13 @@
 renderGrid :: Render ()
 renderGrid = do gray 0
                 setLineWidth 1
-                sequence_ [lineFromTo p1 p2 | (p1,p2)<-lines]                 
+                sequence_ [lineFromTo p1 p2 | (p1,p2)<-lines]
                 setFontSize 22
                 sequence_ [do uncurry moveTo $ tr (-10,60) $ screenCoordinate p
-                              showText (show p) 
+                              showText (show p)
                            | p<-[A1,B1,C1,D1,E1,F1,G1,H1,I1]]
                 sequence_ [do uncurry moveTo $ tr (-10,-50) $ screenCoordinate p
-                              showText (show p) 
+                              showText (show p)
                            | p<-[A5, B6,C7,D8,E8,F8,G7,H6,I5]]
     where tr (dx,dy) (x,y) = (x+dx,y+dy)
           lineFromTo p1 p2 = do uncurry moveTo $ screenCoordinate p1
@@ -523,7 +514,7 @@
                                 stroke
           lines = [(A1,A5), (B1,B6), (C1,C7), (D1,D8), (E1,E4),
                    (E5,E8), (F1,F8), (G1,G7), (H1,H6), (I1,I5),
-                   (A1,E1), (A2,F1),(A3,G1), (A4,H1), 
+                   (A1,E1), (A2,F1),(A3,G1), (A4,H1),
                    (A5, D5), (F4,I1), (B6,I2), (C7,I3), (D8,I4), (E8,I5),
                    (E1,I1), (D1,I2), (C1,I3), (B1,I4), (A1,D4), (F5,I5),
                    (A5,E8), (A4,F8), (A3,G7), (A2,H6)]
@@ -532,23 +523,23 @@
 
 -- setup coordinate transform for the board
 setTransform :: Int -> Int -> Render ()
-setTransform w h 
+setTransform w h
     = do translate (fromIntegral w/2) (fromIntegral h/2)
-         scale (fromIntegral side/1000) (fromIntegral side/1000) 
+         scale (fromIntegral side/1000) (fromIntegral side/1000)
     where side = min w h   -- constraint to square aspect ratio
 
-        
 
 
+
 -- board background (pale yellow)
 boardBg :: Render ()
-boardBg = setSourceRGB 1 0.95 0.6 
+boardBg = setSourceRGB 1 0.95 0.6
 
 -- shades of gray from 0 (black) to 1 (white)
 gray :: Double -> Render ()
 gray x = setSourceRGB x x x
-     
 
+
 -- draw a polygonal line
 polyLine :: [Position] -> Render ()
 polyLine (p:ps) = do uncurry moveTo $ screenCoordinate p
@@ -567,13 +558,13 @@
 
 -- render all pieces in the board
 renderPieces :: Bool -> Bool -> Board -> Render ()
-renderPieces showheights showstacks board 
+renderPieces showheights showstacks board
     = do setLineWidth 2
          -- board pieces
-         sequence_ [ renderStack showheights showstacks x y piece |  
+         sequence_ [ renderStack showheights showstacks x y piece |
                      (pos,piece) <- assocs, let (x,y)= screenCoordinate pos]
     -- sort pieces by reverse position to draw from back to front
-    where assocs = sortBy cmp $ Map.assocs (pieces board)
+    where assocs = sortBy cmp $ HashMap.toList (pieces board)
           cmp (x,_) (y,_) = compare y x
           -- captures = capturedPieces board
           -- whiteCaptures = [(White,k,n) | (White,k,n)<-captures]
@@ -586,20 +577,20 @@
 
 -- | render a stack of pieces
 renderStack :: Bool -> Bool -> Double -> Double -> Piece -> Render ()
-renderStack showheight showstacks xc yc (c,t,size)
-  = do stack size' yc 
+renderStack showheight showstacks xc yc (Piece c t size)
+  = do stack size' yc
        when (showheight && size>1) $ -- show the height?
          do selectFontFace "sans-serif" FontSlantNormal FontWeightBold
             setFontSize 50
-            setSourceRGB 1 1 1 
+            setSourceRGB 1 1 1
             showCenteredText (xc+2) (yt+2) label
-            setSourceRGB 1 0 0 
+            setSourceRGB 1 0 0
             showCenteredText xc yt label
     where label = show size
           size' = if showstacks then size else 1
           -- (xc,yc)= screenCoordinate p
           yt = yc - 10*fromIntegral (size'-1)
-          stack n y 
+          stack n y
             | n>1 = do renderPiece xc y c Tott
                        stack (n-1) (y-10)
             | otherwise = renderPiece xc y c t
@@ -607,28 +598,28 @@
 
 -- | render a single piece
 renderPiece :: Double -> Double -> Board.Color -> Kind -> Render ()
-renderPiece x y c k 
-    = do { chipColor; disc 1 x y; 
+renderPiece x y c k
+    = do { chipColor; disc 1 x y;
            lineColor; ring 1 x y;
-           case k of 
+           case k of
              Tzaar -> do {crownColor; disc 0.8 x y;
                           chipColor; disc 0.6 x y;
                           crownColor; disc 0.4 x y}
              Tzarra -> do { crownColor; disc 0.4 x y }
              Tott -> return ()
-         }            
+         }
     where (chipColor, lineColor, crownColor) = renderColors c
 
 
 showCenteredText :: Double -> Double -> String -> Render ()
-showCenteredText x y txt 
-  = do exts <- textExtents txt 
+showCenteredText x y txt
+  = do exts <- textExtents txt
        let dx = textExtentsWidth exts/2
        let dy = textExtentsHeight exts/2
        moveTo (x-dx) (y+dy)
        showText txt
-                        
 
+
 disc :: Double -> Double -> Double -> Render ()
 disc r x y = arc x y (r*33) 0 (2*pi) >> fill
 
@@ -638,11 +629,11 @@
 
 -- (chip color, line color, crown color)
 renderColors :: Board.Color -> (Render (), Render (), Render ())
-renderColors Black = (setSourceRGB 0 0 0, 
+renderColors Black = (setSourceRGB 0 0 0,
                      setSourceRGB 1 1 1,
                      setSourceRGB 0.75 0.75 0.75)
-renderColors White = (setSourceRGB 1 1 1, 
-                     setSourceRGB 0 0 0, 
+renderColors White = (setSourceRGB 1 1 1,
+                     setSourceRGB 0 0 0,
                      setSourceRGB 0.35 0.25 0)
 
 
@@ -652,10 +643,10 @@
 getPosition canvas x y
     = do (w,h)<-widgetGetSize canvas
          drawin<- widgetGetDrawWindow canvas
-         (xu, yu)<- renderWithDrawable drawin 
+         (xu, yu)<- renderWithDrawable drawin
                     (setTransform w h >> deviceToUser x y)
-         let (p, d) = minimumBy (compare `on` snd) 
-                      [(p, (xu - x')^2 + (yu - y')^2) 
+         let (p, d) = minimumBy (compare `on` snd)
+                      [(p, (xu - x')^2 + (yu - y')^2)
                            | (p, (x', y')) <- Map.assocs screenCoordinates ]
          return (if d<900 then Just p else Nothing)
 
@@ -666,7 +657,7 @@
 screenCoordinate p = screenCoordinates!p
 
 screenCoordinates :: Map Position (Double,Double)
-screenCoordinates 
+screenCoordinates
     = Map.fromList $
       [ (A1, p (-4) (-2))
       , (A2, p (-4) (-1))
@@ -736,4 +727,3 @@
             x' = fromIntegral x * sin (pi / 3)
             y' | even x    = fromIntegral y
                | otherwise = fromIntegral y - (fromIntegral (signum y) * 0.5)
-
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,12 +1,11 @@
 -- Main module for Haskell TZAAR game implementation
--- Pedro Vasconcelos, 2010-2013
+-- Pedro Vasconcelos, 2010
 module Main (main) where
 
 import Paths_hstzaar
 import Board
 import AI
 import GUI
-import Serialize
 import Tournament
 import Tests
 import Data.List (intersperse)
@@ -20,34 +19,34 @@
 import qualified Data.Map as Map
 
 data Flag = Seed Int
-          | NumMatches Int 
+          | NumMatches Int
           | DataDir FilePath
           | RunTests
             deriving Show
 
 
 options :: [OptDescr Flag]
-options = [Option ['s'] ["seed"] (ReqArg (Seed . read) "SEED") 
+options = [Option ['s'] ["seed"] (ReqArg (Seed . read) "SEED")
                       "random number seed",
-           Option ['n'] ["matches"] (ReqArg (NumMatches . read) "N") 
+           Option ['n'] ["matches"] (ReqArg (NumMatches . read) "N")
                       "number of matches (for AI tournaments)",
            Option ['d'] ["dir"] (ReqArg DataDir "DATADIR")
                   "data directory",
-           Option ['t'] ["tests"] (NoArg RunTests) 
+           Option ['t'] ["tests"] (NoArg RunTests)
                       "run QuickCheck tests"
           ]
 
 parseArgs :: [String] -> IO ([Flag],[String])
-parseArgs argv 
+parseArgs argv
     =  case getOpt Permute options argv of
          (flags, argv', []) -> return (flags, argv')
-         (_, _, errs) -> ioError $ 
-                         userError $ 
+         (_, _, errs) -> ioError $
+                         userError $
                          concat errs ++ usageInfo header options ++ footer
-    
+
 header, footer :: String
-header = "usage: hstzaar [OPTION..] [AI] [AI]"
-footer = "\twhere AI is one of: " ++ unwords (map name aiPlayers)
+header = "usage: hstzaar [OPTION..] [AI AI]"
+footer = "\twhere AI is one of: " ++ unwords (map (show.name) aiPlayers)
 
 
 -- default number of matches for AI tournaments
@@ -55,16 +54,15 @@
 matches = 10
 
 processFlags :: [Flag] -> IO ()
-processFlags = mapM_ process 
-    where 
+processFlags = mapM_ process
+    where
       process RunTests = run_tests >> exitSuccess
-      process (Seed s) = setStdGen (mkStdGen s) 
+      process (Seed s) = setStdGen (mkStdGen s)
       process _        = return ()
 
 
 main :: IO ()
 main = do argv<-getArgs
-          rnd <- getStdGen
           (flags, argv')<- parseArgs argv
           processFlags flags
           dir <- getDataDir
@@ -73,33 +71,15 @@
           --
           case argv' of
             [] -> gui gladepath
-            [arg1] -> case lookupAI arg1 aiPlayers of
-              Nothing -> ioError $ 
-                         userError $ "invalid AI: " ++ arg1
-              Just ai -> 
-                do { txt <- getContents  -- read start position
-                   ; case readXML txt of 
-                     Nothing -> putStrLn "ERROR: couldn't parse game file"
-                     Just g -> playAI rnd ai (board g) 
-                   }
-            [arg1,arg2] -> 
+            [arg1,arg2] ->
               case do p1 <- lookupAI arg1 aiPlayers
                       p2 <- lookupAI arg2 aiPlayers
                       return (p1,p2)
-              of Nothing -> ioError $ 
+              of Nothing -> ioError $
                             userError $ "invalid AI: " ++ unwords [arg1, arg2]
                  Just (p1,p2) ->
-                   do let (boards, rnd') = randomBoards numMatches rnd
+                   do rnd <- getStdGen
+                      let (boards, rnd') = randomBoards numMatches rnd
                       setStdGen rnd'
                       playAIs p1 p2 boards rnd
             _ -> ioError $ userError $ usageInfo header options ++ footer
-
-
-
-
-playAI :: StdGen -> AI -> Board -> IO ()
-playAI rnd ai b 
-  | endGame b = putStrLn ("Game end (" ++ show (invert $ active b) ++ " won)")
-  | otherwise = putStrLn (show (active b) ++ ": " ++ showMove m)
-  where (score, m, _) = playing ai b rnd
-        
diff --git a/src/Serialize.hs b/src/Serialize.hs
--- a/src/Serialize.hs
+++ b/src/Serialize.hs
@@ -1,24 +1,24 @@
--- Serialization of Tzaar games to/from XML 
+-- Serialization of Tzaar games to/from XML
 -- Pedro Vasconcelos, 2012
 module Serialize where
 import Data.Version
 import Paths_hstzaar(version)
 import Data.Maybe
 import Text.XML.Light
-import qualified Data.Map as Map
+-- import qualified Data.Map as Map
+import qualified Data.HashMap.Strict as HashMap
 import Board
-import Control.Monad
 
 -- | convertion to/from XML elements
 class ToXML a where
   toXML :: a -> Element
-  
-class FromXML a where  
+
+class FromXML a where
   fromXML :: Element -> Maybe a
 
 
--- | wrapper for a piece together with a board position   
-newtype PosPiece = PosPiece (Position, Piece) 
+-- | wrapper for a piece together with a board position
+newtype PosPiece = PosPiece (Position, Piece)
                  deriving (Eq,Show)
 
 -- | wrapper for a list of moves from game start
@@ -28,8 +28,8 @@
 newtype NumMove = NumMove (Int,Color,Move) deriving (Eq,Show)
 
 instance Node PosPiece where
-  node qn (PosPiece (pos,(c,k,h))) = add_attrs alist $ node qn ()
-    where alist = [attr "color" (show c), 
+  node qn (PosPiece (pos,(Piece c k h))) = add_attrs alist $ node qn ()
+    where alist = [attr "color" (show c),
                    attr "kind" (show k),
                    attr "height" (show h),
                    attr "position" (show pos)]
@@ -48,13 +48,12 @@
 
 
 instance Node Board where
-  node qn b = -- add_attr (attr "active" (show $ active b)) $
-              node qn $          
-              map (Elem . node (unqual "piece") . PosPiece) $ 
-              Map.assocs (pieces b)
+  node qn b = node qn $
+              map (Elem . node (unqual "piece") . PosPiece) $
+              HashMap.toList (pieces b)
 
 instance Node Game where
-  node qn g = add_attrs alist  $ 
+  node qn g = add_attrs alist  $
               node qn [Elem (node (unqual "board") (initial g)),
                        Elem (node (unqual "moves") (MoveList ms))]
     where ms = reverse (trail g) ++ remain g -- all moves
@@ -63,35 +62,34 @@
 
 
 instance ToXML Game where
-  toXML = node (unqual "hstzaar") 
+  toXML = node (unqual "hstzaar")
 
-instance FromXML Board where  
-               -- defaults to White active player  
+instance FromXML Board where
   fromXML el = return (initBoard assocs)
     where assocs = catMaybes
-            [do { c<-readAttr (unqual "color") el' 
+            [do { c<-readAttr (unqual "color") el'
                 ; k<-readAttr (unqual "kind") el'
                 ; h<-readAttr (unqual "height") el'
                 ; pos<-readAttr (unqual "position") el'
-                ; return (pos,(c,k,h))
+                ; return (pos, Piece c k h)
                 } | el'<-findChildren (unqual "piece") el]
-          
 
+
 instance FromXML MoveList where
-  fromXML el = liftM MoveList $ 
-               sequence [ readMove (strContent el') 
-                        | el'<-findChildren (unqual "move") el]
+  fromXML el = Just (MoveList moves)
+    where moves = catMaybes
+                  [ readMove (strContent el')
+                  | el'<-findChildren (unqual "move") el]
 
 
 instance FromXML Game where
   fromXML el = do el1 <- findChild (unqual "board") el
                   el2 <- findChild (unqual "moves") el
+                  c <- readAttr (unqual "human") el  -- human player color
                   b <- fromXML el1
                   MoveList ms <- fromXML el2
-                  c <- readOptAttr White (unqual "human") el  -- human player color
                   let g = initGame b c
-                  -- let b'= foldr applyMoveSkip b (reverse ms)
-                  b' <- foldM applyMoveSkip' b ms
+                  let b' = foldr applyMoveSkip b (reverse ms)
                   return g { board=b', trail=reverse ms }
 
 
@@ -99,33 +97,27 @@
 showXML a = ppTopElement (toXML a)
 
 readXML :: FromXML a => String -> Maybe a
-readXML txt = parseXMLDoc txt >>= fromXML 
+readXML txt = parseXMLDoc txt >>= fromXML
 
 
 
 -- | parse an attribute from an element
-readAttr :: Read a => QName -> Element -> Maybe a          
-readAttr name el = do txt<-findAttr name el 
+readAttr :: Read a => QName -> Element -> Maybe a
+readAttr name el = do txt<-findAttr name el
                       case reads txt of
                         [] -> Nothing
                         (a,_):_ -> Just a
 
-readOptAttr :: Read a => a -> QName -> Element -> Maybe a
-readOptAttr def name  el 
-  = case findAttr name el of 
-    Nothing -> Just def
-    Just txt -> case reads txt of [] -> Nothing
-                                  (a,_):_ -> Just a
 
 readMove :: String -> Maybe Move
 readMove [a,b,'x',c,d] = do (from,_) <- listToMaybe (reads [a,b])
                             (to,_) <- listToMaybe (reads [c,d])
                             return (Capture from to)
-  
+
 readMove [a,b,'-',c,d] = do (from,_) <- listToMaybe (reads [a,b])
                             (to,_) <- listToMaybe (reads [c,d])
                             return (Stack from to)
-readMove "pass"          = Just Pass  
+readMove "pass"          = Just Pass
 readMove "skip"          = Just Skip
 readMove _               = Nothing
 
@@ -133,10 +125,8 @@
 
 -- | make an attribute with an unqualified name
 attr :: String -> String -> Attr
-attr n = Attr (unqual n) 
+attr n = Attr (unqual n)
 
 -- | make a cdata from a string
 cdata :: String -> CData
 cdata txt = CData CDataText txt Nothing
-
-
diff --git a/src/Tests.hs b/src/Tests.hs
--- a/src/Tests.hs
+++ b/src/Tests.hs
@@ -3,12 +3,14 @@
   Pedro Vasconcelos, 2010, 2011
 -}
 module Tests where
-import Board 
+import Board
 --import AI.Tree
 import AI.Eval
 import AI.Minimax
 import qualified Data.Map as Map
+import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Set as Set
+import qualified Data.Vector.Unboxed as Vec
 import Data.List (delete, nub, sort)
 import Control.Monad (liftM)
 
@@ -28,18 +30,18 @@
 
 -- default generator and counter-example shrinker for boards
 instance Arbitrary Board where
-    arbitrary = sized genBoard 
-    
+    arbitrary = sized genBoard
+
 {-
 shrink board
         = [board {active=you} | you<-shrinkHalf (active board)] ++
-          [board {inactive=other} | other<-shrinkHalf (inactive board)] 
+          [board {inactive=other} | other<-shrinkHalf (inactive board)]
 
 -- helper function to shrink half-boards
 -- first try to remove pieces, then reduce heights
 shrinkHalf :: HalfBoard -> [HalfBoard]
 shrinkHalf b = [Map.delete p b | p<-Map.keys b] ++
-               [Map.insert p (t,h') b | 
+               [Map.insert p (t,h') b |
                 (p,(t,h))<-Map.assocs b, h'<-[1..h-1]]
 -}
 
@@ -48,7 +50,7 @@
 -- size argument is a bound for the total number of pieces
 -- always generates board with the 3 kinds for each player
 genBoard ::  Int -> Gen Board
-genBoard size 
+genBoard size
   = do ws <- genStacks White n
        bs <- genStacks Black n
        ps <- genShuffle positions
@@ -56,31 +58,31 @@
        --m <- choose (1, n)
        let whites = zip (take n ps) ws
        let blacks = zip (drop n ps) bs
-       let pmap = Map.fromList (whites++blacks)           
+       let pmap = HashMap.fromList (whites++blacks)
        return Board { active = c
                     , move = 0
-                    , moves = []
+                    -- , moves = []
                     , pieces = pmap
-                    , activeCounts = countStacks c pmap
-                    , inactiveCounts = countStacks (invert c) pmap
-                    , activeHeights = sumHeights c pmap
-                    , inactiveHeights= sumHeights (invert c) pmap
-                    }       
+                    , activeCounts = Vec.fromList $ countStacks c pmap
+                    , inactiveCounts = Vec.fromList $ countStacks (invert c) pmap
+                    , activeHeights = Vec.fromList $ sumHeights c pmap
+                    , inactiveHeights= Vec.fromList $ sumHeights (invert c) pmap
+                    }
     where n = 3 `max` (size`div`2) `min` 30 -- between 3 and 30 stacks
-          
-          
+
+
 -- generate piece stacks
 genStacks :: Color -> Int -> Gen [Piece]
-genStacks c n 
+genStacks c n
   = do ps <- liftM ([Tzaar,Tzarra,Tott]++) (genShuffle pieces)
        hs <- sequence [choose (1,maxHeight) | _<-[1..n]]
-       return (zip3 (repeat c) ps hs)
-    where pieces = replicate 5 Tzaar ++ 
-                   replicate 8 Tzarra ++ 
+       return (zipWith3 Piece (repeat c) ps hs)
+    where pieces = replicate 5 Tzaar ++
+                   replicate 8 Tzarra ++
                    replicate 14 Tott
           maxHeight = 5
-               
 
+
 -- generate random permutations of a list
 genShuffle :: Eq a => [a] -> Gen [a]
 genShuffle [] = return []
@@ -90,7 +92,7 @@
 
 
 ---------------------------------------------------------------------------
--- Quickcheck properties 
+-- Quickcheck properties
 ---------------------------------------------------------------------------
 
 -- properties of the game mechanics
@@ -110,50 +112,50 @@
 -- stacking mantains the sum of pieces heights of the active player
 prop_stacking_moves2 :: Board -> Bool
 prop_stacking_moves2 b
-    = and [ heights (pieces b) == heights (pieces b')          
+    = and [ heights (pieces b) == heights (pieces b')
           | m <- stackingMoves b, let b'=applyMove m b]
-    where 
+    where
       c = active b  -- the current player
-      heights ps = sum [h | (c',_,h)<-Map.elems ps, c'==c]
+      heights ps = sum [h | (Piece c' _ h)<-HashMap.elems ps, c'==c]
 
 -- stacking does not modify opponents pieces
 prop_stacking_moves3 :: Board -> Bool
 prop_stacking_moves3 b
-    = and [ Map.filter (\p->color p==c') (pieces b') ==  
-            Map.filter (\p->color p==c') (pieces b)
+    = and [ HashMap.filter (\p->color p==c') (pieces b') ==
+            HashMap.filter (\p->color p==c') (pieces b)
           | m <- stackingMoves b, let b'=applyMove m b]
-    where 
+    where
       c = active b  -- the current player
       c'= invert c  -- the other player
 
 
 prop_swap_swap :: Board -> Bool
-prop_swap_swap b = swapBoard (swapBoard b) == b
+prop_swap_swap b = swapPlayer (swapPlayer b) == b
 
 prop_active_counts :: Board -> Bool
 prop_active_counts b
-  = and [activeCounts b' ==  countStacks (active b') (pieces b')
+  = and [activeCounts b' ==  Vec.fromList (countStacks (active b') (pieces b'))
         | m<-nextMoves b, let b'=applyMove m b]
-    
+
 prop_inactive_counts :: Board -> Bool
 prop_inactive_counts b
-  = and [inactiveCounts b' ==  countStacks (inactive b') (pieces b')
+  = and [inactiveCounts b' ==  Vec.fromList (countStacks (inactive b') (pieces b'))
         | m<-nextMoves b, let b'=applyMove m b]
-    
-    
 
+
+
 prop_active_heights :: Board -> Bool
 prop_active_heights b
-  = and [activeHeights b' ==  sumHeights (active b') (pieces b')
+  = and [activeHeights b' ==  Vec.fromList (sumHeights (active b') (pieces b'))
         | m<-nextMoves b, let b'=applyMove m b]
-    
+
 prop_inactive_heights :: Board -> Bool
 prop_inactive_heights b
-  = and [inactiveHeights b' ==  sumHeights (inactive b') (pieces b')
+  = and [inactiveHeights b' ==  Vec.fromList (sumHeights (inactive b') (pieces b'))
         | m<-nextMoves b, let b'=applyMove m b]
-    
-    
 
+
+
 -- correctness of the zone of control computation
 -- the zone of control is the set of pieces
 -- that can be captured in a turn (one or two moves)
@@ -161,37 +163,37 @@
 prop_zoc_correct b = pos == pos'
     where
       moves1 = captureMoves b
-      moves2 = concat [captureMoves (swapBoard (applyMove m b)) | m<-moves1]
+      moves2 = concat [captureMoves (swapPlayer (applyMove m b)) | m<-moves1]
       pos = Set.fromList [dest | Capture _ dest<-(moves1++moves2)]
-      pos'= Map.keysSet (zoneOfControl (active b) (pieces b))
+      pos'= Set.fromList $ HashMap.keys $ zoneOfControl (active b) (pieces b)
 
 
 ---------------------------------------------------------------------------
 -- properties of the AI code
 ---------------------------------------------------------------------------
 
--- | a trace is a sequence of game positions           
+-- | a trace is a sequence of game positions
 newtype Trace = Trace { unTrace :: [Board] } deriving Show
 
 instance Arbitrary Trace where
-  arbitrary = do b <- arbitrary 
+  arbitrary = do b <- arbitrary
                  liftM Trace (genTrace b)
-  
 
--- | generate a sequence random board resulting 
+
+-- | generate a sequence random board resulting
 --  from valid moves from a starting board
 genTrace :: Board -> Gen [Board]
-genTrace b 
+genTrace b
   | null ms = return [b]
   | otherwise = do m <- elements ms
                    bs <- genTrace (applyMove m b)
                    return (b:bs)
     where ms = nextMoves b
-  
 
 
+
 -- | players must alternate in a trace
-prop_trace_alternating (Trace bs) 
+prop_trace_alternating (Trace bs)
   = let players = map active bs
     in and $ zipWith (/=) players (tail players)
 
@@ -200,11 +202,11 @@
 prop_trace_ending (Trace bs)
   = let b' = last bs
         bs'= init bs
-    in  all threekinds bs' && 
+    in  all threekinds bs' &&
         (lostone b' || null (nextMoves b'))
   where threekinds b = all (>0) (countStacks (active b) (pieces b) ++
                                  countStacks (inactive b) (pieces b))
-        lostone b = any (==0) (countStacks (active b) (pieces b)) 
+        lostone b = any (==0) (countStacks (active b) (pieces b))
 
 
 -- | upper and lower bounds for the evaluation function
@@ -214,21 +216,21 @@
 
 
 {-
--- correcteness of alpha-beta pruning against plain minimax 
--- parameters: number of pieces, pruning depth 
+-- correcteness of alpha-beta pruning against plain minimax
+-- parameters: number of pieces, pruning depth
 prop_alpha_beta :: Int -> Board -> Bool
-prop_alpha_beta d b 
+prop_alpha_beta d b
   = let bt = pruneDepth d $ mapTree eval1 $ boardTree b
     in negamax_alpha_beta (minBound+1) maxBound bt == negamax bt
-    
 
+
 -- correctness of alpha-beta minimax extended with principal variation
--- parameters: number of pieces, pruning depth 
+-- parameters: number of pieces, pruning depth
 prop_alpha_beta_pv :: Int -> Board -> Bool
 prop_alpha_beta_pv d b
   = let bt = pruneDepth d $ mapTree eval1 $ boardTree b
         PV v ms = undefined -- negamaxPV bt
-        n = length ms        
+        n = length ms
         b' = foldl (flip applyMove) b ms
         v' = eval1 b'
     in (-1)^n * v' == v
@@ -239,7 +241,7 @@
 -- end game positions give plus/minus infinity scores
 prop_inactive_lost :: Eval -> Board -> Property
 prop_inactive_lost f b
-    = not (active_lost b) && inactive_lost b ==> f b == infinity 
+    = not (active_lost b) && inactive_lost b ==> f b == infinity
 
 prop_active_lost :: Eval -> Board -> Property
 prop_active_lost f b
@@ -257,20 +259,20 @@
 
 wellformedTree :: GameTree Board Move -> Bool
 wellformedTree (GameTree b branches)
-  = and [player b /= player b' && 
+  = and [player b /= player b' &&
          wellformedTree t | (m,t@(GameTree b' _)) <- branches]
 
 
 
- 
+
 -- helper functions to filter boards, etc.
 -- "admissible" boards: no winner yet
 admissible :: Board -> Bool
 admissible b = not (active_lost b) && not (inactive_lost b)
 
 active_lost, inactive_lost :: Board -> Bool
-active_lost b 
-    = (move b==1 && null (captureMoves b)) || 
+active_lost b
+    = (move b==1 && null (captureMoves b)) ||
       any (==0) (countStacks $ active b)
 
 inactive_lost b = any (==0) (countStacks $ inactive b)
@@ -312,4 +314,4 @@
 
 
 
-quickCheckN n = quickCheckWith (stdArgs{maxSuccess=n}) 
+quickCheckN n = quickCheckWith (stdArgs{maxSuccess=n})
diff --git a/src/Tournament.hs b/src/Tournament.hs
--- a/src/Tournament.hs
+++ b/src/Tournament.hs
@@ -6,50 +6,52 @@
 import AI.Gametree
 import System.Random
 import Control.Monad
+import Control.Monad.State
 
--- compare two strategies on a starting board 
+
+-- compare two strategies on a starting board
 -- plays 2 games with either strategy first and sums the results
 -- result is 1 or -1 according to the winner
 playMatch :: Board -> StdGen -> AI -> AI -> IO Int
 playMatch b rnd p1 p2
-  | is_terminal b = return (-1) -- p1 can't play, p2 wins
+  | isTerminal b = return (-1) -- p1 can't play, p2 wins
   | otherwise = do putStrLn line
                    liftM negate $ playMatch b' rnd' p2 p1
-    where (score, m, rnd') = playing p1 b rnd
-          line = show (move b) ++ ". " ++  show (active b) ++  
+    where ((m, score), rnd') = runState (strategy p1 b) rnd
+          line = show (move b) ++ ". " ++  show (active b) ++
                   " ("++name p1 ++ "):\t" ++ " " ++
-                 showMove m ++ "\tscore: " ++ show score
+                 showMove m ++ "\t" ++ show score
           b' = applyMove m b
 
 
 
 -- compare two strategies on random boards
 playAIs :: AI -> AI -> [Board] -> StdGen -> IO ()
-playAIs p1 p2 boards rnd 
+playAIs p1 p2 boards rnd
   = do rs<-sequence [do { header i
                         ; r<-playMatch b rnd p1 p2
                         ; hline
                         ; r'<-playMatch b rnd p2 p1
                         ; hline
-                        ; return (r-r') 
-                        } 
-                    | (i,b)<-zip [1..] boards] 
+                        ; return (r-r')
+                        }
+                    | (i,b)<-zip [1..] boards]
        let won = sum [r | r<-rs, r>0]
        let lost= - sum [r | r<-rs, r<0]
        let score = sum rs
-       putStrLn (name p1 ++ " vs " ++ name p2 ++ ": " 
-                 ++ show score ++ " (" 
-                 ++ show won ++ " matches won and " 
+       putStrLn (name p1 ++ " vs " ++ name p2 ++ ": "
+                 ++ show score ++ " ("
+                 ++ show won ++ " matches won and "
                  ++ show lost ++ " lost)")
     where n = length boards
           header i = putStrLn ("Match " ++ show i ++ "/" ++ show n)
           hline = putStrLn (replicate 70 '-')
 
 
--- create random boards 
+-- create random boards
 randomBoards :: Int -> StdGen -> ([Board], StdGen)
 randomBoards 0 rndgen = ([], rndgen)
-randomBoards n rndgen 
+randomBoards n rndgen
   | n>0 = (b:bs, rndgen'')
     where (b, rndgen') = randomBoard rndgen
           (bs, rndgen'') = randomBoards (n-1) rndgen'