Text/ParserCombinators/Parsec/examples/Henk/HenkAS.hs

   1 ----------------------------------------------------------------
   2 -- the Henk Abstract Syntax
   3 -- Copyright 2000, Jan-Willem Roorda and Daan Leijen
   4 ----------------------------------------------------------------
   5 module HenkAS where
   6
   7 import Pretty
   8
   9 ----------------------------------------------------------------
  10 -- Abstract Syntax
  11 ----------------------------------------------------------------
  12 data Program        = Program [TypeDecl] [ValueDecl]
  13
  14 data TypeDecl       = Data Var [Var]
  15
  16 data ValueDecl      = Let Bind
  17                     | LetRec [Bind]
  18
  19 data Bind           = Bind Var Expr
  20
  21 data Expr           = Var Var
  22                     | Lit Lit
  23                     | Box
  24                     | Star
  25                     | Unknown
  26
  27                     | App Expr Expr
  28                     | Case Expr [Alt] [Expr]
  29                     | In ValueDecl Expr
  30                     | Pi Var Expr
  31                     | Lam Var Expr
  32
  33 data Alt            = Alt Pat Expr
  34
  35 data Pat            = PatVar Var
  36                     | PatLit Lit
  37
  38 data Var            = TVar Identifier Expr
  39
  40 data Lit            = LitInt Integer
  41
  42 type Identifier     = String
  43
  44 anonymous           = "_"
  45 isAnonymous s       = (null s || (head s == head anonymous))
  46
  47
  48 ----------------------------------------------------------------
  49 -- pretty print abstract syntax
  50 ----------------------------------------------------------------
  51 instance Show Program where
  52   showsPrec d program   = shows (pprogram program)
  53
  54 vsep ds
  55     = vcat (map ($$ text "") ds)
  56
  57
  58 -- program
  59 pprogram (Program tdecls vdecls)
  60     = vsep ((map ptdecl tdecls) ++ (map pvdecl vdecls))
  61
  62 ptdecl (Data v vs)
  63     = (text "data" <+> pbindvar v)
  64       $$ indent (text "=" <+> braced (map ptvar vs))
  65
  66
  67 pvdecl vdecl
  68     = case vdecl of
  69         Let bind     -> text "let" <+> pbind bind
  70         LetRec binds -> text "letrec" $$ indent (braced (map pbind binds))
  71
  72 pbind (Bind v e)
  73     = pbindvar v $$ indent (text "=" <+> pexpr e)
  74
  75 -- expressions (are parenthesis correct ?)
  76 parensExpr e
  77     = case e of
  78         In _ _      -> parens (pexpr e)
  79         Pi _ _      -> parens (pexpr e)
  80         Lam _ _     -> parens (pexpr e)
  81         Case _ _ _  -> parens (pexpr e)
  82         App _ _     -> parens (pexpr e)
  83         Var (TVar i t) -> case t of
  84                             Unknown -> pexpr e
  85                             other   -> parens (pexpr e)
  86         other       -> pexpr e
  87
  88 pexpr e
  89     = case e of
  90         Var v       -> pboundvar v
  91         Lit l       -> plit l
  92         Box         -> text "[]"
  93         Star        -> text "*"
  94         Unknown     -> text "?"
  95
  96         App e1 e2   -> pexpr e1 <+> parensExpr e2
  97         Case e as ts-> sep $ [text "case" <+> parensExpr e <+> text "of"
  98                              ,nest 3 (braced (map palt as))
  99                              ] ++
 100                              (if (null as)
 101                                then []
 102                                else [text "at"
 103                                     ,nest 3 (braced (map pexpr ts))
 104                                     ])
 105
 106         In v e      -> sep[ pvdecl v, text "in" <+> pexpr e]
 107         Pi v e      -> case v of
 108                          TVar i t    | isAnonymous i -> parensExpr t <+> text "->" <+> pexpr e
 109                          TVar i Star -> sep[ text "\\/" <> text i <> text ".", pexpr e]
 110                          other       -> sep[ text "|~|" <> pbindvar v <> text ".", pexpr e]
 111         Lam v e     -> case v of
 112                          TVar i Star -> sep[ text "/\\" <> text i <> text ".", pexpr e]
 113                          other       -> sep[ text "\\" <> pbindvar v <> text ".", pexpr e]
 114
 115
 116 -- atomic stuff
 117 palt (Alt p e)
 118     = ppat p <+> text "=>" <+> pexpr e
 119
 120 ppat p
 121     = case p of PatVar v -> pboundvar v
 122                 PatLit l -> plit l
 123
 124
 125 pboundvar v@(TVar i e)
 126     = case e of Unknown  -> text i
 127                 other    -> ptvar v
 128
 129 pbindvar v@(TVar i e)
 130     = case e of Star     -> text i
 131                 other    -> ptvar v
 132
 133 ptvar (TVar i e)
 134     = text i <> colon <+> pexpr e
 135
 136
 137 plit l
 138     = case l of LitInt i -> integer i
 139
 140 braced []
 141     = empty
 142
 143 braced ds
 144     = let prefix = map text $ ["{"] ++ repeat ";"
 145       in  cat ((zipWith (<+>) prefix ds) ++ [text "}"])
 146
 147 indent
 148     = nest 4
 149
 150
 151