decls <- addBinds ss (do {
val_ds <- rep_val_binds (hs_valds group) ;
- tycl_ds <- mapM repTyClD (hs_tyclds group) ;
+ tycl_ds <- mapM repTyClD (concat (hs_tyclds group)) ;
inst_ds <- mapM repInstD' (hs_instds group) ;
for_ds <- mapM repForD (hs_fords group) ;
-- more needed
repSafety :: Safety -> DsM (Core TH.Safety)
repSafety PlayRisky = rep2 unsafeName []
+repSafety PlayInterruptible = rep2 interruptibleName []
repSafety (PlaySafe False) = rep2 safeName []
repSafety (PlaySafe True) = rep2 threadsafeName []
rep_InlinePrag :: InlinePragma -- Never defaultInlinePragma
-> DsM (Core TH.InlineSpecQ)
rep_InlinePrag (InlinePragma { inl_act = activation, inl_rule = match, inl_inline = inline })
- | Nothing <- activation1
- = repInlineSpecNoPhase inline1 match1
| Just (flag, phase) <- activation1
- = repInlineSpecPhase inline1 match1 flag phase
- | otherwise = {- unreachable, but shuts up -W -} panic "rep_InlineSpec"
- where
+ = repInlineSpecPhase inline1 match1 flag phase
+ | otherwise
+ = repInlineSpecNoPhase inline1 match1
+ where
match1 = coreBool (rep_RuleMatchInfo match)
activation1 = rep_Activation activation
- inline1 = coreBool inline
+ inline1 = case inline of
+ Inline -> coreBool True
+ _other -> coreBool False
+ -- We have no representation for Inlinable
rep_RuleMatchInfo FunLike = False
rep_RuleMatchInfo ConLike = True
repE (HsCase e (MatchGroup ms _)) = do { arg <- repLE e
; ms2 <- mapM repMatchTup ms
; repCaseE arg (nonEmptyCoreList ms2) }
-repE (HsIf x y z) = do
+repE (HsIf _ x y z) = do
a <- repLE x
b <- repLE y
c <- repLE z
; ans <- repVal patcore x empty_decls
; return (srcLocSpan (getSrcLoc v), ans) }
-rep_bind (L _ (AbsBinds {})) = panic "rep_bind: AbsBinds"
+rep_bind (L _ (AbsBinds {})) = panic "rep_bind: AbsBinds"
-----------------------------------------------------------------------------
-- Since everything in a Bind is mutually recursive we need rename all
repPinfix p1' con_str p2' }
}
repP (NPat l Nothing _) = do { a <- repOverloadedLiteral l; repPlit a }
+repP (ViewPat e p _) = do { e' <- repLE e; p' <- repLP p; repPview e' p' }
repP p@(NPat _ (Just _) _) = notHandled "Negative overloaded patterns" (ppr p)
repP p@(SigPatIn {}) = notHandled "Type signatures in patterns" (ppr p)
-- The problem is to do with scoped type variables.
repPlist :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
repPlist (MkC ps) = rep2 listPName [ps]
+repPview :: Core TH.ExpQ -> Core TH.PatQ -> DsM (Core TH.PatQ)
+repPview (MkC e) (MkC p) = rep2 viewPName [e,p]
+
--------------- Expressions -----------------
repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
repTup (MkC es) = rep2 tupEName [es]
repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]
+repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]
repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
floatPrimLName, doublePrimLName, rationalLName,
-- Pat
litPName, varPName, tupPName, conPName, tildePName, bangPName, infixPName,
- asPName, wildPName, recPName, listPName, sigPName,
+ asPName, wildPName, recPName, listPName, sigPName, viewPName,
-- FieldPat
fieldPatName,
-- Match
unsafeName,
safeName,
threadsafeName,
+ interruptibleName,
-- InlineSpec
inlineSpecNoPhaseName, inlineSpecPhaseName,
-- FunDep
-- data Pat = ...
litPName, varPName, tupPName, conPName, infixPName, tildePName, bangPName,
- asPName, wildPName, recPName, listPName, sigPName :: Name
+ asPName, wildPName, recPName, listPName, sigPName, viewPName :: Name
litPName = libFun (fsLit "litP") litPIdKey
varPName = libFun (fsLit "varP") varPIdKey
tupPName = libFun (fsLit "tupP") tupPIdKey
recPName = libFun (fsLit "recP") recPIdKey
listPName = libFun (fsLit "listP") listPIdKey
sigPName = libFun (fsLit "sigP") sigPIdKey
+viewPName = libFun (fsLit "viewP") viewPIdKey
-- type FieldPat = ...
fieldPatName :: Name
stdCallName = libFun (fsLit "stdCall") stdCallIdKey
-- data Safety = ...
-unsafeName, safeName, threadsafeName :: Name
+unsafeName, safeName, threadsafeName, interruptibleName :: Name
unsafeName = libFun (fsLit "unsafe") unsafeIdKey
safeName = libFun (fsLit "safe") safeIdKey
threadsafeName = libFun (fsLit "threadsafe") threadsafeIdKey
+interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey
-- data InlineSpec = ...
inlineSpecNoPhaseName, inlineSpecPhaseName :: Name
-- data Pat = ...
litPIdKey, varPIdKey, tupPIdKey, conPIdKey, infixPIdKey, tildePIdKey, bangPIdKey,
- asPIdKey, wildPIdKey, recPIdKey, listPIdKey, sigPIdKey :: Unique
+ asPIdKey, wildPIdKey, recPIdKey, listPIdKey, sigPIdKey, viewPIdKey :: Unique
litPIdKey = mkPreludeMiscIdUnique 220
varPIdKey = mkPreludeMiscIdUnique 221
tupPIdKey = mkPreludeMiscIdUnique 222
recPIdKey = mkPreludeMiscIdUnique 227
listPIdKey = mkPreludeMiscIdUnique 228
sigPIdKey = mkPreludeMiscIdUnique 229
+viewPIdKey = mkPreludeMiscIdUnique 360
-- type FieldPat = ...
fieldPatIdKey :: Unique
stdCallIdKey = mkPreludeMiscIdUnique 301
-- data Safety = ...
-unsafeIdKey, safeIdKey, threadsafeIdKey :: Unique
+unsafeIdKey, safeIdKey, threadsafeIdKey, interruptibleIdKey :: Unique
unsafeIdKey = mkPreludeMiscIdUnique 305
safeIdKey = mkPreludeMiscIdUnique 306
threadsafeIdKey = mkPreludeMiscIdUnique 307
+interruptibleIdKey = mkPreludeMiscIdUnique 308
-- data InlineSpec =
inlineSpecNoPhaseIdKey, inlineSpecPhaseIdKey :: Unique