1 module Term 2 (VarId, Term (Var, Abs, App, Let), readsId) 3 where 4 5 import Parse 6 import Shows 7 type VarId = String 8 data Term = Var VarId 9 | Abs VarId Term 10 | App Term Term 11 | Let VarId Term Term 12 instance Show Term where 13 showsPrec d = showsTerm d 14 instance Read Term where 15 readsPrec d = readsTerm 16 readsTerm, readsAbs, readsAtomics, readsAtomic, readsVar :: Parses Term 17 readsTerm = readsAbs 18 `elseP` readsLet 19 `elseP` readsAtomics 20 readsAtomic = readsVar 21 `elseP` parenP readsTerm 22 readsAbs = lexP "\\" `thenP` (\_ -> 23 plusP readsId `thenP` (\xs -> 24 lexP "." `thenP` (\_ -> 25 readsTerm `thenP` (\v -> 26 returnP (foldr Abs v xs))))) 27 readsLet = lexP "let" `thenP` (\_ -> 28 readsId `thenP` (\x -> 29 lexP "=" `thenP` (\_ -> 30 readsTerm `thenP` (\u -> 31 lexP "in" `thenP` (\_ -> 32 readsTerm `thenP` (\v -> 33 returnP (Let x u v))))))) 34 readsAtomics = readsAtomic `thenP` (\t -> 35 starP readsAtomic `thenP` (\ts -> 36 returnP (foldl App t ts))) 37 readsVar = readsId `thenP` (\x -> 38 returnP (Var x)) 39 readsId :: Parses String 40 readsId = lexicalP (isntKeyword `filterP` plusP alphaP) 41 where isntKeyword x = (x /= "let" && x /= "in") 42 showsTerm :: Int -> Shows Term 43 showsTerm d (Var x) = showsString x 44 showsTerm d (Abs x v) = showsParenIf (d>0) 45 (showsString "\\" . showsString x . showsAbs v) 46 showsTerm d (App t u) = showsParenIf (d>1) 47 (showsTerm 1 t . showsChar ' ' . showsTerm 2 u) 48 showsTerm d (Let x u v) = showsParenIf (d>0) 49 (showsString "let " . showsString x . 50 showsString " = " . showsTerm 1 u . 51 showsString " in " . showsTerm 0 v) 52 showsAbs :: Shows Term 53 showsAbs (Abs x t) = showsString " " . showsString x . showsAbs t 54 {- ELSE -} 55 showsAbs t = showsString ". " . showsTerm 0 t