circuit-notation 0.1.0.0 → 0.2.0.0

raw patch · 8 files changed

+204/−597 lines, 8 filesdep ~ghcnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +4/−0
• circuit-notation.cabal +64/−42
• example/Example.hs +0/−10
• src/Circuit.hs +0/−3
• src/CircuitNotation.hs +131/−319
• src/GHC/Types/Unique/Map.hs +0/−213
• src/GHC/Types/Unique/Map/Extra.hs +0/−10

@@ -0,0 +1,5 @@+# Revision history for `circuit-notations`++## 0.2.0.0 -- 2026-04-23++* Start of the changelog

@@ -0,0 +1,4 @@+# circuit-notation++This is a plugin for manipulating circuits in clash with arrow notation. See example/Example.hs for+example usage. Also see [clash-protocols](https://github.com/clash-lang/clash-protocols#).

@@ -1,51 +1,73 @@--- cabal-version: 2.2-name:                circuit-notation-version:             0.1.0.0-synopsis:            A source plugin for manipulating circuits in clash with a arrow notation--- description:-license:             BSD3-license-file:        LICENSE-author:              Christopher Chalmers-maintainer:          c.chalmers@me.com-copyright:           2024 Christopher Chalmers-category:            Hardware-build-type:          Simple-cabal-version:       >=1.10+cabal-version: 2.4+name: circuit-notation+version: 0.2.0.0+synopsis: Source plugin for manipulating circuits in Clash using arrow notation+description:+  Source plugin for manipulating circuits in Clash using arrow notation.+  See the GitHub README for usage and examples:+  <https://github.com/cchalmers/circuit-notation/blob/main/README.md> -library-  exposed-modules:     CircuitNotation Circuit+homepage: https://github.com/cchalmers/circuit-notation+bug-reports: https://github.com/cchalmers/circuit-notation/issues+license: BSD-3-Clause+license-file: LICENSE+author: Christopher Chalmers+maintainer: c.chalmers@me.com+copyright: 2024 Christopher Chalmers+category: Hardware+build-type: Simple+extra-doc-files:+  CHANGELOG.md+  README.md -  if impl(ghc < 9.2)-    other-modules:-      GHC.Types.Unique.Map+tested-with:+  ghc ==9.6.7+  ghc ==9.8.4+  ghc ==9.10.3+  ghc ==9.12.4 -  if impl(ghc < 9.10)+source-repository head+  type: git+  location: https://github.com/cchalmers/circuit-notation.git++library+  exposed-modules:+    Circuit+    CircuitNotation++  if impl(ghc <9.8)     other-modules:       GHC.Types.Unique.Map.Extra-   -- other-extensions:   build-depends:-      base >=4.12 && <5-    , clash-prelude >= 1.0-    , containers-    , data-default-    , ghc (>=8.6 && <8.8) || (>=8.10 && < 9.10)-    , lens-    , mtl-    , parsec-    , pretty-    , pretty-show-    , syb-    , template-haskell-    , unordered-containers-  hs-source-dirs:      src-  default-language:    Haskell2010-  ghc-options:         -Wall+    base >=4.12 && <5,+    clash-prelude >=1.0,+    containers,+    data-default,+    ghc >=9.6 && <9.13,+    lens,+    mtl,+    parsec,+    pretty,+    pretty-show,+    syb,+    template-haskell,+    unordered-containers, -Test-Suite library-testsuite+  hs-source-dirs: src   default-language: Haskell2010-  type:             exitcode-stdio-1.0-  main-is:          unittests.hs-  other-modules:    Example-  hs-source-dirs:   tests, example-  build-depends:    base, circuit-notation, clash-prelude >= 1.0+  ghc-options: -Wall++test-suite library-testsuite+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  main-is: unittests.hs+  other-modules: Example+  hs-source-dirs:+    tests+    example++  build-depends:+    base,+    circuit-notation,+    clash-prelude >=1.0,

