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