Commit 0c8dc9bc authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Improved pretty-printing of intermediate language

parent bbf700ec
......@@ -3,6 +3,7 @@
Description : Pretty printer for IL
Copyright : (c) 1999 - 2003 Wolfgang Lux
Martin Engelke
2011 - 2015 Björn Peemöller
License : OtherLicense
Maintainer : bjp@informatik.uni-kiel.de
......@@ -80,12 +81,12 @@ ppType p (TypeConstructor tc tys)
| isQTupleId tc = parens
(fsep (punctuate comma (map (ppType 0) tys)))
| unqualify tc == nilId = brackets (ppType 0 (head tys))
| otherwise = ppParen (p > 1 && not (null tys))
| otherwise = parenIf (p > 1 && not (null tys))
(ppQIdent tc <+> fsep (map (ppType 2) tys))
ppType _ (TypeVariable n)
| n >= 0 = text (typeVars !! n)
| otherwise = text ('_':show (-n))
ppType p (TypeArrow ty1 ty2) = ppParen (p > 0)
ppType p (TypeArrow ty1 ty2) = parenIf (p > 0)
(fsep (ppArrow (TypeArrow ty1 ty2)))
where
ppArrow (TypeArrow ty1' ty2') = ppType 1 ty1' <+> text "->" : ppArrow ty2'
......@@ -122,27 +123,27 @@ ppExpr p (Apply (Apply (Function f _) e1) e2)
| isQInfixOp f = ppInfixApp p e1 f e2
ppExpr p (Apply (Apply (Constructor c _) e1) e2)
| isQInfixOp c = ppInfixApp p e1 c e2
ppExpr p (Apply e1 e2) = ppParen (p > 2) $ sep
ppExpr p (Apply e1 e2) = parenIf (p > 2) $ sep
[ppExpr 2 e1, nest exprIndent (ppExpr 3 e2)]
ppExpr p (Case _ ev e alts) = ppParen (p > 0) $
ppExpr p (Case _ ev e alts) = parenIf (p > 0) $
text "case" <+> ppEval ev <+> ppExpr 0 e <+> text "of"
$$ nest caseIndent (vcat $ map ppAlt alts)
where ppEval Rigid = text "rigid"
ppEval Flex = text "flex"
ppExpr p (Or e1 e2) = ppParen (p > 0) $ sep
ppExpr p (Or e1 e2) = parenIf (p > 0) $ sep
[nest orIndent (ppExpr 0 e1), char '|', nest orIndent (ppExpr 0 e2)]
ppExpr p (Exist v e) = ppParen (p > 0) $ sep
ppExpr p (Exist v e) = parenIf (p > 0) $ sep
[text "let" <+> ppIdent v <+> text "free" <+> text "in", ppExpr 0 e]
ppExpr p (Let b e) = ppParen (p > 0) $ sep
ppExpr p (Let b e) = parenIf (p > 0) $ sep
[text "let" <+> ppBinding b <+> text "in",ppExpr 0 e]
ppExpr p (Letrec bs e) = ppParen (p > 0) $ sep
ppExpr p (Letrec bs e) = parenIf (p > 0) $ sep
[text "letrec" <+> vcat (map ppBinding bs) <+> text "in", ppExpr 0 e]
ppExpr p (Typed e ty) = ppParen (p > 0) $ sep
ppExpr p (Typed e ty) = parenIf (p > 0) $ sep
[ppExpr 0 e, text "::", ppType 0 ty]
ppInfixApp :: Int -> Expression -> QualIdent -> Expression -> Doc
ppInfixApp p e1 op e2 = ppParen (p > 1) $ sep
ppInfixApp p e1 op e2 = parenIf (p > 1) $ sep
[ppExpr 2 e1 <+> ppQInfixOp op, nest exprIndent (ppExpr 2 e2)]
ppIdent :: Ident -> Doc
......@@ -170,6 +171,3 @@ typeVars :: [String]
typeVars = [mkTypeVar c i | i <- [0 .. ], c <- ['a' .. 'z']] where
mkTypeVar :: Char -> Int -> String
mkTypeVar c i = c : if i == 0 then [] else show i
ppParen :: Bool -> Doc -> Doc
ppParen p = if p then parens else id
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment