- let
- c = addIdUnfolding pre_c (iWantToBeINLINEd UnfoldAlways)
- c_rhs = CoLam [b,g',a]
- (CoLet (CoNonRec t (CoApp (CoApp (atomToExpr arg_k) (CoVarAtom a)) (CoVarAtom b)))
- (CoApp (CoVar g') (CoVarAtom t)))
- n = addIdUnfolding pre_n (iWantToBeINLINEd UnfoldAlways)
- n_rhs = CoLam [a'] (CoVar a')
- in
- returnSmpl (Just (CoLet (CoNonRec c c_rhs) (CoLet (CoNonRec n n_rhs)
- (applyToArgs (CoVar g)
- (TypeArg (ty1 `mkFunTy` ty1):ValArg (CoVarAtom c):ValArg (CoVarAtom n)
- :ValArg arg_z:rest_args)))))
-
-
- | do_fb_red && arg_list_isAppendForm
- = -- foldl k z (foldr (:) ys xs) <args> ==> foldl k (foldl k z xs) ys <args>
- -- be caseful with for order of xs / ys
- tick FoldrFoldr `thenSmpl_`
- newId ty1 `thenSmpl` \ other_foldl ->
- let
- inner_foldl = applyToArgs (CoVar foldlId)
- [TypeArg ty1,TypeArg ty2,
- ValArg arg_k,ValArg arg_z,ValArg xs]
- outer_foldl = applyToArgs (CoVar foldlId)
- ([TypeArg ty1,TypeArg ty2,
- ValArg arg_k,ValArg (CoVarAtom other_foldl),ValArg ys]
- ++ rest_args)
- in returnSmpl (Just (CoLet (CoNonRec other_foldl inner_foldl) outer_foldl))
+ let
+ c = addInlinePragma pre_c
+ c_rhs = Lam b (Lam g' (Lam a
+ (Let (NonRec t (App (App (argToExpr arg_k) (VarArg a)) (VarArg b)))
+ (App (Var g') (VarArg t)))))
+ n = addInlinePragma pre_n
+ n_rhs = Lam a' (Var a')
+ in
+ returnSmpl (Let (NonRec c c_rhs) $
+ Let (NonRec n n_rhs) $
+ mkGenApp (Var g)
+ (TypeArg (mkFunTys [ty1] ty1):ValArg (VarArg c):ValArg (VarArg n)
+ :ValArg arg_z:rest_args))
+ )
+
+ | do_fb_red && arg_list_isAugmentForm
+ -- foldl t1 t2 k z (augment t3 g h) ==>
+ -- let c {- INLINE -} = \ b g' a -> g' (f a b)
+ -- n {- INLINE -} = \ a -> a
+ -- r {- INLINE -} = foldr t2 (t1 -> t1) c n h
+ -- in g t1 c r z
+ -- this next line *is* the foldr/build rule proper.
+ = Just (tick FoldlAugment `thenSmpl_`
+ -- c :: t2 -> (t1 -> t1) -> t1 -> t1
+ -- n :: t1 -> t1
+ newIds [
+ {- pre_c -} mkFunTys [ty2, mkFunTys [ty1] ty1, ty1] ty1,
+ {- pre_n -} mkFunTys [ty1] ty1,
+ {- pre_r -} mkFunTys [ty1] ty1,
+ {- b -} ty2,
+ {- g_ -} mkFunTys [ty1] ty1,
+ {- a -} ty1,
+ {- a' -} ty1,
+ {- t -} ty1
+ ] `thenSmpl` \ [pre_c,
+ pre_n,
+ pre_r,
+ b,
+ g_,
+ a,
+ a',
+ t] ->
+
+ let
+ c = addInlinePragma pre_c
+ c_rhs = Lam b (Lam g_ (Lam a
+ (Let (NonRec t (App (App (argToExpr arg_k) (VarArg a)) (VarArg b)))
+ (App (Var g_) (VarArg t)))))
+ n = addInlinePragma pre_n
+ n_rhs = Lam a' (Var a')
+ r = addInlinePragma pre_r
+ r_rhs = mkGenApp (Var foldrId)
+ [TypeArg ty2,TypeArg (mkFunTys [ty1] ty1),
+ ValArg (VarArg c),
+ ValArg (VarArg n),
+ ValArg h]
+ in
+ returnSmpl (Let (NonRec c c_rhs) $
+ Let (NonRec n n_rhs) $
+ Let (NonRec r r_rhs) $
+ mkGenApp (Var g')
+ (TypeArg (mkFunTys [ty1] ty1):ValArg (VarArg c):ValArg (VarArg r)
+ :ValArg arg_z:rest_args))
+ )