1 module Pretty where
    2 
    3 import Text.PrettyPrint
    4 
    5 import Value
    6 import Syntax
    7 
    8 -- Comment out the Command instance to debug the pretty printer
    9 instance Show Command where
   10   show = show . pretty
   11 
   12 class Pretty a where
   13     pretty :: a -> Doc
   14     prettyPrec :: Int -> a -> Doc
   15 
   16     pretty = prettyPrec 0
   17     prettyPrec _ = pretty
   18 
   19 instance Pretty Command where
   20     pretty Skip     = text "skip"
   21     pretty (x := e) = sep   [ text x <+> text ":="
   22                             , nest 2 $ pretty e
   23                             ]
   24     pretty (Print e) = sep  [ text "print"
   25                             , nest 2 $ pretty e
   26                             ]
   27     pretty (c1 :-> c2) = vcat [ pretty c1 <+> text ";", pretty c2 ]
   28     pretty (If e c1 c2) = vcat  [ sep   [ text "if"
   29                                         , nest 4 $ pretty e
   30                                         , nest 4 $ text "then"
   31                                         ]
   32                                 , nest 2 $ pretty c1
   33                                 , text "else"
   34                                 , nest 2 $ pretty c2
   35                                 , text "fi"
   36                                 ]
   37     pretty (While e c)  = vcat  [ sep   [ text "while"
   38                                         , nest 4 $ pretty e
   39                                         , nest 4 $ text "do"
   40                                         ]
   41                                 , nest 2 $ pretty c
   42                                 , text "od"  
   43                                 ]
   44 
   45 instance Pretty Value where
   46     prettyPrec p (Num n)
   47         | n >= 0    = text $ show n
   48         | otherwise = mparens (p>0) $ text $ show n
   49     prettyPrec p (Bol True)     = text "T"
   50     prettyPrec p (Bol False)    = text "F"
   51     prettyPrec _ Wrong          = text "Wrong"
   52 
   53 instance Pretty Expr where
   54     prettyPrec p (Var x)        = text x
   55     prettyPrec p (Val v)        = prettyPrec p v
   56     prettyPrec p (Uno Minus e)  = mparens (p>0) $ text "-" <> prettyPrec 10 e
   57     prettyPrec p (Uno Not e)    = mparens (p>9) $ text "!" <> prettyPrec 10 e
   58     prettyPrec p (Duo op e1 e2) = mparens (p>prec op) $
   59                                     sep [ prettyPrec (precL op) e1
   60                                         , nest 2 $ sep  [ pretty op
   61                                                         , nest 2 $ prettyPrec (precR op) e2
   62                                                         ]
   63                                         ]
   64 
   65 instance Pretty Op2 where
   66     pretty op = text $ case op of
   67                     And     -> "&"
   68                     Or      -> "|"
   69                     Mul     -> "*"
   70                     Add     -> "+"
   71                     Sub     -> "-"
   72                     Div     -> "/"
   73                     Mod     -> "%"
   74                     Less    -> "<"
   75                     LessEq  -> "<="
   76                     Eq      -> "=="
   77 
   78 prec op     = head [ p | (op', _, p) <- ops, op == op' ]
   79 assoc op    = head [ f | (op', f, _) <- ops, op == op' ]
   80 precL op = case assoc op of
   81                 L   -> prec op
   82                 _   -> prec op + 1
   83 precR op = case assoc op of
   84                 R   -> prec op
   85                 _   -> prec op + 1
   86 
   87 data Assoc = L | R | N
   88 
   89 ops =   
   90   [ (And, L, 2)
   91   , (Or,  L, 1)
   92   , (Mul, L, 7)
   93   , (Add, L, 6)
   94   , (Sub, L, 6)
   95   , (Div, L, 7)
   96   , (Mod, L, 7)
   97   , (Less,   N, 3)
   98   , (LessEq, N, 3)
   99   , (Eq,     N, 3)
  100   ]
  101 
  102 mparens True  d  = cat [ text "(" <> d, text ")" ]
  103 mparens False d  = d