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