parsers
This commit is contained in:
parent
e9b17b8ab2
commit
0ddd95852e
25
Eval.hs
25
Eval.hs
@ -9,6 +9,7 @@ module Eval (
|
||||
Value (..),
|
||||
Card (..),
|
||||
cardNames,
|
||||
pCard,
|
||||
Move (..),
|
||||
card,
|
||||
initGame,
|
||||
@ -22,6 +23,9 @@ import qualified Data.Array.IO as A
|
||||
import System.IO.Unsafe
|
||||
import Data.Maybe
|
||||
|
||||
import Text.ParserCombinators.ReadP
|
||||
import Data.Char
|
||||
|
||||
type Field = (Value, Int)
|
||||
type Fields = A.IOArray Int Field
|
||||
data Player = Player { fields :: Fields } deriving (Show, Eq)
|
||||
@ -40,6 +44,7 @@ data Card = Card_I | Card_Zero | Card_Succ | Card_Dbl | Card_Get | Card_Put | Ca
|
||||
data Move = MoveLeft Card Int | MoveRight Int Card
|
||||
|
||||
cardNames = [(Card_I, "I"),(Card_Zero, "zero"),( Card_Succ, "succ"),( Card_Dbl, "dbl"),( Card_Get, "get"),( Card_Put, "put"),( Card_S, "S"),( Card_K, "K"),( Card_Inc, "inc"),( Card_Dec, "dec"),( Card_Attack, "attack"),( Card_Help, "help"),( Card_Copy, "copy"),( Card_Revive, "revive"),( Card_Zombie, "zombie")]
|
||||
cardNamesX = map (\(a,b) -> (b,a)) cardNames
|
||||
|
||||
instance Monad Turn where
|
||||
(Turn f) >>= g = Turn $ \game -> (f game >>=) $ \(game', r) -> case r of Right x -> (case g x of Turn g' -> g' game'); Left s -> return (game', Left s)
|
||||
@ -71,8 +76,24 @@ instance Show Card where
|
||||
show c = fromJust $ lookup c cardNames
|
||||
|
||||
instance Show Move where
|
||||
show (MoveLeft c pos) = (show c) ++ " >> " ++ (show pos)
|
||||
show (MoveRight pos c) = (show pos) ++ " << " ++ (show c)
|
||||
show (MoveLeft c pos) = (show c) ++ " " ++ (show pos)
|
||||
show (MoveRight pos c) = (show pos) ++ " " ++ (show c)
|
||||
|
||||
pCard :: ReadP Card
|
||||
pCard = do
|
||||
s <- many1 (satisfy isAlpha)
|
||||
case lookup s cardNamesX of
|
||||
Just c -> return c
|
||||
Nothing -> pfail
|
||||
pmPos = readS_to_P reads >>= \i -> if (i >= 0 && i <= 255) then return i else pfail
|
||||
|
||||
pMove = skipSpaces >> ((do c <- pCard; skipSpaces; pos <- pmPos; skipSpaces; return $ MoveLeft c pos) <++ (do pos <- pmPos; skipSpaces; c <- pCard; skipSpaces; return $ MoveRight pos c))
|
||||
|
||||
instance Read Card where
|
||||
readsPrec _ = readP_to_S pCard
|
||||
instance Read Move where
|
||||
readsPrec _ = readP_to_S pMove
|
||||
|
||||
|
||||
take1 :: String -> (Value -> Turn Value) -> Value
|
||||
take1 name f = ValFunction name $ \v -> apply 1 >> f v
|
||||
|
@ -10,17 +10,12 @@ import Control.Monad
|
||||
|
||||
data Term = Const Int | Prim Card | Seq Term Term | Apply Term Term
|
||||
|
||||
cardNamesX = map (\(a,b) -> (b,a)) cardNames
|
||||
|
||||
ptConst :: ReadP Term
|
||||
ptConst = readS_to_P reads >>= return . Const
|
||||
ptPrim = do
|
||||
c <- satisfy isAlpha
|
||||
s' <- many (satisfy isAlpha)
|
||||
let s = c:s'
|
||||
case lookup s cardNamesX of
|
||||
Just c -> return $ Prim c
|
||||
Nothing -> pfail
|
||||
c <- pCard
|
||||
return $ Prim c
|
||||
ptGroup = do
|
||||
char '('
|
||||
t <- ptTerm
|
||||
|
Loading…
Reference in New Issue
Block a user