@@ -11,17 +11,12 @@ -}  {-# LANGUAGE BlockArguments      #-}-{-# LANGUAGE CPP                 #-} {-# LANGUAGE DataKinds           #-} {-# LANGUAGE DeriveFunctor       #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies        #-} {-# LANGUAGE TypeOperators       #-} -#if __GLASGOW_HASKELL__ < 810-{-# LANGUAGE Arrows              #-}-#endif- {-# OPTIONS -fplugin=CircuitNotation #-} {-# OPTIONS -fplugin-opt=CircuitNotation:debug #-} {-# OPTIONS -Wall #-}@@ -41,11 +36,6 @@  idCircuit :: Circuit a a idCircuit = idC--#if __GLASGOW_HASKELL__ < 810-swapC0 :: Circuit (a,b) (b,a)-swapC0 = id $ circuit $ \ ~(a,b) -> ~(b,a)-#endif  swapC1 :: Circuit (a,b) (b,a) swapC1 = id $ circuit $ \ ~(a,b) -> (b,a)

@@ -10,7 +10,6 @@ This file contains the 'Circuit' type, that the notation describes. -} -{-# LANGUAGE CPP                    #-} {-# LANGUAGE DataKinds              #-} {-# LANGUAGE DeriveFunctor          #-} {-# LANGUAGE GADTs                  #-}@@ -28,7 +27,6 @@  import           Clash.Prelude -#if __GLASGOW_HASKELL__ > 900 -- | Unsafe version of ':>'. Will fail if applied to empty vectors. This is used to -- workaround spurious incomplete pattern match warnings generated in newer GHC -- versions.@@ -36,7 +34,6 @@ pattern (:>!) x xs <- (\ys -> (head ys, tail ys) -> (x,xs)) {-# COMPLETE (:>!) #-} infixr 5 :>!-#endif  type family Fwd a type family Bwd a

@@ -27,8 +27,6 @@ {-# LANGUAGE ViewPatterns               #-}  {-# OPTIONS_GHC -Wno-unused-top-binds #-}---- TODO: Fix warnings introduced by GHC 9.2 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}  module CircuitNotation@@ -44,10 +42,6 @@ import qualified Data.Data              as Data import           Data.Default import           Data.Maybe             (fromMaybe)-#if __GLASGOW_HASKELL__ >= 900-#else-import           SrcLoc hiding (noLoc)-#endif import           System.IO.Unsafe import           Data.Typeable @@ -55,29 +49,14 @@ import qualified Language.Haskell.TH    as TH import qualified GHC -#if __GLASGOW_HASKELL__ >= 902 import           GHC.Types.SourceError  (throwOneError) import qualified GHC.Driver.Env         as GHC import qualified GHC.Types.SourceText   as GHC import qualified GHC.Types.SourceError  as GHC import qualified GHC.Driver.Ppr         as GHC-#elif __GLASGOW_HASKELL__ >= 900-import           GHC.Driver.Types       (throwOneError)-import qualified GHC.Driver.Types       as GHC-#else-import           HscTypes               (throwOneError)-#endif -#if __GLASGOW_HASKELL__ == 900-import qualified GHC.Parser.Annotation     as GHC-#endif--#if __GLASGOW_HASKELL__ >= 900 import           GHC.Data.Bag import           GHC.Data.FastString       (mkFastString, unpackFS)-#if __GLASGOW_HASKELL__ < 906-import           GHC.Plugins               (PromotionFlag(NotPromoted))-#endif import           GHC.Types.SrcLoc          hiding (noLoc) import qualified GHC.Data.FastString       as GHC import qualified GHC.Driver.Plugins        as GHC@@ -88,50 +67,25 @@ import qualified GHC.Utils.Error           as Err import qualified GHC.Utils.Outputable      as GHC import qualified GHC.Utils.Outputable      as Outputable-#else-import           Bag-import qualified ErrUtils               as Err-import           FastString             (mkFastString, unpackFS)-import qualified GhcPlugins             as GHC-import qualified OccName-import qualified Outputable-#endif -#if __GLASGOW_HASKELL__ >= 904 import GHC.Driver.Errors.Ppr () -- instance Diagnostic GhcMessage  import qualified GHC.Driver.Config.Diagnostic as GHC import qualified GHC.Driver.Errors.Types      as GHC import qualified GHC.Utils.Logger             as GHC+#if __GLASGOW_HASKELL__ < 910 import qualified GHC.Parser.PostProcess       as GHC+#else+import GHC.Parser.PostProcess () -- instances #endif -#if __GLASGOW_HASKELL__ > 808 import qualified GHC.ThToHs             as Convert import           GHC.Hs-#if __GLASGOW_HASKELL__ >= 902   hiding (locA)-#endif-#else-import qualified Convert-import           HsSyn                  hiding (noExt)-import           HsExtension            (GhcPs, NoExt (..))-#endif -#if __GLASGOW_HASKELL__ <= 806-import           PrelNames              (eqTyCon_RDR)-#elif __GLASGOW_HASKELL__ <= 810-import           TysWiredIn             (eqTyCon_RDR)-import           BasicTypes             (PromotionFlag( NotPromoted ))-#else import           GHC.Builtin.Types      (eqTyCon_RDR)-#endif -#if __GLASGOW_HASKELL__ >= 902 import "ghc" GHC.Types.Unique.Map-#else-import GHC.Types.Unique.Map-#endif  #if __GLASGOW_HASKELL__ < 908 import GHC.Types.Unique.Map.Extra@@ -145,11 +99,8 @@ import           Control.Lens.Operators  -- mtl-import           Control.Monad.State--#if __GLASGOW_HASKELL__ >= 906 import           Control.Monad-#endif+import           Control.Monad.State  -- pretty-show -- import qualified Text.Show.Pretty       as SP@@ -188,90 +139,54 @@ imap f = zipWith f [0 ..]  -- Utils for backwards compat -------------------------------------------#if __GLASGOW_HASKELL__ < 902-type MsgDoc = Err.MsgDoc-type SrcSpanAnnA = SrcSpan-type SrcSpanAnnL = SrcSpan--noSrcSpanA :: SrcSpan-noSrcSpanA = noSrcSpan--noAnnSortKey :: NoExtField-noAnnSortKey = noExtField+#if __GLASGOW_HASKELL__ < 910+type MsgDoc = Outputable.SDoc -emptyComments :: NoExtField-emptyComments = noExtField+locA :: SrcAnn a -> SrcSpan+locA = GHC.locA -locA :: a -> a-locA = id+noAnnSortKey :: AnnSortKey+noAnnSortKey = NoAnnSortKey #else type MsgDoc = Outputable.SDoc -locA :: SrcSpanAnn' a -> SrcSpan+locA :: EpAnn a -> SrcSpan locA = GHC.locA -noAnnSortKey :: AnnSortKey+noAnnSortKey :: AnnSortKey a noAnnSortKey = NoAnnSortKey #endif -#if __GLASGOW_HASKELL__ < 902-type ErrMsg = Err.ErrMsg-#elif __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ < 904-type ErrMsg = Err.MsgEnvelope Err.DecoratedSDoc-#else type ErrMsg = Err.MsgEnvelope GHC.GhcMessage-#endif -#if __GLASGOW_HASKELL__ < 904-sevFatal :: Err.Severity-sevFatal = Err.SevFatal-#else sevFatal :: Err.MessageClass sevFatal = Err.MCFatal-#endif -#if __GLASGOW_HASKELL__ > 900+#if __GLASGOW_HASKELL__ >= 910+noExt :: NoAnn a => a+noExt = noAnn+#else noExt :: EpAnn ann noExt = EpAnnNotUsed-#elif __GLASGOW_HASKELL__ > 808-noExt :: NoExtField-noExt = noExtField-#else-noExt :: NoExt-noExt = NoExt--noExtField :: NoExt-noExtField = NoExt--type NoExtField = NoExt #endif -#if __GLASGOW_HASKELL__ < 904+#if __GLASGOW_HASKELL__ < 910 pattern HsParP :: LHsExpr p -> HsExpr p-pattern HsParP e <- HsPar _ e+pattern HsParP e <- HsPar _ _ e _  pattern ParPatP :: LPat p -> Pat p-pattern ParPatP p <- ParPat _ p+pattern ParPatP p <- ParPat _ _ p _ #else pattern HsParP :: LHsExpr p -> HsExpr p-pattern HsParP e <- HsPar _ _ e _+pattern HsParP e <- HsPar _ e  pattern ParPatP :: LPat p -> Pat p-pattern ParPatP p <- ParPat _ _ p _+pattern ParPatP p <- ParPat _ p #endif -#if __GLASGOW_HASKELL__ < 906-type PrintUnqualified = Outputable.PrintUnqualified-#else type PrintUnqualified = Outputable.NamePprCtx-#endif  mkErrMsg :: GHC.DynFlags -> SrcSpan -> PrintUnqualified -> Outputable.SDoc -> ErrMsg-#if __GLASGOW_HASKELL__ < 902-mkErrMsg = Err.mkErrMsg-#elif __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ < 904-mkErrMsg _ = Err.mkMsgEnvelope-#else -- Check the documentation of -- `GHC.Driver.Errors.Types.ghcUnkownMessage` for some background on -- why plugins should use this generic message constructor.@@ -279,19 +194,12 @@     Err.mkErrorMsgEnvelope locn unqual   . GHC.ghcUnknownMessage   . Err.mkPlainError Err.noHints-#endif  mkLongErrMsg :: GHC.DynFlags -> SrcSpan -> PrintUnqualified -> Outputable.SDoc -> Outputable.SDoc -> ErrMsg-#if __GLASGOW_HASKELL__ < 902-mkLongErrMsg = Err.mkLongErrMsg-#elif __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ < 904-mkLongErrMsg _ = Err.mkLongMsgEnvelope-#else mkLongErrMsg _ locn unqual msg extra =     Err.mkErrorMsgEnvelope locn unqual   $ GHC.ghcUnknownMessage   $ Err.mkDecoratedError Err.noHints [msg, extra]-#endif  -- Types --------------------------------------------------------------- @@ -389,24 +297,11 @@         }   (a, s) <- runStateT m emptyCircuitState   let errs = _cErrors s-#if __GLASGOW_HASKELL__ < 904-  unless (isEmptyBag errs) $ liftIO . throwIO $ GHC.mkSrcErr errs-#else   unless (isEmptyBag errs) $ liftIO . throwIO $ GHC.mkSrcErr $ Err.mkMessages errs-#endif   pure a -#if __GLASGOW_HASKELL__ < 904-mkLocMessage :: Err.Severity -> SrcSpan -> Outputable.SDoc -> Outputable.SDoc-#else mkLocMessage :: Err.MessageClass -> SrcSpan -> Outputable.SDoc -> Outputable.SDoc-#endif--#if __GLASGOW_HASKELL__ < 906-mkLocMessage = Err.mkLocMessageAnn Nothing-#else mkLocMessage = Err.mkLocMessage-#endif  errM :: SrcSpan -> String -> CircuitM () errM loc msg = do@@ -419,26 +314,21 @@ -- It's very possible that most of these are already in the ghc library in some form. It's not the -- easiest library to discover these kind of functions. -#if __GLASGOW_HASKELL__ >= 902 conPatIn :: GenLocated SrcSpanAnnN GHC.RdrName -> HsConPatDetails GhcPs -> Pat GhcPs-#else-conPatIn :: Located GHC.RdrName -> HsConPatDetails GhcPs -> Pat GhcPs-#endif-#if __GLASGOW_HASKELL__ >= 900 conPatIn loc con = ConPat noExt loc con-#else-conPatIn loc con = ConPatIn loc con-#endif -#if __GLASGOW_HASKELL__ >= 902+#if __GLASGOW_HASKELL__ >= 910+noEpAnn :: NoAnn ann => GenLocated SrcSpan e -> GenLocated (EpAnn ann) e+noEpAnn (L l e) = L (EpAnn (spanAsAnchor l) noAnn emptyComments) e++noLoc :: NoAnn ann => e -> GenLocated (EpAnn ann) e+noLoc = noEpAnn . GHC.noLoc+#else noEpAnn :: GenLocated SrcSpan e -> GenLocated (SrcAnn ann) e-noEpAnn (L l e) = L (SrcSpanAnn EpAnnNotUsed l) e+noEpAnn (L l e) = L (SrcSpanAnn noExt l) e  noLoc :: e -> GenLocated (SrcAnn ann) e noLoc = noEpAnn . GHC.noLoc-#else-noLoc :: e -> Located e-noLoc = GHC.noLoc #endif  tupP :: p ~ GhcPs => [LPat p] -> LPat p@@ -448,23 +338,20 @@ vecP :: (?nms :: ExternalNames) => SrcSpanAnnA -> [LPat GhcPs] -> LPat GhcPs vecP srcLoc = \case   [] -> go []-#if __GLASGOW_HASKELL__ < 904-  as -> L srcLoc $ ParPat noExt $ go as-  where-#else+#if __GLASGOW_HASKELL__ < 910   as -> L srcLoc $ ParPat noExt pL (go as) pR   where   pL = L (GHC.mkTokenLocation $ locA srcLoc) HsTok   pR = L (GHC.mkTokenLocation $ locA srcLoc) HsTok+#else+  as -> L srcLoc $ ParPat (pL,pR) (go as)+  where+  pL = EpTok $ spanAsAnchor $ locA srcLoc+  pR = EpTok $ spanAsAnchor $ locA srcLoc #endif   go :: [LPat GhcPs] -> LPat GhcPs   go (p@(L l0 _):pats) =-    let-#if __GLASGOW_HASKELL__ >= 902-      l1 = l0 `seq` noSrcSpanA-#else-      l1 = l0-#endif+    let l1 = l0 `seq` noSrcSpanA     in       L srcLoc $ conPatIn (L l1 (consPat ?nms)) (InfixCon p (go pats))   go [] = L srcLoc $ WildPat noExtField@@ -476,11 +363,7 @@ tildeP loc lpat = L loc (LazyPat noExt lpat)  hsBoxedTuple :: GHC.HsTupleSort-#if __GLASGOW_HASKELL__ >= 902 hsBoxedTuple = HsBoxedOrConstraintTuple-#else-hsBoxedTuple = HsBoxedTuple-#endif  tupT :: [LHsType GhcPs] -> LHsType GhcPs tupT [ty] = ty@@ -497,19 +380,28 @@ appTy a b = noLoc (HsAppTy noExtField a (parenthesizeHsType GHC.appPrec b))  appE :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs-appE fun arg = L noSrcSpanA $ HsApp noExt fun (parenthesizeHsExpr GHC.appPrec arg)+appE fun arg = L noSrcSpanA $ HsApp+#if __GLASGOW_HASKELL__ >= 910+  noExtField+#else+  noAnn+#endif+  fun (parenthesizeHsExpr GHC.appPrec arg)  varE :: SrcSpanAnnA -> GHC.RdrName -> LHsExpr GhcPs varE loc rdr = L loc (HsVar noExtField (noLoc rdr))  parenE :: LHsExpr GhcPs -> LHsExpr GhcPs-#if __GLASGOW_HASKELL__ < 904-parenE e@(L l _) = L l (HsPar noExt e)-#else+#if __GLASGOW_HASKELL__ < 910 parenE e@(L l _) = L l (HsPar noExt pL e pR)   where   pL = L (GHC.mkTokenLocation $ locA l) HsTok   pR = L (GHC.mkTokenLocation $ locA l) HsTok+#else+parenE e@(L l _) = L l (HsPar (pL,pR) e)+  where+  pL = EpTok $ spanAsAnchor $ locA l+  pR = EpTok $ spanAsAnchor $ locA l #endif  var :: String -> GHC.RdrName@@ -526,18 +418,26 @@   [] -> go srcLoc []   as -> parenE $ go srcLoc as   where-  go loc (e@(L l _):es) = L loc $ OpApp noExt e (varE l (thName '(:>))) (go loc es)+  go loc (e@(L l _):es) = L loc $ OpApp+#if __GLASGOW_HASKELL__ >= 912+    noExtField+#else+    noExt+#endif+    e (varE l (thName '(:>))) (go loc es)   go loc [] = varE loc (thName 'Nil)  tupE :: p ~ GhcPs => SrcSpanAnnA -> [LHsExpr p] -> LHsExpr p tupE _ [ele] = ele tupE loc elems = L loc $ ExplicitTuple noExt tupArgs GHC.Boxed   where-#if __GLASGOW_HASKELL__ >= 902-    tupArgs = map (Present noExt) elems+    tupArgs = map+#if __GLASGOW_HASKELL__ >= 910+      (Present noExtField) #else-    tupArgs = map (\arg@(L l _) -> L l (Present noExt arg)) elems+      (Present noAnn) #endif+      elems  unL :: Located a -> a unL (L _ a) = a@@ -551,13 +451,7 @@  -- | Generate a "unique" name by appending the location as a string. genLocName :: SrcSpanAnnA -> String -> String-#if __GLASGOW_HASKELL__ >= 902 genLocName (locA -> GHC.RealSrcSpan rss _) prefix =-#elif __GLASGOW_HASKELL__ >= 900-genLocName (GHC.RealSrcSpan rss _) prefix =-#else-genLocName (GHC.RealSrcSpan rss) prefix =-#endif   prefix <> "_" <>     foldMap (\f -> show (f rss)) [srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol] genLocName _ prefix = prefix@@ -565,12 +459,16 @@ -- | Extract a simple lambda into inputs and body. simpleLambda :: HsExpr GhcPs -> Maybe ([LPat GhcPs], LHsExpr GhcPs) simpleLambda expr = do-#if __GLASGOW_HASKELL__ < 906-  HsLam _ (MG _x alts _origin) <- Just expr-#else+#if __GLASGOW_HASKELL__ < 910   HsLam _ (MG _x alts) <- Just expr+#else+  HsLam _ _ (MG _x alts) <- Just expr #endif+#if __GLASGOW_HASKELL__ >= 912+  L _ [L _ (Match _matchX _matchContext (L _ matchPats) matchGr)] <- Just alts+#else   L _ [L _ (Match _matchX _matchContext matchPats matchGr)] <- Just alts+#endif   GRHSs _grX grHss _grLocalBinds <- Just matchGr   [L _ (GRHS _ _ body)] <- Just grHss   Just (matchPats, body)@@ -588,65 +486,76 @@   -- ^ final `in` expressions   -> LHsExpr p letE loc sigs binds expr =-#if __GLASGOW_HASKELL__ < 904-    L loc (HsLet noExt localBinds expr)-#else+#if __GLASGOW_HASKELL__ < 908     L loc (HsLet noExt tkLet localBinds tkIn expr)+#elif __GLASGOW_HASKELL__ < 910+    L loc (HsLet noExt tkLet localBinds tkIn expr)+#else+    L loc (HsLet (tkLet,tkIn) localBinds expr) #endif   where-#if __GLASGOW_HASKELL__ >= 902     localBinds :: HsLocalBinds GhcPs     localBinds = HsValBinds noExt valBinds-#else-    localBinds :: LHsLocalBindsLR GhcPs GhcPs-    localBinds = L loc $ HsValBinds noExt valBinds-#endif -#if __GLASGOW_HASKELL__ >= 904+#if __GLASGOW_HASKELL__ >= 910+    tkLet = EpTok $ spanAsAnchor $ locA loc+    tkIn  = EpTok $ spanAsAnchor $ locA loc+#else     tkLet = L (GHC.mkTokenLocation $ locA loc) HsTok-    tkIn = L (GHC.mkTokenLocation $ locA loc) HsTok+    tkIn  = L (GHC.mkTokenLocation $ locA loc) HsTok #endif      valBinds :: HsValBindsLR GhcPs GhcPs     valBinds = ValBinds noAnnSortKey hsBinds sigs      hsBinds :: LHsBindsLR GhcPs GhcPs+#if __GLASGOW_HASKELL__ >= 912+    hsBinds = binds+#else     hsBinds = listToBag binds+#endif  -- | Simple construction of a lambda expression lamE :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs-lamE pats expr = noLoc $ HsLam noExtField mg+lamE pats expr =+#if __GLASGOW_HASKELL__ >= 910+    noLoc $ HsLam noExt LamSingle mg+#else+    noLoc $ HsLam noExtField mg+#endif   where     mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))-#if __GLASGOW_HASKELL__ < 906-    mg = MG noExtField matches GHC.Generated-#elif __GLASGOW_HASKELL__ < 908+#if __GLASGOW_HASKELL__ < 908     mg = MG GHC.Generated matches-#else+#elif __GLASGOW_HASKELL__ < 910     mg = MG (GHC.Generated GHC.DoPmc) matches+#else+    mg = MG (GHC.Generated GHC.OtherExpansion GHC.DoPmc) matches #endif +#if __GLASGOW_HASKELL__ >= 912+    matches :: XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]+    matches = noLoc [singleMatch]+#else     matches :: GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]     matches = noLoc $ [singleMatch]+#endif      singleMatch :: GenLocated SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))+#if __GLASGOW_HASKELL__ >= 912+    singleMatch = noLoc $ Match noExtField (LamAlt LamSingle) (L (EpaSpan noSrcSpan) pats) grHss+#elif __GLASGOW_HASKELL__ >= 910+    singleMatch = noLoc $ Match noExt (LamAlt LamSingle) pats grHss+#else     singleMatch = noLoc $ Match noExt LambdaExpr pats grHss+#endif      grHss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))     grHss = GRHSs emptyComments [grHs] $-#if __GLASGOW_HASKELL__ >= 902       (EmptyLocalBinds noExtField)-#else-      (noLoc (EmptyLocalBinds noExtField))-#endif -#if __GLASGOW_HASKELL__ < 904-    grHs :: GenLocated SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))-    grHs = L noSrcSpan $ GRHS noExt [] expr-#else     grHs :: LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))     grHs =  L noSrcSpanA $ GRHS noExt [] expr-#endif  -- | Kinda hacky function to get a string name for named ports. fromRdrName :: GHC.RdrName -> GHC.FastString@@ -690,15 +599,10 @@         case bod of           -- special case for idC as the final statement, gives better type inferences and generates nicer           -- code-#if __GLASGOW_HASKELL__ < 810-          L _ (HsArrApp _xapp (L _ (HsVar _ (L _ (GHC.Unqual occ)))) arg _ _)-            | OccName.occNameString occ == "idC" -> circuitMasters .= bindMaster arg-#else           L _ (OpApp _ (L _ (HsVar _ (L _ (GHC.Unqual occ)))) (L _ op) port)             | isFletching op             , OccName.occNameString occ == "idC" -> do                 circuitMasters .= bindMaster port-#endif            -- Otherwise create a binding and use that as the master. This is equivalent to changing           --   c -< x@@ -722,24 +626,20 @@   :: GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LHsExpr GhcPs))   -> CircuitM () handleStmtM (L loc stmt) = case stmt of-#if __GLASGOW_HASKELL__ >= 902   LetStmt _xlet letBind ->-#else-  LetStmt _xlet (L _ letBind) ->-#endif     -- a regular let bindings     case letBind of       HsValBinds _ (ValBinds _ valBinds sigs) -> do+#if __GLASGOW_HASKELL__ >= 912+        circuitLets <>= valBinds+#else         circuitLets <>= bagToList valBinds+#endif         circuitTypes <>= sigs       _ -> errM (locA loc) ("Unhandled let statement" <> show (Data.toConstr letBind))   BodyStmt _xbody body _idr _idr' ->     bodyBinding Nothing body-#if __GLASGOW_HASKELL__ >= 900   BindStmt _ bind body ->-#else-  BindStmt _xbody bind body _idr _idr' ->-#endif     bodyBinding (Just $ bindSlave bind) body   _ -> errM (locA loc) "Unhandled stmt" @@ -749,29 +649,13 @@   VarPat _ (L _ rdrName) -> Ref (PortName loc (fromRdrName rdrName))   TuplePat _ lpat _ -> Tuple $ fmap bindSlave lpat   ParPatP lpat -> bindSlave lpat-#if __GLASGOW_HASKELL__ >= 902   ConPat _ (L _ (GHC.Unqual occ)) (PrefixCon [] [lpat])-#elif __GLASGOW_HASKELL__ >= 900-  ConPat _ (L _ (GHC.Unqual occ)) (PrefixCon [lpat])-#else-  ConPatIn (L _ (GHC.Unqual occ)) (PrefixCon [lpat])-#endif     | OccName.occNameString occ `elem` fwdNames -> FwdPat lpat   -- empty list is done as the constructor-#if __GLASGOW_HASKELL__ >= 900   ConPat _ (L _ rdr) _-#else-  ConPatIn (L _ rdr) _-#endif     | rdr == thName '[] -> Vec loc []     | rdr == thName '() -> Tuple []-#if __GLASGOW_HASKELL__ < 810-  SigPat ty port -> PortType (hsSigWcType ty) (bindSlave port)-#elif __GLASGOW_HASKELL__ < 900-  SigPat _ port ty -> PortType (hsSigWcType ty) (bindSlave port)-#else   SigPat _ port ty -> PortType (hsps_body ty) (bindSlave port)-#endif   LazyPat _ lpat -> Lazy loc (bindSlave lpat)   ListPat _ pats -> Vec loc (map bindSlave pats)   pat ->@@ -792,29 +676,14 @@   HsApp _xapp (L _ (HsVar _ (L _ (GHC.Unqual occ)))) sig     | OccName.occNameString occ `elem` fwdNames -> FwdExpr sig   ExplicitTuple _ tups _ -> let-#if __GLASGOW_HASKELL__ >= 902     vals = fmap (\(Present _ e) -> e) tups-#else-    vals = fmap (\(L _ (Present _ e)) -> e) tups-#endif     in Tuple $ fmap bindMaster vals-#if __GLASGOW_HASKELL__ >= 902   ExplicitList _ exprs ->-#else-  ExplicitList _ _syntaxExpr exprs ->-#endif     Vec loc $ fmap bindMaster exprs-#if __GLASGOW_HASKELL__ < 810-  HsArrApp _xapp (L _ (HsVar _ (L _ (GHC.Unqual occ)))) sig _ _-    | OccName.occNameString occ `elem` fwdNames -> FwdExpr sig-  ExprWithTySig ty expr' -> PortType (hsSigWcType ty) (bindMaster expr')-  ELazyPat _ expr' -> Lazy loc (bindMaster expr')-#else   -- XXX: Untested?   HsProc _ _ (L _ (HsCmdTop _ (L _ (HsCmdArrApp _xapp (L _ (HsVar _ (L _ (GHC.Unqual occ)))) sig _ _))))     | OccName.occNameString occ `elem` fwdNames -> FwdExpr sig   ExprWithTySig _ expr' ty -> PortType (hsSigWcType ty) (bindMaster expr')-#endif    HsParP expr' -> bindMaster expr' @@ -836,21 +705,12 @@   -> CircuitM () bodyBinding mInput lexpr@(L loc expr) = do   case expr of-#if __GLASGOW_HASKELL__ < 810-    HsArrApp _xhsArrApp circuit port HsFirstOrderApp True ->-      circuitBinds <>= [Binding-        { bCircuit = circuit-        , bOut     = bindMaster port-        , bIn      = fromMaybe (Tuple []) mInput-        }]-#else     OpApp _ circuit (L _ op) port | isFletching op -> do       circuitBinds <>= [Binding         { bCircuit = circuit         , bOut     = bindMaster port         , bIn      = fromMaybe (Tuple []) mInput         }]-#endif      _ -> case mInput of       Nothing -> errM (locA loc) "standalone expressions are not allowed (are Arrows enabled?)"@@ -924,12 +784,8 @@   PortErr loc msgdoc -> unsafePerformIO . throwOneError $     mkLongErrMsg dflags (locA loc) Outputable.alwaysQualify (Outputable.text "Unhandled bind") msgdoc   Lazy loc p -> tildeP loc $ bindWithSuffix dflags dir p-#if __GLASGOW_HASKELL__ >= 902   -- XXX: propagate location   FwdExpr (L _ _) -> nlWildPat-#else-  FwdExpr (L l _) -> L l (WildPat noExt)-#endif   FwdPat lpat -> tagP lpat   PortType ty p -> tagTypeP dir ty $ bindWithSuffix dflags dir p @@ -975,7 +831,13 @@   -> PortDescription PortName   -- ^ master ports   -> LHsExpr p-createInputs dir slaves masters = noLoc $ OpApp noExt s2m (varE noSrcSpanA (fwdBwdCon ?nms)) m2s+createInputs dir slaves masters = noLoc $ OpApp+#if __GLASGOW_HASKELL__ >= 912+  noExtField+#else+  noExt+#endif+  s2m (varE noSrcSpanA (fwdBwdCon ?nms)) m2s   where   m2s = expWithSuffix (revDirec dir) masters   s2m = expWithSuffix dir slaves@@ -988,26 +850,19 @@    in patBind bindPat bod  patBind :: LPat GhcPs -> LHsExpr GhcPs -> HsBind GhcPs-patBind lhs expr = PatBind noExt lhs rhs-#if __GLASGOW_HASKELL__ < 906-   ([], [])+patBind lhs expr =+#if __GLASGOW_HASKELL__ < 910+  PatBind noExt lhs rhs+#else+  PatBind noExtField lhs (HsNoMultAnn noExtField) rhs #endif   where     rhs :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))     rhs = GRHSs emptyComments [gr] $-#if __GLASGOW_HASKELL__ >= 902       EmptyLocalBinds noExtField-#else-      noLoc (EmptyLocalBinds noExtField)-#endif -#if __GLASGOW_HASKELL__ < 904-    gr :: GenLocated SrcSpan (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))-    gr  = L (locA (getLoc expr)) (GRHS noExt [] expr)-#else     gr :: LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))     gr =  L (noAnnSrcSpan (getLocA expr)) (GRHS noExt [] expr)-#endif  circuitConstructor :: (?nms :: ExternalNames) => SrcSpanAnnA -> LHsExpr GhcPs circuitConstructor loc = varE loc (circuitCon ?nms)@@ -1016,13 +871,8 @@ runCircuitFun loc = varE loc (runCircuitName ?nms)  -#if __GLASGOW_HASKELL__ < 902-prefixCon :: [arg] -> HsConDetails arg rec-prefixCon a = PrefixCon a-#else prefixCon :: [arg] -> HsConDetails tyarg arg rec prefixCon a = PrefixCon [] a-#endif  taggedBundleP :: (p ~ GhcPs, ?nms :: ExternalNames) => LPat p -> LPat p taggedBundleP a = noLoc (conPatIn (noLoc (tagBundlePat ?nms)) (prefixCon [a]))@@ -1037,27 +887,16 @@ tagE a = varE noSrcSpanA (tagName ?nms) `appE` a  tagTypeCon :: (p ~ GhcPs, ?nms :: ExternalNames) => LHsType GhcPs-tagTypeCon = noLoc (HsTyVar noExt NotPromoted (noLoc (tagTName ?nms)))+tagTypeCon =+    noLoc (HsTyVar noExt NotPromoted (noLoc (tagTName ?nms)))  sigPat :: (p ~ GhcPs) => SrcSpanAnnA -> LHsType GhcPs -> LPat p -> LPat p sigPat loc ty a = L loc $-#if __GLASGOW_HASKELL__ < 810-    SigPat (HsWC noExt (HsIB noExt ty)) a-#elif __GLASGOW_HASKELL__ < 900-    SigPat noExt a (HsWC noExt (HsIB noExt ty))-#else     SigPat noExt a (HsPS noExt ty)-#endif  sigE :: (?nms :: ExternalNames) => SrcSpanAnnA -> LHsType GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs sigE loc ty a = L loc $-#if __GLASGOW_HASKELL__ < 810-    ExprWithTySig (HsWC noExt (HsIB noExt ty)) a-#elif __GLASGOW_HASKELL__ < 902-    ExprWithTySig noExt a (HsWC noExt (HsIB noExt ty))-#else     ExprWithTySig noExt a (HsWC noExtField (L loc $ HsSig noExtField (HsOuterImplicit noExtField) ty))-#endif  tagTypeP :: (p ~ GhcPs, ?nms :: ExternalNames) => Direction -> LHsType GhcPs -> LPat p -> LPat p tagTypeP dir ty@@ -1087,11 +926,10 @@  hsFunTy :: (p ~ GhcPs) => LHsType p -> LHsType p -> HsType p hsFunTy =-  HsFunTy noExt-#if __GLASGOW_HASKELL__ >= 900 && __GLASGOW_HASKELL__ < 904-    (HsUnrestrictedArrow GHC.NormalSyntax)-#elif __GLASGOW_HASKELL__ >= 904-    (HsUnrestrictedArrow $ L NoTokenLoc HsNormalTok)+#if __GLASGOW_HASKELL__ >= 910+    HsFunTy noExtField (HsUnrestrictedArrow noAnn)+#else+    HsFunTy noExt (HsUnrestrictedArrow $ L NoTokenLoc HsNormalTok) #endif  arrTy :: p ~ GhcPs => LHsType p -> LHsType p -> LHsType p@@ -1118,13 +956,14 @@  tyEq :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs tyEq a b =-#if __GLASGOW_HASKELL__ < 904-  noLoc $ HsOpTy noExtField a (noLoc eqTyCon_RDR) b+  noLoc $ HsOpTy+#if __GLASGOW_HASKELL__ >= 912+    noExtField #else-  noLoc $ HsOpTy noAnn NotPromoted a (noLoc eqTyCon_RDR) b+    noExt #endif--- eqTyCon is a special name that has to be exactly correct for ghc to recognise it. In 8.6 this--- lives in PrelNames and is called eqTyCon_RDR, in later ghcs it's from TysWiredIn.+    NotPromoted a (noLoc eqTyCon_RDR) b+-- eqTyCon is a special name that has to be exactly correct for ghc to recognise it.  -- Final construction -------------------------------------------------- @@ -1192,13 +1031,8 @@ transform     :: (?nms :: ExternalNames)     => Bool-#if __GLASGOW_HASKELL__ >= 900 && __GLASGOW_HASKELL__ < 906-    -> GHC.Located HsModule-    -> GHC.Hsc (GHC.Located HsModule)-#else     -> GHC.Located (HsModule GhcPs)     -> GHC.Hsc (GHC.Located (HsModule GhcPs))-#endif transform debug = SYB.everywhereM (SYB.mkM transform') where   transform' :: LHsExpr GhcPs -> GHC.Hsc (LHsExpr GhcPs) @@ -1252,30 +1086,17 @@ warningMsg :: Outputable.SDoc -> GHC.Hsc () warningMsg sdoc = do   dflags <- GHC.getDynFlags-#if __GLASGOW_HASKELL__ < 902-  liftIO $ Err.warningMsg dflags sdoc-#elif __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ < 904   logger <- GHC.getLogger-  liftIO $ Err.warningMsg logger dflags sdoc-#else-  logger <- GHC.getLogger   let     diagOpts = GHC.initDiagOpts dflags     mc = Err.mkMCDiagnostic diagOpts GHC.WarningWithoutFlag-#if __GLASGOW_HASKELL__ >= 906            Nothing-#endif   liftIO $ GHC.logMsg logger mc noSrcSpan sdoc-#endif  -- | The actual implementation. pluginImpl ::   (?nms :: ExternalNames) => [GHC.CommandLineOption] -> GHC.ModSummary ->-#if __GLASGOW_HASKELL__ < 904-  GHC.HsParsedModule -> GHC.Hsc GHC.HsParsedModule-#else   GHC.ParsedResult -> GHC.Hsc GHC.ParsedResult-#endif pluginImpl cliOptions _modSummary m = do     -- cli options are activated by -fplugin-opt=CircuitNotation:debug     debug <- case cliOptions of@@ -1285,15 +1106,10 @@         warningMsg $ Outputable.text $ "CircuitNotation: unknown cli options " <> show cliOptions         pure False     hpm_module' <- do-#if __GLASGOW_HASKELL__ < 904-      transform debug (GHC.hpm_module m)-    let module' = m { GHC.hpm_module = hpm_module' }-#else       transform debug $ GHC.hpm_module $ GHC.parsedResultModule m     let parsedResultModule' = (GHC.parsedResultModule m)                                 { GHC.hpm_module = hpm_module' }         module' = m { GHC.parsedResultModule = parsedResultModule' }-#endif     return module'  -- Debugging functions -------------------------------------------------@@ -1336,9 +1152,5 @@       Fwd -> GHC.Unqual (OccName.mkTcOcc "Fwd")       Bwd -> GHC.Unqual (OccName.mkTcOcc "Bwd")   , trivialBwd = GHC.Unqual (OccName.mkVarOcc "unitBwd")-#if __GLASGOW_HASKELL__ > 900   , consPat = GHC.Unqual (OccName.mkDataOcc ":>!")-#else-  , consPat = GHC.Unqual (OccName.mkDataOcc ":>")-#endif   }

@@ -1,213 +0,0 @@-{-# LANGUAGE RoleAnnotations #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -Wall #-}---- Like 'UniqFM', these are maps for keys which are Uniquable.--- Unlike 'UniqFM', these maps also remember their keys, which--- makes them a much better drop in replacement for 'Data.Map.Map'.------ Key preservation is right-biased.-module GHC.Types.Unique.Map (-    UniqMap(..),-    emptyUniqMap,-    isNullUniqMap,-    unitUniqMap,-    listToUniqMap,-    listToUniqMap_C,-    addToUniqMap,-    addListToUniqMap,-    addToUniqMap_C,-    addToUniqMap_Acc,-    alterUniqMap,-    addListToUniqMap_C,-    adjustUniqMap,-    delFromUniqMap,-    delListFromUniqMap,-    plusUniqMap,-    plusUniqMap_C,-    plusMaybeUniqMap_C,-    plusUniqMapList,-    minusUniqMap,-    intersectUniqMap,-    disjointUniqMap,-    mapUniqMap,-    filterUniqMap,-    partitionUniqMap,-    sizeUniqMap,-    elemUniqMap,-    lookupUniqMap,-    lookupWithDefaultUniqMap,-    anyUniqMap,-    allUniqMap-) where--#if __GLASGOW_HASKELL__ < 900-import Unique-import UniqFM-import Outputable-#else-import GHC.Types.Unique.FM-import GHC.Types.Unique-import GHC.Utils.Outputable-#endif--import Data.Semigroup as Semi ( Semigroup(..) )-import Data.Coerce-import Data.Maybe-import Data.Data---- | Maps indexed by 'Uniquable' keys-#if __GLASGOW_HASKELL__ < 900-newtype UniqMap k a = UniqMap (UniqFM (k, a))-#else-newtype UniqMap k a = UniqMap (UniqFM k (k, a))-#endif-    deriving (Data, Eq, Functor)-type role UniqMap nominal representational--instance Semigroup (UniqMap k a) where-  (<>) = plusUniqMap--instance Monoid (UniqMap k a) where-    mempty = emptyUniqMap-    mappend = (Semi.<>)--instance (Outputable k, Outputable a) => Outputable (UniqMap k a) where-    ppr (UniqMap m) =-        brackets $ fsep $ punctuate comma $-        [ ppr k <+> text "->" <+> ppr v-        | (k, v) <- eltsUFM m ]--liftC :: (a -> a -> a) -> (k, a) -> (k, a) -> (k, a)-liftC f (_, v) (k', v') = (k', f v v')--emptyUniqMap :: UniqMap k a-emptyUniqMap = UniqMap emptyUFM--isNullUniqMap :: UniqMap k a -> Bool-isNullUniqMap (UniqMap m) = isNullUFM m--unitUniqMap :: Uniquable k => k -> a -> UniqMap k a-unitUniqMap k v = UniqMap (unitUFM k (k, v))--listToUniqMap :: Uniquable k => [(k,a)] -> UniqMap k a-listToUniqMap kvs = UniqMap (listToUFM [ (k,(k,v)) | (k,v) <- kvs])--listToUniqMap_C :: Uniquable k => (a -> a -> a) -> [(k,a)] -> UniqMap k a-listToUniqMap_C f kvs = UniqMap $-    listToUFM_C (liftC f) [ (k,(k,v)) | (k,v) <- kvs]--addToUniqMap :: Uniquable k => UniqMap k a -> k -> a -> UniqMap k a-addToUniqMap (UniqMap m) k v = UniqMap $ addToUFM m k (k, v)--addListToUniqMap :: Uniquable k => UniqMap k a -> [(k,a)] -> UniqMap k a-addListToUniqMap (UniqMap m) kvs = UniqMap $-    addListToUFM m [(k,(k,v)) | (k,v) <- kvs]--addToUniqMap_C :: Uniquable k-               => (a -> a -> a)-               -> UniqMap k a-               -> k-               -> a-               -> UniqMap k a-addToUniqMap_C f (UniqMap m) k v = UniqMap $-    addToUFM_C (liftC f) m k (k, v)--addToUniqMap_Acc :: Uniquable k-                 => (b -> a -> a)-                 -> (b -> a)-                 -> UniqMap k a-                 -> k-                 -> b-                 -> UniqMap k a-addToUniqMap_Acc exi new (UniqMap m) k0 v0 = UniqMap $-    addToUFM_Acc (\b (k, v) -> (k, exi b v))-                 (\b -> (k0, new b))-                 m k0 v0--alterUniqMap :: Uniquable k-             => (Maybe a -> Maybe a)-             -> UniqMap k a-             -> k-             -> UniqMap k a-alterUniqMap f (UniqMap m) k = UniqMap $-    alterUFM (fmap (k,) . f . fmap snd) m k--addListToUniqMap_C-    :: Uniquable k-    => (a -> a -> a)-    -> UniqMap k a-    -> [(k, a)]-    -> UniqMap k a-addListToUniqMap_C f (UniqMap m) kvs = UniqMap $-    addListToUFM_C (liftC f) m-        [(k,(k,v)) | (k,v) <- kvs]--adjustUniqMap-    :: Uniquable k-    => (a -> a)-    -> UniqMap k a-    -> k-    -> UniqMap k a-adjustUniqMap f (UniqMap m) k = UniqMap $-    adjustUFM (\(_,v) -> (k,f v)) m k--delFromUniqMap :: Uniquable k => UniqMap k a -> k -> UniqMap k a-delFromUniqMap (UniqMap m) k = UniqMap $ delFromUFM m k--delListFromUniqMap :: Uniquable k => UniqMap k a -> [k] -> UniqMap k a-delListFromUniqMap (UniqMap m) ks = UniqMap $ delListFromUFM m ks--plusUniqMap :: UniqMap k a -> UniqMap k a -> UniqMap k a-plusUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ plusUFM m1 m2--plusUniqMap_C :: (a -> a -> a) -> UniqMap k a -> UniqMap k a -> UniqMap k a-plusUniqMap_C f (UniqMap m1) (UniqMap m2) = UniqMap $-    plusUFM_C (liftC f) m1 m2--plusMaybeUniqMap_C :: (a -> a -> Maybe a) -> UniqMap k a -> UniqMap k a -> UniqMap k a-plusMaybeUniqMap_C f (UniqMap m1) (UniqMap m2) = UniqMap $-    plusMaybeUFM_C (\(_, v) (k', v') -> fmap (k',) (f v v')) m1 m2--plusUniqMapList :: [UniqMap k a] -> UniqMap k a-plusUniqMapList xs = UniqMap $ plusUFMList (coerce xs)--minusUniqMap :: UniqMap k a -> UniqMap k b -> UniqMap k a-minusUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ minusUFM m1 m2--intersectUniqMap :: UniqMap k a -> UniqMap k b -> UniqMap k a-intersectUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ intersectUFM m1 m2--disjointUniqMap :: UniqMap k a -> UniqMap k b -> Bool-disjointUniqMap (UniqMap m1) (UniqMap m2) = disjointUFM m1 m2--mapUniqMap :: (a -> b) -> UniqMap k a -> UniqMap k b-mapUniqMap f (UniqMap m) = UniqMap $ mapUFM (fmap f) m -- (,) k instance--filterUniqMap :: (a -> Bool) -> UniqMap k a -> UniqMap k a-filterUniqMap f (UniqMap m) = UniqMap $ filterUFM (f . snd) m--partitionUniqMap :: (a -> Bool) -> UniqMap k a -> (UniqMap k a, UniqMap k a)-partitionUniqMap f (UniqMap m) =-    coerce $ partitionUFM (f . snd) m--sizeUniqMap :: UniqMap k a -> Int-sizeUniqMap (UniqMap m) = sizeUFM m--elemUniqMap :: Uniquable k => k -> UniqMap k a -> Bool-elemUniqMap k (UniqMap m) = elemUFM k m--lookupUniqMap :: Uniquable k => UniqMap k a -> k -> Maybe a-lookupUniqMap (UniqMap m) k = fmap snd (lookupUFM m k)--lookupWithDefaultUniqMap :: Uniquable k => UniqMap k a -> a -> k -> a-lookupWithDefaultUniqMap (UniqMap m) a k = fromMaybe a (fmap snd (lookupUFM m k))--anyUniqMap :: (a -> Bool) -> UniqMap k a -> Bool-anyUniqMap f (UniqMap m) = anyUFM (f . snd) m--allUniqMap :: (a -> Bool) -> UniqMap k a -> Bool-allUniqMap f (UniqMap m) = allUFM (f . snd) m

@@ -1,19 +1,9 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-}  module GHC.Types.Unique.Map.Extra where -#if __GLASGOW_HASKELL__ >= 902 import "ghc" GHC.Types.Unique.Map-#else-import GHC.Types.Unique.Map-#endif--#if __GLASGOW_HASKELL__ >= 900 import GHC.Types.Unique.FM (nonDetEltsUFM)-#elif __GLASGOW_HASKELL__ <= 810-import UniqFM (nonDetEltsUFM)-#endif  nonDetUniqMapToList :: UniqMap key a -> [(key, a)] nonDetUniqMapToList (UniqMap u) = nonDetEltsUFM u