X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsMeta.hs;h=5303f9d75319c66884262b74290924d37ba86f19;hb=40b8f4c53505de002e92a33fc85f780fd83cbb9a;hp=82dffd798f8130fd9881da813e98b58cba8ea0b0;hpb=7583384214ed6aa4a90d77c5975728a9b06149f2;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 82dffd7..5303f9d 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -188,7 +188,7 @@ repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt, ; cons1 <- mapM repC cons ; cons2 <- coreList conQTyConName cons1 ; derivs1 <- repDerivs mb_derivs - ; bndrs1 <- coreList nameTyConName bndrs + ; bndrs1 <- coreList tyVarBndrTyConName bndrs ; repData cxt1 tc1 bndrs1 opt_tys2 cons2 derivs1 } ; return $ Just (loc, dec) @@ -204,7 +204,7 @@ repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt, ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1 ; con1 <- repC con ; derivs1 <- repDerivs mb_derivs - ; bndrs1 <- coreList nameTyConName bndrs + ; bndrs1 <- coreList tyVarBndrTyConName bndrs ; repNewtype cxt1 tc1 bndrs1 opt_tys2 con1 derivs1 } ; return $ Just (loc, dec) @@ -217,7 +217,7 @@ repTyClD (L loc (TySynonym { tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys do { opt_tys1 <- maybeMapM repLTys opt_tys -- only for family insts ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1 ; ty1 <- repLTy ty - ; bndrs1 <- coreList nameTyConName bndrs + ; bndrs1 <- coreList tyVarBndrTyConName bndrs ; repTySyn tc1 bndrs1 opt_tys2 ty1 } ; return (Just (loc, dec)) @@ -235,7 +235,7 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, ; fds1 <- repLFunDeps fds ; ats1 <- repLAssocFamilys ats ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1) - ; bndrs1 <- coreList nameTyConName bndrs + ; bndrs1 <- coreList tyVarBndrTyConName bndrs ; repClass cxt1 cls1 bndrs1 fds1 decls1 } ; return $ Just (loc, dec) @@ -255,13 +255,17 @@ repTyFamily :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ)) repTyFamily (L loc (TyFamily { tcdFlavour = flavour, tcdLName = tc, tcdTyVars = tvs, - tcdKind = _kind })) + tcdKind = opt_kind })) tyVarBinds = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences] ; dec <- tyVarBinds tvs $ \bndrs -> do { flav <- repFamilyFlavour flavour - ; bndrs1 <- coreList nameTyConName bndrs - ; repFamily flav tc1 bndrs1 + ; bndrs1 <- coreList tyVarBndrTyConName bndrs + ; case opt_kind of + Nothing -> repFamilyNoKind flav tc1 bndrs1 + Just ki -> do { ki1 <- repKind ki + ; repFamilyKind flav tc1 bndrs1 ki1 + } } ; return $ Just (loc, dec) } @@ -370,16 +374,17 @@ ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:") repC :: LConDecl Name -> DsM (Core TH.ConQ) repC (L _ (ConDecl con _ [] (L _ []) details ResTyH98 _)) - = do { con1 <- lookupLOcc con ; -- See note [Binders and occurrences] - repConstr con1 details } + = do { con1 <- lookupLOcc con -- See note [Binders and occurrences] + ; repConstr con1 details + } repC (L loc (ConDecl con expl tvs (L cloc ctxt) details ResTyH98 doc)) - = do { addTyVarBinds tvs $ \bndrs -> do { - c' <- repC (L loc (ConDecl con expl [] (L cloc []) details ResTyH98 doc)); - ctxt' <- repContext ctxt; - bndrs' <- coreList nameTyConName bndrs; - rep2 forallCName [unC bndrs', unC ctxt', unC c'] + = addTyVarBinds tvs $ \bndrs -> + do { c' <- repC (L loc (ConDecl con expl [] (L cloc []) details + ResTyH98 doc)) + ; ctxt' <- repContext ctxt + ; bndrs' <- coreList tyVarBndrTyConName bndrs + ; rep2 forallCName [unC bndrs', unC ctxt', unC c'] } - } repC (L loc con_decl) -- GADTs = putSrcSpanDs loc $ notHandled "GADT declaration" (ppr con_decl) @@ -426,14 +431,64 @@ rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ; rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)] -- Singleton => Ok -- Empty => Too hard, signature ignored -rep_sig (L loc (TypeSig nm ty)) = rep_proto nm ty loc -rep_sig _ = return [] +rep_sig (L loc (TypeSig nm ty)) = rep_proto nm ty loc +rep_sig (L loc (InlineSig nm ispec)) = rep_inline nm ispec loc +rep_sig (L loc (SpecSig nm ty ispec)) = rep_specialise nm ty ispec loc +rep_sig _ = return [] + +rep_proto :: Located Name -> LHsType Name -> SrcSpan + -> DsM [(SrcSpan, Core TH.DecQ)] +rep_proto nm ty loc + = do { nm1 <- lookupLOcc nm + ; ty1 <- repLTy ty + ; sig <- repProto nm1 ty1 + ; return [(loc, sig)] + } -rep_proto :: Located Name -> LHsType Name -> SrcSpan -> DsM [(SrcSpan, Core TH.DecQ)] -rep_proto nm ty loc = do { nm1 <- lookupLOcc nm ; - ty1 <- repLTy ty ; - sig <- repProto nm1 ty1 ; - return [(loc, sig)] } +rep_inline :: Located Name -> InlineSpec -> SrcSpan + -> DsM [(SrcSpan, Core TH.DecQ)] +rep_inline nm ispec loc + = do { nm1 <- lookupLOcc nm + ; (_, ispec1) <- rep_InlineSpec ispec + ; pragma <- repPragInl nm1 ispec1 + ; return [(loc, pragma)] + } + +rep_specialise :: Located Name -> LHsType Name -> InlineSpec -> SrcSpan + -> DsM [(SrcSpan, Core TH.DecQ)] +rep_specialise nm ty ispec loc + = do { nm1 <- lookupLOcc nm + ; ty1 <- repLTy ty + ; (hasSpec, ispec1) <- rep_InlineSpec ispec + ; pragma <- if hasSpec + then repPragSpecInl nm1 ty1 ispec1 + else repPragSpec nm1 ty1 + ; return [(loc, pragma)] + } + +-- extract all the information needed to build a TH.InlineSpec +-- +rep_InlineSpec :: InlineSpec -> DsM (Bool, Core TH.InlineSpecQ) +rep_InlineSpec (Inline (InlinePragma activation match) inline) + | Nothing <- activation1 + = liftM ((,) False) $ repInlineSpecNoPhase inline1 match1 + | Just (flag, phase) <- activation1 + = liftM ((,) True) $ repInlineSpecPhase inline1 match1 flag phase + | otherwise = {- unreachable, but shuts up -W -} panic "rep_InlineSpec" + where + match1 = coreBool (rep_RuleMatchInfo match) + activation1 = rep_Activation activation + inline1 = coreBool inline + + rep_RuleMatchInfo FunLike = False + rep_RuleMatchInfo ConLike = True + + rep_Activation NeverActive = Nothing + rep_Activation AlwaysActive = Nothing + rep_Activation (ActiveBefore phase) = Just (coreBool False, + MkC $ mkIntExprInt phase) + rep_Activation (ActiveAfter phase) = Just (coreBool True, + MkC $ mkIntExprInt phase) ------------------------------------------------------- @@ -445,8 +500,8 @@ rep_proto nm ty loc = do { nm1 <- lookupLOcc nm ; -- families, depending on whether they are associated or not. -- type ProcessTyVarBinds a = - [LHsTyVarBndr Name] -- the binders to be added - -> ([Core TH.Name] -> DsM (Core (TH.Q a))) -- action in the ext env + [LHsTyVarBndr Name] -- the binders to be added + -> ([Core TH.TyVarBndr] -> DsM (Core (TH.Q a))) -- action in the ext env -> DsM (Core (TH.Q a)) -- gensym a list of type variables and enter them into the meta environment; @@ -456,11 +511,13 @@ type ProcessTyVarBinds a = addTyVarBinds :: ProcessTyVarBinds a addTyVarBinds tvs m = do - let names = map (hsTyVarName.unLoc) tvs + let names = hsLTyVarNames tvs + mkWithKinds = map repTyVarBndrWithKind tvs freshNames <- mkGenSyms names term <- addBinds freshNames $ do - bndrs <- mapM lookupBinder names - m bndrs + bndrs <- mapM lookupBinder names + kindedBndrs <- zipWithM ($) mkWithKinds bndrs + m kindedBndrs wrapGenSyns freshNames term -- Look up a list of type variables; the computations passed as the second @@ -469,9 +526,19 @@ addTyVarBinds tvs m = lookupTyVarBinds :: ProcessTyVarBinds a lookupTyVarBinds tvs m = do - let names = map (hsTyVarName.unLoc) tvs - bndrs <- mapM lookupBinder names - m bndrs + let names = hsLTyVarNames tvs + mkWithKinds = map repTyVarBndrWithKind tvs + bndrs <- mapM lookupBinder names + kindedBndrs <- zipWithM ($) mkWithKinds bndrs + m kindedBndrs + +-- Produce kinded binder constructors from the Haskell tyvar binders +-- +repTyVarBndrWithKind :: LHsTyVarBndr Name + -> Core TH.Name -> DsM (Core TH.TyVarBndr) +repTyVarBndrWithKind (L _ (UserTyVar _)) = repPlainTV +repTyVarBndrWithKind (L _ (KindedTyVar _ ki)) = + \nm -> repKind ki >>= repKindedTV nm -- represent a type context -- @@ -526,7 +593,7 @@ repTy (HsForAllTy _ tvs ctxt ty) = addTyVarBinds tvs $ \bndrs -> do ctxt1 <- repLContext ctxt ty1 <- repLTy ty - bndrs1 <- coreList nameTyConName bndrs + bndrs1 <- coreList tyVarBndrTyConName bndrs repTForall bndrs1 ctxt1 ty1 repTy (HsTyVar n) @@ -561,9 +628,26 @@ repTy (HsOpTy ty1 n ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1) `nlHsAppTy` ty2) repTy (HsParTy t) = repLTy t repTy (HsPredTy pred) = repPredTy pred +repTy (HsKindSig t k) = do + t1 <- repLTy t + k1 <- repKind k + repTSig t1 k1 repTy ty@(HsNumTy _) = notHandled "Number types (for generics)" (ppr ty) repTy ty = notHandled "Exotic form of type" (ppr ty) +-- represent a kind +-- +repKind :: Kind -> DsM (Core TH.Kind) +repKind ki + = do { let (kis, ki') = splitKindFunTys ki + ; kis_rep <- mapM repKind kis + ; ki'_rep <- repNonArrowKind ki' + ; foldlM repArrowK ki'_rep kis_rep + } + where + repNonArrowKind k | isLiftedTypeKind k = repStarK + | otherwise = notHandled "Exotic form of kind" + (ppr k) ----------------------------------------------------------------------------- -- Expressions @@ -920,6 +1004,7 @@ repP (WildPat _) = repPwild repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 } repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' } repP (LazyPat p) = do { p1 <- repLP p; repPtilde p1 } +repP (BangPat p) = do { p1 <- repLP p; repPbang p1 } repP (AsPat x p) = do { x' <- lookupLBinder x; p1 <- repLP p; repPaspat x' p1 } repP (ParPat p) = repLP p repP (ListPat ps _) = do { qs <- repLPs ps; repPlist qs } @@ -1159,6 +1244,9 @@ repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2] repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ) repPtilde (MkC p) = rep2 tildePName [p] +repPbang :: Core TH.PatQ -> DsM (Core TH.PatQ) +repPbang (MkC p) = rep2 bangPName [p] + repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ) repPaspat (MkC s) (MkC p) = rep2 asPName [s, p] @@ -1286,7 +1374,7 @@ repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds] repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ) repFun (MkC nm) (MkC b) = rep2 funDName [nm, b] -repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] +repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr] -> Maybe (Core [TH.TypeQ]) -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ) repData (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC cons) (MkC derivs) @@ -1294,7 +1382,7 @@ repData (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC cons) (MkC derivs) repData (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC cons) (MkC derivs) = rep2 dataInstDName [cxt, nm, tys, cons, derivs] -repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] +repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr] -> Maybe (Core [TH.TypeQ]) -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ) repNewtype (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC con) (MkC derivs) @@ -1302,7 +1390,7 @@ repNewtype (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC con) (MkC derivs) repNewtype (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC con) (MkC derivs) = rep2 newtypeInstDName [cxt, nm, tys, con, derivs] -repTySyn :: Core TH.Name -> Core [TH.Name] +repTySyn :: Core TH.Name -> Core [TH.TyVarBndr] -> Maybe (Core [TH.TypeQ]) -> Core TH.TypeQ -> DsM (Core TH.DecQ) repTySyn (MkC nm) (MkC tvs) Nothing (MkC rhs) @@ -1313,13 +1401,42 @@ repTySyn (MkC nm) (MkC _) (Just (MkC tys)) (MkC rhs) repInst :: Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ) repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceDName [cxt, ty, ds] -repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.FunDep] -> Core [TH.DecQ] -> DsM (Core TH.DecQ) -repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds) = rep2 classDName [cxt, cls, tvs, fds, ds] +repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr] + -> Core [TH.FunDep] -> Core [TH.DecQ] + -> DsM (Core TH.DecQ) +repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds) + = rep2 classDName [cxt, cls, tvs, fds, ds] + +repPragInl :: Core TH.Name -> Core TH.InlineSpecQ -> DsM (Core TH.DecQ) +repPragInl (MkC nm) (MkC ispec) = rep2 pragInlDName [nm, ispec] + +repPragSpec :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ) +repPragSpec (MkC nm) (MkC ty) = rep2 pragSpecDName [nm, ty] + +repPragSpecInl :: Core TH.Name -> Core TH.TypeQ -> Core TH.InlineSpecQ + -> DsM (Core TH.DecQ) +repPragSpecInl (MkC nm) (MkC ty) (MkC ispec) + = rep2 pragSpecInlDName [nm, ty, ispec] -repFamily :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.Name] - -> DsM (Core TH.DecQ) -repFamily (MkC flav) (MkC nm) (MkC tvs) - = rep2 familyDName [flav, nm, tvs] +repFamilyNoKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr] + -> DsM (Core TH.DecQ) +repFamilyNoKind (MkC flav) (MkC nm) (MkC tvs) + = rep2 familyNoKindDName [flav, nm, tvs] + +repFamilyKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr] + -> Core TH.Kind + -> DsM (Core TH.DecQ) +repFamilyKind (MkC flav) (MkC nm) (MkC tvs) (MkC ki) + = rep2 familyKindDName [flav, nm, tvs, ki] + +repInlineSpecNoPhase :: Core Bool -> Core Bool -> DsM (Core TH.InlineSpecQ) +repInlineSpecNoPhase (MkC inline) (MkC conlike) + = rep2 inlineSpecNoPhaseName [inline, conlike] + +repInlineSpecPhase :: Core Bool -> Core Bool -> Core Bool -> Core Int + -> DsM (Core TH.InlineSpecQ) +repInlineSpecPhase (MkC inline) (MkC conlike) (MkC beforeFrom) (MkC phase) + = rep2 inlineSpecPhaseName [inline, conlike, beforeFrom, phase] repFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep) repFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys] @@ -1356,7 +1473,8 @@ repConstr con (InfixCon st1 st2) ------------ Types ------------------- -repTForall :: Core [TH.Name] -> Core TH.CxtQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ) +repTForall :: Core [TH.TyVarBndr] -> Core TH.CxtQ -> Core TH.TypeQ + -> DsM (Core TH.TypeQ) repTForall (MkC tvars) (MkC ctxt) (MkC ty) = rep2 forallTName [tvars, ctxt, ty] @@ -1364,12 +1482,15 @@ repTvar :: Core TH.Name -> DsM (Core TH.TypeQ) repTvar (MkC s) = rep2 varTName [s] repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ) -repTapp (MkC t1) (MkC t2) = rep2 appTName [t1,t2] +repTapp (MkC t1) (MkC t2) = rep2 appTName [t1, t2] repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ) repTapps f [] = return f repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts } +repTSig :: Core TH.TypeQ -> Core TH.Kind -> DsM (Core TH.TypeQ) +repTSig (MkC ty) (MkC ki) = rep2 sigTName [ty, ki] + --------- Type constructors -------------- repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ) @@ -1385,6 +1506,19 @@ repArrowTyCon = rep2 arrowTName [] repListTyCon :: DsM (Core TH.TypeQ) repListTyCon = rep2 listTName [] +------------ Kinds ------------------- + +repPlainTV :: Core TH.Name -> DsM (Core TH.TyVarBndr) +repPlainTV (MkC nm) = rep2 plainTVName [nm] + +repKindedTV :: Core TH.Name -> Core TH.Kind -> DsM (Core TH.TyVarBndr) +repKindedTV (MkC nm) (MkC ki) = rep2 kindedTVName [nm, ki] + +repStarK :: DsM (Core TH.Kind) +repStarK = rep2 starKName [] + +repArrowK :: Core TH.Kind -> Core TH.Kind -> DsM (Core TH.Kind) +repArrowK (MkC ki1) (MkC ki2) = rep2 arrowKName [ki1, ki2] ---------------------------------------------------------- -- Literals @@ -1471,6 +1605,12 @@ nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs)) coreStringLit :: String -> DsM (Core String) coreStringLit s = do { z <- mkStringExpr s; return(MkC z) } +------------ Bool, Literals & Variables ------------------- + +coreBool :: Bool -> Core Bool +coreBool False = MkC $ mkConApp falseDataCon [] +coreBool True = MkC $ mkConApp trueDataCon [] + coreIntLit :: Int -> DsM (Core Int) coreIntLit i = return (MkC (mkIntExprInt i)) @@ -1509,7 +1649,7 @@ templateHaskellNames = [ charLName, stringLName, integerLName, intPrimLName, wordPrimLName, floatPrimLName, doublePrimLName, rationalLName, -- Pat - litPName, varPName, tupPName, conPName, tildePName, infixPName, + litPName, varPName, tupPName, conPName, tildePName, bangPName, infixPName, asPName, wildPName, recPName, listPName, sigPName, -- FieldPat fieldPatName, @@ -1533,8 +1673,10 @@ templateHaskellNames = [ bindSName, letSName, noBindSName, parSName, -- Dec funDName, valDName, dataDName, newtypeDName, tySynDName, - classDName, instanceDName, sigDName, forImpDName, familyDName, dataInstDName, - newtypeInstDName, tySynInstDName, + classDName, instanceDName, sigDName, forImpDName, + pragInlDName, pragSpecDName, pragSpecInlDName, + familyNoKindDName, familyKindDName, dataInstDName, newtypeInstDName, + tySynInstDName, -- Cxt cxtName, -- Pred @@ -1549,13 +1691,19 @@ templateHaskellNames = [ varStrictTypeName, -- Type forallTName, varTName, conTName, appTName, - tupleTName, arrowTName, listTName, + tupleTName, arrowTName, listTName, sigTName, + -- TyVarBndr + plainTVName, kindedTVName, + -- Kind + starKName, arrowKName, -- Callconv cCallName, stdCallName, -- Safety unsafeName, safeName, threadsafeName, + -- InlineSpec + inlineSpecNoPhaseName, inlineSpecPhaseName, -- FunDep funDepName, -- FamFlavour @@ -1566,8 +1714,9 @@ templateHaskellNames = [ clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName, stmtQTyConName, decQTyConName, conQTyConName, strictTypeQTyConName, varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName, - typeTyConName, matchTyConName, clauseTyConName, patQTyConName, - fieldPatQTyConName, fieldExpQTyConName, funDepTyConName, predQTyConName, + typeTyConName, tyVarBndrTyConName, matchTyConName, clauseTyConName, + patQTyConName, fieldPatQTyConName, fieldExpQTyConName, funDepTyConName, + predQTyConName, -- Quasiquoting quoteExpName, quotePatName] @@ -1590,7 +1739,8 @@ qqFun = mk_known_key_name OccName.varName qqLib -------------------- TH.Syntax ----------------------- qTyConName, nameTyConName, fieldExpTyConName, patTyConName, fieldPatTyConName, expTyConName, decTyConName, typeTyConName, - matchTyConName, clauseTyConName, funDepTyConName, predTyConName :: Name + tyVarBndrTyConName, matchTyConName, clauseTyConName, funDepTyConName, + predTyConName :: Name qTyConName = thTc (fsLit "Q") qTyConKey nameTyConName = thTc (fsLit "Name") nameTyConKey fieldExpTyConName = thTc (fsLit "FieldExp") fieldExpTyConKey @@ -1599,6 +1749,7 @@ fieldPatTyConName = thTc (fsLit "FieldPat") fieldPatTyConKey expTyConName = thTc (fsLit "Exp") expTyConKey decTyConName = thTc (fsLit "Dec") decTyConKey typeTyConName = thTc (fsLit "Type") typeTyConKey +tyVarBndrTyConName= thTc (fsLit "TyVarBndr") tyVarBndrTyConKey matchTyConName = thTc (fsLit "Match") matchTyConKey clauseTyConName = thTc (fsLit "Clause") clauseTyConKey funDepTyConName = thTc (fsLit "FunDep") funDepTyConKey @@ -1633,7 +1784,7 @@ doublePrimLName = libFun (fsLit "doublePrimL") doublePrimLIdKey rationalLName = libFun (fsLit "rationalL") rationalLIdKey -- data Pat = ... -litPName, varPName, tupPName, conPName, infixPName, tildePName, +litPName, varPName, tupPName, conPName, infixPName, tildePName, bangPName, asPName, wildPName, recPName, listPName, sigPName :: Name litPName = libFun (fsLit "litP") litPIdKey varPName = libFun (fsLit "varP") varPIdKey @@ -1641,6 +1792,7 @@ tupPName = libFun (fsLit "tupP") tupPIdKey conPName = libFun (fsLit "conP") conPIdKey infixPName = libFun (fsLit "infixP") infixPIdKey tildePName = libFun (fsLit "tildeP") tildePIdKey +bangPName = libFun (fsLit "bangP") bangPIdKey asPName = libFun (fsLit "asP") asPIdKey wildPName = libFun (fsLit "wildP") wildPIdKey recPName = libFun (fsLit "recP") recPIdKey @@ -1714,7 +1866,8 @@ parSName = libFun (fsLit "parS") parSIdKey -- data Dec = ... funDName, valDName, dataDName, newtypeDName, tySynDName, classDName, - instanceDName, sigDName, forImpDName, familyDName, dataInstDName, + instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName, + pragSpecInlDName, familyNoKindDName, familyKindDName, dataInstDName, newtypeInstDName, tySynInstDName :: Name funDName = libFun (fsLit "funD") funDIdKey valDName = libFun (fsLit "valD") valDIdKey @@ -1725,7 +1878,11 @@ classDName = libFun (fsLit "classD") classDIdKey instanceDName = libFun (fsLit "instanceD") instanceDIdKey sigDName = libFun (fsLit "sigD") sigDIdKey forImpDName = libFun (fsLit "forImpD") forImpDIdKey -familyDName = libFun (fsLit "familyD") familyDIdKey +pragInlDName = libFun (fsLit "pragInlD") pragInlDIdKey +pragSpecDName = libFun (fsLit "pragSpecD") pragSpecDIdKey +pragSpecInlDName = libFun (fsLit "pragSpecInlD") pragSpecInlDIdKey +familyNoKindDName= libFun (fsLit "familyNoKindD")familyNoKindDIdKey +familyKindDName = libFun (fsLit "familyKindD") familyKindDIdKey dataInstDName = libFun (fsLit "dataInstD") dataInstDIdKey newtypeInstDName = libFun (fsLit "newtypeInstD") newtypeInstDIdKey tySynInstDName = libFun (fsLit "tySynInstD") tySynInstDIdKey @@ -1761,14 +1918,25 @@ varStrictTypeName = libFun (fsLit "varStrictType") varStrictTKey -- data Type = ... forallTName, varTName, conTName, tupleTName, arrowTName, - listTName, appTName :: Name + listTName, appTName, sigTName :: Name forallTName = libFun (fsLit "forallT") forallTIdKey varTName = libFun (fsLit "varT") varTIdKey conTName = libFun (fsLit "conT") conTIdKey -tupleTName = libFun (fsLit "tupleT") tupleTIdKey -arrowTName = libFun (fsLit "arrowT") arrowTIdKey -listTName = libFun (fsLit "listT") listTIdKey +tupleTName = libFun (fsLit "tupleT") tupleTIdKey +arrowTName = libFun (fsLit "arrowT") arrowTIdKey +listTName = libFun (fsLit "listT") listTIdKey appTName = libFun (fsLit "appT") appTIdKey +sigTName = libFun (fsLit "sigT") sigTIdKey + +-- data TyVarBndr = ... +plainTVName, kindedTVName :: Name +plainTVName = libFun (fsLit "plainTV") plainTVIdKey +kindedTVName = libFun (fsLit "kindedTV") kindedTVIdKey + +-- data Kind = ... +starKName, arrowKName :: Name +starKName = libFun (fsLit "starK") starKIdKey +arrowKName = libFun (fsLit "arrowK") arrowKIdKey -- data Callconv = ... cCallName, stdCallName :: Name @@ -1781,6 +1949,11 @@ unsafeName = libFun (fsLit "unsafe") unsafeIdKey safeName = libFun (fsLit "safe") safeIdKey threadsafeName = libFun (fsLit "threadsafe") threadsafeIdKey +-- data InlineSpec = ... +inlineSpecNoPhaseName, inlineSpecPhaseName :: Name +inlineSpecNoPhaseName = libFun (fsLit "inlineSpecNoPhase") inlineSpecNoPhaseIdKey +inlineSpecPhaseName = libFun (fsLit "inlineSpecPhase") inlineSpecPhaseIdKey + -- data FunDep = ... funDepName :: Name funDepName = libFun (fsLit "funDep") funDepIdKey @@ -1818,7 +1991,7 @@ quotePatName = qqFun (fsLit "quotePat") quotePatKey expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey, decQTyConKey, patTyConKey, matchQTyConKey, clauseQTyConKey, - stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey, + stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey, tyVarBndrTyConKey, decTyConKey, varStrictTypeQTyConKey, strictTypeQTyConKey, fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey, fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey, @@ -1836,6 +2009,7 @@ stmtQTyConKey = mkPreludeTyConUnique 109 conQTyConKey = mkPreludeTyConUnique 110 typeQTyConKey = mkPreludeTyConUnique 111 typeTyConKey = mkPreludeTyConUnique 112 +tyVarBndrTyConKey = mkPreludeTyConUnique 125 decTyConKey = mkPreludeTyConUnique 113 varStrictTypeQTyConKey = mkPreludeTyConUnique 114 strictTypeQTyConKey = mkPreludeTyConUnique 115 @@ -1880,7 +2054,7 @@ doublePrimLIdKey = mkPreludeMiscIdUnique 216 rationalLIdKey = mkPreludeMiscIdUnique 217 -- data Pat = ... -litPIdKey, varPIdKey, tupPIdKey, conPIdKey, infixPIdKey, tildePIdKey, +litPIdKey, varPIdKey, tupPIdKey, conPIdKey, infixPIdKey, tildePIdKey, bangPIdKey, asPIdKey, wildPIdKey, recPIdKey, listPIdKey, sigPIdKey :: Unique litPIdKey = mkPreludeMiscIdUnique 220 varPIdKey = mkPreludeMiscIdUnique 221 @@ -1888,6 +2062,7 @@ tupPIdKey = mkPreludeMiscIdUnique 222 conPIdKey = mkPreludeMiscIdUnique 223 infixPIdKey = mkPreludeMiscIdUnique 312 tildePIdKey = mkPreludeMiscIdUnique 224 +bangPIdKey = mkPreludeMiscIdUnique 359 asPIdKey = mkPreludeMiscIdUnique 225 wildPIdKey = mkPreludeMiscIdUnique 226 recPIdKey = mkPreludeMiscIdUnique 227 @@ -1959,8 +2134,9 @@ parSIdKey = mkPreludeMiscIdUnique 271 -- data Dec = ... funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey, - classDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, familyDIdKey, - dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey :: Unique + classDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, pragInlDIdKey, + pragSpecDIdKey, pragSpecInlDIdKey, familyNoKindDIdKey, familyKindDIdKey, + dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey :: Unique funDIdKey = mkPreludeMiscIdUnique 272 valDIdKey = mkPreludeMiscIdUnique 273 dataDIdKey = mkPreludeMiscIdUnique 274 @@ -1970,7 +2146,11 @@ classDIdKey = mkPreludeMiscIdUnique 277 instanceDIdKey = mkPreludeMiscIdUnique 278 sigDIdKey = mkPreludeMiscIdUnique 279 forImpDIdKey = mkPreludeMiscIdUnique 297 -familyDIdKey = mkPreludeMiscIdUnique 340 +pragInlDIdKey = mkPreludeMiscIdUnique 348 +pragSpecDIdKey = mkPreludeMiscIdUnique 349 +pragSpecInlDIdKey = mkPreludeMiscIdUnique 352 +familyNoKindDIdKey= mkPreludeMiscIdUnique 340 +familyKindDIdKey = mkPreludeMiscIdUnique 353 dataInstDIdKey = mkPreludeMiscIdUnique 341 newtypeInstDIdKey = mkPreludeMiscIdUnique 342 tySynInstDIdKey = mkPreludeMiscIdUnique 343 @@ -2006,7 +2186,7 @@ varStrictTKey = mkPreludeMiscIdUnique 287 -- data Type = ... forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, arrowTIdKey, - listTIdKey, appTIdKey :: Unique + listTIdKey, appTIdKey, sigTIdKey :: Unique forallTIdKey = mkPreludeMiscIdUnique 290 varTIdKey = mkPreludeMiscIdUnique 291 conTIdKey = mkPreludeMiscIdUnique 292 @@ -2014,6 +2194,17 @@ tupleTIdKey = mkPreludeMiscIdUnique 294 arrowTIdKey = mkPreludeMiscIdUnique 295 listTIdKey = mkPreludeMiscIdUnique 296 appTIdKey = mkPreludeMiscIdUnique 293 +sigTIdKey = mkPreludeMiscIdUnique 358 + +-- data TyVarBndr = ... +plainTVIdKey, kindedTVIdKey :: Unique +plainTVIdKey = mkPreludeMiscIdUnique 354 +kindedTVIdKey = mkPreludeMiscIdUnique 355 + +-- data Kind = ... +starKIdKey, arrowKIdKey :: Unique +starKIdKey = mkPreludeMiscIdUnique 356 +arrowKIdKey = mkPreludeMiscIdUnique 357 -- data Callconv = ... cCallIdKey, stdCallIdKey :: Unique @@ -2026,6 +2217,11 @@ unsafeIdKey = mkPreludeMiscIdUnique 305 safeIdKey = mkPreludeMiscIdUnique 306 threadsafeIdKey = mkPreludeMiscIdUnique 307 +-- data InlineSpec = +inlineSpecNoPhaseIdKey, inlineSpecPhaseIdKey :: Unique +inlineSpecNoPhaseIdKey = mkPreludeMiscIdUnique 350 +inlineSpecPhaseIdKey = mkPreludeMiscIdUnique 351 + -- data FunDep = ... funDepIdKey :: Unique funDepIdKey = mkPreludeMiscIdUnique 320 @@ -2039,4 +2235,3 @@ dataFamIdKey = mkPreludeMiscIdUnique 345 quoteExpKey, quotePatKey :: Unique quoteExpKey = mkPreludeMiscIdUnique 321 quotePatKey = mkPreludeMiscIdUnique 322 -