mkHsPar, mkHsApp, mkHsConApp, mkSimpleHsAlt,
mkSimpleMatch, unguardedGRHSs, unguardedRHS,
mkMatchGroup, mkMatch, mkHsLam, mkHsIf,
- mkHsWrap, mkLHsWrap, mkHsWrapCoI, mkLHsWrapCoI,
- coiToHsWrapper, mkHsLams, mkHsDictLet,
- mkHsOpApp, mkHsDo, mkHsComp, mkHsWrapPat, mkHsWrapPatCoI, mkDoStmts,
+ mkHsWrap, mkLHsWrap, mkHsWrapCo, mkLHsWrapCo,
+ coToHsWrapper, mkHsDictLet, mkHsLams,
+ mkHsOpApp, mkHsDo, mkHsComp, mkHsWrapPat, mkHsWrapPatCo,
nlHsTyApp, nlHsVar, nlHsLit, nlHsApp, nlHsApps, nlHsIntLit, nlHsVarApps,
nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList,
-- Stmts
mkTransformStmt, mkTransformByStmt, mkExprStmt, mkBindStmt, mkLastStmt,
- emptyGroupStmt, mkGroupUsingStmt, mkGroupByStmt, mkGroupByUsingStmt,
+ emptyTransStmt, mkGroupUsingStmt, mkGroupByStmt, mkGroupByUsingStmt,
emptyRecStmt, mkRecStmt,
-- Template Haskell
import RdrName
import Var
import Coercion
-import Type
+import TypeRep
import DataCon
import Name
import NameSet
mkHsWrap co_fn e | isIdHsWrapper co_fn = e
| otherwise = HsWrap co_fn e
-mkHsWrapCoI :: CoercionI -> HsExpr id -> HsExpr id
-mkHsWrapCoI (IdCo _) e = e
-mkHsWrapCoI (ACo co) e = mkHsWrap (WpCast co) e
+mkHsWrapCo :: Coercion -> HsExpr id -> HsExpr id
+mkHsWrapCo (Refl _) e = e
+mkHsWrapCo co e = mkHsWrap (WpCast co) e
-mkLHsWrapCoI :: CoercionI -> LHsExpr id -> LHsExpr id
-mkLHsWrapCoI (IdCo _) e = e
-mkLHsWrapCoI (ACo co) (L loc e) = L loc (mkHsWrap (WpCast co) e)
+mkLHsWrapCo :: Coercion -> LHsExpr id -> LHsExpr id
+mkLHsWrapCo (Refl _) e = e
+mkLHsWrapCo co (L loc e) = L loc (mkHsWrap (WpCast co) e)
-coiToHsWrapper :: CoercionI -> HsWrapper
-coiToHsWrapper (IdCo _) = idHsWrapper
-coiToHsWrapper (ACo co) = WpCast co
+coToHsWrapper :: Coercion -> HsWrapper
+coToHsWrapper (Refl _) = idHsWrapper
+coToHsWrapper co = WpCast co
mkHsWrapPat :: HsWrapper -> Pat id -> Type -> Pat id
mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p
| otherwise = CoPat co_fn p ty
-mkHsWrapPatCoI :: CoercionI -> Pat id -> Type -> Pat id
-mkHsWrapPatCoI (IdCo _) pat _ = pat
-mkHsWrapPatCoI (ACo co) pat ty = CoPat (WpCast co) pat ty
+mkHsWrapPatCo :: Coercion -> Pat id -> Type -> Pat id
+mkHsWrapPatCo (Refl _) pat _ = pat
+mkHsWrapPatCo co pat ty = CoPat (WpCast co) pat ty
mkHsLam :: [LPat id] -> LHsExpr id -> LHsExpr id
mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
mkHsIsString :: FastString -> PostTcType -> HsOverLit id
mkHsDo :: HsStmtContext Name -> [LStmt id] -> HsExpr id
mkHsComp :: HsStmtContext Name -> [LStmt id] -> LHsExpr id -> HsExpr id
-mkDoStmts :: [LStmt id] -> [LStmt id]
mkNPat :: HsOverLit id -> Maybe (SyntaxExpr id) -> Pat id
mkNPlusKPat :: Located id -> HsOverLit id -> Pat id
-mkTransformStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
-mkTransformByStmt :: [LStmt idL] -> LHsExpr idR -> LHsExpr idR -> StmtLR idL idR
-
mkLastStmt :: LHsExpr idR -> StmtLR idL idR
mkExprStmt :: LHsExpr idR -> StmtLR idL idR
mkBindStmt :: LPat idL -> LHsExpr idR -> StmtLR idL idR
noRebindableInfo :: Bool
noRebindableInfo = error "noRebindableInfo" -- Just another placeholder;
--- mkDoStmts turns a trailing ExprStmt into a LastStmt
-mkDoStmts [L loc (ExprStmt e _ _ _)] = [L loc (mkLastStmt e)]
-mkDoStmts (s:ss) = s : mkDoStmts ss
-mkDoStmts [] = []
-
mkHsDo ctxt stmts = HsDo ctxt stmts placeHolderType
mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])
where
mkNPat lit neg = NPat lit neg noSyntaxExpr
mkNPlusKPat id lit = NPlusKPat id lit noSyntaxExpr noSyntaxExpr
-mkTransformStmt stmts usingExpr = TransformStmt stmts [] usingExpr Nothing noSyntaxExpr noSyntaxExpr
-mkTransformByStmt stmts usingExpr byExpr = TransformStmt stmts [] usingExpr (Just byExpr) noSyntaxExpr noSyntaxExpr
-
+mkTransformStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
+mkTransformByStmt :: [LStmt idL] -> LHsExpr idR -> LHsExpr idR -> StmtLR idL idR
mkGroupUsingStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
mkGroupByStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
mkGroupByUsingStmt :: [LStmt idL] -> LHsExpr idR -> LHsExpr idR -> StmtLR idL idR
-emptyGroupStmt :: StmtLR idL idR
-emptyGroupStmt = GroupStmt { grpS_stmts = [], grpS_bndrs = [], grpS_explicit = False
- , grpS_by = Nothing, grpS_using = noLoc noSyntaxExpr
- , grpS_ret = noSyntaxExpr, grpS_bind = noSyntaxExpr
- , grpS_fmap = noSyntaxExpr }
-mkGroupUsingStmt ss u = emptyGroupStmt { grpS_stmts = ss, grpS_explicit = True, grpS_using = u }
-mkGroupByStmt ss b = emptyGroupStmt { grpS_stmts = ss, grpS_by = Just b }
-mkGroupByUsingStmt ss b u = emptyGroupStmt { grpS_stmts = ss, grpS_by = Just b
- , grpS_explicit = True, grpS_using = u }
+emptyTransStmt :: StmtLR idL idR
+emptyTransStmt = TransStmt { trS_form = undefined, trS_stmts = [], trS_bndrs = []
+ , trS_by = Nothing, trS_using = noLoc noSyntaxExpr
+ , trS_ret = noSyntaxExpr, trS_bind = noSyntaxExpr
+ , trS_fmap = noSyntaxExpr }
+mkTransformStmt ss u = emptyTransStmt { trS_form = ThenForm, trS_stmts = ss, trS_using = u }
+mkTransformByStmt ss u b = emptyTransStmt { trS_form = ThenForm, trS_stmts = ss, trS_using = u, trS_by = Just b }
+mkGroupByStmt ss b = emptyTransStmt { trS_form = GroupFormB, trS_stmts = ss, trS_by = Just b }
+mkGroupUsingStmt ss u = emptyTransStmt { trS_form = GroupFormU, trS_stmts = ss, trS_using = u }
+mkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupFormU, trS_stmts = ss
+ , trS_by = Just b, trS_using = u }
mkLastStmt expr = LastStmt expr noSyntaxExpr
mkExprStmt expr = ExprStmt expr noSyntaxExpr noSyntaxExpr placeHolderType
collectStmtBinders (LastStmt {}) = []
collectStmtBinders (ParStmt xs _ _ _) = collectLStmtsBinders
$ concatMap fst xs
-collectStmtBinders (TransformStmt stmts _ _ _ _ _) = collectLStmtsBinders stmts
-collectStmtBinders (GroupStmt { grpS_stmts = stmts }) = collectLStmtsBinders stmts
-collectStmtBinders (RecStmt { recS_stmts = ss }) = collectLStmtsBinders ss
+collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts
+collectStmtBinders (RecStmt { recS_stmts = ss }) = collectLStmtsBinders ss
----------------- Patterns --------------------------
hs_stmt (LastStmt {}) = emptyNameSet
hs_stmt (ParStmt xs _ _ _) = hs_lstmts $ concatMap fst xs
- hs_stmt (TransformStmt stmts _ _ _ _ _) = hs_lstmts stmts
- hs_stmt (GroupStmt { grpS_stmts = stmts }) = hs_lstmts stmts
- hs_stmt (RecStmt { recS_stmts = ss }) = hs_lstmts ss
+ hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts
+ hs_stmt (RecStmt { recS_stmts = ss }) = hs_lstmts ss
hs_local_binds (HsValBinds val_binds) = hsValBindsImplicits val_binds
hs_local_binds (HsIPBinds _) = emptyNameSet