Browse Source

parse terms

master
Stefan Bühler 9 years ago
parent
commit
e9b17b8ab2
1 changed files with 43 additions and 0 deletions
  1. +43
    -0
      Lambda.hs

+ 43
- 0
Lambda.hs View File

@@ -4,8 +4,51 @@ module Lambda where
import Eval
import System.IO

import Text.ParserCombinators.ReadP
import Data.Char
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
ptGroup = do
char '('
t <- ptTerm
skipSpaces; char ')'
return t
ptEnd = eof <++ do
c:_ <- look
when (isAlphaNum c || c == ';' || c == '(') pfail
ptApply f = do
skipSpaces
(ptEnd >> return f) <++
(char ';' >> ptTerm >>= \g -> return $ Seq f g) <++
(ptTerm1 >>= \x -> ptApply (Apply f x))
ptTerm1 = skipSpaces >> (ptConst <++ ptPrim <++ ptGroup)

ptTerm = ptTerm1 >>= ptApply

instance Show Term where
show (Const i) = show i
show (Prim c) = show c
show (Seq f g) = show f ++ ";" ++ show g
show (Apply f (Const i)) = show f ++ " " ++ show i
show (Apply f (Prim c)) = show f ++ " " ++ show c
show (Apply f x) = show f ++ "(" ++ show x ++ ")"

instance Read Term where
readsPrec _ = readP_to_S ptTerm

cI = Prim Card_I
cGet n = Apply (Prim Card_Get) (Const n)
cPut = Prim Card_Put


Loading…
Cancel
Save