Browse Source

parsers

master
Stefan Bühler 9 years ago
parent
commit
0ddd95852e
2 changed files with 25 additions and 9 deletions
  1. +23
    -2
      Eval.hs
  2. +2
    -7
      Lambda.hs

+ 23
- 2
Eval.hs View File

@@ -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


+ 2
- 7
Lambda.hs View File

@@ -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