module S09 (
alphaEq,
showTerm,
eval,
uibkMail,
fromHex
) where
import S05
import Arith
import Parser
alphaEq _ (Var x) (Var y) = x == y
alphaEq fresh (Lab x s) (Lab y t) = alphaEq ('*':fresh) s' t'
where subst x = applySubst x (Var fresh)
s' = subst x s
t' = subst y t
alphaEq fresh (App s t) (App u v) = alphaEq fresh s u && alphaEq fresh t v
alphaEq _ _ _ = False
instance Eq Term where
s == t = alphaEq "*" s t
par s = "(" ++ s ++ ")"
s `app` t = s ++ " " ++ t
showTerm (Var x) = x
showTerm (App s (t @ (App _ _))) = showTerm s `app` par (showTerm t)
showTerm (App s t) = showTerm s `app` showTerm t
showTerm t = par ("\\" ++ showLambdas t)
showLambdas (Lab x (t @ (Lab _ _))) = x ++ " " ++ showLambdas t
showLambdas (Lab x t) = x ++ "." ++ showTerm t
instance Show Term where
show = showTerm
eval :: Exp -> Integer
eval (Nat n) = n
eval (Neg e) = (eval e)
eval (Add a b) = (eval a) + (eval b)
eval (Sub a b) = (eval a) (eval b)
eval (Mul a b) = (eval a) * (eval b)
eval (Div a b) = (eval a) `div` (eval b)
string :: String -> CharP String
string [] = return []
string (c:cs) = do { char c; ss <- string cs; return (c:ss) }
optional :: Parser t a -> Parser t ()
optional p = (p >> return ()) <|> return ()
uibkMail :: String -> Maybe (String, String)
uibkMail = parse p
where p = do
forename <- many1 (noneof ".")
char '.'
surname <- many1 (noneof "@")
char '@'
optional (string "student.")
string "uibk.ac.at"
return (forename, surname)
isHexDigit :: Char -> Bool
isHexDigit c = c `elem` "0123456789abcdefABCDEF"
digitToInt :: Char -> Int
digitToInt '0' = 0
digitToInt '1' = 1
digitToInt '2' = 2
digitToInt '3' = 3
digitToInt '4' = 4
digitToInt '5' = 5
digitToInt '6' = 6
digitToInt '7' = 7
digitToInt '8' = 8
digitToInt '9' = 9
digitToInt 'a' = 10
digitToInt 'b' = 11
digitToInt 'c' = 12
digitToInt 'd' = 13
digitToInt 'e' = 14
digitToInt 'f' = 15
digitToInt 'A' = 10
digitToInt 'B' = 11
digitToInt 'C' = 12
digitToInt 'D' = 13
digitToInt 'E' = 14
digitToInt 'F' = 15
fromHex :: String -> Maybe Int
fromHex = parse p
where p = do
ds <- many1 (sat isHexDigit)
return (foldl (\i c -> 16 * i + digitToInt c) 0 ds)