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