- where ifTerm pred f prec t@Term{}
- | pred t = Just `liftM` f prec t
- ifTerm _ _ _ _ = return Nothing
-
- isTupleTy ty = fromMaybe False $ do
- (tc,_) <- tcSplitTyConApp_maybe ty
- return (isBoxedTupleTyCon tc)
-
- isTyCon a_tc ty = fromMaybe False $ do
- (tc,_) <- tcSplitTyConApp_maybe ty
- return (a_tc == tc)
-
- isIntegerTy ty = fromMaybe False $ do
- (tc,_) <- tcSplitTyConApp_maybe ty
- return (tyConName tc == integerTyConName)
-
- coerceShow f _p = return . text . show . f . unsafeCoerce# . val
-
- --Note pprinting of list terms is not lazy
- doList p (Term{subTerms=[h,t]}) = do
- let elems = h : getListTerms t
- isConsLast = not(termType(last elems) `coreEqType` termType h)
- print_elems <- mapM (y cons_prec) elems
- return$ if isConsLast
- then cparen (p >= cons_prec)
- . pprDeeperList fsep
- . punctuate (space<>colon)
- $ print_elems
- else brackets (pprDeeperList fcat$
- punctuate comma print_elems)
-
- where getListTerms Term{subTerms=[h,t]} = h : getListTerms t
- getListTerms Term{subTerms=[]} = []
- getListTerms t@Suspension{} = [t]
- getListTerms t = pprPanic "getListTerms" (ppr t)
- doList _ _ = panic "doList"
+ where
+ ifTerm :: (Term -> Bool)
+ -> (Precedence -> Term -> m SDoc)
+ -> Precedence -> Term -> m (Maybe SDoc)
+ ifTerm pred f prec t@Term{}
+ | pred t = Just `liftM` f prec t
+ ifTerm _ _ _ _ = return Nothing
+
+ isTupleTy ty = fromMaybe False $ do
+ (tc,_) <- tcSplitTyConApp_maybe ty
+ return (isBoxedTupleTyCon tc)
+
+ isTyCon a_tc ty = fromMaybe False $ do
+ (tc,_) <- tcSplitTyConApp_maybe ty
+ return (a_tc == tc)
+
+ isIntegerTy ty = fromMaybe False $ do
+ (tc,_) <- tcSplitTyConApp_maybe ty
+ return (tyConName tc == integerTyConName)
+
+ ppr_int, ppr_char, ppr_float, ppr_double, ppr_integer
+ :: Precedence -> Term -> m SDoc
+ ppr_int _ v = return (Ppr.int (unsafeCoerce# (val v)))
+ ppr_char _ v = return (Ppr.char '\'' <> Ppr.char (unsafeCoerce# (val v)) <> Ppr.char '\'')
+ ppr_float _ v = return (Ppr.float (unsafeCoerce# (val v)))
+ ppr_double _ v = return (Ppr.double (unsafeCoerce# (val v)))
+ ppr_integer _ v = return (Ppr.integer (unsafeCoerce# (val v)))
+
+ --Note pprinting of list terms is not lazy
+ ppr_list :: Precedence -> Term -> m SDoc
+ ppr_list p (Term{subTerms=[h,t]}) = do
+ let elems = h : getListTerms t
+ isConsLast = not(termType(last elems) `eqType` termType h)
+ is_string = all (isCharTy . ty) elems
+
+ print_elems <- mapM (y cons_prec) elems
+ if is_string
+ then return (Ppr.doubleQuotes (Ppr.text (unsafeCoerce# (map val elems))))
+ else if isConsLast
+ then return $ cparen (p >= cons_prec)
+ $ pprDeeperList fsep
+ $ punctuate (space<>colon) print_elems
+ else return $ brackets
+ $ pprDeeperList fcat
+ $ punctuate comma print_elems
+
+ where getListTerms Term{subTerms=[h,t]} = h : getListTerms t
+ getListTerms Term{subTerms=[]} = []
+ getListTerms t@Suspension{} = [t]
+ getListTerms t = pprPanic "getListTerms" (ppr t)
+ ppr_list _ _ = panic "doList"