never executed always true always false
    1 {-# LANGUAGE AllowAmbiguousTypes     #-} -- for unXRec, etc.
    2 {-# LANGUAGE ConstraintKinds         #-}
    3 {-# LANGUAGE DataKinds               #-}
    4 {-# LANGUAGE DeriveDataTypeable      #-}
    5 {-# LANGUAGE EmptyCase               #-}
    6 {-# LANGUAGE EmptyDataDeriving       #-}
    7 {-# LANGUAGE StandaloneDeriving      #-}
    8 {-# LANGUAGE FlexibleContexts        #-}
    9 {-# LANGUAGE FlexibleInstances       #-}
   10 {-# LANGUAGE GADTs                   #-}
   11 {-# LANGUAGE MultiParamTypeClasses   #-}
   12 {-# LANGUAGE RankNTypes              #-}
   13 {-# LANGUAGE ScopedTypeVariables     #-}
   14 {-# LANGUAGE TypeFamilyDependencies  #-}
   15 {-# LANGUAGE UndecidableInstances    #-} -- Wrinkle in Note [Trees That Grow]
   16                                          -- in module Language.Haskell.Syntax.Extension
   17 
   18 -- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.*
   19 module Language.Haskell.Syntax.Extension where
   20 
   21 -- This module captures the type families to precisely identify the extension
   22 -- points for GHC.Hs syntax
   23 
   24 import GHC.Prelude
   25 
   26 import GHC.TypeLits (Symbol, KnownSymbol)
   27 import Data.Data hiding ( Fixity )
   28 import Data.Kind (Type)
   29 import GHC.Utils.Outputable
   30 
   31 {-
   32 Note [Trees That Grow]
   33 ~~~~~~~~~~~~~~~~~~~~~~
   34 
   35 See https://gitlab.haskell.org/ghc/ghc/wikis/implementing-trees-that-grow
   36 
   37 The hsSyn AST is reused across multiple compiler passes. We also have the
   38 Template Haskell AST, and the haskell-src-exts one (outside of GHC)
   39 
   40 Supporting multiple passes means the AST has various warts on it to cope with
   41 the specifics for the phases, such as the 'ValBindsOut', 'ConPatOut',
   42 'SigPatOut' etc.
   43 
   44 The growable AST will allow each of these variants to be captured explicitly,
   45 such that they only exist in the given compiler pass AST, as selected by the
   46 type parameter to the AST.
   47 
   48 In addition it will allow tool writers to define their own extensions to capture
   49 additional information for the tool, in a natural way.
   50 
   51 A further goal is to provide a means to harmonise the Template Haskell and
   52 haskell-src-exts ASTs as well.
   53 
   54 Wrinkle: In order to print out the AST, we need to know it is Outputable.
   55 We also sometimes need to branch on the particular pass that we're in
   56 (e.g. to print out type information once we know it). In order to allow
   57 both of these actions, we define OutputableBndrId, which gathers the necessary
   58 OutputableBndr and IsPass constraints. The use of this constraint in instances
   59 generally requires UndecidableInstances.
   60 
   61 See also Note [IsPass] and Note [NoGhcTc] in GHC.Hs.Extension.
   62 
   63 -}
   64 
   65 -- | A placeholder type for TTG extension points that are not currently
   66 -- unused to represent any particular value.
   67 --
   68 -- This should not be confused with 'NoExtCon', which are found in unused
   69 -- extension /constructors/ and therefore should never be inhabited. In
   70 -- contrast, 'NoExtField' is used in extension /points/ (e.g., as the field of
   71 -- some constructor), so it must have an inhabitant to construct AST passes
   72 -- that manipulate fields with that extension point as their type.
   73 data NoExtField = NoExtField
   74   deriving (Data,Eq,Ord)
   75 
   76 instance Outputable NoExtField where
   77   ppr _ = text "NoExtField"
   78 
   79 -- | Used when constructing a term with an unused extension point.
   80 noExtField :: NoExtField
   81 noExtField = NoExtField
   82 
   83 -- | Used in TTG extension constructors that have yet to be extended with
   84 -- anything. If an extension constructor has 'NoExtCon' as its field, it is
   85 -- not intended to ever be constructed anywhere, and any function that consumes
   86 -- the extension constructor can eliminate it by way of 'noExtCon'.
   87 --
   88 -- This should not be confused with 'NoExtField', which are found in unused
   89 -- extension /points/ (not /constructors/) and therefore can be inhabited.
   90 
   91 -- See also [NoExtCon and strict fields].
   92 data NoExtCon
   93   deriving (Data,Eq,Ord)
   94 
   95 instance Outputable NoExtCon where
   96   ppr = noExtCon
   97 
   98 -- | Eliminate a 'NoExtCon'. Much like 'Data.Void.absurd'.
   99 noExtCon :: NoExtCon -> a
  100 noExtCon x = case x of {}
  101 
  102 -- | GHC's L prefixed variants wrap their vanilla variant in this type family,
  103 -- to add 'SrcLoc' info via 'Located'. Other passes than 'GhcPass' not
  104 -- interested in location information can define this as
  105 -- @type instance XRec NoLocated a = a@.
  106 -- See Note [XRec and SrcSpans in the AST]
  107 type family XRec p a = r | r -> a
  108 
  109 type family Anno a = b -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation
  110 
  111 {-
  112 Note [XRec and SrcSpans in the AST]
  113 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  114 XRec is meant to replace most of the uses of `Located` in the AST. It is another
  115 extension point meant to make it easier for non-GHC applications to reuse the
  116 AST for their own purposes, and not have to deal the hassle of (perhaps) useless
  117 SrcSpans everywhere.
  118 
  119 instead of `Located (HsExpr p)` or similar types, we will now have `XRec p
  120 (HsExpr p)`
  121 
  122 XRec allows annotating certain points in the AST with extra
  123 information. This maybe be source spans (for GHC), nothing (for TH),
  124 types (for HIE files), exact print annotations (for exactprint) or
  125 anything else.
  126 
  127 This should hopefully bring us one step closer to sharing the AST between GHC
  128 and TH.
  129 
  130 We use the `UnXRec`, `MapXRec` and `WrapXRec` type classes to aid us in writing
  131 pass-polymorphic code that deals with `XRec`s
  132 -}
  133 
  134 -- | We can strip off the XRec to access the underlying data.
  135 -- See Note [XRec and SrcSpans in the AST]
  136 class UnXRec p where
  137   unXRec :: XRec p a -> a
  138 
  139 -- | We can map over the underlying type contained in an @XRec@ while preserving
  140 -- the annotation as is.
  141 class MapXRec p where
  142   mapXRec :: (Anno a ~ Anno b) => (a -> b) -> XRec p a -> XRec p b
  143 -- See Note [XRec and SrcSpans in the AST]
  144 -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation
  145 -- AZ: Is there a way to not have Anno in this file, but still have MapXRec?
  146 --     Perhaps define XRec with an additional b parameter, only used in Hs as (Anno b)?
  147 
  148 -- | The trivial wrapper that carries no additional information
  149 -- See Note [XRec and SrcSpans in the AST]
  150 class WrapXRec p a where
  151   wrapXRec :: a -> XRec p a
  152 
  153 -- | Maps the "normal" id type for a given pass
  154 type family IdP p
  155 
  156 type LIdP p = XRec p (IdP p)
  157 
  158 -- =====================================================================
  159 -- Type families for the HsBinds extension points
  160 
  161 -- HsLocalBindsLR type families
  162 type family XHsValBinds      x x'
  163 type family XHsIPBinds       x x'
  164 type family XEmptyLocalBinds x x'
  165 type family XXHsLocalBindsLR x x'
  166 
  167 -- HsValBindsLR type families
  168 type family XValBinds    x x'
  169 type family XXValBindsLR x x'
  170 
  171 -- HsBindLR type families
  172 type family XFunBind    x x'
  173 type family XPatBind    x x'
  174 type family XVarBind    x x'
  175 type family XAbsBinds   x x'
  176 type family XPatSynBind x x'
  177 type family XXHsBindsLR x x'
  178 
  179 -- ABExport type families
  180 type family XABE x
  181 type family XXABExport x
  182 
  183 -- PatSynBind type families
  184 type family XPSB x x'
  185 type family XXPatSynBind x x'
  186 
  187 -- HsIPBinds type families
  188 type family XIPBinds    x
  189 type family XXHsIPBinds x
  190 
  191 -- IPBind type families
  192 type family XCIPBind x
  193 type family XXIPBind x
  194 
  195 -- Sig type families
  196 type family XTypeSig          x
  197 type family XPatSynSig        x
  198 type family XClassOpSig       x
  199 type family XIdSig            x
  200 type family XFixSig           x
  201 type family XInlineSig        x
  202 type family XSpecSig          x
  203 type family XSpecInstSig      x
  204 type family XMinimalSig       x
  205 type family XSCCFunSig        x
  206 type family XCompleteMatchSig x
  207 type family XXSig             x
  208 
  209 -- FixitySig type families
  210 type family XFixitySig          x
  211 type family XXFixitySig         x
  212 
  213 -- StandaloneKindSig type families
  214 type family XStandaloneKindSig  x
  215 type family XXStandaloneKindSig x
  216 
  217 -- =====================================================================
  218 -- Type families for the HsDecls extension points
  219 
  220 -- HsDecl type families
  221 type family XTyClD       x
  222 type family XInstD       x
  223 type family XDerivD      x
  224 type family XValD        x
  225 type family XSigD        x
  226 type family XKindSigD    x
  227 type family XDefD        x
  228 type family XForD        x
  229 type family XWarningD    x
  230 type family XAnnD        x
  231 type family XRuleD       x
  232 type family XSpliceD     x
  233 type family XDocD        x
  234 type family XRoleAnnotD  x
  235 type family XXHsDecl     x
  236 
  237 -- -------------------------------------
  238 -- HsGroup type families
  239 type family XCHsGroup      x
  240 type family XXHsGroup      x
  241 
  242 -- -------------------------------------
  243 -- SpliceDecl type families
  244 type family XSpliceDecl       x
  245 type family XXSpliceDecl      x
  246 
  247 -- -------------------------------------
  248 -- TyClDecl type families
  249 type family XFamDecl       x
  250 type family XSynDecl       x
  251 type family XDataDecl      x
  252 type family XClassDecl     x
  253 type family XXTyClDecl     x
  254 
  255 -- -------------------------------------
  256 -- FunDep type families
  257 type family XCFunDep      x
  258 type family XXFunDep      x
  259 
  260 -- -------------------------------------
  261 -- TyClGroup type families
  262 type family XCTyClGroup      x
  263 type family XXTyClGroup      x
  264 
  265 -- -------------------------------------
  266 -- FamilyResultSig type families
  267 type family XNoSig            x
  268 type family XCKindSig         x -- Clashes with XKindSig above
  269 type family XTyVarSig         x
  270 type family XXFamilyResultSig x
  271 
  272 -- -------------------------------------
  273 -- FamilyDecl type families
  274 type family XCFamilyDecl      x
  275 type family XXFamilyDecl      x
  276 
  277 -- -------------------------------------
  278 -- HsDataDefn type families
  279 type family XCHsDataDefn      x
  280 type family XXHsDataDefn      x
  281 
  282 -- -------------------------------------
  283 -- HsDerivingClause type families
  284 type family XCHsDerivingClause      x
  285 type family XXHsDerivingClause      x
  286 
  287 -- -------------------------------------
  288 -- DerivClauseTys type families
  289 type family XDctSingle       x
  290 type family XDctMulti        x
  291 type family XXDerivClauseTys x
  292 
  293 -- -------------------------------------
  294 -- ConDecl type families
  295 type family XConDeclGADT   x
  296 type family XConDeclH98    x
  297 type family XXConDecl      x
  298 
  299 -- -------------------------------------
  300 -- FamEqn type families
  301 type family XCFamEqn      x r
  302 type family XXFamEqn      x r
  303 
  304 -- -------------------------------------
  305 -- TyFamInstDecl type families
  306 type family XCTyFamInstDecl x
  307 type family XXTyFamInstDecl x
  308 
  309 -- -------------------------------------
  310 -- ClsInstDecl type families
  311 type family XCClsInstDecl      x
  312 type family XXClsInstDecl      x
  313 
  314 -- -------------------------------------
  315 -- InstDecl type families
  316 type family XClsInstD      x
  317 type family XDataFamInstD  x
  318 type family XTyFamInstD    x
  319 type family XXInstDecl     x
  320 
  321 -- -------------------------------------
  322 -- DerivDecl type families
  323 type family XCDerivDecl      x
  324 type family XXDerivDecl      x
  325 
  326 -- -------------------------------------
  327 -- DerivStrategy type family
  328 type family XStockStrategy    x
  329 type family XAnyClassStrategy x
  330 type family XNewtypeStrategy  x
  331 type family XViaStrategy      x
  332 
  333 -- -------------------------------------
  334 -- DefaultDecl type families
  335 type family XCDefaultDecl      x
  336 type family XXDefaultDecl      x
  337 
  338 -- -------------------------------------
  339 -- ForeignDecl type families
  340 type family XForeignImport     x
  341 type family XForeignExport     x
  342 type family XXForeignDecl      x
  343 
  344 -- -------------------------------------
  345 -- RuleDecls type families
  346 type family XCRuleDecls      x
  347 type family XXRuleDecls      x
  348 
  349 -- -------------------------------------
  350 -- RuleDecl type families
  351 type family XHsRule          x
  352 type family XXRuleDecl       x
  353 
  354 -- -------------------------------------
  355 -- RuleBndr type families
  356 type family XCRuleBndr      x
  357 type family XRuleBndrSig    x
  358 type family XXRuleBndr      x
  359 
  360 -- -------------------------------------
  361 -- WarnDecls type families
  362 type family XWarnings        x
  363 type family XXWarnDecls      x
  364 
  365 -- -------------------------------------
  366 -- WarnDecl type families
  367 type family XWarning        x
  368 type family XXWarnDecl      x
  369 
  370 -- -------------------------------------
  371 -- AnnDecl type families
  372 type family XHsAnnotation  x
  373 type family XXAnnDecl      x
  374 
  375 -- -------------------------------------
  376 -- RoleAnnotDecl type families
  377 type family XCRoleAnnotDecl  x
  378 type family XXRoleAnnotDecl  x
  379 
  380 -- -------------------------------------
  381 -- InjectivityAnn type families
  382 type family XCInjectivityAnn  x
  383 type family XXInjectivityAnn  x
  384 
  385 -- =====================================================================
  386 -- Type families for the HsExpr extension points
  387 
  388 type family XVar            x
  389 type family XUnboundVar     x
  390 type family XRecSel         x
  391 type family XOverLabel      x
  392 type family XIPVar          x
  393 type family XOverLitE       x
  394 type family XLitE           x
  395 type family XLam            x
  396 type family XLamCase        x
  397 type family XApp            x
  398 type family XAppTypeE       x
  399 type family XOpApp          x
  400 type family XNegApp         x
  401 type family XPar            x
  402 type family XSectionL       x
  403 type family XSectionR       x
  404 type family XExplicitTuple  x
  405 type family XExplicitSum    x
  406 type family XCase           x
  407 type family XIf             x
  408 type family XMultiIf        x
  409 type family XLet            x
  410 type family XDo             x
  411 type family XExplicitList   x
  412 type family XRecordCon      x
  413 type family XRecordUpd      x
  414 type family XGetField       x
  415 type family XProjection     x
  416 type family XExprWithTySig  x
  417 type family XArithSeq       x
  418 type family XBracket        x
  419 type family XRnBracketOut   x
  420 type family XTcBracketOut   x
  421 type family XSpliceE        x
  422 type family XProc           x
  423 type family XStatic         x
  424 type family XTick           x
  425 type family XBinTick        x
  426 type family XPragE          x
  427 type family XXExpr          x
  428 
  429 -- -------------------------------------
  430 -- DotFieldOcc type families
  431 type family XCDotFieldOcc  x
  432 type family XXDotFieldOcc  x
  433 
  434 -- -------------------------------------
  435 -- HsPragE type families
  436 type family XSCC            x
  437 type family XXPragE         x
  438 
  439 
  440 -- -------------------------------------
  441 -- AmbiguousFieldOcc type families
  442 type family XUnambiguous        x
  443 type family XAmbiguous          x
  444 type family XXAmbiguousFieldOcc x
  445 
  446 -- -------------------------------------
  447 -- HsTupArg type families
  448 type family XPresent  x
  449 type family XMissing  x
  450 type family XXTupArg  x
  451 
  452 -- -------------------------------------
  453 -- HsSplice type families
  454 type family XTypedSplice   x
  455 type family XUntypedSplice x
  456 type family XQuasiQuote    x
  457 type family XSpliced       x
  458 type family XXSplice       x
  459 
  460 -- -------------------------------------
  461 -- HsBracket type families
  462 type family XExpBr      x
  463 type family XPatBr      x
  464 type family XDecBrL     x
  465 type family XDecBrG     x
  466 type family XTypBr      x
  467 type family XVarBr      x
  468 type family XTExpBr     x
  469 type family XXBracket   x
  470 
  471 -- -------------------------------------
  472 -- HsCmdTop type families
  473 type family XCmdTop  x
  474 type family XXCmdTop x
  475 
  476 -- -------------------------------------
  477 -- MatchGroup type families
  478 type family XMG           x b
  479 type family XXMatchGroup  x b
  480 
  481 -- -------------------------------------
  482 -- Match type families
  483 type family XCMatch  x b
  484 type family XXMatch  x b
  485 
  486 -- -------------------------------------
  487 -- GRHSs type families
  488 type family XCGRHSs  x b
  489 type family XXGRHSs  x b
  490 
  491 -- -------------------------------------
  492 -- GRHS type families
  493 type family XCGRHS  x b
  494 type family XXGRHS  x b
  495 
  496 -- -------------------------------------
  497 -- StmtLR type families
  498 type family XLastStmt        x x' b
  499 type family XBindStmt        x x' b
  500 type family XApplicativeStmt x x' b
  501 type family XBodyStmt        x x' b
  502 type family XLetStmt         x x' b
  503 type family XParStmt         x x' b
  504 type family XTransStmt       x x' b
  505 type family XRecStmt         x x' b
  506 type family XXStmtLR         x x' b
  507 
  508 -- -------------------------------------
  509 -- HsCmd type families
  510 type family XCmdArrApp  x
  511 type family XCmdArrForm x
  512 type family XCmdApp     x
  513 type family XCmdLam     x
  514 type family XCmdPar     x
  515 type family XCmdCase    x
  516 type family XCmdLamCase x
  517 type family XCmdIf      x
  518 type family XCmdLet     x
  519 type family XCmdDo      x
  520 type family XCmdWrap    x
  521 type family XXCmd       x
  522 
  523 -- -------------------------------------
  524 -- ParStmtBlock type families
  525 type family XParStmtBlock  x x'
  526 type family XXParStmtBlock x x'
  527 
  528 -- -------------------------------------
  529 -- ApplicativeArg type families
  530 type family XApplicativeArgOne   x
  531 type family XApplicativeArgMany  x
  532 type family XXApplicativeArg     x
  533 
  534 -- =====================================================================
  535 -- Type families for the HsImpExp extension points
  536 
  537 -- TODO
  538 
  539 -- =====================================================================
  540 -- Type families for the HsLit extension points
  541 
  542 -- We define a type family for each extension point. This is based on prepending
  543 -- 'X' to the constructor name, for ease of reference.
  544 type family XHsChar x
  545 type family XHsCharPrim x
  546 type family XHsString x
  547 type family XHsStringPrim x
  548 type family XHsInt x
  549 type family XHsIntPrim x
  550 type family XHsWordPrim x
  551 type family XHsInt64Prim x
  552 type family XHsWord64Prim x
  553 type family XHsInteger x
  554 type family XHsRat x
  555 type family XHsFloatPrim x
  556 type family XHsDoublePrim x
  557 type family XXLit x
  558 
  559 -- -------------------------------------
  560 -- HsOverLit type families
  561 type family XOverLit  x
  562 type family XXOverLit x
  563 
  564 -- =====================================================================
  565 -- Type families for the HsPat extension points
  566 
  567 type family XWildPat     x
  568 type family XVarPat      x
  569 type family XLazyPat     x
  570 type family XAsPat       x
  571 type family XParPat      x
  572 type family XBangPat     x
  573 type family XListPat     x
  574 type family XTuplePat    x
  575 type family XSumPat      x
  576 type family XConPat      x
  577 type family XViewPat     x
  578 type family XSplicePat   x
  579 type family XLitPat      x
  580 type family XNPat        x
  581 type family XNPlusKPat   x
  582 type family XSigPat      x
  583 type family XCoPat       x
  584 type family XXPat        x
  585 type family XHsFieldBind x
  586 
  587 -- =====================================================================
  588 -- Type families for the HsTypes type families
  589 
  590 
  591 -- -------------------------------------
  592 -- LHsQTyVars type families
  593 type family XHsQTvs       x
  594 type family XXLHsQTyVars  x
  595 
  596 -- -------------------------------------
  597 -- HsOuterTyVarBndrs type families
  598 type family XHsOuterImplicit    x
  599 type family XHsOuterExplicit    x flag
  600 type family XXHsOuterTyVarBndrs x
  601 
  602 -- -------------------------------------
  603 -- HsSigType type families
  604 type family XHsSig      x
  605 type family XXHsSigType x
  606 
  607 -- -------------------------------------
  608 -- HsWildCardBndrs type families
  609 type family XHsWC              x b
  610 type family XXHsWildCardBndrs  x b
  611 
  612 -- -------------------------------------
  613 -- HsPatSigType type families
  614 type family XHsPS x
  615 type family XXHsPatSigType x
  616 
  617 -- -------------------------------------
  618 -- HsType type families
  619 type family XForAllTy        x
  620 type family XQualTy          x
  621 type family XTyVar           x
  622 type family XAppTy           x
  623 type family XAppKindTy       x
  624 type family XFunTy           x
  625 type family XListTy          x
  626 type family XTupleTy         x
  627 type family XSumTy           x
  628 type family XOpTy            x
  629 type family XParTy           x
  630 type family XIParamTy        x
  631 type family XStarTy          x
  632 type family XKindSig         x
  633 type family XSpliceTy        x
  634 type family XDocTy           x
  635 type family XBangTy          x
  636 type family XRecTy           x
  637 type family XExplicitListTy  x
  638 type family XExplicitTupleTy x
  639 type family XTyLit           x
  640 type family XWildCardTy      x
  641 type family XXType           x
  642 
  643 -- ---------------------------------------------------------------------
  644 -- HsForAllTelescope type families
  645 type family XHsForAllVis        x
  646 type family XHsForAllInvis      x
  647 type family XXHsForAllTelescope x
  648 
  649 -- ---------------------------------------------------------------------
  650 -- HsTyVarBndr type families
  651 type family XUserTyVar   x
  652 type family XKindedTyVar x
  653 type family XXTyVarBndr  x
  654 
  655 -- ---------------------------------------------------------------------
  656 -- ConDeclField type families
  657 type family XConDeclField  x
  658 type family XXConDeclField x
  659 
  660 -- ---------------------------------------------------------------------
  661 -- FieldOcc type families
  662 type family XCFieldOcc x
  663 type family XXFieldOcc x
  664 
  665 -- =====================================================================
  666 -- Type families for the HsImpExp type families
  667 
  668 -- -------------------------------------
  669 -- ImportDecl type families
  670 type family XCImportDecl       x
  671 type family XXImportDecl       x
  672 
  673 -- -------------------------------------
  674 -- IE type families
  675 type family XIEVar             x
  676 type family XIEThingAbs        x
  677 type family XIEThingAll        x
  678 type family XIEThingWith       x
  679 type family XIEModuleContents  x
  680 type family XIEGroup           x
  681 type family XIEDoc             x
  682 type family XIEDocNamed        x
  683 type family XXIE               x
  684 
  685 -- -------------------------------------
  686 
  687 -- =====================================================================
  688 -- Misc
  689 
  690 -- | See Note [NoGhcTc] in GHC.Hs.Extension. It has to be in this
  691 -- module because it is used like an extension point (in the data definitions
  692 -- of types that should be parameter-agnostic.
  693 type family NoGhcTc (p :: Type)
  694 
  695 -- =====================================================================
  696 -- End of Type family definitions
  697 -- =====================================================================
  698 
  699 
  700 
  701 -- =====================================================================
  702 -- Token information
  703 
  704 type LHsToken tok p = XRec p (HsToken tok)
  705 
  706 data HsToken (tok :: Symbol) = HsTok
  707 
  708 deriving instance KnownSymbol tok => Data (HsToken tok)
  709 
  710 type LHsUniToken tok utok p = XRec p (HsUniToken tok utok)
  711 
  712 -- With UnicodeSyntax, there might be multiple ways to write the same token.
  713 -- For example an arrow could be either "->" or "→". This choice must be
  714 -- recorded in order to exactprint such tokens,
  715 -- so instead of HsToken "->" we introduce HsUniToken "->" "→".
  716 --
  717 -- See also IsUnicodeSyntax in GHC.Parser.Annotation; we do not use here to
  718 -- avoid a dependency.
  719 data HsUniToken (tok :: Symbol) (utok :: Symbol) = HsNormalTok | HsUnicodeTok
  720 
  721 deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (HsUniToken tok utok)