@@ -1,4 +1,4 @@
1−{-# OPTIONS_GHC -Wall #-}
1+{-# OPTIONS_GHC -W #-}
22module SourceSyntax.Type where
33
44import Data.Binary
@@ -32,7 +32,12 @@ instance Pretty Type where
3232 pretty tipe =
3333 case tipe of
3434 Lambda _ _ -> P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]
35− where t:ts = collectLambdas tipe
35+ where
36+ t:ts = map prettyLambda (collectLambdas tipe)
37+ prettyLambda t = case t of
38+ Lambda _ _ -> P.parens (pretty t)
39+ _ -> pretty t
40+
3641 Var x -> P.text x
3742 Data "_List" [t] -> P.brackets (pretty t)
3843 Data name tipes
@@ -46,12 +51,11 @@ instance Pretty Type where
4651 prettyField (f,t) = P.text f <+> P.text ":" <+> pretty t
4752 prettyFields = commaSep . map prettyField $ fields
4853
49−collectLambdas :: Type -> [Doc]
54+collectLambdas :: Type -> [Type]
5055collectLambdas tipe =
5156 case tipe of
52− Lambda arg@(Lambda _ _) body -> P.parens (pretty arg) : collectLambdas body
53− Lambda arg body -> pretty arg : collectLambdas body
54− _ -> [pretty tipe]
57+ Lambda arg body -> arg : collectLambdas body
58+ _ -> [tipe]
5559
5660prettyParens :: Type -> Doc
5761prettyParens tipe = parensIf needed (pretty tipe)