diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2019, Christopher Chalmers
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Christopher Chalmers nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/circuit-notation.cabal b/circuit-notation.cabal
new file mode 100644
--- /dev/null
+++ b/circuit-notation.cabal
@@ -0,0 +1,51 @@
+-- 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
+
+library
+  exposed-modules:     CircuitNotation Circuit
+
+  if impl(ghc < 9.2)
+    other-modules:
+      GHC.Types.Unique.Map
+
+  if impl(ghc < 9.10)
+    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
+
+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
diff --git a/example/Example.hs b/example/Example.hs
new file mode 100644
--- /dev/null
+++ b/example/Example.hs
@@ -0,0 +1,270 @@
+{-
+ ██████╗██╗██████╗  ██████╗██╗   ██╗██╗████████╗███████╗
+██╔════╝██║██╔══██╗██╔════╝██║   ██║██║╚══██╔══╝██╔════╝
+██║     ██║██████╔╝██║     ██║   ██║██║   ██║   ███████╗
+██║     ██║██╔══██╗██║     ██║   ██║██║   ██║   ╚════██║
+╚██████╗██║██║  ██║╚██████╗╚██████╔╝██║   ██║   ███████║
+ ╚═════╝╚═╝╚═╝  ╚═╝ ╚═════╝ ╚═════╝ ╚═╝   ╚═╝   ╚══════╝
+  (C) 2020, Christopher Chalmers
+
+This file contains examples of using the Circuit Notation.
+-}
+
+{-# 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 #-}
+
+
+---- | Hack idiom-brackets using Source Plugin.
+----
+---- As nobody (?) writes their lists as `([1, 2, 3])`,
+---- we can steal that syntax!
+---- module Main (main) where
+
+module Example where
+
+import           Circuit
+
+import           Clash.Prelude
+
+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)
+
+swapC2 :: Circuit (a,b) (b,a)
+swapC2 = id $ circuit $ \ (a,b) -> (b,a)
+
+circuitA :: Circuit () (DF domain Int)
+circuitA = Circuit (\_ -> () :-> pure (DFM2S True 3))
+
+circuitB :: Circuit () (Signal domain Int)
+circuitB = Circuit (\_ -> () :-> pure 3)
+
+circuitC :: Circuit (Signal domain Int) (DF domain Int)
+circuitC = Circuit (\(as :-> _) -> () :-> DFM2S True <$> as)
+
+noLambda :: Circuit () (DF domain Int)
+noLambda = circuit $ do
+  i <- circuitA
+  idC -< i
+
+-- noLambda =
+--   let
+--     inferenceHelper ::
+--       () =>
+--       ((Circuit () iTy -> CircuitT () iTy) -> CircuitT () iTy)
+--       -> Circuit () iTy
+--     inferenceHelper = \ f -> Circuit (f runCircuit)
+--   in
+--     inferenceHelper
+--       (\ run0 (~() :-> i_Bwd)
+--         -> let () :-> i_Fwd = run0 circuitA (() :-> i_Bwd)
+--             in () :-> i_Fwd)
+
+
+sigExpr :: Signal domain Int -> Circuit () (DF domain Int)
+sigExpr sig = circuit do
+  i <- circuitC -< Signal sig
+  idC -< i
+
+-- sigPat :: (( Signal Int -> Signal Int ))
+sigPat :: Circuit (Signal domain Int) (Signal domain Int)
+sigPat = circuit $ \(Signal a) -> do
+  i <- idC -< Signal a
+  idC -< i
+
+sigPat2 :: Circuit (Signal dom Int) (Signal dom Int)
+sigPat2 = circuit $ \(Signal a) -> do
+  i <- (idC :: Circuit (Signal dom Int) (Signal dom Int)) -< Signal a
+  idC -< i
+
+fwdCircuit :: Circuit (Vec 3 (Signal dom Int)) (Vec 3 (Signal dom Int))
+fwdCircuit = circuit $ \(Fwd x) -> do
+  i <- idC -< Fwd (fmap (+1) x)
+  idC -< i
+
+fwdWithLetCircuit :: KnownNat n => Circuit (Vec n (Signal dom Int)) (Vec n (Signal dom Int))
+fwdWithLetCircuit = circuit $ \(Fwd x) -> do
+  let y = fmap (+1) x
+  i <- idC -< Fwd y
+  idC -< i
+
+fstC :: Circuit (Signal domain a, Signal domain b) (Signal domain a)
+fstC = circuit $ \(a, _b) -> do idC -< a
+
+fstC2 :: Circuit (Signal domain a, Signal domain b) (Signal domain a)
+fstC2 = circuit $ \ab -> do
+  (a, _b) <- idC -< ab
+  idC -< a
+
+fstC3 :: Circuit (Signal domain a, Signal domain b) (Signal domain a)
+fstC3 = circuit \(a, _b) -> a
+
+unfstC :: Circuit (DF domain a) (DF domain a, DF domain b)
+unfstC = circuit $ \a -> do
+  idC -< (a, _b)
+
+unfstC2 :: Circuit (DF domain a) (DF domain a, DF domain b)
+unfstC2 = circuit $ \a -> do
+  ab <- circuit (\(aa,bb) -> (bb,aa)) -< (_b, a)
+  idC -< ab
+
+unfstC3 :: Circuit (DF dom a) (DF dom a, DF dom b)
+unfstC3 = circuit $ \a -> do
+  ab <- idC -< (a, _b)
+  ab' <- idC -< ab
+  idC -< ab'
+
+-- a version of `idC` on `Signal domain Int` which has bad type inference.
+idCHard
+  :: (Fwd a ~ Signal domain Int, Bwd a ~ (), Fwd b ~ Signal domain Int, Bwd b ~ ())
+  => Circuit a b
+idCHard = Circuit $ \ (aFwd :-> ()) -> () :-> aFwd
+
+typedBus1 :: forall domain . Circuit (Signal domain Int) (Signal domain Int)
+typedBus1 = circuit $ \a -> do
+  (b :: Signal domain Int) <- idCHard -< a
+  idCHard -< b
+
+typedBus2 :: forall domain . Circuit (Signal domain Int) (Signal domain Int)
+typedBus2 = circuit $ \a -> do
+  b <- idCHard -< a
+  idCHard -< (b :: Signal domain Int)
+
+swapTest :: forall a b. Circuit (a,b) (b,a)
+-- swapTest = circuit $ \(a,b) -> (idCircuit :: Circuit (b, a) (b, a)) -< (b, a)
+swapTest = circuit $ \(a,b) -> do idC -< (b, a)
+
+unvecC :: Circuit (Vec 2 a) (a, a)
+unvecC = circuit \ ~[x,y] -> (x, y)
+
+vecC :: Circuit (a, a) (Vec 2 a)
+vecC = circuit \(x, y) -> [x,y]
+
+vec0 :: Circuit (Vec 0 a) ()
+vec0 = circuit \[] -> ()
+
+vec00 :: Circuit (Vec 0 a) (Vec 0 a)
+vec00 = circuit \[] -> []
+
+fanout :: forall dom. Circuit (DF dom Int) (DF dom Int)
+fanout = circuit $ \a -> do
+  [x] <- go -< a
+  idC -< x
+ where
+  go :: Circuit (DF dom Int) (Vec n (DF dom Int))
+  go = error "Not implemented"
+
+-- test that signals can be duplicated
+dupSignalC0 :: Circuit (Signal dom Bool) (Signal dom Bool, Signal dom Bool)
+dupSignalC0 = circuit $ \x -> (x, x)
+
+dupSignalC1 :: Circuit (Signal dom Bool) (Signal dom Bool, Signal dom Bool, Signal dom Bool)
+dupSignalC1 = circuit $ \x -> do
+    y <- idC -< x
+    idC -< (y, y, x)
+
+-- -- myDesire :: Circuit Int Char
+-- -- myDesire = Circuit (\(aM2S,bS2M) -> let
+-- --   (aM2S', bS2M') = runCircuit myCircuit (aM2S, bS2M)
+-- --   in (aM2S', bS2M'))
+--
+-- -- var :: (Int, Int)
+-- -- var = (3, 5)
+--
+-- -- myLet :: Int
+-- -- myLet = let (yo, yo') = var in yo
+--
+-- -- ah :: (Int,Int)
+-- -- ah = (7,11)
+--
+-- -- tupCir1 :: Circuit (Int, Char) (Char, Int)
+-- -- tupCir1 = circuit \ input -> do
+-- --   (c,i) <- swapC @Int -< input
+-- --   i' <- myCircuit -< [i]
+-- --   let myIdCircuit = circuit \port -> port
+-- --   c' <- myCircuitRev -< c
+-- --   c'' <- myIdCircuit -< c'
+-- --   idC -< (i', c'')
+--
+-- tupleCircuit :: Circuit Int Char
+-- tupleCircuit = id $ circuit \a -> do
+--   let b = 3
+--   b <- (circuit \a -> do b <- myCircuit -< a;idC -< b) -< a
+--   a' <- myCircuitRev -< b
+--   b' <- myCircuit -< a'
+--   b'' <- (circuit \aa -> do idC -< aa) -< b'
+--   idC -< b''
+--
+-- -- simpleCircuit :: Circuit Int Char
+-- -- simpleCircuit = id $ circuit \a -> do
+-- --   b <- (circuit \a -> do b <- myCircuit -< a;idC -< b) -< a
+-- --   a' <- myCircuitRev -< b
+-- --   b' <- myCircuit -< a'
+-- --   b'' <- (circuit \aa -> do idC -< aa) -< b'
+-- --   idC -< b''
+--
+-- myCircuit :: Int
+-- myCircuit = circuit \(v1 :: DF d a) (v3 :: blah) -> do
+--   v1' <- total -< (v3 :: DF domain Int) -< (v4 :: DF domain Int)
+--   v2 <- total -< v1
+--   let a = b
+--   -- v2' <- total2 -< v2
+--   -- v3 <- zipC -< (v1', v2')
+--   v1 <- idC -< v3
+--
+-- -- type RunCircuit a b = (Circuit a b -> (M2S a, S2M b) -> (M2S b, S2M a))
+-- -- type CircuitId a b = Circuit a b -> Circuit a b
+--
+-- -- myCircuit = let
+-- --   _circuits :: (RunCircuit a b, RunCircuit c d, RunCircuit (b,d) e, CircuitId (a,c) e)
+-- --   _circuits@(runC1, runC2, runC2, cId) = (runCircuit, runCircuit, runCircuit, id)
+--
+-- --   in cId $ Circuit $ \((v1M2S, v2M2S),outputS2M) -> let
+--
+-- --   (v1'M2S, v1S2M) = runC1 total (v1M2s, v1'S2M)
+-- --   (v2'M2S, v2S2M) = runC2 total2 (v2M2s, v2'S2M)
+-- --   (v3M2S, (v1'S2M, v2'S2M)) = runC3 zipC ((v1'M2S, v2'M2S), v3S2M)
+--
+-- --   in (v3M2S, (v1S2M, v2S2M))
+--
+--
+--
+--
+--   -- circuitHelper
+--   --   :: Circuit a b
+--   --   -> Circuit c d
+--   --   -> Circuit (b,d) e
+--
+--
+-- -- myCircuit :: Int
+-- -- myCircuit = circuit (\(v1,v2) -> (v2,v1))
+--
+-- -- myCircuit :: Int
+-- -- myCircuit = circuit do
+-- --   (v2,v1) <- yeah
+-- --   idC -< (v1, v2)
+--
+-- -- myCircuit = proc v1 -> do
+-- --   x <- total -< value
+--   -- fin -< a
+--   -- idC -< (t / n)
diff --git a/src/Circuit.hs b/src/Circuit.hs
new file mode 100644
--- /dev/null
+++ b/src/Circuit.hs
@@ -0,0 +1,212 @@
+{-
+ ██████╗██╗██████╗  ██████╗██╗   ██╗██╗████████╗███████╗
+██╔════╝██║██╔══██╗██╔════╝██║   ██║██║╚══██╔══╝██╔════╝
+██║     ██║██████╔╝██║     ██║   ██║██║   ██║   ███████╗
+██║     ██║██╔══██╗██║     ██║   ██║██║   ██║   ╚════██║
+╚██████╗██║██║  ██║╚██████╗╚██████╔╝██║   ██║   ███████║
+ ╚═════╝╚═╝╚═╝  ╚═╝ ╚═════╝ ╚═════╝ ╚═╝   ╚═╝   ╚══════╝
+  (C) 2020, Christopher Chalmers
+
+This file contains the 'Circuit' type, that the notation describes.
+-}
+
+{-# LANGUAGE CPP                    #-}
+{-# LANGUAGE DataKinds              #-}
+{-# LANGUAGE DeriveFunctor          #-}
+{-# LANGUAGE GADTs                  #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE NoImplicitPrelude      #-}
+{-# LANGUAGE PatternSynonyms        #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TypeApplications       #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE TypeOperators          #-}
+{-# LANGUAGE ViewPatterns           #-}
+
+module Circuit where
+
+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.
+pattern (:>!) :: a -> Vec n a -> Vec (n + 1) a
+pattern (:>!) x xs <- (\ys -> (head ys, tail ys) -> (x,xs))
+{-# COMPLETE (:>!) #-}
+infixr 5 :>!
+#endif
+
+type family Fwd a
+type family Bwd a
+
+infixr 0 :->
+-- | A type to symbolise arguments going to results of a circuit.
+data (a :-> b) = a :-> b
+  deriving (Show, Eq)
+
+-- | The identity circuit.
+idC :: Circuit a a
+idC = Circuit $ \(aFwd :-> aBwd) -> aBwd :-> aFwd
+
+data DF (dom :: Domain)  a
+data DFM2S a = DFM2S Bool a
+newtype DFS2M = DFS2M Bool
+
+instance Default (DFM2S a) where
+  def = DFM2S False (error "error default")
+instance Default DFS2M where
+  def = DFS2M True
+
+type instance Fwd (DF dom a) = Signal dom (DFM2S a)
+type instance Bwd (DF dom a) = Signal dom DFS2M
+
+type instance Fwd (Vec n a) = Vec n (Fwd a)
+type instance Bwd (Vec n a) = Vec n (Bwd a)
+
+type instance Fwd [a] = [Fwd a]
+type instance Bwd [a] = [Bwd a]
+
+type instance Fwd () = ()
+type instance Bwd () = ()
+
+type instance Fwd (a,b) = (Fwd a, Fwd b)
+type instance Bwd (a,b) = (Bwd a, Bwd b)
+
+type instance Fwd (a,b,c) = (Fwd a, Fwd b, Fwd c)
+type instance Bwd (a,b,c) = (Bwd a, Bwd b, Bwd c)
+
+type instance Fwd (Signal dom a) = Signal dom a
+type instance Bwd (Signal dom a) = ()
+
+-- | Circuit type.
+newtype Circuit a b = Circuit { runCircuit :: CircuitT a b }
+type CircuitT a b = (Fwd a :-> Bwd b) -> (Bwd a :-> Fwd b)
+
+
+type TagCircuitT a b = (BusTag a (Fwd a) :-> BusTag b (Bwd b)) -> (BusTag a (Bwd a) :-> BusTag b (Fwd b))
+
+newtype BusTag t b = BusTag {unBusTag :: b}
+
+mkTagCircuit :: TagCircuitT a b -> Circuit a b
+mkTagCircuit f = Circuit $ \ (aFwd :-> bBwd) -> let
+    (BusTag aBwd :-> BusTag bFwd) = f (BusTag aFwd :-> BusTag bBwd)
+  in (aBwd :-> bFwd)
+
+runTagCircuit :: Circuit a b -> TagCircuitT a b
+runTagCircuit (Circuit c) (aFwd :-> bBwd) = let
+    (aBwd :-> bFwd) = c (unBusTag aFwd :-> unBusTag bBwd)
+  in (BusTag aBwd :-> BusTag bFwd)
+
+pattern TagCircuit :: TagCircuitT a b -> Circuit a b
+pattern TagCircuit f <- (runTagCircuit -> f) where
+  TagCircuit f = mkTagCircuit f
+
+
+class TrivialBwd a where
+  unitBwd :: a
+
+instance TrivialBwd () where
+  unitBwd = ()
+
+instance (TrivialBwd a) => TrivialBwd (Signal dom a) where
+  unitBwd = pure unitBwd
+
+instance (TrivialBwd a, KnownNat n) => TrivialBwd (Vec n a) where
+  unitBwd = repeat unitBwd
+
+instance (TrivialBwd a, TrivialBwd b) => TrivialBwd (a,b) where
+  unitBwd = (unitBwd, unitBwd)
+
+instance (TrivialBwd a, TrivialBwd b, TrivialBwd c) => TrivialBwd (a,b,c) where
+  unitBwd = (unitBwd, unitBwd, unitBwd)
+
+instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d) => TrivialBwd (a,b,c,d) where
+  unitBwd = (unitBwd, unitBwd, unitBwd, unitBwd)
+
+instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d, TrivialBwd e) => TrivialBwd (a,b,c,d,e) where
+  unitBwd = (unitBwd, unitBwd, unitBwd, unitBwd, unitBwd)
+
+instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d, TrivialBwd e, TrivialBwd f) => TrivialBwd (a,b,c,d,e,f) where
+  unitBwd = (unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd)
+
+instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d, TrivialBwd e, TrivialBwd f, TrivialBwd g) => TrivialBwd (a,b,c,d,e,f,g) where
+  unitBwd = (unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd)
+
+instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d, TrivialBwd e, TrivialBwd f, TrivialBwd g, TrivialBwd h) => TrivialBwd (a,b,c,d,e,f,g,h) where
+  unitBwd = (unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd)
+
+instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d, TrivialBwd e, TrivialBwd f, TrivialBwd g, TrivialBwd h, TrivialBwd i) => TrivialBwd (a,b,c,d,e,f,g,h,i) where
+  unitBwd = (unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd)
+
+instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d, TrivialBwd e, TrivialBwd f, TrivialBwd g, TrivialBwd h, TrivialBwd i, TrivialBwd j) => TrivialBwd (a,b,c,d,e,f,g,h,i,j) where
+  unitBwd = (unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd, unitBwd)
+
+instance TrivialBwd a => TrivialBwd (BusTag t a) where
+  unitBwd = BusTag unitBwd
+
+class BusTagBundle t a where
+  type BusTagUnbundled t a = res | res -> t a
+  taggedBundle :: BusTagUnbundled t a -> BusTag t a
+  taggedUnbundle :: BusTag t a -> BusTagUnbundled t a
+
+instance BusTagBundle () () where
+  type BusTagUnbundled () () = ()
+  taggedBundle = BusTag
+  taggedUnbundle = unBusTag
+
+instance BusTagBundle (ta, tb) (a, b) where
+  type BusTagUnbundled (ta, tb) (a, b) = (BusTag ta a, BusTag tb b)
+  taggedBundle (BusTag a, BusTag b) = BusTag (a, b)
+  taggedUnbundle (BusTag (a, b)) =  (BusTag a, BusTag b)
+
+instance BusTagBundle (ta, tb, tc) (a, b, c) where
+  type BusTagUnbundled (ta, tb, tc) (a, b, c) = (BusTag ta a, BusTag tb b, BusTag tc c)
+  taggedBundle (BusTag a, BusTag b, BusTag c) = BusTag (a, b, c)
+  taggedUnbundle (BusTag (a, b, c)) =  (BusTag a, BusTag b, BusTag c)
+
+instance BusTagBundle (ta, tb, tc, td) (a, b, c, d) where
+  type BusTagUnbundled (ta, tb, tc, td) (a, b, c, d) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d)
+  taggedBundle (BusTag a, BusTag b, BusTag c, BusTag d) = BusTag (a, b, c, d)
+  taggedUnbundle (BusTag (a, b, c, d)) =  (BusTag a, BusTag b, BusTag c, BusTag d)
+
+instance BusTagBundle (ta, tb, tc, td, te) (a, b, c, d, e) where
+  type BusTagUnbundled (ta, tb, tc, td, te) (a, b, c, d, e) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d, BusTag te e)
+  taggedBundle (BusTag a, BusTag b, BusTag c, BusTag d, BusTag e) = BusTag (a, b, c, d, e)
+  taggedUnbundle (BusTag (a, b, c, d, e)) =  (BusTag a, BusTag b, BusTag c, BusTag d, BusTag e)
+
+instance BusTagBundle (ta, tb, tc, td, te, tf) (a, b, c, d, e, f) where
+  type BusTagUnbundled (ta, tb, tc, td, te, tf) (a, b, c, d, e, f) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d, BusTag te e, BusTag tf f)
+  taggedBundle (BusTag a, BusTag b, BusTag c, BusTag d, BusTag e, BusTag f) = BusTag (a, b, c, d, e, f)
+  taggedUnbundle (BusTag (a, b, c, d, e, f)) =  (BusTag a, BusTag b, BusTag c, BusTag d, BusTag e, BusTag f)
+
+instance BusTagBundle (ta, tb, tc, td, te, tf, tg) (a, b, c, d, e, f, g) where
+  type BusTagUnbundled (ta, tb, tc, td, te, tf, tg) (a, b, c, d, e, f, g) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d, BusTag te e, BusTag tf f, BusTag tg g)
+  taggedBundle (BusTag a, BusTag b, BusTag c, BusTag d, BusTag e, BusTag f, BusTag g) = BusTag (a, b, c, d, e, f, g)
+  taggedUnbundle (BusTag (a, b, c, d, e, f, g)) =  (BusTag a, BusTag b, BusTag c, BusTag d, BusTag e, BusTag f, BusTag g)
+
+instance BusTagBundle (ta, tb, tc, td, te, tf, tg, th) (a, b, c, d, e, f, g, h) where
+  type BusTagUnbundled (ta, tb, tc, td, te, tf, tg, th) (a, b, c, d, e, f, g, h) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d, BusTag te e, BusTag tf f, BusTag tg g, BusTag th h)
+  taggedBundle (BusTag a, BusTag b, BusTag c, BusTag d, BusTag e, BusTag f, BusTag g, BusTag h) = BusTag (a, b, c, d, e, f, g, h)
+  taggedUnbundle (BusTag (a, b, c, d, e, f, g, h)) =  (BusTag a, BusTag b, BusTag c, BusTag d, BusTag e, BusTag f, BusTag g, BusTag h)
+
+instance BusTagBundle (ta, tb, tc, td, te, tf, tg, th, ti) (a, b, c, d, e, f, g, h, i) where
+  type BusTagUnbundled (ta, tb, tc, td, te, tf, tg, th, ti) (a, b, c, d, e, f, g, h, i) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d, BusTag te e, BusTag tf f, BusTag tg g, BusTag th h, BusTag ti i)
+  taggedBundle (BusTag a, BusTag b, BusTag c, BusTag d, BusTag e, BusTag f, BusTag g, BusTag h, BusTag i) = BusTag (a, b, c, d, e, f, g, h, i)
+  taggedUnbundle (BusTag (a, b, c, d, e, f, g, h, i)) =  (BusTag a, BusTag b, BusTag c, BusTag d, BusTag e, BusTag f, BusTag g, BusTag h, BusTag i)
+
+instance BusTagBundle (ta, tb, tc, td, te, tf, tg, th, ti, tj) (a, b, c, d, e, f, g, h, i, j) where
+  type BusTagUnbundled (ta, tb, tc, td, te, tf, tg, th, ti, tj) (a, b, c, d, e, f, g, h, i, j) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d, BusTag te e, BusTag tf f, BusTag tg g, BusTag th h, BusTag ti i, BusTag tj j)
+  taggedBundle (BusTag a, BusTag b, BusTag c, BusTag d, BusTag e, BusTag f, BusTag g, BusTag h, BusTag i, BusTag j) = BusTag (a, b, c, d, e, f, g, h, i, j)
+  taggedUnbundle (BusTag (a, b, c, d, e, f, g, h, i, j)) =  (BusTag a, BusTag b, BusTag c, BusTag d, BusTag e, BusTag f, BusTag g, BusTag h, BusTag i, BusTag j)
+
+instance BusTagBundle (Vec n t) (Vec n a) where
+  type BusTagUnbundled (Vec n t) (Vec n a) = Vec n (BusTag t a)
+  taggedBundle = BusTag . fmap unBusTag
+  taggedUnbundle = fmap BusTag . unBusTag
+
+pattern BusTagBundle :: BusTagBundle t a => BusTagUnbundled t a -> BusTag t a
+pattern BusTagBundle a <- (taggedUnbundle -> a) where
+  BusTagBundle a = taggedBundle a
+{-# COMPLETE BusTagBundle #-}
diff --git a/src/CircuitNotation.hs b/src/CircuitNotation.hs
new file mode 100644
--- /dev/null
+++ b/src/CircuitNotation.hs
@@ -0,0 +1,1344 @@
+{-
+ ██████╗██╗██████╗  ██████╗██╗   ██╗██╗████████╗███████╗
+██╔════╝██║██╔══██╗██╔════╝██║   ██║██║╚══██╔══╝██╔════╝
+██║     ██║██████╔╝██║     ██║   ██║██║   ██║   ███████╗
+██║     ██║██╔══██╗██║     ██║   ██║██║   ██║   ╚════██║
+╚██████╗██║██║  ██║╚██████╗╚██████╔╝██║   ██║   ███████║
+ ╚═════╝╚═╝╚═╝  ╚═╝ ╚═════╝ ╚═════╝ ╚═╝   ╚═╝   ╚══════╝
+  (C) 2020, Christopher Chalmers
+
+Notation for describing the 'Circuit' type.
+-}
+
+{-# LANGUAGE BlockArguments             #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE ImplicitParams             #-}
+{-# LANGUAGE LambdaCase                 #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE PackageImports             #-}
+{-# LANGUAGE PatternSynonyms            #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE TypeOperators              #-}
+{-# LANGUAGE ViewPatterns               #-}
+
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
+
+-- TODO: Fix warnings introduced by GHC 9.2
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module CircuitNotation
+  ( plugin
+  , mkPlugin
+  , thName
+  , ExternalNames (..)
+  , Direction(..)
+  ) where
+
+-- base
+import           Control.Exception
+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
+
+-- ghc
+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
+import qualified GHC.Driver.Session        as GHC
+import qualified GHC.Types.Basic           as GHC
+import qualified GHC.Types.Name.Occurrence as OccName
+import qualified GHC.Types.Name.Reader     as GHC
+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
+import qualified GHC.Parser.PostProcess       as GHC
+#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
+#endif
+
+-- clash-prelude
+import Clash.Prelude (Vec((:>), Nil))
+
+-- lens
+import qualified Control.Lens           as L
+import           Control.Lens.Operators
+
+-- mtl
+import           Control.Monad.State
+
+#if __GLASGOW_HASKELL__ >= 906
+import           Control.Monad
+#endif
+
+-- pretty-show
+-- import qualified Text.Show.Pretty       as SP
+
+-- syb
+import qualified Data.Generics          as SYB
+
+-- The stages of this plugin
+--
+-- 1. Go through the parsed module source and find usages of the circuit keyword (`transform`).
+-- 2. Parse the circuit, either do notation or a one liner, go through each statement and convert it
+--    to a CircuitQQ.
+-- 3. Go through the CircuitQQ and check that everything is consistent (every master has a matching
+--    slave).
+-- 4. Convert the Bindings to let statements, at the same time build up a description of the types
+--    to make the type descriptor helper.
+
+
+-- Utils ---------------------------------------------------------------
+isSomeVar :: (p ~ GhcPs) => GHC.FastString -> HsExpr p -> Bool
+isSomeVar s = \case
+  HsVar _ (L _ v) -> v == GHC.mkVarUnqual s
+  _               -> False
+
+isCircuitVar :: p ~ GhcPs => HsExpr p -> Bool
+isCircuitVar = isSomeVar "circuit"
+
+isDollar :: p ~ GhcPs => HsExpr p -> Bool
+isDollar = isSomeVar "$"
+
+-- | Is (-<)?
+isFletching :: p ~ GhcPs => HsExpr p -> Bool
+isFletching = isSomeVar "-<"
+
+imap :: (Int -> a -> b) -> [a] -> [b]
+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
+
+emptyComments :: NoExtField
+emptyComments = noExtField
+
+locA :: a -> a
+locA = id
+#else
+type MsgDoc = Outputable.SDoc
+
+locA :: SrcSpanAnn' a -> SrcSpan
+locA = GHC.locA
+
+noAnnSortKey :: AnnSortKey
+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
+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
+pattern HsParP :: LHsExpr p -> HsExpr p
+pattern HsParP e <- HsPar _ e
+
+pattern ParPatP :: LPat p -> Pat p
+pattern ParPatP p <- ParPat _ p
+#else
+pattern HsParP :: LHsExpr p -> HsExpr p
+pattern HsParP e <- HsPar _ _ e _
+
+pattern ParPatP :: LPat p -> Pat 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.
+mkErrMsg _ locn unqual =
+    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 ---------------------------------------------------------------
+
+-- | The name given to a 'port', i.e. the name of a variable either to the left of a '<-' or to the
+--   right of a '-<'.
+data PortName = PortName SrcSpanAnnA GHC.FastString
+  deriving (Eq)
+
+instance Show PortName where
+  show (PortName _ fs) = GHC.unpackFS fs
+
+data PortDescription a
+    = Tuple [PortDescription a]
+    | Vec SrcSpanAnnA [PortDescription a]
+    | Ref a
+    | RefMulticast a
+    | Lazy SrcSpanAnnA (PortDescription a)
+    | FwdExpr (LHsExpr GhcPs)
+    | FwdPat (LPat GhcPs)
+    | PortType (LHsType GhcPs) (PortDescription a)
+    | PortErr SrcSpanAnnA MsgDoc
+    deriving (Foldable, Functor, Traversable)
+
+_Ref :: L.Prism' (PortDescription a) a
+_Ref = L.prism' Ref (\case Ref a -> Just a; _ -> Nothing)
+
+instance L.Plated (PortDescription a) where
+  plate f = \case
+    Tuple ps -> Tuple <$> traverse f ps
+    Vec s ps -> Vec s <$> traverse f ps
+    Lazy s p -> Lazy s <$> f p
+    PortType t p -> PortType t <$> f p
+    p -> pure p
+
+-- | A single circuit binding. These are generated from parsing statements.
+-- @
+-- bOut <- bCircuit -< bIn
+-- @
+data Binding exp l = Binding
+    { bCircuit :: exp
+    , bOut     :: PortDescription l
+    , bIn      :: PortDescription l
+    }
+    deriving (Functor)
+
+data CircuitState dec exp nm = CircuitState
+    { _cErrors        :: Bag ErrMsg
+    , _counter        :: Int
+    -- ^ unique counter for generated variables
+    , _circuitSlaves  :: PortDescription nm
+    -- ^ the final statement in a circuit
+    , _circuitTypes   :: [LSig GhcPs]
+    -- ^ type signatures in let bindings
+    , _circuitLets    :: [dec]
+    -- ^ user defined let expression inside the circuit
+    , _circuitBinds   :: [Binding exp nm]
+    -- ^ @out <- circuit <- in@ statements
+    , _circuitMasters :: PortDescription nm
+    -- ^ ports bound at the first lambda of a circuit
+    , _portVarTypes :: UniqMap GHC.FastString (SrcSpanAnnA, LHsType GhcPs)
+    -- ^ types of single variable ports
+    , _portTypes :: [(LHsType GhcPs, PortDescription nm)]
+    -- ^ type of more 'complicated' things (very far from vigorous)
+    , _uniqueCounter :: Int
+    -- ^ counter to keep internal variables "unique"
+    , _circuitLoc :: SrcSpanAnnA
+    -- ^ span of the circuit expression
+    }
+
+L.makeLenses 'CircuitState
+
+-- | The monad used when running a single circuit.
+newtype CircuitM a = CircuitM (StateT (CircuitState (LHsBind GhcPs) (LHsExpr GhcPs) PortName) GHC.Hsc a)
+  deriving (Functor, Applicative, Monad, MonadIO, MonadState (CircuitState (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)) (GenLocated SrcSpanAnnA (HsExpr GhcPs)) PortName))
+
+-- , MonadState (CircuitState (LHsBind GhcPs) (LHsExpr GhcPs) PortName)
+
+instance GHC.HasDynFlags CircuitM where
+  getDynFlags = (CircuitM . lift) GHC.getDynFlags
+
+runCircuitM :: CircuitM a -> GHC.Hsc a
+runCircuitM (CircuitM m) = do
+  let emptyCircuitState = CircuitState
+        { _cErrors = emptyBag
+        , _counter = 0
+        , _circuitSlaves = Tuple []
+        , _circuitTypes = []
+        , _circuitLets = []
+        , _circuitBinds = []
+        , _circuitMasters = Tuple []
+        , _portVarTypes = emptyUniqMap
+        , _portTypes = []
+        , _uniqueCounter = 1
+        , _circuitLoc = noSrcSpanA
+        }
+  (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
+  dflags <- GHC.getDynFlags
+  let errMsg = mkLocMessage sevFatal loc (Outputable.text msg)
+  cErrors %= consBag (mkErrMsg dflags loc Outputable.alwaysQualify errMsg)
+
+-- ghc helpers ---------------------------------------------------------
+
+-- 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
+noEpAnn :: GenLocated SrcSpan e -> GenLocated (SrcAnn ann) e
+noEpAnn (L l e) = L (SrcSpanAnn EpAnnNotUsed 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
+tupP [pat] = pat
+tupP pats = noLoc $ TuplePat noExt pats GHC.Boxed
+
+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
+  as -> L srcLoc $ ParPat noExt pL (go as) pR
+  where
+  pL = L (GHC.mkTokenLocation $ locA srcLoc) HsTok
+  pR = L (GHC.mkTokenLocation $ locA srcLoc) HsTok
+#endif
+  go :: [LPat GhcPs] -> LPat GhcPs
+  go (p@(L l0 _):pats) =
+    let
+#if __GLASGOW_HASKELL__ >= 902
+      l1 = l0 `seq` noSrcSpanA
+#else
+      l1 = l0
+#endif
+    in
+      L srcLoc $ conPatIn (L l1 (consPat ?nms)) (InfixCon p (go pats))
+  go [] = L srcLoc $ WildPat noExtField
+
+varP :: SrcSpanAnnA -> String -> LPat GhcPs
+varP loc nm = L loc $ VarPat noExtField (noLoc $ var nm)
+
+tildeP :: SrcSpanAnnA -> LPat GhcPs -> LPat GhcPs
+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
+tupT tys = noLoc $ HsTupleTy noExt hsBoxedTuple tys
+
+vecT :: SrcSpanAnnA -> [LHsType GhcPs] -> LHsType GhcPs
+vecT s [] = L s $ HsParTy noExt (conT s (thName ''Vec) `appTy` tyNum s 0 `appTy` (varT s (genLocName s "vec")))
+vecT s tys@(ty:_) = L s $ HsParTy noExt (conT s (thName ''Vec) `appTy` tyNum s (length tys) `appTy` ty)
+
+tyNum :: SrcSpanAnnA -> Int -> LHsType GhcPs
+tyNum s i = L s (HsTyLit noExtField (HsNumTy GHC.NoSourceText (fromIntegral i)))
+
+appTy :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
+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)
+
+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
+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
+#endif
+
+var :: String -> GHC.RdrName
+var = GHC.Unqual . OccName.mkVarOcc
+
+tyVar :: String -> GHC.RdrName
+tyVar = GHC.Unqual . OccName.mkTyVarOcc
+
+tyCon :: String -> GHC.RdrName
+tyCon = GHC.Unqual . OccName.mkTcOcc
+
+vecE :: SrcSpanAnnA -> [LHsExpr GhcPs] -> LHsExpr GhcPs
+vecE srcLoc = \case
+  [] -> 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 [] = 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
+#else
+    tupArgs = map (\arg@(L l _) -> L l (Present noExt arg)) elems
+#endif
+
+unL :: Located a -> a
+unL (L _ a) = a
+
+-- | Get a ghc name from a TH name that's known to be unique.
+thName :: TH.Name -> GHC.RdrName
+thName nm =
+  case Convert.thRdrNameGuesses nm of
+    [name] -> name
+    _      -> error "thName called on a non NameG Name"
+
+-- | 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
+
+-- | 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
+  HsLam _ (MG _x alts) <- Just expr
+#endif
+  L _ [L _ (Match _matchX _matchContext matchPats matchGr)] <- Just alts
+  GRHSs _grX grHss _grLocalBinds <- Just matchGr
+  [L _ (GRHS _ _ body)] <- Just grHss
+  Just (matchPats, body)
+
+-- | Create a simple let binding.
+letE
+  :: p ~ GhcPs
+  => SrcSpanAnnA
+  -- ^ location for top level let bindings
+  -> [LSig p]
+  -- ^ type signatures
+  -> [LHsBind p]
+  -- ^ let bindings
+  -> LHsExpr p
+  -- ^ final `in` expressions
+  -> LHsExpr p
+letE loc sigs binds expr =
+#if __GLASGOW_HASKELL__ < 904
+    L loc (HsLet noExt localBinds expr)
+#else
+    L loc (HsLet noExt tkLet localBinds tkIn 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
+    tkLet = 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
+    hsBinds = listToBag binds
+
+-- | Simple construction of a lambda expression
+lamE :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
+lamE pats expr = noLoc $ HsLam noExtField mg
+  where
+    mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
+#if __GLASGOW_HASKELL__ < 906
+    mg = MG noExtField matches GHC.Generated
+#elif __GLASGOW_HASKELL__ < 908
+    mg = MG GHC.Generated matches
+#else
+    mg = MG (GHC.Generated GHC.DoPmc) matches
+#endif
+
+    matches :: GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
+    matches = noLoc $ [singleMatch]
+
+    singleMatch :: GenLocated SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
+    singleMatch = noLoc $ Match noExt LambdaExpr pats grHss
+
+    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
+fromRdrName = \case
+  GHC.Unqual occName -> mkFastString (OccName.occNameString occName)
+  GHC.Orig _ occName -> mkFastString (OccName.occNameString occName)
+  nm -> mkFastString (deepShowD nm)
+
+-- Parsing -------------------------------------------------------------
+
+-- | "parse" a circuit, i.e. convert it from ghc's ast to our representation of a circuit. This is
+-- the expression following the 'circuit' keyword.
+parseCircuit
+  :: p ~ GhcPs
+  => LHsExpr p
+  -> CircuitM ()
+parseCircuit = \case
+  -- strip out parenthesis
+  L _ (HsParP lexp) -> parseCircuit lexp
+
+  -- a lambda to match the slave ports
+  L _ (simpleLambda -> Just ([matchPats], body)) -> do
+    circuitSlaves .= bindSlave matchPats
+    circuitBody body
+
+  -- a version without a lambda (i.e. no slaves)
+  e -> circuitBody e
+
+-- | The main part of a circuit expression. Either a do block or simple rearranging case.
+circuitBody :: LHsExpr GhcPs -> CircuitM ()
+circuitBody = \case
+  -- strip out parenthesis
+  L _ (HsParP lexp) -> circuitBody lexp
+
+  L loc (HsDo _x _stmtContext (L _ (unsnoc -> Just (stmts, L finLoc finStmt)))) -> do
+    circuitLoc .= loc
+    mapM_ handleStmtM stmts
+
+    case finStmt of
+      BodyStmt _bodyX bod _idr _idr' ->
+        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
+          -- into
+          --   finalStmt <- c -< x
+          --   idC -< finalStmt
+          _ -> do
+            let ref = Ref (PortName finLoc "final:stmt")
+            bodyBinding (Just ref) (bod)
+            circuitMasters .= ref
+
+      stmt -> errM (locA finLoc) ("Unhandled final stmt " <> show (Data.toConstr stmt))
+
+  -- the simple case without do notation
+  L loc master -> do
+    circuitLoc .= loc
+    circuitMasters .= bindMaster (L loc master)
+
+-- | Handle a single statement.
+handleStmtM
+  :: 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
+        circuitLets <>= bagToList valBinds
+        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"
+
+-- | Turn patterns to the left of a @<-@ into a PortDescription.
+bindSlave :: p ~ GhcPs => LPat p -> PortDescription PortName
+bindSlave (L loc expr) = case expr of
+  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 ->
+    PortErr loc
+            (mkLocMessage
+              sevFatal
+              (locA loc)
+              (Outputable.text $ "Unhandled pattern " <> show (Data.toConstr pat))
+              )
+
+-- | Turn expressions to the right of a @-<@ into a PortDescription.
+bindMaster :: LHsExpr GhcPs -> PortDescription PortName
+bindMaster (L loc expr) = case expr of
+  HsVar _xvar (L _vloc rdrName)
+    | rdrName == thName '() -> Tuple []
+    | rdrName == thName '[] -> Vec loc [] -- XXX: vloc?
+    | otherwise -> Ref (PortName loc (fromRdrName rdrName)) -- XXX: vloc?
+  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'
+
+  -- OpApp _xapp (L _ circuitVar) (L _ infixVar) appR -> k
+
+  _ -> PortErr loc
+    (mkLocMessage
+      sevFatal
+      (locA loc)
+      (Outputable.text $ "Unhandled expression " <> show (Data.toConstr expr))
+      )
+
+-- | Create a binding expression
+bodyBinding
+  :: Maybe (PortDescription PortName)
+  -- ^ the bound variable, this can be Nothing if there is no @<-@ (a circuit with no slaves)
+  -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
+  -- ^ the statement with an optional @-<@
+  -> 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?)"
+      Just input -> circuitBinds <>= [Binding
+        { bCircuit = lexpr
+        , bOut     = Tuple []
+        , bIn      = input
+        }]
+
+-- Checking ------------------------------------------------------------
+
+data Dir = Slave | Master
+
+checkCircuit :: p ~ GhcPs => CircuitM ()
+checkCircuit = do
+  slaves <- L.use circuitSlaves
+  masters <- L.use circuitMasters
+  binds <- L.use circuitBinds
+
+  let portNames d = L.toListOf (L.cosmos . _Ref . L.to (f d))
+      f :: Dir -> PortName -> (GHC.FastString, ([SrcSpanAnnA], [SrcSpanAnnA]))
+      f Slave (PortName srcLoc portName) = (portName, ([srcLoc], []))
+      f Master (PortName srcLoc portName) = (portName, ([], [srcLoc]))
+      bindingNames = \b -> portNames Master (bOut b) <> portNames Slave (bIn b)
+      topNames = portNames Slave slaves <> portNames Master masters
+      nameMap = listToUniqMap_C mappend $ topNames <> concatMap bindingNames binds
+
+  duplicateMasters <- concat <$> forM (nonDetUniqMapToList nameMap) \(name, occ) -> do
+    let isIgnored = case unpackFS name of {('_':_) -> True; _ -> False}
+
+    case occ of
+      ([], []) -> pure []
+      ([_], [_]) -> pure []
+      (s:_, []) | not isIgnored -> errM (locA s) ("Slave port " <> show name <> " has no associated master") >> pure []
+      ([], m:_) | not isIgnored -> errM (locA m) ("Master port " <> show name <> " has no associated slave") >> pure []
+      (ss@(s:_:_), _) ->
+        -- would be nice to show locations of all occurrences here, not sure how to do that while
+        -- keeping ghc api
+        errM (locA s) ("Slave port " <> show name <> " defined " <> show (length ss) <> " times") >> pure []
+      (_ss, ms) -> do
+        -- if master is defined multiple times, we broadcast it
+        if length ms > 1
+          then pure [name]
+          else pure []
+
+  let
+    modifyMulticast = \case
+      Ref p@(PortName _ a) | a `elem` duplicateMasters -> RefMulticast p
+      p -> p
+
+  -- update relevant master ports to be multicast
+  circuitSlaves %= L.transform modifyMulticast
+  circuitMasters %= L.transform modifyMulticast
+  circuitBinds . L.mapped %= \b -> b
+    { bIn = L.transform modifyMulticast (bIn b),
+      bOut = L.transform modifyMulticast (bOut b)
+    }
+
+-- Creating ------------------------------------------------------------
+
+data Direction = Fwd | Bwd deriving Show
+
+bindWithSuffix :: (p ~ GhcPs, ?nms :: ExternalNames) => GHC.DynFlags -> Direction -> PortDescription PortName -> LPat p
+bindWithSuffix dflags dir = \case
+  Tuple ps -> tildeP noSrcSpanA $ taggedBundleP $ tupP $ fmap (bindWithSuffix dflags dir) ps
+  Vec s ps -> taggedBundleP $ vecP s $ fmap (bindWithSuffix dflags dir) ps
+  Ref (PortName loc fs) -> varP loc (GHC.unpackFS fs <> "_" <> show dir)
+  RefMulticast (PortName loc fs) -> case dir of
+    Bwd -> L loc (WildPat noExtField)
+    Fwd -> varP loc (GHC.unpackFS fs <> "_" <> show dir)
+  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
+
+revDirec :: Direction -> Direction
+revDirec = \case
+  Fwd -> Bwd
+  Bwd -> Fwd
+
+bindOutputs
+  :: (p ~ GhcPs, ?nms :: ExternalNames)
+  => GHC.DynFlags
+  -> Direction
+  -> PortDescription PortName
+  -- ^ slave ports
+  -> PortDescription PortName
+  -- ^ master ports
+  -> LPat p
+bindOutputs dflags direc slaves masters = noLoc $ conPatIn (noLoc (fwdBwdCon ?nms)) (InfixCon m2s s2m)
+  where
+  m2s = bindWithSuffix dflags direc masters
+  s2m = bindWithSuffix dflags (revDirec direc) slaves
+
+expWithSuffix :: (p ~ GhcPs, ?nms :: ExternalNames) => Direction -> PortDescription PortName -> LHsExpr p
+expWithSuffix dir = \case
+  Tuple ps -> taggedBundleE $ tupE noSrcSpanA $ fmap (expWithSuffix dir) ps
+  Vec s ps -> taggedBundleE $ vecE s $ fmap (expWithSuffix dir) ps
+  Ref (PortName loc fs)   -> varE loc (var $ GHC.unpackFS fs <> "_" <> show dir)
+  RefMulticast (PortName loc fs) -> case dir of
+    Bwd -> varE noSrcSpanA (trivialBwd ?nms)
+    Fwd -> varE loc (var $ GHC.unpackFS fs <> "_" <> show dir)
+  -- laziness only affects the pattern side
+  Lazy _ p   -> expWithSuffix dir p
+  PortErr _ _ -> error "expWithSuffix PortErr!"
+  FwdExpr lexpr -> tagE lexpr
+  FwdPat (L l _) -> tagE $ varE l (trivialBwd ?nms)
+  PortType ty p -> tagTypeE dir ty (expWithSuffix dir p)
+
+createInputs
+  :: (p ~ GhcPs, ?nms :: ExternalNames)
+  => Direction
+  -> PortDescription PortName
+  -- ^ slave ports
+  -> PortDescription PortName
+  -- ^ master ports
+  -> LHsExpr p
+createInputs dir slaves masters = noLoc $ OpApp noExt s2m (varE noSrcSpanA (fwdBwdCon ?nms)) m2s
+  where
+  m2s = expWithSuffix (revDirec dir) masters
+  s2m = expWithSuffix dir slaves
+
+decFromBinding :: (p ~ GhcPs, ?nms :: ExternalNames) => GHC.DynFlags -> Binding (LHsExpr p) PortName -> HsBind p
+decFromBinding dflags Binding {..} = do
+  let bindPat  = bindOutputs dflags Bwd bIn bOut
+      inputExp = createInputs Fwd bOut bIn
+      bod = runCircuitFun noSrcSpanA `appE` bCircuit `appE` inputExp
+   in patBind bindPat bod
+
+patBind :: LPat GhcPs -> LHsExpr GhcPs -> HsBind GhcPs
+patBind lhs expr = PatBind noExt lhs rhs
+#if __GLASGOW_HASKELL__ < 906
+   ([], [])
+#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)
+
+runCircuitFun :: (?nms :: ExternalNames) => SrcSpanAnnA -> LHsExpr GhcPs
+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]))
+
+taggedBundleE :: (p ~ GhcPs, ?nms :: ExternalNames) => LHsExpr p -> LHsExpr p
+taggedBundleE a = varE noSrcSpanA (tagBundlePat ?nms) `appE` a
+
+tagP :: (p ~ GhcPs, ?nms :: ExternalNames) => LPat p -> LPat p
+tagP a = noLoc (conPatIn (noLoc (tagName ?nms)) (prefixCon [a]))
+
+tagE :: (p ~ GhcPs, ?nms :: ExternalNames) => LHsExpr p -> LHsExpr p
+tagE a = varE noSrcSpanA (tagName ?nms) `appE` a
+
+tagTypeCon :: (p ~ GhcPs, ?nms :: ExternalNames) => LHsType GhcPs
+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
+  = sigPat noSrcSpanA (tagTypeCon `appTy` ty `appTy` busType)
+  where
+    busType = conT noSrcSpanA (fwdAndBwdTypes ?nms dir) `appTy` ty
+
+tagTypeE :: (p ~ GhcPs, ?nms :: ExternalNames) => Direction -> LHsType GhcPs -> LHsExpr p -> LHsExpr p
+tagTypeE dir ty a
+  = sigE noSrcSpanA (tagTypeCon `appTy` ty `appTy` busType) a
+  where
+    busType = conT noSrcSpanA (fwdAndBwdTypes ?nms dir) `appTy` ty
+
+constVar :: SrcSpanAnnA -> LHsExpr GhcPs
+constVar loc = varE loc (thName 'const)
+
+deepShowD :: Data.Data a => a -> String
+deepShowD a = show (Data.toConstr a) <>
+  -- " (" <> (unwords . fst) (SYB.gmapM (\x -> ([show $ Data.toConstr x], x)) a) <> ")"
+  " (" <> (unwords . fst) (SYB.gmapM (\x -> ([deepShowD x], x)) a) <> ")"
+
+unsnoc :: [a] -> Maybe ([a], a)
+unsnoc [] = Nothing
+unsnoc [x] = Just ([], x)
+unsnoc (x:xs) = Just (x:a, b)
+    where Just (a,b) = unsnoc xs
+
+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)
+#endif
+
+arrTy :: p ~ GhcPs => LHsType p -> LHsType p -> LHsType p
+arrTy a b = noLoc $ hsFunTy (parenthesizeHsType GHC.funPrec a) (parenthesizeHsType GHC.funPrec b)
+
+varT :: SrcSpanAnnA -> String -> LHsType GhcPs
+varT loc nm = L loc (HsTyVar noExt NotPromoted (noLoc (tyVar nm)))
+
+conT :: SrcSpanAnnA -> GHC.RdrName -> LHsType GhcPs
+conT loc nm = L loc (HsTyVar noExt NotPromoted (noLoc nm))
+
+-- perhaps this should happen on construction
+gatherTypes
+  :: p ~ GhcPs
+  => PortDescription PortName
+  -> CircuitM ()
+gatherTypes = L.traverseOf_ L.cosmos addTypes
+  where
+    addTypes = \case
+      PortType ty (Ref (PortName loc fs)) ->
+        portVarTypes %= \pvt -> alterUniqMap (const (Just (loc, ty))) pvt fs
+      PortType ty p -> portTypes <>= [(ty, p)]
+      _             -> pure ()
+
+tyEq :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
+tyEq a b =
+#if __GLASGOW_HASKELL__ < 904
+  noLoc $ HsOpTy noExtField a (noLoc eqTyCon_RDR) b
+#else
+  noLoc $ HsOpTy noAnn NotPromoted a (noLoc eqTyCon_RDR) b
+#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.
+
+-- Final construction --------------------------------------------------
+
+circuitQQExpM
+  :: (p ~ GhcPs, ?nms :: ExternalNames)
+  => CircuitM (LHsExpr p)
+circuitQQExpM = do
+  checkCircuit
+
+  dflags <- GHC.getDynFlags
+  binds <- L.use circuitBinds
+  lets <- L.use circuitLets
+  letTypes <- L.use circuitTypes
+  slaves <- L.use circuitSlaves
+  masters <- L.use circuitMasters
+
+  -- Construction of the circuit expression
+  let decs = lets <> map (noLoc . decFromBinding dflags) binds
+
+  let pats = bindOutputs dflags Fwd masters slaves
+      res  = createInputs Bwd slaves masters
+
+      body :: LHsExpr GhcPs
+      body = letE noSrcSpanA letTypes decs res
+
+  -- see [inference-helper]
+  mapM_
+    (\(Binding _ outs ins) -> gatherTypes outs >> gatherTypes ins)
+    binds
+  mapM_ gatherTypes [masters, slaves]
+
+  pure $ circuitConstructor noSrcSpanA `appE` lamE [pats] body
+
+grr :: MonadIO m => OccName.NameSpace -> m ()
+grr nm
+  | nm == OccName.tcName = liftIO $ putStrLn "tcName"
+  | nm == OccName.clsName = liftIO $ putStrLn "clsName"
+  | nm == OccName.tcClsName = liftIO $ putStrLn "tcClsName"
+  | nm == OccName.dataName = liftIO $ putStrLn "dataName"
+  | nm == OccName.varName = liftIO $ putStrLn "varName"
+  | nm == OccName.tvName = liftIO $ putStrLn "tvName"
+  | otherwise = liftIO $ putStrLn "I dunno"
+
+completeUnderscores :: (?nms :: ExternalNames) => CircuitM ()
+completeUnderscores = do
+  binds <- L.use circuitBinds
+  masters <- L.use circuitMasters
+  slaves <- L.use circuitSlaves
+  let addDef :: String -> PortDescription PortName -> CircuitM ()
+      addDef suffix = \case
+        Ref (PortName loc (unpackFS -> name@('_':_))) -> do
+          let bind = patBind (varP loc (name <> suffix)) (tagE $ varE loc (thName 'def))
+          circuitLets <>= [L loc bind]
+
+        _ -> pure ()
+      addBind :: Binding exp PortName -> CircuitM ()
+      addBind (Binding _ bOut bIn) = do
+        L.traverseOf_ L.cosmos (addDef "_Fwd") bOut
+        L.traverseOf_ L.cosmos (addDef "_Bwd") bIn
+  mapM_ addBind binds
+  addBind (Binding undefined masters slaves)
+
+
+-- | Transform declarations in the module by converting circuit blocks.
+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)
+
+  -- the circuit keyword directly applied (either with parenthesis or with BlockArguments)
+  transform' (L _ (HsApp _xapp (L _ circuitVar) lappB))
+    | isCircuitVar circuitVar = runCircuitM $ do
+        x <- parseCircuit lappB >> completeUnderscores >> circuitQQExpM
+        when debug $ ppr x
+        pure x
+
+  -- `circuit $` application
+  transform' (L _ (OpApp _xapp c@(L _ circuitVar) (L _ infixVar) appR))
+    | isDollar infixVar && dollarChainIsCircuit circuitVar = do
+        runCircuitM $ do
+          x <- parseCircuit appR >> completeUnderscores >> circuitQQExpM
+          when debug $ ppr x
+          pure (dollarChainReplaceCircuit x c)
+
+  transform' e = pure e
+
+-- | check if circuit is applied via `a $ chain $ of $ dollars`.
+dollarChainIsCircuit :: HsExpr GhcPs -> Bool
+dollarChainIsCircuit = \case
+  HsVar _ (L _ v)                             -> v == GHC.mkVarUnqual "circuit"
+  OpApp _xapp _appL (L _ infixVar) (L _ appR) -> isDollar infixVar && dollarChainIsCircuit appR
+  _                                           -> False
+
+-- | Replace the circuit if it's part of a chain of `$`.
+dollarChainReplaceCircuit :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
+dollarChainReplaceCircuit circuitExpr (L loc app) = case app of
+  HsVar _ (L _loc v)
+    -> if v == GHC.mkVarUnqual "circuit"
+         then circuitExpr
+         else error "dollarChainAddCircuit: not a circuit"
+  OpApp xapp appL (L infixLoc infixVar) appR
+    -> L loc $ OpApp xapp appL (L infixLoc infixVar) (dollarChainReplaceCircuit circuitExpr appR)
+  t -> error $ "dollarChainAddCircuit unhandled case " <> showC t
+
+-- | The plugin for circuit notation.
+plugin :: GHC.Plugin
+plugin = mkPlugin defExternalNames
+
+-- | Make a plugin with custom external names
+mkPlugin :: ExternalNames -> GHC.Plugin
+mkPlugin nms = GHC.defaultPlugin
+  { GHC.parsedResultAction = let ?nms = nms in pluginImpl
+    -- Mark plugin as 'pure' to prevent recompilations.
+  , GHC.pluginRecompile = \_cliOptions -> pure GHC.NoForceRecompile
+  }
+
+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
+      []        -> pure False
+      ["debug"] -> pure True
+      _ -> do
+        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 -------------------------------------------------
+
+ppr :: GHC.Outputable a => a -> CircuitM ()
+ppr a = do
+  dflags <- GHC.getDynFlags
+  liftIO $ putStrLn (GHC.showPpr dflags a)
+
+showC :: Data.Data a => a -> String
+showC a = show (typeOf a) <> " " <> show (Data.toConstr a)
+
+-- Names ---------------------------------------------------------------
+
+fwdNames :: [String]
+fwdNames = ["Fwd", "Signal"]
+
+-- | Collection of names external to circuit-notation.
+data ExternalNames = ExternalNames
+  { circuitCon :: GHC.RdrName
+  , runCircuitName :: GHC.RdrName
+  , tagBundlePat :: GHC.RdrName
+  , tagName :: GHC.RdrName
+  , tagTName :: GHC.RdrName
+  , fwdBwdCon :: GHC.RdrName
+  , fwdAndBwdTypes :: Direction -> GHC.RdrName
+  , trivialBwd :: GHC.RdrName
+  , consPat :: GHC.RdrName
+  }
+
+defExternalNames :: ExternalNames
+defExternalNames = ExternalNames
+  { circuitCon = GHC.Unqual (OccName.mkDataOcc "TagCircuit")
+  , runCircuitName = GHC.Unqual (OccName.mkVarOcc "runTagCircuit")
+  , tagBundlePat = GHC.Unqual (OccName.mkDataOcc "BusTagBundle")
+  , tagName = GHC.Unqual (OccName.mkDataOcc "BusTag")
+  , tagTName = GHC.Unqual (OccName.mkTcOcc "BusTag")
+  , fwdBwdCon = GHC.Unqual (OccName.mkDataOcc ":->")
+  , fwdAndBwdTypes = \case
+      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
+  }
diff --git a/src/GHC/Types/Unique/Map.hs b/src/GHC/Types/Unique/Map.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/Types/Unique/Map.hs
@@ -0,0 +1,213 @@
+{-# 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
diff --git a/src/GHC/Types/Unique/Map/Extra.hs b/src/GHC/Types/Unique/Map/Extra.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/Types/Unique/Map/Extra.hs
@@ -0,0 +1,19 @@
+{-# 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
diff --git a/tests/unittests.hs b/tests/unittests.hs
new file mode 100644
--- /dev/null
+++ b/tests/unittests.hs
@@ -0,0 +1,11 @@
+-- This option is a test by itself: if we were to export a plugin with the
+-- wrong type or name, GHC would refuse to compile this file.
+{-# OPTIONS -fplugin=CircuitNotation #-}
+
+module Main where
+
+import           Circuit
+import           Example
+
+main :: IO ()
+main = pure ()