Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC

Commits:

5 changed files:

Changes:

  • compiler/GHC/Builtin/TH.hs
    ... ... @@ -8,10 +8,8 @@ module GHC.Builtin.TH where
    8 8
    9 9 
     import GHC.Prelude ()
    10 10
    11 
    -import GHC.Types.Name( Name, KnownOcc )
    11 
    +import GHC.Types.Name( KnownOcc )
    12 12 
     import GHC.Types.Name.Occurrence
    13 
    -import GHC.Types.Unique ( Unique )
    14 
    -import GHC.Builtin.Uniques
    15 13 
     import GHC.Data.FastString
    16 14
    17 15 
     -------------------- TH.Syntax -----------------------
    ... ... @@ -230,8 +228,7 @@ implicitParamBindDOcc = mkVarOcc "implicitParamBindD"
    230 228
    231 229 
     -- type Ctxt = ...
    232 230 
     cxtName :: KnownOcc
    233 
    -cxtName = mkVarOcc "cxt" -- TODO: WHERE IS THIS; AND DO I NEED TO EXPORT IT FROM GHC.Essentials??
    234 
    -                         -- Look at the knownOccs below up until BangTypeName too.
    231 
    +cxtName = mkVarOcc "cxt"
    235 232
    236 233 
     -- data SourceUnpackedness = ...
    237 234 
     noSourceUnpackednessOcc, sourceNoUnpackOcc, sourceUnpackOcc :: KnownOcc
    ... ... @@ -260,23 +257,23 @@ bangName = mkVarOcc "bang"
    260 257
    261 258 
     -- type BangType = ...
    262 259 
     bangTypeName :: KnownOcc
    263 
    -bangTypeName = libFun (fsLit "bangType") bangTKey
    260 
    +bangTypeName = mkVarOcc "bangType"
    264 261
    265 262 
     -- type VarBangType = ...
    266 263 
     varBangTypeName :: KnownOcc
    267 
    -varBangTypeName = libFun (fsLit "varBangType") varBangTKey
    264 
    +varBangTypeName = mkVarOcc "varBangType"
    268 265
    269 266 
     -- data PatSynDir = ...
    270 267 
     unidirPatSynName, implBidirPatSynName, explBidirPatSynName :: KnownOcc
    271 
    -unidirPatSynName    = libFun (fsLit "unidir")    unidirPatSynIdKey
    272 
    -implBidirPatSynName = libFun (fsLit "implBidir") implBidirPatSynIdKey
    273 
    -explBidirPatSynName = libFun (fsLit "explBidir") explBidirPatSynIdKey
    268 
    +unidirPatSynName    = mkVarOcc "unidir"
    269 
    +implBidirPatSynName = mkVarOcc "implBidir"
    270 
    +explBidirPatSynName = mkVarOcc "explBidir"
    274 271
    275 272 
     -- data PatSynArgs = ...
    276 273 
     prefixPatSynName, infixPatSynName, recordPatSynName :: KnownOcc
    277 
    -prefixPatSynName = libFun (fsLit "prefixPatSyn") prefixPatSynIdKey
    278 
    -infixPatSynName  = libFun (fsLit "infixPatSyn")  infixPatSynIdKey
    279 
    -recordPatSynName = libFun (fsLit "recordPatSyn") recordPatSynIdKey
    274 
    +prefixPatSynName = mkVarOcc "prefixPatSyn"
    275 
    +infixPatSynName  = mkVarOcc "infixPatSyn"
    276 
    +recordPatSynName = mkVarOcc "recordPatSyn"
    280 277
    281 278 
     -- data Type = ...
    282 279 
     forallTName, forallVisTName, varTName, conTName, infixTName, tupleTName,
    ... ... @@ -284,124 +281,124 @@ forallTName, forallVisTName, varTName, conTName, infixTName, tupleTName,
    284 281 
         appTName, appKindTName, sigTName, equalityTName, litTName, promotedTName,
    285 282 
         promotedTupleTName, promotedNilTName, promotedConsTName,
    286 283 
         wildCardTName, implicitParamTName :: KnownOcc
    287 
    -forallTName         = libFun (fsLit "forallT")        forallTIdKey
    288 
    -forallVisTName      = libFun (fsLit "forallVisT")     forallVisTIdKey
    289 
    -varTName            = libFun (fsLit "varT")           varTIdKey
    290 
    -conTName            = libFun (fsLit "conT")           conTIdKey
    291 
    -tupleTName          = libFun (fsLit "tupleT")         tupleTIdKey
    292 
    -unboxedTupleTName   = libFun (fsLit "unboxedTupleT")  unboxedTupleTIdKey
    293 
    -unboxedSumTName     = libFun (fsLit "unboxedSumT")    unboxedSumTIdKey
    294 
    -arrowTName          = libFun (fsLit "arrowT")         arrowTIdKey
    295 
    -mulArrowTName       = libFun (fsLit "mulArrowT")      mulArrowTIdKey
    296 
    -listTName           = libFun (fsLit "listT")          listTIdKey
    297 
    -appTName            = libFun (fsLit "appT")           appTIdKey
    298 
    -appKindTName        = libFun (fsLit "appKindT")       appKindTIdKey
    299 
    -sigTName            = libFun (fsLit "sigT")           sigTIdKey
    300 
    -equalityTName       = libFun (fsLit "equalityT")      equalityTIdKey
    301 
    -litTName            = libFun (fsLit "litT")           litTIdKey
    302 
    -promotedTName       = libFun (fsLit "promotedT")      promotedTIdKey
    303 
    -promotedTupleTName  = libFun (fsLit "promotedTupleT") promotedTupleTIdKey
    304 
    -promotedNilTName    = libFun (fsLit "promotedNilT")   promotedNilTIdKey
    305 
    -promotedConsTName   = libFun (fsLit "promotedConsT")  promotedConsTIdKey
    306 
    -wildCardTName       = libFun (fsLit "wildCardT")      wildCardTIdKey
    307 
    -infixTName          = libFun (fsLit "infixT")         infixTIdKey
    308 
    -implicitParamTName  = libFun (fsLit "implicitParamT") implicitParamTIdKey
    284 
    +forallTName         = mkVarOcc "forallT"
    285 
    +forallVisTName      = mkVarOcc "forallVisT"
    286 
    +varTName            = mkVarOcc "varT"
    287 
    +conTName            = mkVarOcc "conT"
    288 
    +tupleTName          = mkVarOcc "tupleT"
    289 
    +unboxedTupleTName   = mkVarOcc "unboxedTupleT"
    290 
    +unboxedSumTName     = mkVarOcc "unboxedSumT"
    291 
    +arrowTName          = mkVarOcc "arrowT"
    292 
    +mulArrowTName       = mkVarOcc "mulArrowT"
    293 
    +listTName           = mkVarOcc "listT"
    294 
    +appTName            = mkVarOcc "appT"
    295 
    +appKindTName        = mkVarOcc "appKindT"
    296 
    +sigTName            = mkVarOcc "sigT"
    297 
    +equalityTName       = mkVarOcc "equalityT"
    298 
    +litTName            = mkVarOcc "litT"
    299 
    +promotedTName       = mkVarOcc "promotedT"
    300 
    +promotedTupleTName  = mkVarOcc "promotedTupleT"
    301 
    +promotedNilTName    = mkVarOcc "promotedNilT"
    302 
    +promotedConsTName   = mkVarOcc "promotedConsT"
    303 
    +wildCardTName       = mkVarOcc "wildCardT"
    304 
    +infixTName          = mkVarOcc "infixT"
    305 
    +implicitParamTName  = mkVarOcc "implicitParamT"
    309 306
    310 307 
     -- data TyLit = ...
    311 308 
     numTyLitName, strTyLitName, charTyLitName :: KnownOcc
    312 
    -numTyLitName = libFun (fsLit "numTyLit") numTyLitIdKey
    313 
    -strTyLitName = libFun (fsLit "strTyLit") strTyLitIdKey
    314 
    -charTyLitName = libFun (fsLit "charTyLit") charTyLitIdKey
    309 
    +numTyLitName  = mkVarOcc "numTyLit"
    310 
    +strTyLitName  = mkVarOcc "strTyLit"
    311 
    +charTyLitName = mkVarOcc "charTyLit"
    315 312
    316 313 
     -- data TyVarBndr = ...
    317 314 
     plainTVName, kindedTVName :: KnownOcc
    318 
    -plainTVName  = libFun (fsLit "plainTV")  plainTVIdKey
    319 
    -kindedTVName = libFun (fsLit "kindedTV") kindedTVIdKey
    315 
    +plainTVName  = mkVarOcc "plainTV"
    316 
    +kindedTVName = mkVarOcc "kindedTV"
    320 317
    321 318 
     plainInvisTVName, kindedInvisTVName :: KnownOcc
    322 
    -plainInvisTVName  = libFun (fsLit "plainInvisTV")  plainInvisTVIdKey
    323 
    -kindedInvisTVName = libFun (fsLit "kindedInvisTV") kindedInvisTVIdKey
    319 
    +plainInvisTVName  = mkVarOcc "plainInvisTV"
    320 
    +kindedInvisTVName = mkVarOcc "kindedInvisTV"
    324 321
    325 322 
     plainBndrTVName, kindedBndrTVName :: KnownOcc
    326 
    -plainBndrTVName  = libFun (fsLit "plainBndrTV")  plainBndrTVIdKey
    327 
    -kindedBndrTVName = libFun (fsLit "kindedBndrTV") kindedBndrTVIdKey
    323 
    +plainBndrTVName  = mkVarOcc "plainBndrTV"
    324 
    +kindedBndrTVName = mkVarOcc "kindedBndrTV"
    328 325
    329 326 
     -- data Specificity = ...
    330 327 
     specifiedSpecName, inferredSpecName :: KnownOcc
    331 
    -specifiedSpecName = libFun (fsLit "specifiedSpec") specifiedSpecKey
    332 
    -inferredSpecName  = libFun (fsLit "inferredSpec")  inferredSpecKey
    328 
    +specifiedSpecName = mkVarOcc "specifiedSpec"
    329 
    +inferredSpecName  = mkVarOcc "inferredSpec"
    333 330
    334 331 
     -- data BndrVis = ...
    335 332 
     bndrReqName, bndrInvisName :: KnownOcc
    336 
    -bndrReqName   = libFun (fsLit "bndrReq")   bndrReqKey
    337 
    -bndrInvisName = libFun (fsLit "bndrInvis") bndrInvisKey
    333 
    +bndrReqName   = mkVarOcc "bndrReq"
    334 
    +bndrInvisName = mkVarOcc "bndrInvis"
    338 335
    339 336 
     -- data Role = ...
    340 337 
     nominalRName, representationalRName, phantomRName, inferRName :: KnownOcc
    341 
    -nominalRName          = libFun (fsLit "nominalR")          nominalRIdKey
    342 
    -representationalRName = libFun (fsLit "representationalR") representationalRIdKey
    343 
    -phantomRName          = libFun (fsLit "phantomR")          phantomRIdKey
    344 
    -inferRName            = libFun (fsLit "inferR")            inferRIdKey
    338 
    +nominalRName          = mkVarOcc "nominalR"
    339 
    +representationalRName = mkVarOcc "representationalR"
    340 
    +phantomRName          = mkVarOcc "phantomR"
    341 
    +inferRName            = mkVarOcc "inferR"
    345 342
    346 343 
     -- data Kind = ...
    347 344 
     starKName, constraintKName :: KnownOcc
    348 
    -starKName       = libFun (fsLit "starK")        starKIdKey
    349 
    -constraintKName = libFun (fsLit "constraintK")  constraintKIdKey
    345 
    +starKName       = mkVarOcc "starK"
    346 
    +constraintKName = mkVarOcc "constraintK"
    350 347
    351 348 
     -- data FamilyResultSig = ...
    352 349 
     noSigName, kindSigName, tyVarSigName :: KnownOcc
    353 
    -noSigName    = libFun (fsLit "noSig")    noSigIdKey
    354 
    -kindSigName  = libFun (fsLit "kindSig")  kindSigIdKey
    355 
    -tyVarSigName = libFun (fsLit "tyVarSig") tyVarSigIdKey
    350 
    +noSigName    = mkVarOcc "noSig"
    351 
    +kindSigName  = mkVarOcc "kindSig"
    352 
    +tyVarSigName = mkVarOcc "tyVarSig"
    356 353
    357 354 
     -- data InjectivityAnn = ...
    358 355 
     injectivityAnnName :: KnownOcc
    359 
    -injectivityAnnName = libFun (fsLit "injectivityAnn") injectivityAnnIdKey
    356 
    +injectivityAnnName = mkVarOcc "injectivityAnn"
    360 357
    361 358 
     -- data Callconv = ...
    362 359 
     cCallName, stdCallName, cApiCallName, primCallName, javaScriptCallName :: KnownOcc
    363 
    -cCallName = libFun (fsLit "cCall") cCallIdKey
    364 
    -stdCallName = libFun (fsLit "stdCall") stdCallIdKey
    365 
    -cApiCallName = libFun (fsLit "cApi") cApiCallIdKey
    366 
    -primCallName = libFun (fsLit "prim") primCallIdKey
    367 
    -javaScriptCallName = libFun (fsLit "javaScript") javaScriptCallIdKey
    360 
    +cCallName          = mkVarOcc "cCall"
    361 
    +stdCallName        = mkVarOcc "stdCall"
    362 
    +cApiCallName       = mkVarOcc "cApi"
    363 
    +primCallName       = mkVarOcc "prim"
    364 
    +javaScriptCallName = mkVarOcc "javaScript"
    368 365
    369 366 
     -- data Safety = ...
    370 367 
     unsafeName, safeName, interruptibleName :: KnownOcc
    371 
    -unsafeName     = libFun (fsLit "unsafe") unsafeIdKey
    372 
    -safeName       = libFun (fsLit "safe") safeIdKey
    373 
    -interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey
    368 
    +unsafeName        = mkVarOcc "unsafe"
    369 
    +safeName          = mkVarOcc "safe"
    370 
    +interruptibleName = mkVarOcc "interruptible"
    374 371
    375 372 
     -- data RuleBndr = ...
    376 373 
     ruleVarName, typedRuleVarName :: KnownOcc
    377 
    -ruleVarName      = libFun (fsLit ("ruleVar"))      ruleVarIdKey
    378 
    -typedRuleVarName = libFun (fsLit ("typedRuleVar")) typedRuleVarIdKey
    374 
    +ruleVarName      = mkVarOcc "ruleVar"
    375 
    +typedRuleVarName = mkVarOcc "typedRuleVar"
    379 376
    380 377 
     -- data FunDep = ...
    381 378 
     funDepName :: KnownOcc
    382 
    -funDepName     = libFun (fsLit "funDep") funDepIdKey
    379 
    +funDepName = mkVarOcc "funDep"
    383 380
    384 381 
     -- data TySynEqn = ...
    385 382 
     tySynEqnName :: KnownOcc
    386 
    -tySynEqnName = libFun (fsLit "tySynEqn") tySynEqnIdKey
    383 
    +tySynEqnName = mkVarOcc "tySynEqn"
    387 384
    388 385 
     -- data AnnTarget = ...
    389 386 
     valueAnnotationName, typeAnnotationName, moduleAnnotationName :: KnownOcc
    390 
    -valueAnnotationName  = libFun (fsLit "valueAnnotation")  valueAnnotationIdKey
    391 
    -typeAnnotationName   = libFun (fsLit "typeAnnotation")   typeAnnotationIdKey
    392 
    -moduleAnnotationName = libFun (fsLit "moduleAnnotation") moduleAnnotationIdKey
    387 
    +valueAnnotationName  = mkVarOcc "valueAnnotation"
    388 
    +typeAnnotationName   = mkVarOcc "typeAnnotation"
    389 
    +moduleAnnotationName = mkVarOcc "moduleAnnotation"
    393 390
    394 391 
     -- type DerivClause = ...
    395 392 
     derivClauseName :: KnownOcc
    396 
    -derivClauseName = libFun (fsLit "derivClause") derivClauseIdKey
    393 
    +derivClauseName = mkVarOcc "derivClause"
    397 394
    398 395 
     -- data DerivStrategy = ...
    399 396 
     stockStrategyName, anyclassStrategyName, newtypeStrategyName,
    400 397 
       viaStrategyName :: KnownOcc
    401 
    -stockStrategyName    = libFun (fsLit "stockStrategy")    stockStrategyIdKey
    402 
    -anyclassStrategyName = libFun (fsLit "anyclassStrategy") anyclassStrategyIdKey
    403 
    -newtypeStrategyName  = libFun (fsLit "newtypeStrategy")  newtypeStrategyIdKey
    404 
    -viaStrategyName      = libFun (fsLit "viaStrategy")      viaStrategyIdKey
    398 
    +stockStrategyName    = mkVarOcc "stockStrategy"
    399 
    +anyclassStrategyName = mkVarOcc "anyclassStrategy"
    400 
    +newtypeStrategyName  = mkVarOcc "newtypeStrategy"
    401 
    +viaStrategyName      = mkVarOcc "viaStrategy"
    405 402
    406 403 
     patQTyConOcc, expQTyConOcc, stmtTyConOcc,
    407 404 
         conTyConOcc, bangTypeTyConOcc,
    ... ... @@ -433,276 +430,42 @@ derivStrategyTyConOcc = mkTcOcc "DerivStrategy"
    433 430
    434 431 
     -- quasiquoting
    435 432 
     quoteExpName, quotePatName, quoteDecName, quoteTypeName :: KnownOcc
    436 
    -quoteExpName  = qqFld (fsLit "quoteExp")  quoteExpKey
    437 
    -quotePatName  = qqFld (fsLit "quotePat")  quotePatKey
    438 
    -quoteDecName  = qqFld (fsLit "quoteDec")  quoteDecKey
    439 
    -quoteTypeName = qqFld (fsLit "quoteType") quoteTypeKey
    433 
    +quoteExpName  = mkRecFieldOcc (fsLit "QuasiQuoter") "quoteExp"
    434 
    +quotePatName  = mkRecFieldOcc (fsLit "QuasiQuoter") "quotePat"
    435 
    +quoteDecName  = mkRecFieldOcc (fsLit "QuasiQuoter") "quoteDec"
    436 
    +quoteTypeName = mkRecFieldOcc (fsLit "QuasiQuoter") "quoteType"
    440 437
    441 438 
     -- data Inline = ...
    442 439 
     noInlineDataConName, inlineDataConName, inlinableDataConName :: KnownOcc
    443 
    -noInlineDataConName  = thCon (fsLit "NoInline")  noInlineDataConKey
    444 
    -inlineDataConName    = thCon (fsLit "Inline")    inlineDataConKey
    445 
    -inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey
    440 
    +noInlineDataConName  = mkDataOcc "NoInline"
    441 
    +inlineDataConName    = mkDataOcc "Inline"
    442 
    +inlinableDataConName = mkDataOcc "Inlinable"
    446 443
    447 444 
     -- data RuleMatch = ...
    448 445 
     conLikeDataConName, funLikeDataConName :: KnownOcc
    449 
    -conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey
    450 
    -funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey
    446 
    +conLikeDataConName = mkDataOcc "ConLike"
    447 
    +funLikeDataConName = mkDataOcc "FunLike"
    451 448
    452 449 
     -- data Phases = ...
    453 450 
     allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: KnownOcc
    454 
    -allPhasesDataConName   = thCon (fsLit "AllPhases")   allPhasesDataConKey
    455 
    -fromPhaseDataConName   = thCon (fsLit "FromPhase")   fromPhaseDataConKey
    456 
    -beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey
    451 
    +allPhasesDataConName   = mkDataOcc "AllPhases"
    452 
    +fromPhaseDataConName   = mkDataOcc "FromPhase"
    453 
    +beforePhaseDataConName = mkDataOcc "BeforePhase"
    457 454
    458 455 
     -- data Overlap = ...
    459 456 
     overlappableDataConName,
    460 457 
       overlappingDataConName,
    461 458 
       overlapsDataConName,
    462 459 
       incoherentDataConName :: KnownOcc
    463 
    -overlappableDataConName = thCon (fsLit "Overlappable") overlappableDataConKey
    464 
    -overlappingDataConName  = thCon (fsLit "Overlapping")  overlappingDataConKey
    465 
    -overlapsDataConName     = thCon (fsLit "Overlaps")     overlapsDataConKey
    466 
    -incoherentDataConName   = thCon (fsLit "Incoherent")   incoherentDataConKey
    460 
    +overlappableDataConName = mkDataOcc "Overlappable"
    461 
    +overlappingDataConName  = mkDataOcc "Overlapping"
    462 
    +overlapsDataConName     = mkDataOcc "Overlaps"
    463 
    +incoherentDataConName   = mkDataOcc "Incoherent"
    467 464
    468 465 
     -- data NamespaceSpecifier = ...
    469 466 
     noNamespaceSpecifierDataConName,
    470 467 
       typeNamespaceSpecifierDataConName,
    471 468 
       dataNamespaceSpecifierDataConName :: KnownOcc
    472 
    -noNamespaceSpecifierDataConName =
    473 
    -  thCon (fsLit "NoNamespaceSpecifier") noNamespaceSpecifierDataConKey
    474 
    -typeNamespaceSpecifierDataConName =
    475 
    -  thCon (fsLit "TypeNamespaceSpecifier") typeNamespaceSpecifierDataConKey
    476 
    -dataNamespaceSpecifierDataConName =
    477 
    -  thCon (fsLit "DataNamespaceSpecifier") dataNamespaceSpecifierDataConKey
    478 
    -
    479 
    -{- *********************************************************************
    480 
    -*                                                                      *
    481 
    -                     Class keys
    482 
    -*                                                                      *
    483 
    -********************************************************************* -}
    484 
    -
    485 
    --- ClassUniques available: 200-299
    486 
    --- Check in GHC.Builtin.KnownKeys if you want to change this
    487 
    -
    488 
    -liftClassKey :: Unique
    489 
    -liftClassKey = mkPreludeClassUnique 200
    490 
    -
    491 
    -{- *********************************************************************
    492 
    -*                                                                      *
    493 
    -                     TyCon keys
    494 
    -*                                                                      *
    495 
    -********************************************************************* -}
    496 
    -
    497 
    --- TyConUniques available: 200-299
    498 
    --- Check in GHC.Builtin.KnownKeys if you want to change this
    499 
    -
    500 
    -
    501 
    -{- *********************************************************************
    502 
    -*                                                                      *
    503 
    -                     DataCon keys
    504 
    -*                                                                      *
    505 
    -********************************************************************* -}
    506 
    -
    507 
    --- DataConUniques available: 100-150
    508 
    --- If you want to change this, make sure you check in GHC.Builtin.KnownKeys
    509 
    -
    510 
    --- data Inline = ...
    511 
    -noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
    512 
    -noInlineDataConKey  = mkPreludeDataConUnique 200
    513 
    -inlineDataConKey    = mkPreludeDataConUnique 201
    514 
    -inlinableDataConKey = mkPreludeDataConUnique 202
    515 
    -
    516 
    --- data RuleMatch = ...
    517 
    -conLikeDataConKey, funLikeDataConKey :: Unique
    518 
    -conLikeDataConKey = mkPreludeDataConUnique 204
    519 
    -funLikeDataConKey = mkPreludeDataConUnique 205
    520 
    -
    521 
    --- data Phases = ...
    522 
    -allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique
    523 
    -allPhasesDataConKey   = mkPreludeDataConUnique 206
    524 
    -fromPhaseDataConKey   = mkPreludeDataConUnique 207
    525 
    -beforePhaseDataConKey = mkPreludeDataConUnique 208
    526 
    -
    527 
    --- data Overlap = ..
    528 
    -overlappableDataConKey,
    529 
    -  overlappingDataConKey,
    530 
    -  overlapsDataConKey,
    531 
    -  incoherentDataConKey :: Unique
    532 
    -overlappableDataConKey = mkPreludeDataConUnique 209
    533 
    -overlappingDataConKey  = mkPreludeDataConUnique 210
    534 
    -overlapsDataConKey     = mkPreludeDataConUnique 211
    535 
    -incoherentDataConKey   = mkPreludeDataConUnique 212
    536 
    -
    537 
    --- data NamespaceSpecifier = ...
    538 
    -noNamespaceSpecifierDataConKey,
    539 
    -  typeNamespaceSpecifierDataConKey,
    540 
    -  dataNamespaceSpecifierDataConKey :: Unique
    541 
    -noNamespaceSpecifierDataConKey = mkPreludeDataConUnique 213
    542 
    -typeNamespaceSpecifierDataConKey = mkPreludeDataConUnique 214
    543 
    -dataNamespaceSpecifierDataConKey = mkPreludeDataConUnique 215
    544 
    -{- *********************************************************************
    545 
    -*                                                                      *
    546 
    -                     Id keys
    547 
    -*                                                                      *
    548 
    -********************************************************************* -}
    549 
    -
    550 
    --- IdUniques available: 200-499
    551 
    --- If you want to change this, make sure you check in GHC.Builtin.KnownKeys
    552 
    -
    553 
    --- type BangType = ...
    554 
    -bangTKey :: Unique
    555 
    -bangTKey          = mkPreludeMiscIdUnique 375
    556 
    -
    557 
    --- type VarBangType = ...
    558 
    -varBangTKey :: Unique
    559 
    -varBangTKey       = mkPreludeMiscIdUnique 376
    560 
    -
    561 
    --- data PatSynDir = ...
    562 
    -unidirPatSynIdKey, implBidirPatSynIdKey, explBidirPatSynIdKey :: Unique
    563 
    -unidirPatSynIdKey    = mkPreludeMiscIdUnique 377
    564 
    -implBidirPatSynIdKey = mkPreludeMiscIdUnique 378
    565 
    -explBidirPatSynIdKey = mkPreludeMiscIdUnique 379
    566 
    -
    567 
    --- data PatSynArgs = ...
    568 
    -prefixPatSynIdKey, infixPatSynIdKey, recordPatSynIdKey :: Unique
    569 
    -prefixPatSynIdKey = mkPreludeMiscIdUnique 380
    570 
    -infixPatSynIdKey  = mkPreludeMiscIdUnique 381
    571 
    -recordPatSynIdKey = mkPreludeMiscIdUnique 382
    572 
    -
    573 
    --- data Type = ...
    574 
    -forallTIdKey, forallVisTIdKey, varTIdKey, conTIdKey, tupleTIdKey,
    575 
    -    unboxedTupleTIdKey, unboxedSumTIdKey, arrowTIdKey, listTIdKey, appTIdKey,
    576 
    -    appKindTIdKey, sigTIdKey, equalityTIdKey, litTIdKey, promotedTIdKey,
    577 
    -    promotedTupleTIdKey, promotedNilTIdKey, promotedConsTIdKey,
    578 
    -    wildCardTIdKey, implicitParamTIdKey, infixTIdKey :: Unique
    579 
    -forallTIdKey        = mkPreludeMiscIdUnique 390
    580 
    -forallVisTIdKey     = mkPreludeMiscIdUnique 391
    581 
    -varTIdKey           = mkPreludeMiscIdUnique 392
    582 
    -conTIdKey           = mkPreludeMiscIdUnique 393
    583 
    -tupleTIdKey         = mkPreludeMiscIdUnique 394
    584 
    -unboxedTupleTIdKey  = mkPreludeMiscIdUnique 395
    585 
    -unboxedSumTIdKey    = mkPreludeMiscIdUnique 396
    586 
    -arrowTIdKey         = mkPreludeMiscIdUnique 397
    587 
    -listTIdKey          = mkPreludeMiscIdUnique 398
    588 
    -appTIdKey           = mkPreludeMiscIdUnique 399
    589 
    -appKindTIdKey       = mkPreludeMiscIdUnique 400
    590 
    -sigTIdKey           = mkPreludeMiscIdUnique 401
    591 
    -equalityTIdKey      = mkPreludeMiscIdUnique 402
    592 
    -litTIdKey           = mkPreludeMiscIdUnique 403
    593 
    -promotedTIdKey      = mkPreludeMiscIdUnique 404
    594 
    -promotedTupleTIdKey = mkPreludeMiscIdUnique 405
    595 
    -promotedNilTIdKey   = mkPreludeMiscIdUnique 406
    596 
    -promotedConsTIdKey  = mkPreludeMiscIdUnique 407
    597 
    -wildCardTIdKey      = mkPreludeMiscIdUnique 408
    598 
    -implicitParamTIdKey = mkPreludeMiscIdUnique 409
    599 
    -infixTIdKey         = mkPreludeMiscIdUnique 410
    600 
    -
    601 
    --- data TyLit = ...
    602 
    -numTyLitIdKey, strTyLitIdKey, charTyLitIdKey :: Unique
    603 
    -numTyLitIdKey  = mkPreludeMiscIdUnique 411
    604 
    -strTyLitIdKey  = mkPreludeMiscIdUnique 412
    605 
    -charTyLitIdKey = mkPreludeMiscIdUnique 413
    606 
    -
    607 
    --- data TyVarBndr = ...
    608 
    -plainTVIdKey, kindedTVIdKey :: Unique
    609 
    -plainTVIdKey       = mkPreludeMiscIdUnique 414
    610 
    -kindedTVIdKey      = mkPreludeMiscIdUnique 415
    611 
    -
    612 
    -plainInvisTVIdKey, kindedInvisTVIdKey :: Unique
    613 
    -plainInvisTVIdKey       = mkPreludeMiscIdUnique 482
    614 
    -kindedInvisTVIdKey      = mkPreludeMiscIdUnique 483
    615 
    -
    616 
    -plainBndrTVIdKey, kindedBndrTVIdKey :: Unique
    617 
    -plainBndrTVIdKey       = mkPreludeMiscIdUnique 484
    618 
    -kindedBndrTVIdKey      = mkPreludeMiscIdUnique 485
    619 
    -
    620 
    --- data Role = ...
    621 
    -nominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique
    622 
    -nominalRIdKey          = mkPreludeMiscIdUnique 416
    623 
    -representationalRIdKey = mkPreludeMiscIdUnique 417
    624 
    -phantomRIdKey          = mkPreludeMiscIdUnique 418
    625 
    -inferRIdKey            = mkPreludeMiscIdUnique 419
    626 
    -
    627 
    --- data Kind = ...
    628 
    -starKIdKey, constraintKIdKey :: Unique
    629 
    -starKIdKey        = mkPreludeMiscIdUnique 425
    630 
    -constraintKIdKey  = mkPreludeMiscIdUnique 426
    631 
    -
    632 
    --- data FamilyResultSig = ...
    633 
    -noSigIdKey, kindSigIdKey, tyVarSigIdKey :: Unique
    634 
    -noSigIdKey        = mkPreludeMiscIdUnique 427
    635 
    -kindSigIdKey      = mkPreludeMiscIdUnique 428
    636 
    -tyVarSigIdKey     = mkPreludeMiscIdUnique 429
    637 
    -
    638 
    --- data InjectivityAnn = ...
    639 
    -injectivityAnnIdKey :: Unique
    640 
    -injectivityAnnIdKey = mkPreludeMiscIdUnique 430
    641 
    -
    642 
    --- data Callconv = ...
    643 
    -cCallIdKey, stdCallIdKey, cApiCallIdKey, primCallIdKey,
    644 
    -  javaScriptCallIdKey :: Unique
    645 
    -cCallIdKey          = mkPreludeMiscIdUnique 431
    646 
    -stdCallIdKey        = mkPreludeMiscIdUnique 432
    647 
    -cApiCallIdKey       = mkPreludeMiscIdUnique 433
    648 
    -primCallIdKey       = mkPreludeMiscIdUnique 434
    649 
    -javaScriptCallIdKey = mkPreludeMiscIdUnique 435
    650 
    -
    651 
    --- data Safety = ...
    652 
    -unsafeIdKey, safeIdKey, interruptibleIdKey :: Unique
    653 
    -unsafeIdKey        = mkPreludeMiscIdUnique 440
    654 
    -safeIdKey          = mkPreludeMiscIdUnique 441
    655 
    -interruptibleIdKey = mkPreludeMiscIdUnique 442
    656 
    -
    657 
    --- data FunDep = ...
    658 
    -funDepIdKey :: Unique
    659 
    -funDepIdKey = mkPreludeMiscIdUnique 445
    660 
    -
    661 
    --- mulArrow
    662 
    -mulArrowTIdKey :: Unique
    663 
    -mulArrowTIdKey = mkPreludeMiscIdUnique 446
    664 
    -
    665 
    --- data TySynEqn = ...
    666 
    -tySynEqnIdKey :: Unique
    667 
    -tySynEqnIdKey = mkPreludeMiscIdUnique 460
    668 
    -
    669 
    --- quasiquoting
    670 
    -quoteExpKey, quotePatKey, quoteDecKey, quoteTypeKey :: Unique
    671 
    -quoteExpKey  = mkPreludeMiscIdUnique 470
    672 
    -quotePatKey  = mkPreludeMiscIdUnique 471
    673 
    -quoteDecKey  = mkPreludeMiscIdUnique 472
    674 
    -quoteTypeKey = mkPreludeMiscIdUnique 473
    675 
    -
    676 
    --- data RuleBndr = ...
    677 
    -ruleVarIdKey, typedRuleVarIdKey :: Unique
    678 
    -ruleVarIdKey      = mkPreludeMiscIdUnique 480
    679 
    -typedRuleVarIdKey = mkPreludeMiscIdUnique 481
    680 
    -
    681 
    --- data AnnTarget = ...
    682 
    -valueAnnotationIdKey, typeAnnotationIdKey, moduleAnnotationIdKey :: Unique
    683 
    -valueAnnotationIdKey  = mkPreludeMiscIdUnique 490
    684 
    -typeAnnotationIdKey   = mkPreludeMiscIdUnique 491
    685 
    -moduleAnnotationIdKey = mkPreludeMiscIdUnique 492
    686 
    -
    687 
    --- type DerivPred = ...
    688 
    -derivClauseIdKey :: Unique
    689 
    -derivClauseIdKey = mkPreludeMiscIdUnique 493
    690 
    -
    691 
    --- data DerivStrategy = ...
    692 
    -stockStrategyIdKey, anyclassStrategyIdKey, newtypeStrategyIdKey,
    693 
    -  viaStrategyIdKey :: Unique
    694 
    -stockStrategyIdKey    = mkPreludeDataConUnique 494
    695 
    -anyclassStrategyIdKey = mkPreludeDataConUnique 495
    696 
    -newtypeStrategyIdKey  = mkPreludeDataConUnique 496
    697 
    -viaStrategyIdKey      = mkPreludeDataConUnique 497
    698 
    -
    699 
    --- data Specificity = ...
    700 
    -specifiedSpecKey, inferredSpecKey :: Unique
    701 
    -specifiedSpecKey = mkPreludeMiscIdUnique 498
    702 
    -inferredSpecKey  = mkPreludeMiscIdUnique 499
    703 
    -
    704 
    --- data BndrVis = ...
    705 
    -bndrReqKey, bndrInvisKey :: Unique
    706 
    -bndrReqKey   = mkPreludeMiscIdUnique 800  -- TODO (int-index): make up some room in the 5** numberspace?
    707 
    -bndrInvisKey = mkPreludeMiscIdUnique 801
    708 
    -
    469 
    +noNamespaceSpecifierDataConName   = mkDataOcc "NoNamespaceSpecifier"
    470 
    +typeNamespaceSpecifierDataConName = mkDataOcc "TypeNamespaceSpecifier"
    471 
    +dataNamespaceSpecifierDataConName = mkDataOcc "DataNamespaceSpecifier"

  • compiler/GHC/HsToCore/Quote.hs
    ... ... @@ -887,7 +887,7 @@ repC (L _ (ConDeclH98 { con_name = con
    887 887 
                 ; ctxt' <- repMbContext mcxt
    888 888 
                 ; if not is_existential && isNothing mcxt
    889 889 
                   then return c'
    890 
    -              else rep2 forallCName ([unC ex_bndrs, unC ctxt', unC c'])
    890 
    +              else rep2 forallCOcc ([unC ex_bndrs, unC ctxt', unC c'])
    891 891 
                 }
    892 892
    893 893 
     repC (L l (ConDeclGADT { con_names  = cons
    ... ... @@ -908,12 +908,12 @@ repC (L l (ConDeclGADT { con_names = cons
    908 908 
         let loop last_bndrs' [] = do
    909 909 
               ctxt' <- repMbContext mcxt
    910 910 
               c'    <- repGadtDataCons cons args res_ty
    911 
    -          rep2 forallCName ([unC last_bndrs', unC ctxt', unC c'])
    911 
    +          rep2 forallCOcc ([unC last_bndrs', unC ctxt', unC c'])
    912 912 
             loop last_bndrs' (bndrs : bndrs_s) =
    913 913 
               addHsTyVarBinds FreshNamesOnly bndrs $ \bndrs' -> do
    914 914 
                 body_c' <- loop bndrs' bndrs_s
    915 915 
                 ctxt' <- repContext []
    916 
    -            rep2 forallCName [unC last_bndrs', unC ctxt', unC body_c']
    916 
    +            rep2 forallCOcc [unC last_bndrs', unC ctxt', unC body_c']
    917 917 
         in loop outer_bndrs' invis_inner_bndrs
    918 918
    919 919 
       | Nothing <- m_invis_inner_bndrs
    ... ... @@ -935,14 +935,14 @@ repMbContext Nothing = repContext []
    935 935 
     repMbContext (Just (L _ cxt)) = repContext cxt
    936 936
    937 937 
     repSrcUnpackedness :: SrcUnpackedness -> MetaM (Core (M TH.SourceUnpackedness))
    938 
    -repSrcUnpackedness SrcUnpack   = rep2 sourceUnpackName         []
    939 
    -repSrcUnpackedness SrcNoUnpack = rep2 sourceNoUnpackName       []
    940 
    -repSrcUnpackedness NoSrcUnpack = rep2 noSourceUnpackednessName []
    938 
    +repSrcUnpackedness SrcUnpack   = rep2 sourceUnpackOcc         []
    939 
    +repSrcUnpackedness SrcNoUnpack = rep2 sourceNoUnpackOcc       []
    940 
    +repSrcUnpackedness NoSrcUnpack = rep2 noSourceUnpackednessOcc []
    941 941
    942 942 
     repSrcStrictness :: SrcStrictness -> MetaM (Core (M TH.SourceStrictness))
    943 
    -repSrcStrictness SrcLazy     = rep2 sourceLazyName         []
    944 
    -repSrcStrictness SrcStrict   = rep2 sourceStrictName       []
    945 
    -repSrcStrictness NoSrcStrict = rep2 noSourceStrictnessName []
    943 
    +repSrcStrictness SrcLazy     = rep2 sourceLazyOcc         []
    944 
    +repSrcStrictness SrcStrict   = rep2 sourceStrictOcc       []
    945 
    +repSrcStrictness NoSrcStrict = rep2 noSourceStrictnessOcc []
    946 946
    947 947 
     repConDeclField :: HsConDeclField GhcRn -> MetaM (Core (M TH.BangType))
    948 948 
     repConDeclField (CDF { cdf_unpack, cdf_bang, cdf_type }) = do
    ... ... @@ -2344,7 +2344,7 @@ globalVarLocal unique name
    2344 2344 
       = do  { MkC occ <- occNameLit name
    2345 2345 
             ; platform <- targetPlatform <$> getDynFlags
    2346 2346 
             ; let uni = mkIntegerExpr platform (toInteger $ getKey unique)
    2347 
    -        ; rep2_nwDsM mkNameLName [occ,uni] }
    2347 
    +        ; rep2_nwDsM mkNameLOcc [occ,uni] }
    2348 2348
    2349 2349 
     globalVarExternal :: Module -> OccName -> DsM (Core TH.Name)
    2350 2350 
     globalVarExternal mod name_occ
    ... ... @@ -2352,14 +2352,14 @@ globalVarExternal mod name_occ
    2352 2352 
             ; MkC pkg <- coreStringLit name_pkg
    2353 2353 
             ; MkC occ <- occNameLit name_occ
    2354 2354 
             ; if | isDataOcc name_occ
    2355 
    -             -> rep2_nwDsM mkNameG_dName [pkg,mod,occ]
    2355 
    +             -> rep2_nwDsM mkNameG_dOcc [pkg,mod,occ]
    2356 2356 
                  | isVarOcc  name_occ
    2357 
    -             -> rep2_nwDsM mkNameG_vName [pkg,mod,occ]
    2357 
    +             -> rep2_nwDsM mkNameG_vOcc [pkg,mod,occ]
    2358 2358 
                  | isTcOcc   name_occ
    2359 
    -             -> rep2_nwDsM mkNameG_tcName [pkg,mod,occ]
    2359 
    +             -> rep2_nwDsM mkNameG_tcOcc [pkg,mod,occ]
    2360 2360 
                  | Just con_fs <- fieldOcc_maybe name_occ
    2361 2361 
                  -> do { MkC con <- coreStringLit con_fs
    2362 
    -                   ; rep2_nwDsM mkNameG_fldName [pkg,mod,con,occ] }
    2362 
    +                   ; rep2_nwDsM mkNameG_fldOcc [pkg,mod,con,occ] }
    2363 2363 
                  | otherwise
    2364 2364 
                  -> pprPanic "GHC.HsToCore.Quote.globalVar" (ppr name_occ)
    2365 2365 
             }
    ... ... @@ -2465,11 +2465,11 @@ krep2X lift_dsm get_wrap n xs = do
    2465 2465
    2466 2466
    2467 2467
    2468 
    -dataCon' :: Name -> [CoreExpr] -> MetaM (Core a)
    2469 
    -dataCon' n args = do { id <- lift $ dsLookupDataCon n
    2468 
    +dataCon' :: KnownOcc -> [CoreExpr] -> MetaM (Core a)
    2469 
    +dataCon' n args = do { id <- lift $ dsLookupKnownOccDataCon n
    2470 2470 
                          ; return $ MkC $ mkCoreConApps id args }
    2471 2471
    2472 
    -dataCon :: Name -> MetaM (Core a)
    2472 
    +dataCon :: KnownOcc -> MetaM (Core a)
    2473 2473 
     dataCon n = dataCon' n []
    2474 2474
    2475 2475
    ... ... @@ -2615,7 +2615,7 @@ repDoBlock doName maybeModName (MkC ss) = do
    2615 2615 
         coreModNameM = case maybeModName of
    2616 2616 
           Just m -> do
    2617 2617 
             MkC s <- lift $ coreStringLit (moduleNameFS m)
    2618 
    -        mName <- rep2_nw mkModNameName [s]
    2618 
    +        mName <- rep2_nw mkModNameOcc [s]
    2619 2619 
             coreJust modNameTyConOcc mName
    2620 2620 
           _ -> coreNothing modNameTyConOcc
    2621 2621
    ... ... @@ -2918,15 +2918,15 @@ repH98DataCon con details
    2918 2918 
              case details of
    2919 2919 
                PrefixCon ps -> do
    2920 2920 
                  arg_tys <- repPrefixConArgs IsNotPrefixConGADT ps
    2921 
    -             rep2 normalCName [unC con', unC arg_tys]
    2921 
    +             rep2 normalCOcc [unC con', unC arg_tys]
    2922 2922 
                InfixCon st1 st2 -> do
    2923 2923 
                  verifyLinearFields IsNotPrefixConGADT [st1, st2]
    2924 2924 
                  arg1 <- repConDeclField st1
    2925 2925 
                  arg2 <- repConDeclField st2
    2926 
    -             rep2 infixCName [unC arg1, unC con', unC arg2]
    2926 
    +             rep2 infixCOcc [unC arg1, unC con', unC arg2]
    2927 2927 
                RecCon ips -> do
    2928 2928 
                  arg_vtys <- repRecConArgs ips
    2929 
    -             rep2 recCName [unC con', unC arg_vtys]
    2929 
    +             rep2 recCOcc [unC con', unC arg_vtys]
    2930 2930
    2931 2931 
     repGadtDataCons :: NonEmpty (LocatedN Name)
    2932 2932 
                     -> HsConDeclGADTDetails GhcRn
    ... ... @@ -2938,11 +2938,11 @@ repGadtDataCons cons details res_ty
    2938 2938 
                PrefixConGADT _ ps -> do
    2939 2939 
                  arg_tys <- repPrefixConArgs IsPrefixConGADT ps
    2940 2940 
                  res_ty' <- repLTy res_ty
    2941 
    -             rep2 gadtCName [ unC (nonEmptyCoreList' cons'), unC arg_tys, unC res_ty']
    2941 
    +             rep2 gadtCOcc [ unC (nonEmptyCoreList' cons'), unC arg_tys, unC res_ty']
    2942 2942 
                RecConGADT _ ips -> do
    2943 2943 
                  arg_vtys <- repRecConArgs ips
    2944 2944 
                  res_ty'  <- repLTy res_ty
    2945 
    -             rep2 recGadtCName [unC (nonEmptyCoreList' cons'), unC arg_vtys,
    2945 
    +             rep2 recGadtCOcc [unC (nonEmptyCoreList' cons'), unC arg_vtys,
    2946 2946 
                                     unC res_ty']
    2947 2947
    2948 2948 
     -- TH currently only supports linear constructors.
    ... ... @@ -3197,15 +3197,15 @@ repRdrName rdr_name = do
    3197 3197 
           -- used for holes anyway so it probably never happens
    3198 3198
    3199 3199 
     repNameS :: Core String -> MetaM (Core TH.Name)
    3200 
    -repNameS (MkC name) = rep2_nw mkNameSName [name]
    3200 
    +repNameS (MkC name) = rep2_nw mkNameSOcc [name]
    3201 3201
    3202 3202 
     repNameQ :: Core String -> Core String -> MetaM (Core TH.Name)
    3203 
    -repNameQ (MkC mn) (MkC name) = rep2_nw mkNameQName [mn, name]
    3203 
    +repNameQ (MkC mn) (MkC name) = rep2_nw mkNameQOcc [mn, name]
    3204 3204
    3205 3205 
     --------------- Miscellaneous -------------------
    3206 3206
    3207 3207 
     repGensym :: Core String -> MetaM (Core (M TH.Name))
    3208 
    -repGensym (MkC lit_str) = rep2 newNameName [lit_str]
    3208 
    +repGensym (MkC lit_str) = rep2 newNameOcc [lit_str]
    3209 3209
    3210 3210 
     repBindM :: Type -> Type        -- a and b
    3211 3211 
              -> Core (M a) -> Core (a -> M b) -> MetaM (Core (M b))

  • compiler/GHC/Rename/Splice.hs
    ... ... @@ -337,10 +337,10 @@ runRnSplice flavour run_meta ppr_res splice
    337 337 
                 Just h  -> h splice
    338 338
    339 339 
            -- TODO: Should call tcUntypedSplice here
    340 
    -       ; let the_expr = case splice' of
    341 
    -                HsUntypedSpliceExpr _ e ->  e
    342 
    -                HsQuasiQuote _ q str -> mkQuasiQuoteExpr flavour q str
    343 
    -                XUntypedSplice {} -> pprPanic "runRnSplice: XUntypedSplice" (pprUntypedSplice False Nothing splice')
    340 
    +       ; the_expr <- case splice' of
    341 
    +            HsUntypedSpliceExpr _ e -> pure e
    342 
    +            HsQuasiQuote _ q str -> fst <$> rnLExpr (mkQuasiQuoteExpr flavour q str)
    343 
    +            XUntypedSplice {} -> pprPanic "runRnSplice: XUntypedSplice" (pprUntypedSplice False Nothing splice')
    344 344
    345 345 
                  -- Typecheck the expression
    346 346 
            ; meta_exp_ty   <- tcMetaKnownOccTy meta_ty_name
    ... ... @@ -392,18 +392,18 @@ recordPendingSplice _ _ (TcPending _ _ _) = panic "impossible"
    392 392 
     ------------------
    393 393 
     mkQuasiQuoteExpr :: UntypedSpliceFlavour -> LIdP GhcRn
    394 394 
                      -> XRec GhcPs FastString
    395 
    -                 -> LHsExpr GhcRn
    395 
    +                 -> LHsExpr GhcPs
    396 396 
     -- Return the expression (quoter "...quote...")
    397 397 
     -- which is what we must run in a quasi-quote
    398 398 
     mkQuasiQuoteExpr flavour quoter (L q_span' quote)
    399 399 
       = L q_span $ HsApp noExtField (L q_span
    400 400 
                  $ HsApp noExtField (L q_span
    401 
    -                    (mkHsVar (L (l2l q_span) quote_selector)))
    401 
    +                    (mkHsVar (L (l2l q_span) (Exact (ExactOcc quote_selector)))))
    402 402 
                                     quoterExpr)
    403 403 
                         quoteExpr
    404 404 
       where
    405 405 
         q_span = noAnnSrcSpan (locA q_span')
    406 
    -    quoterExpr = L (l2l quoter) $! mkHsVar          $! quoter
    406 
    +    quoterExpr = L (l2l quoter) $! mkHsVar    $! Exact . ExactName <$> quoter
    407 407 
         quoteExpr  = L q_span $! HsLit noExtField $! HsString NoSourceText quote
    408 408 
         quote_selector = case flavour of
    409 409 
                            UntypedExpSplice  -> quoteExpName

  • compiler/GHC/Tc/Gen/Splice.hs
    ... ... @@ -834,7 +834,7 @@ tcUntypedSplice (QuoteWrapper _ m_var) splice_name (HsQuasiQuote (HsQuasiQuoteEx
    834 834 
        res_co <- unifyInvisibleType InvisibleKind splice_ty quote_ty
    835 835
    836 836 
        -- 3. Lookup the relevant field selector from QuasiQuoter
    837 
    -   sel <- tcLookupId qq_sel_name
    837 
    +   sel <- tcLookupKnownOccId qq_sel_name
    838 838
    839 839 
        -- 4. Apply the selector to the quasi-quoter
    840 840 
        let expr' = mkLHsWrapCo res_co $
    ... ... @@ -877,7 +877,7 @@ tcPendingSpliceTyped q@(QuoteWrapper _ m_var) splice_name (HsTypedSpliceExpr _ e
    877 877 
            ; let rep = getRuntimeRep res_ty
    878 878 
            ; meta_exp_ty <- tcCodeTy m_var res_ty
    879 879 
            ; expr' <- tcCheckMonoExpr expr meta_exp_ty
    880 
    -       ; untype_code <- tcLookupId unTypeCodeName
    880 
    +       ; untype_code <- tcLookupKnownOccId unTypeCodeOcc
    881 881 
            ; let expr'' = mkHsApp
    882 882 
                              (mkLHsWrap (applyQuoteWrapper q)
    883 883 
                                (nlHsTyApp untype_code [rep, res_ty])) expr'

  • libraries/base/src/GHC/Essentials.hs
    ... ... @@ -195,7 +195,7 @@ module GHC.Essentials
    195 195 
         , Lift, Quote  -- The Lift and Quote classeso
    196 196 
         , Q, DecsQ, ExpQ, TypeQ, PatQ
    197 197 
         , Name, Decs, TH.Type, FunDep
    198 
    -    , Pred, Code, InjectivityAnn, Overlap, ModName, QuasiQuoter
    198 
    +    , Pred, Code, InjectivityAnn, ModName
    199 199 
         , Con, BangType, VarBangType, RuleBndr, TySynEqn, Role, DerivClause
    200 200 
         , Kind, TyVarBndrUnit, TyVarBndrSpec, TyVarBndrVis, DerivStrategy
    201 201 
         , sequenceQ, newName, mkName, mkNameG_v, mkNameG_d, mkNameG_tc, mkNameG_fld, mkNameL
    ... ... @@ -221,6 +221,9 @@ module GHC.Essentials
    221 221 
              , letE, caseE, doE, mdoE, compE, fromE, fromThenE, fromToE, fromThenToE
    222 222 
              , listE, sigE, recConE, recUpdE, staticE, unboundVarE, labelE, implicitParamVarE
    223 223 
              , getFieldE, projectionE, typeE, forallE, forallVisE, constrainedE
    224 
    +    , TH.cxt
    225 
    +    , TH.noSourceUnpackedness, TH.sourceNoUnpack, TH.sourceUnpack
    226 
    +    , TH.noSourceStrictness, TH.sourceLazy, TH.sourceStrict
    224 227 
         , FieldExp, fieldExp
    225 228 
         , FieldPat, fieldPat
    226 229 
         , Match, match
    ... ... @@ -228,6 +231,35 @@ module GHC.Essentials
    228 231 
         , Stmt, bindS, letS, noBindS, parS, recS
    229 232 
         , Body, normalB, guardedB
    230 233 
         , Guard, normalGE, patGE
    234 
    +    , normalC, recC, infixC, forallC, gadtC, recGadtC
    235 
    +    , TH.bang, TH.bangType, TH.varBangType
    236 
    +    , TH.unidir, TH.implBidir, TH.explBidir
    237 
    +    , TH.prefixPatSyn, TH.recordPatSyn, TH.infixPatSyn
    238 
    +    , forallT, forallVisT, varT, conT, infixT, tupleT,
    239 
    +    , unboxedTupleT, unboxedSumT, arrowT, mulArrowT, listT,
    240 
    +    , appT, appKindT, sigT, equalityT, litT, promotedT,
    241 
    +    , promotedTupleT, promotedNilT, promotedConsT,
    242 
    +    , wildCardT, implicitParamT
    243 
    +    , numTyLit, strTyLit, charTyLit
    244 
    +    , plainTV, kindedTV
    245 
    +    , plainInvisTV, kindedInvisTV
    246 
    +    , specifiedSpec, inferredSpec
    247 
    +    , bndrReq, bndrInvis
    248 
    +    , nominalR, representationalR, phantomR, inferR
    249 
    +    , starK, constraintK
    250 
    +    , noSig, kindSig, tyVarSig
    251 
    +    , injectivityAnn
    252 
    +    , TH.cCall, TH.stdCall, TH.cApiCall, TH.primCall, TH.javaScriptCall
    253 
    +    , TH.unsafe, TH.safe, TH.interruptible
    254 
    +    , TH.ruleVar, TH.typedRuleVar
    255 
    +    , TH.funDep, TH.tySynEqn
    256 
    +    , TH.valueAnnotation, TH.typeAnnotation, TH.moduleAnnotation
    257 
    +    , TH.derivClause
    258 
    +    , TH.stockStrategy, TH.anyclassStrategy, TH.newtypeStrategy, TH.viaStrategy
    259 
    +    , TH.QuasiQuoter(..)
    260 
    +    , TH.Inline(..), TH.RuleMatch(..)
    261 
    +    , TH.Phases(..) , TH.Overlap(..)
    262 
    +    , TH.NamespaceSpecifier(..)
    231 263
    232 264 
         -- GHCi
    233 265 
         , GHCiSandboxIO(ghciStepIO)
    ... ... @@ -298,7 +330,7 @@ import GHC.Internal.TH.Syntax as TH
    298 330 
            hiding( Fixity(..), SourceUnpackedness(..), SourceStrictness(..)
    299 331 
                  , DecidedStrictness(..) )
    300 332 
        -- hiding(Fixity) see Note [Tricky known-occ cases] in GHC.Builtin.KnownOccs
    301 
    -import GHC.Internal.TH.Lib
    333 
    +import GHC.Internal.TH.Lib as TH
    302 334 
     import GHC.Internal.TH.Lift
    303 335 
     import GHC.Internal.TH.Monad
    304 336 
     import GHC.Internal.TopHandler

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help