Clean up

README.md

@@ -2,5 +2,6 @@ Hamilcar
 =======
 
 Haskell Shogi program
+(c) Y.Kodama 2014
 
 Original source code: http://d.hatena.ne.jp/mclh46/20110331/1301553690

src/Board.hs

@@ -42,21 +42,33 @@ module Board (
                     9 -> "\tWhand\t=> " ++ prettyHs Piece.W hs
                     otherwise -> ""
             in unlines $ [row r ++ info r | r <- [2..10]] ++ map (show . second sort) (filter (([]/=) . snd) $ assocs pcl)
+
     empSqs = accumArray seq Piece.Wall(0, 220) $ ( , ) <$> Move.onBdPoss <*> [Piece.Empty]::Sqs
+
     hsBnd co = ((Piece.Pc co Piece.Unp Piece.FU), (Piece.Pc co Piece.Unp Piece.HI))
     hsRa = range . hsBnd
+
     bothHsRa = hsRa Piece.B ++ hsRa Piece.W
+
     sideHs co hs = [(pc, n) | pc <- hsRa co, let n = hs ! pc, n/= 0]
+
     empHs = listArray Piece.pcBnd $ repeat 0 :: Hs
+
     prettyHs co hs = unwords [show pc ++ show n | (pc, n) <- sideHs co hs]
+
     pclRa co = range ((Piece.Pc co Piece.Unp Piece.FU), (Piece.Pc co Piece.Pro Piece.HI))
+
     sidePcl co pcl = [(pc, pcl ! pc) | pc <- pclRa co]
+
     empPcl = listArray Piece.pcBnd $ repeat []
     empBd = (Board.Bd empSqs empHs Piece.B 0 empPcl)
+
     bdModify bd @ (Board.Bd a1 a2 a3 a4 a5) f1 f2 f3 f4 f5 = Bd (f1 a1) (f2 a2) (f3 a3) (f4 a4) (f5 a5)
+
     bdDoMvs, bdUndoMvs::Bd -> [Move.Mv] -> Bd
     bdDoMvs = foldl bdDo
     bdUndoMvs = foldr (flip bdUndo)
+
     bdDo, bdUndo::Bd -> Move.Mv -> Bd
     bdDo bd mv =
         case mv of

src/Move.hs

@@ -14,14 +14,25 @@ module Move (
 
     data Mv =
           Drop {dropTo::Piece.Pos, dropPc::Piece.Pc}
-        | Mv {fr::Piece.Pos, to::Piece.Pos, mvPc::Piece.Pc, cap::Piece.Pc, isPro::Bool} deriving (Eq, Ord)
+        | Mv {
+            fr::Piece.Pos,
+            to::Piece.Pos,
+            mvPc::Piece.Pc,
+            cap::Piece.Pc,
+            isPro::Bool
+        } deriving (Eq, Ord)
     instance Show Mv where
         show (Drop to pc) = (dropToUSI pc) ++ (Util.notation to)
         show (Mv fr to pc _ isPro) = Util.notation to ++ show pc ++ "(" ++ Util.notation fr ++ ")" ++ Util.if' (isPro, "+", "")
+
     isCapture = (/= Piece.Empty) . cap
+
     mvColor (Drop {dropPc = x}) = Piece.co x
     mvColor (Mv {mvPc = x}) = Piece.co x
+
     dropToUSI = (++ "*") . show . Piece.p8
+
     mvToUSI (Drop to pc) = dropToUSI pc ++ Util.posToUSI to
     mvToUSI (Mv fr to _ _ isPro) = Util.posToUSI fr ++ Util.posToUSI to ++ Util.if' (isPro, "+", "")
+
     onBdPoss = Util.toPos <$> range ((1, 1), (9, 9))::[Piece.Pos]

src/Piece.hs

@@ -26,10 +26,12 @@ module Piece (
     import Data.List
 
     type Pos = Int
+
     data Co = B | W deriving (Eq, Ord, Enum, Ix)
     data Pro = Unp | Pro deriving (Eq, Ord, Enum, Ix)
     data Pc = Empty | Wall | Pc {co::Co, pro::Pro, p8::P8} deriving (Eq, Ord)
     data P8 = FU | KY | KE | GI | KI | KA | HI | OU deriving (Eq, Ord, Enum, Ix)
+
     instance Enum Pc where
         fromEnum (Pc co pr p8) = fromEnum co * 16 + fromEnum pr * 8 + fromEnum p8
         toEnum x = Pc (toEnum $ div x 16) (toEnum$div x 8 `mod` 2) (toEnum $ mod x 8)
@@ -53,24 +55,41 @@ module Piece (
         show = (:[]) . (p8Chars !!) . fromEnum
 
     p8Chars = "PLNSGBRK"
+
     pcBnd = ((Pc B Unp FU), (Pc W Pro OU))
+
     pcRa = range pcBnd
+
     pcOppCo pc = pc {co = Util.oppEn$co pc}
     pcOppPro pc = pc {pro = Util.oppEn$pro pc}
+
     unpPc pc = pc {pro = Unp}
+
     pcCanPro (Pc _ pro p8) = pro == Unp && p8 /= OU && p8 /= KI
+
     p8FromUSI c = toEnum <$> findIndex (toUpper c ==) p8Chars
-    isSlider p inc = case p8 p of {KA -> even inc; HI -> odd inc; KY -> pro p == Unp; otherwise -> False}
+
+    isSlider p inc = case p8 p of {
+        KA -> even inc;
+        HI -> odd inc;
+        KY -> pro p == Unp;
+        otherwise -> False;
+    }
+
     blacki = f Unp FU OU is ++ f Pro FU GI(repeat g) ++ f Pro KA HI(repeat k)
         where
             f pro s e = zip [Pc B pro p8 | p8 <- [s..e]]
             is @ [p, _, _, _, g, b, r, k] = map sort
                 [[-17], p, [-35, -33], p ++ b, [-18, -17, -16, -1, 1, 17], [-18, -16, 16, 18], [-17, -1, 1, 17], b ++ r]
-    pcIncs = (a!)::Pc -> [Pos]
+
+    pcIncs::Pc -> [Pos]
+    pcIncs = (a!)
         where
             a = array pcBnd $ blacki ++ map (pcOppCo *** map negate) blacki
+
     deltaToInc = (a!)
         where
             f n ds = [(d * l, d) | l <- [1..n], d <- ds]
             a = accumArray ( + ) 0 (-144, 144) $ f 1[-35, -33, 33, 35] ++ f 8 [-18, -17, -16, -1, 1, 16, 17, 18]
-    strDeltaToInc = Util.showGrid(\ x y -> deltaToInc (x + y * 17)) [-8..8] [-8..8]
+
+    strDeltaToInc = Util.showGrid (\ x y -> deltaToInc (x + y * 17)) [-8..8] [-8..8]

src/Search.hs

@@ -16,11 +16,14 @@ module Search(
     type Dep = Int
     type Cnt = Int
     data Result = Result {va::Int, pv::[Move.Mv]} deriving (Eq, Ord)
+
     conv mv res = Result (-va res) (mv:pv res)
+
     minmax::Int -> Board.Bd -> Result
-    minmax dep bd = f dep bd where
-        f 0 bd = Result (Eval.eval bd) []
-        f dep bd = maximumBy (on compare va) nexts
-            where
-            nexts = map next $ MoveGenerator.mvGenFull bd
-            next mv = conv mv . f (dep - 1) $ Board.bdDo bd mv
+    minmax dep bd = f dep bd
+        where
+            f 0 bd = Result (Eval.eval bd) []
+            f dep bd = maximumBy (on compare va) nexts
+                where
+                    nexts = map next $ MoveGenerator.mvGenFull bd
+                    next mv = conv mv . f (dep - 1) $ Board.bdDo bd mv

src/Usi.hs

@@ -19,26 +19,31 @@ module Usi (
 
     castEn::Bool -> Piece.Co
     castEn = Util.modiEn id
+
     sfenStartpos = ["lnsgkgsnl/1r5b1/ppppppppp/9/9/9/PPPPPPPPP/1B5R1/LNSGKGSNL", "b", "-"]
+
     bdFromSfen s =
-        (Board.Bd (Board.empSqs//sqs) (Board.empHs//hsFromSfen(ss!!2))
-            (Util.if'(ss!!1 == "b", Piece.B, Piece.W)) 0
-            (accumArray (flip(:)) [] Piece.pcBnd$map swap sqs) )
+        (Board.Bd (Board.empSqs // sqs) (Board.empHs // hsFromSfen(ss !! 2))
+            (Util.if' (ss !! 1 == "b", Piece.B, Piece.W)) 0
+            (accumArray (flip (:)) [] Piece.pcBnd $ map swap sqs) )
                 where
                     ss = if length s >= 3 then s else sfenStartpos
                     sqs = sqsFromSfen$ss !! 0
+
     pcFromSfen::Char -> (Piece.Co, Piece.P8)
     pcFromSfen = castEn . isLower &&& fromJust . Piece.p8FromUSI . toUpper
+
     sqsFromSfen sfen = parser sfen (2, 4) Piece.Unp
         where
             parser::[Char] -> (Int, Int) -> Piece.Pro -> [Board.Sq]
             parser [] _ _ =[]
-            parser (x:xs) sq @( r, f) pro
+            parser (x:xs) sq @ ( r, f) pro
                 | isDigit x = parser xs (r, f + digitToInt x) pro
                 | x =='/' = parser xs (r + 1, 4) pro
                 | x =='+' = parser xs sq Piece.Pro
                 | otherwise = ((r * 17 + f), Piece.Pc co pro p8):parser xs (r, f + 1) Piece.Unp
                     where (co, p8) = pcFromSfen x
+
     hsFromSfen sfen = parser sfen 1
         where
             parser [] _ =[]
@@ -47,6 +52,7 @@ module Usi (
                 | isDigit x = parser xs (digitToInt x)
                 | otherwise = (Piece.Pc co Piece.Unp p8, cnt):parser xs 1
                     where (co, p8) = pcFromSfen x
+
     mvFromSfen (Board.Bd sqs _ me _ _) sfen=
         case Piece.p8FromUSI(sfen!!0) of
             Just p8 -> -- is drop
@@ -60,15 +66,17 @@ module Usi (
                     cap = sqs!to
                     isPro = length sfen == 5
                 in (Move.Mv fr to mvPc cap isPro)
+
     readUSIPosition sfens=
         let ws = tail$words sfens
             sbd = Util.if' (head ws == "startpos", ["startpos"], take 3 ws)
             bd = bdFromSfen sbd
             smvs = drop 1 $ dropWhile (/= "moves") ws
             mvs = mvsFromSfen bd $ smvs
         in (bd, mvs)
+
     usiLoop bd = do
-        sfens<-getLine
+        sfens <- getLine
         let cmds = words sfens
         case head cmds of
             "isready" -> putStrLn$"readyok"
@@ -81,6 +89,7 @@ module Usi (
                 putStrLn $ "bestmove " ++ Move.mvToUSI(head pv)
             otherwise -> putStrLn ("undefined command.." ++ sfens)
         usiLoop bd -- next
+
     mvsFromSfen::Board.Bd -> [String] -> [Move.Mv]
     mvsFromSfen bd [] = []
     mvsFromSfen bd (s:ss) = mv:mvsFromSfen(Board.bdDo bd mv)ss