Browse Source

parsers

master
Stefan Bühler 10 years ago
parent
commit
0ddd95852e
  1. 25
      Eval.hs
  2. 9
      Lambda.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

9
Lambda.hs

@ -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…
Cancel
Save