-pprCoreExpr, pprParendCoreExpr
- :: PprStyle
- -> (PprStyle -> bndr -> Pretty) -- to print "major" val_bdrs
- -> (PprStyle -> bndr -> Pretty) -- to print "minor" val_bdrs
- -> (PprStyle -> bdee -> Pretty) -- to print bindees
- -> GenCoreExpr bndr bdee
- -> Pretty
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (Var name) = pbdee sty name
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (Lit literal) = ppr sty literal
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (Con con [] []) = ppr sty con
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (Con con types args)
- = ppHang (ppBesides [ppr sty con, ppChar '!'])
- 4 (ppSep ( (map (pprParendUniType sty) types)
- ++ (map (pprCoreAtom sty pbdee) args)))
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (Prim prim tys args)
- = ppHang (ppBesides [ppr sty prim, ppChar '!'])
- 4 (ppSep ( (map (pprParendUniType sty) tys)
- ++ (map (pprCoreAtom sty pbdee) args) ))
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (Lam val_bdr expr)
- = ppHang (ppCat [ppStr "\\", pbdr2 sty val_bdr, ppStr "->"])
- 4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoTyLam tyvar expr)
- = ppHang (ppCat [ppStr "/\\", interppSP sty (tyvar:tyvars),
- ppStr "->", pp_varss var_lists])
- 4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr_after)
- where
- (tyvars, var_lists, expr_after) = collect_tyvars expr
-
- collect_tyvars (CoTyLam tyv e) = ( tyv:tyvs, vs, e_after )
- where (tyvs, vs, e_after) = collect_tyvars e
- collect_tyvars e@(Lam _ _) = ( [], vss, e_after )
- where (vss, e_after) = collect_vars e
- collect_tyvars other_e = ( [], [], other_e )
-
- collect_vars (Lam var e) = ([var]:varss, e_after)
- where (varss, e_after) = collect_vars e
- collect_vars other_e = ( [], other_e )
-
- pp_varss [] = ppNil
- pp_varss (vars:varss)
- = ppCat [ppStr "\\", ppInterleave ppSP (map (pbdr2 sty) vars),
- ppStr "->", pp_varss varss]
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee expr@(App fun_expr atom)
- = let
- (fun, args) = collect_args expr []
- in
- ppHang (pprParendCoreExpr sty pbdr1 pbdr2 pbdee fun)
- 4 (ppSep (map (pprCoreAtom sty pbdee) args))
- where
- collect_args (App fun arg) args = collect_args fun (arg:args)
- collect_args fun args = (fun, args)
+seqExpr :: CoreExpr -> ()
+seqExpr (Var v) = v `seq` ()
+seqExpr (Lit lit) = lit `seq` ()
+seqExpr (App f a) = seqExpr f `seq` seqExpr a
+seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
+seqExpr (Let b e) = seqBind b `seq` seqExpr e
+seqExpr (Case e b as) = seqExpr e `seq` seqBndr b `seq` seqAlts as
+seqExpr (Note n e) = seqNote n `seq` seqExpr e
+seqExpr (Type t) = seqType t