[project @ 1996-03-19 08:58:34 by partain]

[ghc-hetmet.git] / ghc / compiler / deforest / Deforest.lhs

diff --git a/ghc/compiler/deforest/Deforest.lhs b/ghc/compiler/deforest/Deforest.lhs
index 623750a..8c75121 100644 (file)
--- a/ghc/compiler/deforest/Deforest.lhs
+++ b/ghc/compiler/deforest/Deforest.lhs
@@ -23,12 +23,10 @@
 > import CmdLineOpts   ( GlobalSwitch, SwitchResult )
 > import CoreSyn
 > import Id            ( getIdInfo, Id )
-> import IdEnv
 > import IdInfo
 > import Outputable
 > import SimplEnv      ( SwitchChecker(..) )
-> import SplitUniq
-> import TyVarEnv
+> import UniqSupply
 > import Util
 
 > -- tmp, for traces
@@ -37,17 +35,17 @@
 > -- stub (ToDo)
 > domIdEnv = panic "Deforest: domIdEnv"
 
-> deforestProgram 
+> deforestProgram
 >      :: SwitchChecker GlobalSwitch{-maybe-}
->      -> PlainCoreProgram 
->      -> SplitUniqSupply 
->      -> PlainCoreProgram
->      
-> deforestProgram sw prog uq = 
+>      -> [CoreBinding]
+>      -> UniqSupply
+>      -> [CoreBinding]
+>
+> deforestProgram sw prog uq =
 >      let
 >              def_program = core2def sw prog
 >              out_program = (
->                      defProg sw nullIdEnv def_program  `thenSUs` \prog ->
+>                      defProg sw nullIdEnv def_program  `thenUs` \prog ->
 >                      def2core prog)
 >                      uq
 >      in
@@ -61,8 +59,8 @@ Recursive functions are first transformed by the deforester.  If the
 function is annotated as deforestable, then it is converted to
 treeless form for unfolding later on.
 
-Also converting non-recursive functions that are annotated with 
-{-# DEFOREST #-} now.  Probably don't need to convert these to treeless 
+Also converting non-recursive functions that are annotated with
+{-# DEFOREST #-} now.  Probably don't need to convert these to treeless
 form: just the inner recursive bindings they contain.  eg:
 
 repeat = \x -> letrec xs = x:xs in xs
@@ -70,71 +68,71 @@ repeat = \x -> letrec xs = x:xs in xs
 is non-recursive, but we want to unfold it and annotate the binding
 for xs as unfoldable, too.
 
-> defProg 
+> defProg
 >      :: SwitchChecker GlobalSwitch{-maybe-}
->      -> IdEnv DefExpr 
->      -> [DefBinding] 
->      -> SUniqSM [DefBinding]
->      
-> defProg sw p [] = returnSUs []
-> 
-> defProg sw p (CoNonRec v e : bs) = 
+>      -> IdEnv DefExpr
+>      -> [DefBinding]
+>      -> UniqSM [DefBinding]
+>
+> defProg sw p [] = returnUs []
+>
+> defProg sw p (NonRec v e : bs) =
 >      trace ("Processing: `" ++
 >                      ppShow 80 (ppr PprDebug v) ++ "'\n") (
->      tran sw p nullTyVarEnv e []             `thenSUs` \e ->
->      mkLoops e                               `thenSUs` \(extracted,e) ->
+>      tran sw p nullTyVarEnv e []             `thenUs` \e ->
+>      mkLoops e                               `thenUs` \(extracted,e) ->
 >      let e' = mkDefLetrec extracted e in
 >      (
 >        if deforestable v then
 >              let (vs,es) = unzip extracted in
->              convertToTreelessForm sw e      `thenSUs` \e ->
->              mapSUs (convertToTreelessForm sw) es    `thenSUs` \es ->
+>              convertToTreelessForm sw e      `thenUs` \e ->
+>              mapUs (convertToTreelessForm sw) es     `thenUs` \es ->
 >              defProg sw (growIdEnvList p ((v,e):zip vs es)) bs
 >        else
->              defProg sw p bs         
->      )                                       `thenSUs` \bs ->
->      returnSUs (CoNonRec v e' : bs)
+>              defProg sw p bs
+>      )                                       `thenUs` \bs ->
+>      returnUs (NonRec v e' : bs)
 >      )
->              
-> defProg sw p (CoRec bs : bs') =
->      mapSUs (defRecBind sw p) bs             `thenSUs` \res  ->
+>
+> defProg sw p (Rec bs : bs') =
+>      mapUs (defRecBind sw p) bs              `thenUs` \res  ->
 >      let
 >              (resid, unfold) = unzip res
 >              p' = growIdEnvList p (concat unfold)
 >      in
->      defProg sw p' bs'                       `thenSUs` \bs' ->
->      returnSUs (CoRec resid: bs')
+>      defProg sw p' bs'                       `thenUs` \bs' ->
+>      returnUs (Rec resid: bs')
 
 
-> defRecBind 
+> defRecBind
 >      :: SwitchChecker GlobalSwitch{-maybe-}
->      -> IdEnv DefExpr 
+>      -> IdEnv DefExpr
 >      -> (Id,DefExpr)
->      -> SUniqSM ((Id,DefExpr),[(Id,DefExpr)])
->      
+>      -> UniqSM ((Id,DefExpr),[(Id,DefExpr)])
+>
 > defRecBind sw p (v,e) =
 >      trace ("Processing: `" ++
 >                      ppShow 80 (ppr PprDebug v) ++ "'\n") (
->      tran sw p nullTyVarEnv e []             `thenSUs` \e' ->
->      mkLoops e'                              `thenSUs` \(bs,e') ->
+>      tran sw p nullTyVarEnv e []             `thenUs` \e' ->
+>      mkLoops e'                              `thenUs` \(bs,e') ->
 >      let e'' = mkDefLetrec bs e' in
->      
->      d2c e'' `thenSUs` \core_e ->
->      let showBind (v,e) = ppShow 80 (ppr PprDebug v) ++ 
->              "=\n" ++ ppShow 80 (ppr PprDebug e) ++ "\n" 
+>
+>      d2c e'' `thenUs` \core_e ->
+>      let showBind (v,e) = ppShow 80 (ppr PprDebug v) ++
+>              "=\n" ++ ppShow 80 (ppr PprDebug e) ++ "\n"
 >      in
->      trace ("Extracting from `" ++ 
+>      trace ("Extracting from `" ++
 >              ppShow 80 (ppr PprDebug v) ++ "'\n"
 >              ++ "{ result:\n" ++ showBind (v,core_e) ++ "}\n") $
->      
+>
 >      if deforestable v
->              then 
+>              then
 >                      let (vs,es) = unzip bs in
->                      convertToTreelessForm sw e'     `thenSUs` \e' ->
->                      mapSUs (convertToTreelessForm sw) es `thenSUs` \es ->
->                      returnSUs ((v,e''),(v,e'):zip vs es)
->              else 
+>                      convertToTreelessForm sw e'     `thenUs` \e' ->
+>                      mapUs (convertToTreelessForm sw) es `thenUs` \es ->
+>                      returnUs ((v,e''),(v,e'):zip vs es)
+>              else
 >                      trace (show (length bs)) (
->                      returnSUs ((v,e''),[])
+>                      returnUs ((v,e''),[])
 >                      )
 >      )