@@ -89,9 +89,10 @@ data Assoc =
89
89
90
90
type InfixOp = (Prec , Assoc , PP. Doc -> PP. Doc )
91
91
92
- ppInfixOps :: (a -> Maybe (InfixOp ,a ,a )) -> (Bool -> a -> PP. Doc ) -> a -> PP. Doc
92
+ ppInfixOps :: (a -> Maybe (InfixOp ,a ,a )) -> (Bool -> a -> PP. Doc ) ->
93
+ Bool -> a -> PP. Doc
93
94
ppInfixOps dest pp =
94
- go Nothing True
95
+ go Nothing
95
96
where
96
97
go mprec rightmost a =
97
98
case dest a of
@@ -217,7 +218,7 @@ instance Printable Type where
217
218
OpType t [x] -> basic False x <+> toDoc t
218
219
OpType t xs -> normals xs <+> toDoc t
219
220
220
- normal = ppInfixOps destInfix basic
221
+ normal = ppInfixOps destInfix basic True
221
222
222
223
normals = PP. parens . PP. fsep . PP. punctuate PP. comma . map normal
223
224
@@ -325,19 +326,21 @@ instance Printable Term where
325
326
([] ,_) -> binder rightmost tm
326
327
(ns,t) -> ppPrefixOps ns $ binder rightmost t
327
328
328
- letterm rightmost tm =
329
- case stripLet tm of
330
- ([] ,_) -> negation rightmost tm
331
- (ves,t) -> if not rightmost then parens tm
332
- else ppLet application normal ves t
329
+ infixTerm = ppInfixOps destInfix negation
333
330
334
331
conditional rightmost tm =
335
332
case stripCond tm of
336
- ([] ,_) -> letterm rightmost tm
337
- ((c,t) : cts, e) -> if not rightmost then parens tm
338
- else ppCond normal c t cts e
333
+ ([] ,_) -> infixTerm rightmost tm
334
+ ((c,t) : cts, e) -> ppCond (infixTerm False )
335
+ (infixTerm rightmost) c t cts e
336
+
337
+ letTerm rightmost tm =
338
+ case stripLet tm of
339
+ ([] ,_) -> conditional rightmost tm
340
+ (ves,t) -> ppLet application (conditional False )
341
+ (conditional rightmost) ves t
339
342
340
- normal = ppInfixOps destInfix conditional
343
+ normal = letTerm True
341
344
342
345
parens = PP. parens . normal
343
346
@@ -616,9 +619,9 @@ instance Printable Term where
616
619
Just (c,t,u) -> ((c,t) : cts, e) where (cts,e) = stripCond u
617
620
Nothing -> ([] ,tm)
618
621
619
- ppCond :: (Term -> PP. Doc ) -> Term -> Term -> [ (Term , Term )] -> Term ->
620
- PP. Doc
621
- ppCond pp =
622
+ ppCond :: (Term -> PP. Doc ) -> (Term -> PP. Doc ) ->
623
+ Term -> Term -> [( Term , Term )] -> Term -> PP. Doc
624
+ ppCond pp ppe =
622
625
\ c t cts e ->
623
626
PP. sep (ifThen c t : map elseIfThen cts ++ [elseBranch e])
624
627
where
@@ -629,7 +632,7 @@ instance Printable Term where
629
632
PP. text " else" <+> PP. sep [PP. text " if" <+> pp c,
630
633
PP. text " then" <+> pp t]
631
634
632
- elseBranch e = PP. text " else" <+> pp e
635
+ elseBranch e = PP. text " else" <+> ppe e
633
636
634
637
-------------------------------------------------------------------------
635
638
-- Lets
@@ -650,15 +653,15 @@ instance Printable Term where
650
653
Just (v,e,u) -> ((v,e) : ves, t) where (ves,t) = stripLet u
651
654
Nothing -> ([] ,tm)
652
655
653
- ppLet :: (Term -> PP. Doc ) -> (Term -> PP. Doc ) ->
656
+ ppLet :: (Term -> PP. Doc ) -> (Term -> PP. Doc ) -> ( Term -> PP. Doc ) ->
654
657
[(Term ,Term )] -> Term -> PP. Doc
655
- ppLet ppv pp =
658
+ ppLet ppv ppe pp =
656
659
\ ves t ->
657
660
PP. sep (map letBind ves ++ [pp t])
658
661
where
659
662
letBind (v,e) =
660
663
PP. text " let" <+> PP. sep [ppv v <+> PP. text " <-" ,
661
- pp e <+> PP. text " in" ]
664
+ ppe e <+> PP. text " in" ]
662
665
663
666
-------------------------------------------------------------------------
664
667
-- Numerals
0 commit comments