import {-# SOURCE #-} DsExpr ( dsExpr, dsLet )
-import HsSyn ( Stmt(..), HsExpr )
-import TcHsSyn ( TypecheckedStmt, TypecheckedHsExpr )
+import HsSyn ( Stmt(..) )
+import TcHsSyn ( TypecheckedStmt )
import DsHsSyn ( outPatType )
import CoreSyn
import DsUtils
import CmdLineOpts ( opt_FoldrBuildOn )
-import CoreUtils ( coreExprType )
+import CoreUtils ( exprType, mkIfThenElse )
import Id ( idType )
-import Var ( Id, TyVar )
-import Const ( Con(..) )
-import PrelInfo ( foldrId, buildId )
-import Type ( mkTyVarTy, mkForAllTy, mkFunTys, mkFunTy, Type )
-import TysPrim ( alphaTyVar, alphaTy )
-import TysWiredIn ( nilDataCon, consDataCon, listTyCon )
+import Var ( Id )
+import Type ( mkTyVarTy, mkFunTys, mkFunTy, Type )
+import TysPrim ( alphaTyVar )
+import TysWiredIn ( nilDataCon, consDataCon )
import Match ( matchSimply )
-import Outputable
+import PrelNames ( foldrName, buildName )
\end{code}
List comprehensions may be desugared in one of two ways: ``ordinary''
n_ty = mkTyVarTy n_tyvar
c_ty = mkFunTys [elt_ty, n_ty] n_ty
in
- newSysLocalsDs [c_ty,n_ty] `thenDs` \ [c, n] ->
+ newSysLocalsDs [c_ty,n_ty] `thenDs` \ [c, n] ->
- dfListComp c n quals `thenDs` \ result ->
+ dfListComp c n quals `thenDs` \ result ->
- returnDs (Var buildId `App` Type elt_ty
- `App` mkLams [n_tyvar, c, n] result)
+ dsLookupGlobalValue buildName `thenDs` \ build_id ->
+ returnDs (Var build_id `App` Type elt_ty
+ `App` mkLams [n_tyvar, c, n] result)
\end{code}
%************************************************************************
deListComp [ReturnStmt expr] list -- Figure 7.4, SLPJ, p 135, rule C above
= dsExpr expr `thenDs` \ core_expr ->
- returnDs (mkConsExpr (coreExprType core_expr) core_expr list)
+ returnDs (mkConsExpr (exprType core_expr) core_expr list)
deListComp (GuardStmt guard locn : quals) list -- rule B above
= dsExpr guard `thenDs` \ core_guard ->
deListComp (BindStmt pat list1 locn : quals) core_list2 -- rule A' above
= dsExpr list1 `thenDs` \ core_list1 ->
let
- u3_ty@u1_ty = coreExprType core_list1 -- two names, same thing
+ u3_ty@u1_ty = exprType core_list1 -- two names, same thing
-- u1_ty is a [alpha] type, and u2_ty = alpha
u2_ty = outPatType pat
- res_ty = coreExprType core_list2
+ res_ty = exprType core_list2
h_ty = u1_ty `mkFunTy` res_ty
in
newSysLocalsDs [h_ty, u1_ty, u2_ty, u3_ty] `thenDs` \ [h, u1, u2, u3] ->
rest_expr core_fail `thenDs` \ core_match ->
let
rhs = Lam u1 $
- Case (Var u1) u1 [(DataCon nilDataCon, [], core_list2),
- (DataCon consDataCon, [u2, u3], core_match)]
+ Case (Var u1) u1 [(DataAlt nilDataCon, [], core_list2),
+ (DataAlt consDataCon, [u2, u3], core_match)]
in
returnDs (Let (Rec [(h, rhs)]) letrec_body)
\end{code}
matchSimply (Var x) ListCompMatch pat core_rest (Var b) `thenDs` \ core_expr ->
-- now build the outermost foldr, and return
+ dsLookupGlobalValue foldrName `thenDs` \ foldr_id ->
returnDs (
- Var foldrId `App` Type x_ty
- `App` Type b_ty
- `App` mkLams [x, b] core_expr
- `App` Var n_id
- `App` core_list1
+ Var foldr_id `App` Type x_ty
+ `App` Type b_ty
+ `App` mkLams [x, b] core_expr
+ `App` Var n_id
+ `App` core_list1
)
\end{code}