2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[DsListComp]{Desugaring list comprehensions}
7 module DsListComp ( dsListComp ) where
10 import AbsSyn -- the stuff being desugared
11 import PlainCore -- the output of desugaring;
12 -- importing this module also gets all the
13 -- CoreSyn utility functions
14 import DsMonad -- the monadery used in the desugarer
16 import AbsPrel ( mkFunTy, nilDataCon, consDataCon, listTyCon,
19 import AbsUniType ( alpha_tv, alpha, mkTyVarTy, mkForallTy )
20 import CmdLineOpts ( GlobalSwitch(..) )
21 import DsExpr ( dsExpr )
23 import Id ( getIdInfo, replaceIdInfo )
25 import Match ( matchSimply )
29 List comprehensions may be desugared in one of two ways: ``ordinary''
30 (as you would expect if you read SLPJ's book) and ``with foldr/build
31 turned on'' (if you read Gill {\em et al.}'s paper on the subject).
33 There will be at least one ``qualifier'' in the input.
36 dsListComp :: PlainCoreExpr -> [TypecheckedQual] -> DsM PlainCoreExpr
39 = let expr_ty = typeOfCoreExpr expr
41 ifSwitchSetDs FoldrBuildOn (
42 new_alpha_tyvar `thenDs` \ (n_tyvar, n_ty) ->
44 c_ty = expr_ty `mkFunTy` (n_ty `mkFunTy` n_ty)
45 g_ty = mkForallTy [alpha_tv] (
46 (expr_ty `mkFunTy` (alpha `mkFunTy` alpha))
47 `mkFunTy` (alpha `mkFunTy` alpha))
49 newSysLocalsDs [c_ty,n_ty,g_ty] `thenDs` \ [c, n, g] ->
51 dfListComp expr expr_ty
54 quals `thenDs` \ result ->
56 returnDs (mkBuild expr_ty n_tyvar c n g result)
58 ) {-else be boring-} (
59 deListComp expr quals (nIL_EXPR expr_ty)
62 nIL_EXPR ty = CoCon nilDataCon [ty] []
64 new_alpha_tyvar :: DsM (TyVar, UniType)
66 = newTyVarsDs [alpha_tv] `thenDs` \ [new_ty] ->
67 returnDs (new_ty,mkTyVarTy new_ty)
70 %************************************************************************
72 \subsection[DsListComp-ordinary]{Ordinary desugaring of list comprehensions}
74 %************************************************************************
76 Just as in Phil's chapter~7 in SLPJ, using the rules for
77 optimally-compiled list comprehensions. This is what Kevin followed
78 as well, and I quite happily do the same. The TQ translation scheme
79 transforms a list of qualifiers (either boolean expressions or
80 generators) into a single expression which implements the list
81 comprehension. Because we are generating 2nd-order polymorphic
82 lambda-calculus, calls to NIL and CONS must be applied to a type
83 argument, as well as their usual value arguments.
85 TE << [ e | qs ] >> = TQ << [ e | qs ] ++ Nil (typeOf e) >>
88 TQ << [ e | ] ++ L >> = Cons (typeOf e) TE <<e>> TE <<L>>
91 TQ << [ e | b , qs ] ++ L >> =
92 if TE << b >> then TQ << [ e | qs ] ++ L >> else TE << L >>
95 TQ << [ e | p <- L1, qs ] ++ L2 >> =
101 (( \ TE << p >> -> ( TQ << [e | qs] ++ (h u3) >> )) u2)
106 "h", "u1", "u2", and "u3" are new variables.
109 @deListComp@ is the TQ translation scheme. Roughly speaking, @dsExpr@
110 is the TE translation scheme. Note that we carry around the @L@ list
111 already desugared. @dsListComp@ does the top TE rule mentioned above.
114 deListComp :: PlainCoreExpr -> [TypecheckedQual] -> PlainCoreExpr -> DsM PlainCoreExpr
116 deListComp expr [] list -- Figure 7.4, SLPJ, p 135, rule C above
117 = mkCoConDs consDataCon [typeOfCoreExpr expr] [expr, list]
119 deListComp expr ((FilterQual filt): quals) list -- rule B above
120 = dsExpr filt `thenDs` \ core_filt ->
121 deListComp expr quals list `thenDs` \ core_rest ->
122 returnDs ( mkCoreIfThenElse core_filt core_rest list )
124 deListComp expr ((GeneratorQual pat list1):quals) core_list2 -- rule A' above
125 = dsExpr list1 `thenDs` \ core_list1 ->
127 u3_ty@u1_ty = typeOfCoreExpr core_list1 -- two names, same thing
129 -- u1_ty is a [alpha] type, and u2_ty = alpha
130 u2_ty = typeOfPat pat
132 res_ty = typeOfCoreExpr core_list2
133 h_ty = mkFunTy u1_ty res_ty
135 newSysLocalsDs [h_ty, u1_ty, u2_ty, u3_ty]
136 `thenDs` \ [h', u1, u2, u3] ->
138 Make the function h unfoldable by the deforester.
139 Since it only occurs once in the body, we can't get
140 an increase in code size by unfolding it.
142 -- getSwitchCheckerDs `thenDs` \ sw_chkr ->
144 h = if False -- LATER: sw_chkr DoDeforest???
145 then replaceIdInfo h' (addInfo (getIdInfo h') DoDeforest)
148 -- the "fail" value ...
149 mkCoAppDs (CoVar h) (CoVar u3) `thenDs` \ core_fail ->
151 deListComp expr quals core_fail `thenDs` \ rest_expr ->
153 matchSimply (CoVar u2) pat res_ty rest_expr core_fail `thenDs` \ core_match ->
155 mkCoAppDs (CoVar h) core_list1 `thenDs` \ letrec_body ->
163 [(nilDataCon, [], core_list2),
164 (consDataCon, [u2, u3], core_match)]
170 %************************************************************************
172 \subsection[DsListComp-foldr-build]{Foldr/Build desugaring of list comprehensions}
174 %************************************************************************
176 @dfListComp@ are the rules used with foldr/build turned on:
178 TE < [ e | ] >> c n = c e n
179 TE << [ e | b , q ] >> c n = if b then TE << [ e | q ] >> c n else n
180 TE << [ e | p <- l , q ] c n = foldr
181 (\ TE << p >> b -> TE << [ e | q ] >> c b
185 dfListComp :: PlainCoreExpr -- the inside of the comp
186 -> UniType -- the type of the inside
187 -> UniType -> Id -- 'c'; its type and id
188 -> UniType -> Id -- 'n'; its type and id
189 -> [TypecheckedQual] -- the rest of the qual's
192 dfListComp expr expr_ty c_ty c_id n_ty n_id []
193 = mkCoAppDs (CoVar c_id) expr `thenDs` \ inner ->
194 mkCoAppDs inner (CoVar n_id)
196 dfListComp expr expr_ty c_ty c_id n_ty n_id ((FilterQual filt) : quals)
197 = dsExpr filt `thenDs` \ core_filt ->
198 dfListComp expr expr_ty c_ty c_id n_ty n_id quals
199 `thenDs` \ core_rest ->
200 returnDs (mkCoreIfThenElse core_filt core_rest (CoVar n_id))
202 dfListComp expr expr_ty c_ty c_id n_ty n_id ((GeneratorQual pat list1):quals)
203 -- evaluate the two lists
204 = dsExpr list1 `thenDs` \ core_list1 ->
206 -- find the required type
208 let p_ty = typeOfPat pat
209 b_ty = n_ty -- alias b_ty to n_ty
210 fn_ty = p_ty `mkFunTy` (b_ty `mkFunTy` b_ty)
211 lst_ty = typeOfCoreExpr core_list1
214 -- create some new local id's
216 newSysLocalsDs [b_ty,p_ty,fn_ty,lst_ty] `thenDs` \ [b,p,fn,lst] ->
218 -- build rest of the comprehesion
220 dfListComp expr expr_ty c_ty c_id b_ty b quals `thenDs` \ core_rest ->
221 -- build the pattern match
223 matchSimply (CoVar p) pat b_ty core_rest (CoVar b) `thenDs` \ core_expr ->
225 -- now build the outermost foldr, and return
229 [CoNonRec fn (CoLam [p,b] core_expr),
230 CoNonRec lst core_list1]
231 (mkFoldr p_ty n_ty fn n_id lst)