2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
4 \section[Deforest]{Top level deforestation module}
6 >#include "HsVersions.h"
23 > import CmdLineOpts ( GlobalSwitch, SwitchResult )
25 > import Id ( getIdInfo, Id )
28 > import SimplEnv ( SwitchChecker(..) )
36 > domIdEnv = panic "Deforest: domIdEnv"
39 > :: SwitchChecker GlobalSwitch{-maybe-}
44 > deforestProgram sw prog uq =
46 > def_program = core2def sw prog
48 > defProg sw nullIdEnv def_program `thenUs` \prog ->
54 We have to collect all the unfoldings (functions that were annotated
55 with DEFOREST) and pass them in an environment to subsequent calls of
58 Recursive functions are first transformed by the deforester. If the
59 function is annotated as deforestable, then it is converted to
60 treeless form for unfolding later on.
62 Also converting non-recursive functions that are annotated with
63 {-# DEFOREST #-} now. Probably don't need to convert these to treeless
64 form: just the inner recursive bindings they contain. eg:
66 repeat = \x -> letrec xs = x:xs in xs
68 is non-recursive, but we want to unfold it and annotate the binding
69 for xs as unfoldable, too.
72 > :: SwitchChecker GlobalSwitch{-maybe-}
75 > -> UniqSM [DefBinding]
77 > defProg sw p [] = returnUs []
79 > defProg sw p (NonRec v e : bs) =
80 > trace ("Processing: `" ++
81 > ppShow 80 (ppr PprDebug v) ++ "'\n") (
82 > tran sw p nullTyVarEnv e [] `thenUs` \e ->
83 > mkLoops e `thenUs` \(extracted,e) ->
84 > let e' = mkDefLetrec extracted e in
86 > if deforestable v then
87 > let (vs,es) = unzip extracted in
88 > convertToTreelessForm sw e `thenUs` \e ->
89 > mapUs (convertToTreelessForm sw) es `thenUs` \es ->
90 > defProg sw (growIdEnvList p ((v,e):zip vs es)) bs
94 > returnUs (NonRec v e' : bs)
97 > defProg sw p (Rec bs : bs') =
98 > mapUs (defRecBind sw p) bs `thenUs` \res ->
100 > (resid, unfold) = unzip res
101 > p' = growIdEnvList p (concat unfold)
103 > defProg sw p' bs' `thenUs` \bs' ->
104 > returnUs (Rec resid: bs')
108 > :: SwitchChecker GlobalSwitch{-maybe-}
111 > -> UniqSM ((Id,DefExpr),[(Id,DefExpr)])
113 > defRecBind sw p (v,e) =
114 > trace ("Processing: `" ++
115 > ppShow 80 (ppr PprDebug v) ++ "'\n") (
116 > tran sw p nullTyVarEnv e [] `thenUs` \e' ->
117 > mkLoops e' `thenUs` \(bs,e') ->
118 > let e'' = mkDefLetrec bs e' in
120 > d2c e'' `thenUs` \core_e ->
121 > let showBind (v,e) = ppShow 80 (ppr PprDebug v) ++
122 > "=\n" ++ ppShow 80 (ppr PprDebug e) ++ "\n"
124 > trace ("Extracting from `" ++
125 > ppShow 80 (ppr PprDebug v) ++ "'\n"
126 > ++ "{ result:\n" ++ showBind (v,core_e) ++ "}\n") $
130 > let (vs,es) = unzip bs in
131 > convertToTreelessForm sw e' `thenUs` \e' ->
132 > mapUs (convertToTreelessForm sw) es `thenUs` \es ->
133 > returnUs ((v,e''),(v,e'):zip vs es)
135 > trace (show (length bs)) (
136 > returnUs ((v,e''),[])