diff --git a/Math/LinearMap/Category.hs b/Math/LinearMap/Category.hs
--- a/Math/LinearMap/Category.hs
+++ b/Math/LinearMap/Category.hs
@@ -418,7 +418,7 @@
 -- v '<.>^' (w |&> 'euclideanNorm')  ≡  v '<.>' w
 -- @
 (|&>) :: LSpace v => DualVector v -> Variance v -> v
-dv |&> Norm m = GHC.sym coerceDoubleDual $ m-+$>dv
+dv |&> Norm m = symVSC coerceDoubleDual $ m-+$>dv
 
 
 -- | 'spanNorm' / 'spanVariance' are inefficient if the number of vectors
diff --git a/Math/LinearMap/Category/Class.hs b/Math/LinearMap/Category/Class.hs
--- a/Math/LinearMap/Category/Class.hs
+++ b/Math/LinearMap/Category/Class.hs
@@ -47,6 +47,7 @@
 import Math.VectorSpace.ZeroDimensional
 import Data.VectorSpace.Free
 
+import Data.Kind (Type)
 import qualified GHC.Generics as Gnrx
 import GHC.Generics (Generic, (:*:)((:*:)))
 
@@ -73,6 +74,41 @@
                            BoundarylessWitness v ->
 #endif
                            LinearManifoldWitness v
+
+-- | A coercion that is compatible with the vector space structure of the types.
+--   Intended to be used for lossless conversion between newtype wrappers around
+--   vector spaces, under the requirement that they internally use the same basis
+--   (if any). Note that this does not mean they also need to have the same inner
+--   product / dual space.
+data VSCCoercion a b where
+  VSCCoercion :: Coercible a b
+     => VSCCoercion a b
+
+getVSCCoercion :: VSCCoercion a b -> Coercion a b
+getVSCCoercion VSCCoercion = Coercion
+
+symVSC :: VSCCoercion a b -> VSCCoercion b a
+symVSC VSCCoercion = VSCCoercion
+
+firstVSC :: VSCCoercion a b -> VSCCoercion (a,c) (b,c)
+firstVSC VSCCoercion = VSCCoercion
+
+secondVSC :: VSCCoercion a b -> VSCCoercion (c,a) (c,b)
+secondVSC VSCCoercion = VSCCoercion
+
+unsafeFollowVSC :: Coercible a b => c a b -> VSCCoercion a b
+unsafeFollowVSC _ = VSCCoercion
+
+unsafeFloutVSC :: Coercible a b => c b a -> VSCCoercion a b
+unsafeFloutVSC _ = VSCCoercion
+
+instance Category VSCCoercion where
+  id = VSCCoercion
+  VSCCoercion . VSCCoercion = VSCCoercion
+instance EnhancedCat Coercion VSCCoercion where
+  arr = getVSCCoercion
+instance EnhancedCat (->) VSCCoercion where
+  arr VSCCoercion x = coerce x
   
 class (VectorSpace v, PseudoAffine v) => TensorSpace v where
   -- | The internal representation of a 'Tensor' product.
@@ -80,7 +116,7 @@
   -- For Euclidean spaces, this is generally constructed by replacing each @s@
   -- scalar field in the @v@ vector with an entire @w@ vector. I.e., you have
   -- then a “nested vector” or, if @v@ is a @DualVector@ / “row vector”, a matrix.
-  type TensorProduct v w :: *
+  type TensorProduct v w :: Type
   scalarSpaceWitness :: ScalarSpaceWitness v
   linearManifoldWitness :: LinearManifoldWitness v
   zeroTensor :: (TensorSpace w, Scalar w ~ Scalar v)
@@ -120,7 +156,7 @@
                     , Scalar u ~ Scalar v, Scalar w ~ Scalar v, Scalar x ~ Scalar v )
            => Bilinear ((w,x) -+> u) (v⊗w, v⊗x) (v⊗u)
   coerceFmapTensorProduct :: Hask.Functor p
-       => p v -> Coercion a b -> Coercion (TensorProduct v a) (TensorProduct v b)
+       => p v -> VSCCoercion a b -> VSCCoercion (TensorProduct v a) (TensorProduct v b)
   -- | “Sanity-check” a vector. This typically amounts to detecting any NaN components,
   --   which should trigger a @Nothing@ result. Otherwise, the result should be @Just@
   --   the input, but may also be optimised / memoised if applicable (i.e. for
@@ -151,7 +187,7 @@
   --   (In this case, a dual vector will be just a “row vector” if you consider
   --   @v@-vectors as “column vectors”. 'LinearMap' will then effectively have
   --   a matrix layout.)
-  type DualVector v :: *
+  type DualVector v :: Type
   
   dualSpaceWitness :: DualSpaceWitness v
  
@@ -178,9 +214,9 @@
                         , dualSpaceWitness :: DualSpaceWitness v ) of
     (ScalarSpaceWitness,DualSpaceWitness) -> arr asTensor >>> fromFlatTensor
   
-  coerceDoubleDual :: Coercion v (DualVector (DualVector v))
+  coerceDoubleDual :: VSCCoercion v (DualVector (DualVector v))
   coerceDoubleDual = case dualSpaceWitness :: DualSpaceWitness v of
-    DualSpaceWitness -> Coercion
+    DualSpaceWitness -> VSCCoercion
   
   trace :: (v+>v) -+> Scalar v
   trace = case scalarSpaceWitness :: ScalarSpaceWitness v of
@@ -261,7 +297,7 @@
   transposeTensor = const0
   fmapTensor = biConst0
   fzipTensorWith = biConst0
-  coerceFmapTensorProduct _ Coercion = Coercion
+  coerceFmapTensorProduct _ VSCCoercion = VSCCoercion
   wellDefinedVector Origin = Just Origin
   wellDefinedTensor (Tensor Origin) = Just (Tensor Origin)
 instance Num' s => LinearSpace (ZeroDim s) where
@@ -273,7 +309,7 @@
   tensorId = LinearMap Origin
   toLinearForm = LinearFunction . const $ LinearMap Origin
   fromLinearForm = const0
-  coerceDoubleDual = Coercion
+  coerceDoubleDual = VSCCoercion
   contractTensorMap = const0
   contractMapTensor = const0
   contractLinearMapAgainst = biConst0
@@ -310,28 +346,28 @@
 --   linear mappings, but they also form a useful vector space on their own right.
 newtype Tensor s v w = Tensor {getTensorProduct :: TensorProduct v w}
 
-asTensor :: Coercion (LinearMap s v w) (Tensor s (DualVector v) w)
-asTensor = Coercion
-fromTensor :: Coercion (Tensor s (DualVector v) w) (LinearMap s v w)
-fromTensor = Coercion
+asTensor :: VSCCoercion (LinearMap s v w) (Tensor s (DualVector v) w)
+asTensor = VSCCoercion
+fromTensor :: VSCCoercion (Tensor s (DualVector v) w) (LinearMap s v w)
+fromTensor = VSCCoercion
 
 asLinearMap :: ∀ s v w . (LinearSpace v, Scalar v ~ s)
-           => Coercion (Tensor s v w) (LinearMap s (DualVector v) w)
+           => VSCCoercion (Tensor s v w) (LinearMap s (DualVector v) w)
 asLinearMap = case dualSpaceWitness :: DualSpaceWitness v of
-                DualSpaceWitness -> Coercion
+                DualSpaceWitness -> VSCCoercion
 fromLinearMap :: ∀ s v w . (LinearSpace v, Scalar v ~ s)
-           => Coercion (LinearMap s (DualVector v) w) (Tensor s v w)
+           => VSCCoercion (LinearMap s (DualVector v) w) (Tensor s v w)
 fromLinearMap = case dualSpaceWitness :: DualSpaceWitness v of
-                DualSpaceWitness -> Coercion
+                DualSpaceWitness -> VSCCoercion
 
 
 pseudoFmapTensorLHS :: (TensorProduct v w ~ TensorProduct v' w)
-           => c v v' -> Coercion (Tensor s v w) (Tensor s v' w)
-pseudoFmapTensorLHS _ = Coercion
+           => c v v' -> VSCCoercion (Tensor s v w) (Tensor s v' w)
+pseudoFmapTensorLHS _ = VSCCoercion
 
 pseudoPrecomposeLinmap :: (TensorProduct (DualVector v) w ~ TensorProduct (DualVector v') w)
-           => c v' v -> Coercion (LinearMap s v w) (LinearMap s v' w)
-pseudoPrecomposeLinmap _ = Coercion
+           => c v' v -> VSCCoercion (LinearMap s v w) (LinearMap s v' w)
+pseudoPrecomposeLinmap _ = VSCCoercion
 
 envTensorLHSCoercion :: ( TensorProduct v w ~ TensorProduct v' w
                         , TensorProduct v w' ~ TensorProduct v' w' )
@@ -513,9 +549,11 @@
   subtractTensors (Tensor (fu, fv)) (Tensor (fu', fv'))
           = (fu ^-^ fu') <⊕ (fv ^-^ fv')
   toFlatTensor = case scalarSpaceWitness :: ScalarSpaceWitness u of
-     ScalarSpaceWitness -> follow Tensor <<< toFlatTensor *** toFlatTensor
+     ScalarSpaceWitness -> LinearFunction coerce
+                          <<< toFlatTensor *** toFlatTensor
   fromFlatTensor = case scalarSpaceWitness :: ScalarSpaceWitness u of
-     ScalarSpaceWitness -> flout Tensor >>> fromFlatTensor *** fromFlatTensor
+     ScalarSpaceWitness -> LinearFunction coerce
+                          >>> fromFlatTensor *** fromFlatTensor
   tensorProduct = bilinearFunction $ \(u,v) w ->
                     Tensor ((tensorProduct-+$>u)-+$>w, (tensorProduct-+$>v)-+$>w)
   transposeTensor = LinearFunction $ \(Tensor (uw,vw))
@@ -529,7 +567,7 @@
   coerceFmapTensorProduct p cab = case
              ( coerceFmapTensorProduct (fst<$>p) cab
              , coerceFmapTensorProduct (snd<$>p) cab ) of
-          (Coercion, Coercion) -> Coercion
+          (VSCCoercion, VSCCoercion) -> VSCCoercion
   wellDefinedVector (u,v) = liftA2 (,) (wellDefinedVector u) (wellDefinedVector v)
   wellDefinedTensor (Tensor (u,v))
          = liftA2 ((Tensor.) . (,)) (wellDefinedTensor u) (wellDefinedTensor v)
@@ -607,31 +645,31 @@
 
 -- | @((v'⊗w)+>x) -> ((v+>w)+>x)
 argFromTensor :: ∀ s v w x . (LinearSpace v, LinearSpace w, Scalar v ~ s, Scalar w ~ s)
-                 => Coercion (LinearMap s (Tensor s (DualVector v) w) x)
+                 => VSCCoercion (LinearMap s (Tensor s (DualVector v) w) x)
                              (LinearMap s (LinearMap s v w) x)
 argFromTensor = case dualSpaceWitness :: DualSpaceWitness v of
      DualSpaceWitness -> curryLinearMap >>> fromLinearMap >>> coUncurryLinearMap
 
 -- | @((v+>w)+>x) -> ((v'⊗w)+>x)@
 argAsTensor :: ∀ s v w x . (LinearSpace v, LinearSpace w, Scalar v ~ s, Scalar w ~ s)
-                 => Coercion (LinearMap s (LinearMap s v w) x)
+                 => VSCCoercion (LinearMap s (LinearMap s v w) x)
                              (LinearMap s (Tensor s (DualVector v) w) x)
 argAsTensor = case dualSpaceWitness :: DualSpaceWitness v of
      DualSpaceWitness -> uncurryLinearMap <<< asLinearMap <<< coCurryLinearMap
 
 -- | @(u+>(v⊗w)) -> (u+>v)⊗w@
-deferLinearMap :: Coercion (LinearMap s u (Tensor s v w)) (Tensor s (LinearMap s u v) w)
-deferLinearMap = Coercion
+deferLinearMap :: VSCCoercion (LinearMap s u (Tensor s v w)) (Tensor s (LinearMap s u v) w)
+deferLinearMap = VSCCoercion
 
 -- | @(u+>v)⊗w -> u+>(v⊗w)@
-hasteLinearMap :: Coercion (Tensor s (LinearMap s u v) w) (LinearMap s u (Tensor s v w))
-hasteLinearMap = Coercion
+hasteLinearMap :: VSCCoercion (Tensor s (LinearMap s u v) w) (LinearMap s u (Tensor s v w))
+hasteLinearMap = VSCCoercion
 
 
-lassocTensor :: Coercion (Tensor s u (Tensor s v w)) (Tensor s (Tensor s u v) w)
-lassocTensor = Coercion
-rassocTensor :: Coercion (Tensor s (Tensor s u v) w) (Tensor s u (Tensor s v w))
-rassocTensor = Coercion
+lassocTensor :: VSCCoercion (Tensor s u (Tensor s v w)) (Tensor s (Tensor s u v) w)
+lassocTensor = VSCCoercion
+rassocTensor :: VSCCoercion (Tensor s (Tensor s u v) w) (Tensor s u (Tensor s v w))
+rassocTensor = VSCCoercion
 
 instance ∀ s u v . ( LinearSpace u, TensorSpace v, Scalar u ~ s, Scalar v ~ s )
                        => TensorSpace (LinearMap s u v) where
@@ -687,21 +725,21 @@
                 -> arr deferLinearMap <<< fzipWith (fzipWith f)
                      <<< arr hasteLinearMap *** arr hasteLinearMap
   coerceFmapTensorProduct = cftlp dualSpaceWitness
-   where cftlp :: ∀ a b p . DualSpaceWitness u -> p (LinearMap s u v) -> Coercion a b
-                   -> Coercion (TensorProduct (DualVector u) (Tensor s v a))
+   where cftlp :: ∀ a b p . DualSpaceWitness u -> p (LinearMap s u v) -> VSCCoercion a b
+                   -> VSCCoercion (TensorProduct (DualVector u) (Tensor s v a))
                                (TensorProduct (DualVector u) (Tensor s v b))
          cftlp DualSpaceWitness _ c
                    = coerceFmapTensorProduct ([]::[DualVector u])
-                                             (fmap c :: Coercion (v⊗a) (v⊗b))
+                                             (fmap c :: VSCCoercion (v⊗a) (v⊗b))
   wellDefinedVector = case dualSpaceWitness :: DualSpaceWitness u of
-      DualSpaceWitness -> arr asTensor >>> wellDefinedTensor >>> arr (fmap fromTensor)
+      DualSpaceWitness -> arr asTensor >>> wellDefinedTensor >>> arr (fmap (getVSCCoercion fromTensor))
   wellDefinedTensor
-      = arr hasteLinearMap >>> wellDefinedVector >>> arr (fmap deferLinearMap)
+      = arr hasteLinearMap >>> wellDefinedVector >>> arr (fmap (getVSCCoercion deferLinearMap))
 
 -- | @((u+>v)+>w) -> u⊗(v+>w)@
 coCurryLinearMap :: ∀ s u v w . ( LinearSpace u, Scalar u ~ s
                                 , LinearSpace v, Scalar v ~ s ) =>
-              Coercion (LinearMap s (LinearMap s u v) w) (Tensor s u (LinearMap s v w))
+              VSCCoercion (LinearMap s (LinearMap s u v) w) (Tensor s u (LinearMap s v w))
 coCurryLinearMap = case ( dualSpaceWitness :: DualSpaceWitness u
                         , dualSpaceWitness :: DualSpaceWitness v ) of
      (DualSpaceWitness, DualSpaceWitness)
@@ -710,7 +748,7 @@
 -- | @(u⊗(v+>w)) -> (u+>v)+>w@
 coUncurryLinearMap :: ∀ s u v w . ( LinearSpace u, Scalar u ~ s
                                 , LinearSpace v, Scalar v ~ s ) =>
-              Coercion (Tensor s u (LinearMap s v w)) (LinearMap s (LinearMap s u v) w)
+              VSCCoercion (Tensor s u (LinearMap s v w)) (LinearMap s (LinearMap s u v) w)
 coUncurryLinearMap = case ( dualSpaceWitness :: DualSpaceWitness u
                           , dualSpaceWitness :: DualSpaceWitness v ) of
      (DualSpaceWitness, DualSpaceWitness)
@@ -718,17 +756,17 @@
 
 -- | @((u⊗v)+>w) -> (u+>(v+>w))@
 curryLinearMap :: ∀ u v w s . ( LinearSpace u, Scalar u ~ s )
-           => Coercion (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
+           => VSCCoercion (LinearMap s (Tensor s u v) w) (LinearMap s u (LinearMap s v w))
 curryLinearMap = case dualSpaceWitness :: DualSpaceWitness u of
-           DualSpaceWitness -> (Coercion :: Coercion ((u⊗v)+>w)
+           DualSpaceWitness -> (VSCCoercion :: VSCCoercion ((u⊗v)+>w)
                                      ((DualVector u)⊗(Tensor s (DualVector v) w)) )
                                  >>> fmap fromTensor >>> fromTensor
 
 -- | @(u+>(v+>w)) -> ((u⊗v)+>w)@
 uncurryLinearMap :: ∀ u v w s . ( LinearSpace u, Scalar u ~ s )
-           => Coercion (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
+           => VSCCoercion (LinearMap s u (LinearMap s v w)) (LinearMap s (Tensor s u v) w)
 uncurryLinearMap = case dualSpaceWitness :: DualSpaceWitness u of
-           DualSpaceWitness -> (Coercion :: Coercion 
+           DualSpaceWitness -> (VSCCoercion :: VSCCoercion 
                                      ((DualVector u)⊗(Tensor s (DualVector v) w))
                                      ((u⊗v)+>w) )
                                  <<< fmap asTensor <<< asTensor
@@ -751,7 +789,7 @@
   tensorId = uncurryLinearMap . coUncurryLinearMap . fmap curryLinearMap
                . coCurryLinearMap . fmap deferLinearMap $ id
   coerceDoubleDual = case dualSpaceWitness :: DualSpaceWitness v of
-     DualSpaceWitness -> Coercion
+     DualSpaceWitness -> VSCCoercion
   applyLinear = case dualSpaceWitness :: DualSpaceWitness u of
     DualSpaceWitness -> bilinearFunction $ \f g
                   -> let tf = argAsTensor $ f
@@ -821,13 +859,14 @@
                 -> arr lassocTensor <<< fzipWith (fzipWith f)
                      <<< arr rassocTensor *** arr rassocTensor
   coerceFmapTensorProduct = cftlp
-   where cftlp :: ∀ a b p . p (Tensor s u v) -> Coercion a b
-                   -> Coercion (TensorProduct u (Tensor s v a))
+   where cftlp :: ∀ a b p . p (Tensor s u v) -> VSCCoercion a b
+                   -> VSCCoercion (TensorProduct u (Tensor s v a))
                                (TensorProduct u (Tensor s v b))
          cftlp _ c = coerceFmapTensorProduct ([]::[u])
-                                             (fmap c :: Coercion (v⊗a) (v⊗b))
+                                             (fmap c :: VSCCoercion (v⊗a) (v⊗b))
   wellDefinedVector = wellDefinedTensor
-  wellDefinedTensor = arr rassocTensor >>> wellDefinedTensor >>> arr (fmap lassocTensor)
+  wellDefinedTensor = arr (getVSCCoercion rassocTensor)
+                       >>> wellDefinedTensor >>> arr (fmap (getVSCCoercion lassocTensor))
 instance ∀ s u v . (LinearSpace u, LinearSpace v, Scalar u ~ s, Scalar v ~ s)
                        => LinearSpace (Tensor s u v) where
   type DualVector (Tensor s u v) = LinearMap s u (DualVector v)
@@ -836,7 +875,7 @@
                . fmap curryLinearMap . curryLinearMap $ tensorId
   coerceDoubleDual = case ( dualSpaceWitness :: DualSpaceWitness u
                           , dualSpaceWitness :: DualSpaceWitness v ) of
-    (DualSpaceWitness, DualSpaceWitness) -> Coercion
+    (DualSpaceWitness, DualSpaceWitness) -> VSCCoercion
   dualSpaceWitness = case ( dualSpaceWitness :: DualSpaceWitness u
                           , dualSpaceWitness :: DualSpaceWitness v ) of
     (DualSpaceWitness, DualSpaceWitness) -> DualSpaceWitness
@@ -895,22 +934,22 @@
     DualSpaceWitness -> \f -> arr asTensor *** arr asTensor >>> fzipWith f >>> arr fromTensor
 
 instance (TensorSpace v, Scalar v ~ s)
-            => Functor (Tensor s v) Coercion Coercion where
+            => Functor (Tensor s v) VSCCoercion VSCCoercion where
   fmap = crcFmap
    where crcFmap :: ∀ s v a b . (TensorSpace v, Scalar v ~ s)
-              => Coercion a b -> Coercion (Tensor s v a) (Tensor s v b)
+              => VSCCoercion a b -> VSCCoercion (Tensor s v a) (Tensor s v b)
          crcFmap f = case coerceFmapTensorProduct ([]::[v]) f of
-                       Coercion -> Coercion
+                       VSCCoercion -> VSCCoercion
 
 instance (LinearSpace v, Scalar v ~ s)
-            => Functor (LinearMap s v) Coercion Coercion where
+            => Functor (LinearMap s v) VSCCoercion VSCCoercion where
   fmap = crcFmap dualSpaceWitness
    where crcFmap :: ∀ s v a b . (LinearSpace v, Scalar v ~ s)
-              => DualSpaceWitness v -> Coercion a b
-                            -> Coercion (LinearMap s v a) (LinearMap s v b)
+              => DualSpaceWitness v -> VSCCoercion a b
+                            -> VSCCoercion (LinearMap s v a) (LinearMap s v b)
          crcFmap DualSpaceWitness f
              = case coerceFmapTensorProduct ([]::[DualVector v]) f of
-                       Coercion -> Coercion
+                       VSCCoercion -> VSCCoercion
 
 instance Category (LinearFunction s) where
   type Object (LinearFunction s) v = (TensorSpace v, Scalar v ~ s)
@@ -931,8 +970,8 @@
   terminal = const0
 instance EnhancedCat (->) (LinearFunction s) where
   arr = getLinearFunction
-instance EnhancedCat (LinearFunction s) Coercion where
-  arr = LinearFunction . coerceWith
+instance EnhancedCat (LinearFunction s) VSCCoercion where
+  arr VSCCoercion = LinearFunction coerce
 
 instance (LinearSpace w, Num' s, Scalar w ~ s)
      => Functor (LinearFunction s w) (LinearFunction s) (LinearFunction s) where
@@ -945,13 +984,13 @@
 sampleLinearFunctionFn = LinearFunction $
                 \f -> sampleLinearFunction -+$> f . applyLinear
 
-fromLinearFn :: Coercion (LinearFunction s (LinearFunction s u v) w)
+fromLinearFn :: VSCCoercion (LinearFunction s (LinearFunction s u v) w)
                          (Tensor s (LinearFunction s v u) w)
-fromLinearFn = Coercion
+fromLinearFn = VSCCoercion
 
-asLinearFn :: Coercion (Tensor s (LinearFunction s u v) w)
+asLinearFn :: VSCCoercion (Tensor s (LinearFunction s u v) w)
                        (LinearFunction s (LinearFunction s v u) w)
-asLinearFn = Coercion
+asLinearFn = VSCCoercion
 
 
 instance ∀ s u v . (LinearSpace u, LinearSpace v, Scalar u ~ s, Scalar v ~ s)
@@ -977,7 +1016,7 @@
 #endif
   zeroTensor = fromLinearFn $ const0
   toFlatTensor = case scalarSpaceWitness :: ScalarSpaceWitness u of
-     ScalarSpaceWitness -> fmap fromLinearFn $ applyDualVector
+     ScalarSpaceWitness -> fmap (getVSCCoercion fromLinearFn) $ applyDualVector
   fromFlatTensor = case ( scalarSpaceWitness :: ScalarSpaceWitness u
                         , dualSpaceWitness :: DualSpaceWitness u ) of
      (ScalarSpaceWitness, DualSpaceWitness)
@@ -1010,7 +1049,7 @@
   fzipTensorWith = case scalarSpaceWitness :: ScalarSpaceWitness u of
      ScalarSpaceWitness -> bilinearFunction $ \f (g,h)
                     -> fromLinearFn $ f . ((asLinearFn$g)&&&(asLinearFn$h))
-  coerceFmapTensorProduct _ Coercion = Coercion
+  coerceFmapTensorProduct _ VSCCoercion = VSCCoercion
   wellDefinedVector = arr sampleLinearFunction >>> wellDefinedVector
                        >>> fmap (arr applyLinear)
   wellDefinedTensor = arr asLinearFn >>> (. applyLinear)
@@ -1020,9 +1059,9 @@
                                    -> sampleLinearFunction
                                       >>> getLinearFunction applyLinear m)
 
-exposeLinearFn :: Coercion (LinearMap s (LinearFunction s u v) w)
+exposeLinearFn :: VSCCoercion (LinearMap s (LinearFunction s u v) w)
                            (LinearFunction s (LinearFunction s u v) w)
-exposeLinearFn = Coercion
+exposeLinearFn = VSCCoercion
 
 instance (LinearSpace u, LinearSpace v, Scalar u ~ s, Scalar v ~ s)
      => LinearSpace (LinearFunction s u v) where
@@ -1030,11 +1069,11 @@
   dualSpaceWitness = case ( dualSpaceWitness :: DualSpaceWitness u
                           , dualSpaceWitness :: DualSpaceWitness v ) of
       (DualSpaceWitness, DualSpaceWitness) -> DualSpaceWitness
-  linearId = sym exposeLinearFn $ id
-  tensorId = uncurryLinearMap . sym exposeLinearFn
+  linearId = symVSC exposeLinearFn $ id
+  tensorId = uncurryLinearMap . symVSC exposeLinearFn
                $ LinearFunction $ \f -> sampleLinearFunction-+$>tensorProduct-+$>f
-  coerceDoubleDual = Coercion
-  sampleLinearFunction = LinearFunction . arr $ sym exposeLinearFn
+  coerceDoubleDual = VSCCoercion
+  sampleLinearFunction = LinearFunction . arr $ symVSC exposeLinearFn
   applyDualVector = case scalarSpaceWitness :: ScalarSpaceWitness u of
        ScalarSpaceWitness -> bilinearFunction $
                       \f g -> trace . sampleLinearFunction -+$> f . g
@@ -1105,7 +1144,7 @@
 instance ∀ v s . TensorSpace v => TensorSpace (Gnrx.Rec0 v s) where
   type TensorProduct (Gnrx.Rec0 v s) w = TensorProduct v w
   wellDefinedVector = fmap Gnrx.K1 . wellDefinedVector . Gnrx.unK1
-  wellDefinedTensor = arr (fmap $ pseudoFmapTensorLHS Gnrx.K1)
+  wellDefinedTensor = arr (fmap . getVSCCoercion $ pseudoFmapTensorLHS Gnrx.K1)
                          . wellDefinedTensor . arr (pseudoFmapTensorLHS Gnrx.unK1)
   scalarSpaceWitness = genericTensorspaceError
   linearManifoldWitness = genericTensorspaceError
@@ -1128,8 +1167,8 @@
    where tT :: ∀ w . (TensorSpace w, Scalar w ~ Scalar v)
                 => (Gnrx.Rec0 v s ⊗ w) -+> (w ⊗ Gnrx.Rec0 v s)
          tT = LinearFunction
-           $ arr (Coercion . coerceFmapTensorProduct ([]::[w])
-                                    (Coercion :: Coercion v (Gnrx.Rec0 v s)) . Coercion)
+           $ arr (VSCCoercion . coerceFmapTensorProduct ([]::[w])
+                                    (VSCCoercion :: VSCCoercion v (Gnrx.Rec0 v s)) . VSCCoercion)
               . getLinearFunction transposeTensor . arr (pseudoFmapTensorLHS Gnrx.unK1)
   fmapTensor = LinearFunction $
          \f -> envTensorLHSCoercion Gnrx.K1 (fmapTensor-+$>f)
@@ -1140,16 +1179,16 @@
                              , pseudoFmapTensorLHS Gnrx.unK1 $ xt )
   coerceFmapTensorProduct = cmtp
    where cmtp :: ∀ p a b . Hask.Functor p
-             => p (Gnrx.Rec0 v s) -> Coercion a b
-               -> Coercion (TensorProduct (Gnrx.Rec0 v s) a)
+             => p (Gnrx.Rec0 v s) -> VSCCoercion a b
+               -> VSCCoercion (TensorProduct (Gnrx.Rec0 v s) a)
                            (TensorProduct (Gnrx.Rec0 v s) b)
          cmtp p crc = case coerceFmapTensorProduct ([]::[v]) crc of
-                  Coercion -> Coercion
+                  VSCCoercion -> VSCCoercion
 
 instance ∀ i c f p . TensorSpace (f p) => TensorSpace (Gnrx.M1 i c f p) where
   type TensorProduct (Gnrx.M1 i c f p) w = TensorProduct (f p) w
   wellDefinedVector = fmap Gnrx.M1 . wellDefinedVector . Gnrx.unM1
-  wellDefinedTensor = arr (fmap $ pseudoFmapTensorLHS Gnrx.M1)
+  wellDefinedTensor = arr (fmap . getVSCCoercion $ pseudoFmapTensorLHS Gnrx.M1)
                          . wellDefinedTensor . arr (pseudoFmapTensorLHS Gnrx.unM1)
   scalarSpaceWitness = genericTensorspaceError
   linearManifoldWitness = genericTensorspaceError
@@ -1172,8 +1211,8 @@
    where tT :: ∀ w . (TensorSpace w, Scalar w ~ Scalar (f p))
                 => (Gnrx.M1 i c f p ⊗ w) -+> (w ⊗ Gnrx.M1 i c f p)
          tT = LinearFunction
-           $ arr (Coercion . coerceFmapTensorProduct ([]::[w])
-                                (Coercion :: Coercion (f p) (Gnrx.M1 i c f p)) . Coercion)
+           $ arr (VSCCoercion . coerceFmapTensorProduct ([]::[w])
+                                (VSCCoercion :: VSCCoercion (f p) (Gnrx.M1 i c f p)) . VSCCoercion)
               . getLinearFunction transposeTensor . arr (pseudoFmapTensorLHS Gnrx.unM1)
   fmapTensor = LinearFunction $
          \f -> envTensorLHSCoercion Gnrx.M1 (fmapTensor-+$>f)
@@ -1184,11 +1223,11 @@
                              , pseudoFmapTensorLHS Gnrx.unM1 $ xt )
   coerceFmapTensorProduct = cmtp
    where cmtp :: ∀ ぴ a b . Hask.Functor ぴ
-             => ぴ (Gnrx.M1 i c f p) -> Coercion a b
-               -> Coercion (TensorProduct (Gnrx.M1 i c f p) a)
+             => ぴ (Gnrx.M1 i c f p) -> VSCCoercion a b
+               -> VSCCoercion (TensorProduct (Gnrx.M1 i c f p) a)
                            (TensorProduct (Gnrx.M1 i c f p) b)
          cmtp p crc = case coerceFmapTensorProduct ([]::[f p]) crc of
-                  Coercion -> Coercion
+                  VSCCoercion -> VSCCoercion
 
 instance ∀ f g p . ( TensorSpace (f p), TensorSpace (g p), Scalar (f p) ~ Scalar (g p) )
                        => TensorSpace ((f:*:g) p) where
@@ -1224,7 +1263,7 @@
   coerceFmapTensorProduct p cab = case
              ( coerceFmapTensorProduct ((\(u:*:_)->u)<$>p) cab
              , coerceFmapTensorProduct ((\(_:*:v)->v)<$>p) cab ) of
-          (Coercion, Coercion) -> Coercion
+          (VSCCoercion, VSCCoercion) -> VSCCoercion
   wellDefinedVector (u:*:v) = liftA2 (:*:) (wellDefinedVector u) (wellDefinedVector v)
   wellDefinedTensor (Tensor (u,v))
          = liftA2 ((Tensor.) . (,)) (wellDefinedTensor u) (wellDefinedTensor v)
@@ -1235,7 +1274,7 @@
                   => TensorSpace (GenericNeedle m) where
   type TensorProduct (GenericNeedle m) w = TensorProduct (Needle (VRep m)) w
   wellDefinedVector = fmap GenericNeedle . wellDefinedVector . getGenericNeedle
-  wellDefinedTensor = arr (fmap $ pseudoFmapTensorLHS GenericNeedle)
+  wellDefinedTensor = arr (fmap . getVSCCoercion $ pseudoFmapTensorLHS GenericNeedle)
                          . wellDefinedTensor . arr (pseudoFmapTensorLHS getGenericNeedle)
   scalarSpaceWitness = case scalarSpaceWitness
                                :: ScalarSpaceWitness (Needle (VRep m)) of
@@ -1271,9 +1310,9 @@
    where tT :: ∀ w . (TensorSpace w, Scalar w ~ Scalar (Needle m))
                 => (GenericNeedle m ⊗ w) -+> (w ⊗ GenericNeedle m)
          tT = LinearFunction
-           $ arr (Coercion . coerceFmapTensorProduct ([]::[w])
-                              (Coercion :: Coercion (Needle (VRep m))
-                                                    (GenericNeedle m)) . Coercion)
+           $ arr (VSCCoercion . coerceFmapTensorProduct ([]::[w])
+                              (VSCCoercion :: VSCCoercion (Needle (VRep m))
+                                                    (GenericNeedle m)) . VSCCoercion)
               . getLinearFunction transposeTensor . arr (pseudoFmapTensorLHS getGenericNeedle)
   fmapTensor = LinearFunction $
          \f -> envTensorLHSCoercion GenericNeedle (fmapTensor-+$>f)
@@ -1284,17 +1323,18 @@
                              , pseudoFmapTensorLHS getGenericNeedle $ xt )
   coerceFmapTensorProduct = cmtp
    where cmtp :: ∀ p a b . Hask.Functor p
-             => p (GenericNeedle m) -> Coercion a b
-               -> Coercion (TensorProduct (GenericNeedle m) a)
+             => p (GenericNeedle m) -> VSCCoercion a b
+               -> VSCCoercion (TensorProduct (GenericNeedle m) a)
                            (TensorProduct (GenericNeedle m) b)
          cmtp p crc = case coerceFmapTensorProduct ([]::[Needle (VRep m)]) crc of
-                  Coercion -> Coercion
+                  VSCCoercion -> VSCCoercion
 
 instance (LinearSpace v, Num (Scalar v)) => LinearSpace (Gnrx.Rec0 v s) where
   type DualVector (Gnrx.Rec0 v s) = DualVector v
   dualSpaceWitness = genericTensorspaceError
   linearId = pseudoPrecomposeLinmap Gnrx.unK1
-                . fmap (follow Gnrx.K1) $ linearId
+                . fmap VSCCoercion
+                $ linearId
   applyDualVector = bilinearFunction $ \dv (Gnrx.K1 v) -> (applyDualVector-+$>dv)-+$>v
   applyLinear = bilinearFunction $ \(LinearMap f) (Gnrx.K1 v)
                       -> (applyLinear-+$>LinearMap f)-+$>v
@@ -1310,7 +1350,8 @@
   type DualVector (Gnrx.M1 i c f p) = DualVector (f p)
   dualSpaceWitness = genericTensorspaceError
   linearId = pseudoPrecomposeLinmap Gnrx.unM1
-                . fmap (follow Gnrx.M1) $ linearId
+                . fmap VSCCoercion
+                $ linearId
   applyDualVector = bilinearFunction $ \dv (Gnrx.M1 v) -> (applyDualVector-+$>dv)-+$>v
   applyLinear = bilinearFunction $ \(LinearMap f) (Gnrx.M1 v)
                       -> (applyLinear-+$>LinearMap f)-+$>v
@@ -1368,8 +1409,10 @@
                            , dualSpaceWitness :: DualSpaceWitness (g p) ) of
       (DualSpaceWitness, DualSpaceWitness)
        -> \(Tensor (ft, gt))
-        -> Tensor <$> liftA2 (,) (fmap fromTensor $ wellDefinedTensor (fromLinearMap $ ft))
-                                 (fmap fromTensor $ wellDefinedTensor (fromLinearMap $ gt))
+        -> Tensor <$> liftA2 (,) (fmap (getVSCCoercion fromTensor)
+                                    $ wellDefinedTensor (fromLinearMap $ ft))
+                                 (fmap (getVSCCoercion fromTensor)
+                                    $ wellDefinedTensor (fromLinearMap $ gt))
   scalarSpaceWitness = case scalarSpaceWitness :: ScalarSpaceWitness (f p) of
         ScalarSpaceWitness -> ScalarSpaceWitness
   linearManifoldWitness = LinearManifoldWitness
@@ -1436,7 +1479,7 @@
        (DualSpaceWitness, DualSpaceWitness) -> case
              ( coerceFmapTensorProduct ((\(GenericTupleDual u _)->u)<$>p) cab
              , coerceFmapTensorProduct ((\(GenericTupleDual _ v)->v)<$>p) cab ) of
-          (Coercion, Coercion) -> Coercion
+          (VSCCoercion, VSCCoercion) -> VSCCoercion
   
 
 
@@ -1537,7 +1580,7 @@
   type TensorProduct (GenericNeedle' m) w
          = TensorProduct (DualVector (Needle (VRep m))) w
   wellDefinedVector = fmap GenericNeedle' . wellDefinedVector . getGenericNeedle'
-  wellDefinedTensor = arr (fmap $ pseudoFmapTensorLHS GenericNeedle')
+  wellDefinedTensor = arr (fmap . getVSCCoercion $ pseudoFmapTensorLHS GenericNeedle')
                          . wellDefinedTensor . arr (pseudoFmapTensorLHS getGenericNeedle')
   scalarSpaceWitness = case scalarSpaceWitness
                     :: ScalarSpaceWitness (DualVector (Needle (VRep m))) of
@@ -1573,9 +1616,9 @@
    where tT :: ∀ w . (TensorSpace w, Scalar w ~ Scalar (Needle m))
                 => (GenericNeedle' m ⊗ w) -+> (w ⊗ GenericNeedle' m)
          tT = LinearFunction
-           $ arr (Coercion . coerceFmapTensorProduct ([]::[w])
-                              (Coercion :: Coercion (DualVector (Needle (VRep m)))
-                                                    (GenericNeedle' m)) . Coercion)
+           $ arr (VSCCoercion . coerceFmapTensorProduct ([]::[w])
+                              (VSCCoercion :: VSCCoercion (DualVector (Needle (VRep m)))
+                                                    (GenericNeedle' m)) . VSCCoercion)
               . getLinearFunction transposeTensor . arr (pseudoFmapTensorLHS getGenericNeedle')
   fmapTensor = LinearFunction $
          \f -> envTensorLHSCoercion GenericNeedle' (fmapTensor-+$>f)
@@ -1586,12 +1629,12 @@
                              , pseudoFmapTensorLHS getGenericNeedle' $ xt )
   coerceFmapTensorProduct = cmtp
    where cmtp :: ∀ p a b . Hask.Functor p
-             => p (GenericNeedle' m) -> Coercion a b
-               -> Coercion (TensorProduct (GenericNeedle' m) a)
+             => p (GenericNeedle' m) -> VSCCoercion a b
+               -> VSCCoercion (TensorProduct (GenericNeedle' m) a)
                            (TensorProduct (GenericNeedle' m) b)
          cmtp p crc = case coerceFmapTensorProduct
                               ([]::[DualVector (Needle (VRep m))]) crc of
-                  Coercion -> Coercion
+                  VSCCoercion -> VSCCoercion
 
 
 instance ∀ s m . ( Num' s
@@ -1600,7 +1643,8 @@
                  , Scalar (Needle (VRep m)) ~ s )
                   => LinearSpace (GenericNeedle m) where
   type DualVector (GenericNeedle m) = GenericNeedle' m
-  linearId = fmap (follow GenericNeedle) . pseudoPrecomposeLinmap getGenericNeedle
+  linearId = fmap VSCCoercion
+              . pseudoPrecomposeLinmap getGenericNeedle
                $ linearId
   dualSpaceWitness = case ( closedScalarWitness :: ClosedScalarWitness s
                           , dualSpaceWitness :: DualSpaceWitness (Needle (VRep m)) ) of
@@ -1629,7 +1673,7 @@
                   => LinearSpace (GenericNeedle' m) where
   type DualVector (GenericNeedle' m) = GenericNeedle m
   linearId = case dualSpaceWitness :: DualSpaceWitness (Needle (VRep m)) of
-       DualSpaceWitness -> fmap (follow GenericNeedle')
+       DualSpaceWitness -> fmap VSCCoercion
                          . pseudoPrecomposeLinmap getGenericNeedle' $ linearId
   dualSpaceWitness = case ( closedScalarWitness :: ClosedScalarWitness s
                           , dualSpaceWitness :: DualSpaceWitness (Needle (VRep m)) ) of
diff --git a/Math/LinearMap/Category/Instances.hs b/Math/LinearMap/Category/Instances.hs
--- a/Math/LinearMap/Category/Instances.hs
+++ b/Math/LinearMap/Category/Instances.hs
@@ -107,26 +107,27 @@
   scaleTensor = bilinearFunction $ \μ (Tensor t) -> Tensor $ μ*^t; \
   addTensors (Tensor v) (Tensor w) = Tensor $ v ^+^ w; \
   subtractTensors (Tensor v) (Tensor w) = Tensor $ v ^-^ w; \
-  negateTensor = pretendLike Tensor lNegateV; \
-  toFlatTensor = follow Tensor; \
-  fromFlatTensor = flout Tensor; \
-  tensorProduct = LinearFunction $ \μ -> follow Tensor . scaleWith μ; \
-  transposeTensor = toFlatTensor . flout Tensor; \
-  fmapTensor = LinearFunction $ pretendLike Tensor; \
-  fzipTensorWith = LinearFunction \
-                   $ \f -> follow Tensor <<< f <<< flout Tensor *** flout Tensor; \
-  coerceFmapTensorProduct _ Coercion = Coercion; \
+  negateTensor = LinearFunction $ \(Tensor v) -> Tensor (negateV v); \
+  toFlatTensor = LinearFunction $ follow Tensor; \
+  fromFlatTensor = LinearFunction $ flout Tensor; \
+  tensorProduct = bilinearFunction $ \μ \
+           -> follow Tensor . getLinearFunction (scaleWith μ); \
+  transposeTensor = toFlatTensor . LinearFunction (flout Tensor); \
+  fmapTensor = bilinearFunction $ \f (Tensor t) -> Tensor (f-+$>t); \
+  fzipTensorWith = bilinearFunction \
+                   $ \(LinearFunction f) -> follow Tensor <<< f <<< flout Tensor *** flout Tensor; \
+  coerceFmapTensorProduct _ VSCCoercion = VSCCoercion; \
   wellDefinedTensor (Tensor w) = Tensor <$> wellDefinedVector w }; \
 instance LinearSpace (S) where { \
   type DualVector (S) = (S); \
   dualSpaceWitness = DualSpaceWitness; \
   linearId = LinearMap 1; \
-  tensorId = uncurryLinearMap $ LinearMap $ fmap (follow Tensor) -+$> id; \
+  tensorId = uncurryLinearMap $ LinearMap $ fmap (LinearFunction $ follow Tensor) -+$> id; \
   idTensor = Tensor 1; \
-  fromLinearForm = flout LinearMap; \
-  coerceDoubleDual = Coercion; \
-  contractTensorMap = flout Tensor . flout LinearMap; \
-  contractMapTensor = flout LinearMap . flout Tensor; \
+  fromLinearForm = LinearFunction $ flout LinearMap; \
+  coerceDoubleDual = VSCCoercion; \
+  contractTensorMap = LinearFunction $ flout Tensor . flout LinearMap; \
+  contractMapTensor = LinearFunction $ flout LinearMap . flout Tensor; \
   applyDualVector = scale; \
   applyLinear = LinearFunction $ \(LinearMap w) -> scaleV w; \
   applyTensorFunctional = bilinearFunction $ \(LinearMap du) (Tensor u) -> du<.>^u; \
@@ -168,9 +169,9 @@
   scaleTensor = bilinearFunction   \
           $ \μ -> Tensor . fmap (μ*^) . getTensorProduct; \
   toFlatTensor = case closedScalarWitness :: ClosedScalarWitness s of{ \
-                         ClosedScalarWitness -> follow Tensor}; \
+                         ClosedScalarWitness -> LinearFunction $ follow Tensor}; \
   fromFlatTensor = case closedScalarWitness :: ClosedScalarWitness s of{ \
-                         ClosedScalarWitness -> flout Tensor}; \
+                         ClosedScalarWitness -> LinearFunction $ flout Tensor}; \
   tensorProduct = bilinearFunction $ \w v -> Tensor $ fmap (*^v) w; \
   transposeTensor = LinearFunction (tp); \
   fmapTensor = bilinearFunction $       \
@@ -178,7 +179,7 @@
   fzipTensorWith = bilinearFunction $ \
           \(LinearFunction f) (Tensor vw, Tensor vx) \
                   -> Tensor $ liftA2 (curry f) vw vx; \
-  coerceFmapTensorProduct _ Coercion = Coercion; \
+  coerceFmapTensorProduct _ VSCCoercion = VSCCoercion; \
   wellDefinedTensor = getTensorProduct >>> Hask.traverse wellDefinedVector \
                        >>> fmap Tensor };                  \
 instance ∀ s . (Num' s, Eq s) => LinearSpace (V s) where {                  \
@@ -192,9 +193,9 @@
    ; ti DualSpaceWitness = LinearMap $ \
           fmap (\f -> fmap (LinearFunction $ Tensor . f)-+$>asTensor $ id) \
                (tenid :: V (w -> V w)) }; \
-  coerceDoubleDual = Coercion; \
+  coerceDoubleDual = VSCCoercion; \
   fromLinearForm = case closedScalarWitness :: ClosedScalarWitness s of{ \
-                         ClosedScalarWitness -> flout LinearMap}; \
+                         ClosedScalarWitness -> LinearFunction $ flout LinearMap}; \
   contractTensorMap = LinearFunction $ (contraction) . coerce . getLinearMap;      \
   contractMapTensor = LinearFunction $ (contraction) . coerce . getTensorProduct;      \
 {-contractTensorWith = bilinearFunction $ \
@@ -332,7 +333,7 @@
   fmapTensor = bilinearFunction $ \f (Tensor a) -> Tensor $ map (f$) a
   fzipTensorWith = bilinearFunction $ \f (Tensor a, Tensor b)
                      -> Tensor $ zipWith (curry $ arr f) a b
-  coerceFmapTensorProduct _ Coercion = Coercion
+  coerceFmapTensorProduct _ VSCCoercion = VSCCoercion
   wellDefinedTensor (Tensor a) = Tensor <$> Hask.traverse wellDefinedVector a
   
 
@@ -372,7 +373,7 @@
   fmapTensor = bilinearFunction $ \f (Tensor a) -> Tensor $ map (f$) a
   fzipTensorWith = bilinearFunction $ \f (Tensor a, Tensor b)
                      -> Tensor $ zipWith (curry $ arr f) a b
-  coerceFmapTensorProduct _ Coercion = Coercion
+  coerceFmapTensorProduct _ VSCCoercion = VSCCoercion
 
 instance (Num' n, UArr.Unbox n) => LinearSpace (Sequence n) where
   type DualVector (Sequence n) = FinSuppSeq n
@@ -490,7 +491,7 @@
   tensorProduct = bilinearFunction $ \(SymTensor t) g
                     -> Tensor $ fmap (LinearFunction (⊗g)) $ t
   transposeTensor = LinearFunction $ \(Tensor f) -> getLinearFunction (
-                            arr (fmap Coercion) . transposeTensor . arr lassocTensor) f
+                            arr (fmap VSCCoercion) . transposeTensor . arr lassocTensor) f
   fmapTensor = bilinearFunction $ \f (Tensor t) -> Tensor $ fmap (fmap f) $ t
   fzipTensorWith = bilinearFunction $ \f (Tensor s, Tensor t)
                  -> Tensor $ fzipWith (fzipWith f) $ (s,t)
@@ -504,11 +505,11 @@
           (ClosedScalarWitness, DualSpaceWitness) -> DualSpaceWitness
   linearId = case dualSpaceWitness :: DualSpaceWitness v of
     DualSpaceWitness -> LinearMap $ rassocTensor . asTensor
-                          . fmap (follow SymTensor . asTensor) $ id
+                          . fmap (unsafeFollowVSC SymTensor . asTensor) $ id
   tensorId = LinearMap $ asTensor . fmap asTensor . curryLinearMap
                            . fmap asTensor
                            . curryLinearMap
-                           . fmap (follow $ \t -> Tensor $ rassocTensor $ t)
+                           . fmap (unsafeFollowVSC $ \t -> Tensor $ rassocTensor $ t)
                            $ id
   applyLinear = case dualSpaceWitness :: DualSpaceWitness v of
     DualSpaceWitness -> bilinearFunction $ \(LinearMap f) (SymTensor t)
@@ -545,7 +546,7 @@
 type v⊗〃+>w = LinearMap (Scalar v) (SymmetricTensor (Scalar v) v) w
 
 currySymBilin :: LinearSpace v => (v⊗〃+>w) -+> (v+>(v+>w))
-currySymBilin = LinearFunction . arr $ fmap fromTensor . fromTensor . flout LinearMap
+currySymBilin = LinearFunction . arr $ fmap fromTensor . fromTensor . VSCCoercion
 
 
 
diff --git a/Math/LinearMap/Category/Instances/Deriving.hs b/Math/LinearMap/Category/Instances/Deriving.hs
--- a/Math/LinearMap/Category/Instances/Deriving.hs
+++ b/Math/LinearMap/Category/Instances/Deriving.hs
@@ -191,7 +191,7 @@
          $(varP 'fzipTensorWith) = bilinearFunction
            $ \(LinearFunction f) (Tensor tv, Tensor tw)
                 -> Tensor $ liftA2 (curry f) tv tw
-         $(varP 'coerceFmapTensorProduct) = \_ Coercion
+         $(varP 'coerceFmapTensorProduct) = \_ VSCCoercion
            -> error "Cannot yet coerce tensors defined from a `HasBasis` instance. This would require `RoleAnnotations` on `:->:`. Cf. https://gitlab.haskell.org/ghc/ghc/-/issues/8177"
        |]
   , InstanceD Nothing <$> cxt <*> [t|BasisGeneratedSpace $v|] <*> do
@@ -439,7 +439,7 @@
   fzipTensorWith = bilinearFunction
     $ \(LinearFunction f) (Tensor tv, Tensor tw)
          -> Tensor $ liftA2 (curry f) tv tw
-  coerceFmapTensorProduct _ Coercion
+  coerceFmapTensorProduct _ VSCCoercion
     = error "Cannot yet coerce tensors defined from a `HasBasis` instance. This would require `RoleAnnotations` on `:->:`. Cf. https://gitlab.haskell.org/ghc/ghc/-/issues/8177"
 
 
@@ -623,7 +623,7 @@
 #endif
       ) => AbstractTensorSpace v where
   abstractTensorProductsCoercion
-    :: Coercion (TensorProduct v w)
+    :: VSCCoercion (TensorProduct v w)
                 (TensorProduct (VectorSpaceImplementation v) w)
 
 class ( AbstractTensorSpace v, LinearSpace (VectorSpaceImplementation v)
@@ -641,30 +641,30 @@
         DualSpaceWitness -> scalarsSameInAbstraction @v φ
 
 abstractDualVectorCoercion :: ∀ a
-   . Coercion (AbstractDualVector a (VectorSpaceImplementation a))
+   . VSCCoercion (AbstractDualVector a (VectorSpaceImplementation a))
               (DualVector (VectorSpaceImplementation a))
-abstractDualVectorCoercion = Coercion
+abstractDualVectorCoercion = VSCCoercion
 
 abstractTensorsCoercion :: ∀ a c w
   . ( AbstractVectorSpace a, LinearSpace c
     , c ~ VectorSpaceImplementation a, TensorSpace w )
-      => Coercion (AbstractDualVector a c⊗w) (DualVector c⊗w)
-abstractTensorsCoercion = Coercion
+      => VSCCoercion (AbstractDualVector a c⊗w) (DualVector c⊗w)
+abstractTensorsCoercion = VSCCoercion
 
 abstractLinmapCoercion :: ∀ a c w
   . ( AbstractLinearSpace a, LinearSpace c
     , c ~ VectorSpaceImplementation a, TensorSpace w )
-      => Coercion (AbstractDualVector a c+>w) (DualVector c+>w)
+      => VSCCoercion (AbstractDualVector a c+>w) (DualVector c+>w)
 abstractLinmapCoercion = case ( dualSpaceWitness @c
                               , abstractTensorProductsCoercion @a @w ) of
-   (DualSpaceWitness, Coercion) -> Coercion
+   (DualSpaceWitness, VSCCoercion) -> VSCCoercion
 
 coerceLinearMapCodomain :: ∀ v w x . ( LinearSpace v, Coercible w x )
          => (v+>w) -> (v+>x)
 coerceLinearMapCodomain = case dualSpaceWitness @v of
  DualSpaceWitness -> \(LinearMap m)
      -> LinearMap $ (coerceFmapTensorProduct ([]::[DualVector v])
-                            (Coercion :: Coercion w x) $ m)
+                            (VSCCoercion :: VSCCoercion w x) $ m)
 
 instance (Show (DualVector c)) => Show (AbstractDualVector a c) where
   showsPrec p (AbstractDualVector_ φ) = showParen (p>10)
@@ -774,8 +774,8 @@
                      , Scalar (DualVector c) ~ Scalar a )
             => (AbstractDualVector a c ⊗ w) -+> (w ⊗ AbstractDualVector a c)
          tt = case coerceFmapTensorProduct @w []
-                       (Coercion @(DualVector c) @(AbstractDualVector a c)) of
-             Coercion -> coerce (transposeTensor @(DualVector c) @w)
+                       (VSCCoercion @(DualVector c) @(AbstractDualVector a c)) of
+             VSCCoercion -> coerce (transposeTensor @(DualVector c) @w)
   fmapTensor = ft
    where ft :: ∀ w x . ( TensorSpace w, Scalar w ~ Scalar a
                        , TensorSpace x, Scalar x ~ Scalar a )
@@ -813,7 +813,7 @@
     (DualSpaceWitness, ScalarSpaceWitness)
         -> scalarsSameInAbstraction @a DualSpaceWitness
   linearId = witnessAbstractDualVectorTensorSpacyness @a @c
-       (sym (abstractLinmapCoercion @a)
+       (symVSC (abstractLinmapCoercion @a)
            $ sampleLinearFunction @(DualVector c)
            -+$> linearFunction AbstractDualVector)
   tensorId = tid
@@ -824,10 +824,10 @@
             -> witnessAbstractDualVectorTensorSpacyness @a (
                 let LinearMap ida = linearId :: (DualVector c ⊗ w) +> (DualVector c ⊗ w)
                 in LinearMap $ 
-                    sym (abstractTensorProductsCoercion @a
+                    symVSC (abstractTensorProductsCoercion @a
                           @(DualVector w ⊗ (AbstractDualVector a c⊗w)) )
                     . coerceFmapTensorProduct ([]::[c ⊗ DualVector w])
-                       (Coercion @(DualVector c ⊗ w) @(AbstractDualVector a c ⊗ w))
+                       (VSCCoercion @(DualVector c ⊗ w) @(AbstractDualVector a c ⊗ w))
                     $ ida )
   applyDualVector = scalarsSameInAbstraction @a ( bilinearFunction
      $ \v (AbstractDualVector d) -> (applyDualVector -+$> d)-+$>(coerce v::c) )
@@ -883,14 +883,14 @@
             => (AbstractDualVector a c +> w)
                   -> (SubBasis (AbstractDualVector a c), DList w)
          dclm = case (dualFinitenessWitness @c, abstractTensorProductsCoercion @a @w) of
-          (DualFinitenessWitness DualSpaceWitness, Coercion)
+          (DualFinitenessWitness DualSpaceWitness, VSCCoercion)
               -> coerce (decomposeLinMap @(DualVector c) @w)
   decomposeLinMapWithin = scalarsSameInAbstraction @a dclm
    where dclm :: ∀ w . (LSpace w, Scalar w ~ Scalar c)
             => SubBasis (AbstractDualVector a c) -> (AbstractDualVector a c +> w)
                    -> Either (SubBasis (AbstractDualVector a c), DList w) (DList w)
          dclm = case (dualFinitenessWitness @c, abstractTensorProductsCoercion @a @w) of
-          (DualFinitenessWitness DualSpaceWitness, Coercion)
+          (DualFinitenessWitness DualSpaceWitness, VSCCoercion)
               -> coerce (decomposeLinMapWithin @(DualVector c) @w)
   recomposeSB = case dualFinitenessWitness @c of
           DualFinitenessWitness DualSpaceWitness -> scalarsSameInAbstraction @a
@@ -907,13 +907,13 @@
            => SubBasis (AbstractDualVector a c)
                  -> [w] -> (AbstractDualVector a c +> w, [w])
          rlm = case (dualFinitenessWitness @c, abstractTensorProductsCoercion @a @w) of
-          (DualFinitenessWitness DualSpaceWitness, Coercion)
+          (DualFinitenessWitness DualSpaceWitness, VSCCoercion)
               -> coerce (recomposeLinMap @(DualVector c) @w)
   recomposeContraLinMap = scalarsSameInAbstraction @a rclm
    where rclm :: ∀ f w . (LinearSpace w, Scalar w ~ Scalar c, Hask.Functor f)
            => (f (Scalar w) -> w) -> f a -> AbstractDualVector a c +> w
          rclm = case (dualFinitenessWitness @c, abstractTensorProductsCoercion @a @w) of
-          (DualFinitenessWitness DualSpaceWitness, Coercion) -> \f ->
+          (DualFinitenessWitness DualSpaceWitness, VSCCoercion) -> \f ->
              (coerce $ recomposeContraLinMap @(DualVector c) @w @f) f
                . fmap (coerce :: a -> c)
   recomposeContraLinMapTensor = scalarsSameInAbstraction @a rclmt
@@ -928,7 +928,7 @@
                       , abstractTensorProductsCoercion @a @(DualVector u)
                       , abstractTensorProductsCoercion @a
                           @(Tensor (Scalar a) (DualVector u) w) ) of
-            (DualFinitenessWitness DualSpaceWitness, Coercion, Coercion) -> \f ->
+            (DualFinitenessWitness DualSpaceWitness, VSCCoercion, VSCCoercion) -> \f ->
               (coerce $ recomposeContraLinMapTensor @(DualVector c) @u @w @f) f
                 . fmap (coerce :: (AbstractDualVector a c+>DualVector u)
                                     -> (DualVector c+>DualVector u))
@@ -959,14 +959,14 @@
          tdbc = case (dualSpaceWitness @c, dualSpaceWitness @w) of
            (DualSpaceWitness, DualSpaceWitness)
                -> case abstractTensorProductsCoercion @a @(DualVector w) of
-             Coercion -> coerce (tensorDualBasisCandidates @(DualVector c) @w)
+             VSCCoercion -> coerce (tensorDualBasisCandidates @(DualVector c) @w)
   symTensorDualBasisCandidates = scalarsSameInAbstraction @a
-          ( case ( coerceFmapTensorProduct @c [] (Coercion @a @c)
+          ( case ( coerceFmapTensorProduct @c [] (VSCCoercion @a @c)
                           . abstractTensorProductsCoercion @a @a
                  , coerceFmapTensorProduct @(DualVector c) []
-                      (Coercion @(AbstractDualVector a c) @(DualVector c))
+                      (VSCCoercion @(AbstractDualVector a c) @(DualVector c))
                  , dualSpaceWitness @c ) of
-             (Coercion, Coercion, DualSpaceWitness)
+             (VSCCoercion, VSCCoercion, DualSpaceWitness)
                -> coerce (symTensorDualBasisCandidates @(DualVector c))
           )
 
@@ -1112,14 +1112,14 @@
 abstractVS_wellDefinedTensor
     = scalarsSameInAbstraction @v
         (case abstractTensorProductsCoercion @v @w of
-           Coercion -> coerce (wellDefinedTensor @(VectorSpaceImplementation v) @w))
+           VSCCoercion -> coerce (wellDefinedTensor @(VectorSpaceImplementation v) @w))
 
 abstractVS_tensorProduct :: ∀ v w . ( AbstractTensorSpace v
            , TensorSpace w, Scalar w ~ Scalar v
            ) => Bilinear v w (v ⊗ w)
 abstractVS_tensorProduct = scalarsSameInAbstraction @v
     ( case ( abstractTensorProductsCoercion @v @w ) of
-       Coercion -> coerce (tensorProduct @(VectorSpaceImplementation v) @w) )
+       VSCCoercion -> coerce (tensorProduct @(VectorSpaceImplementation v) @w) )
 
 abstractVS_transposeTensor :: ∀ v w . ( AbstractTensorSpace v
            , TensorSpace w, Scalar w ~ Scalar v
@@ -1128,8 +1128,8 @@
     = scalarsSameInAbstraction @v ( case
            ( abstractTensorProductsCoercion @v @w
            , coerceFmapTensorProduct @w []
-                (Coercion @(VectorSpaceImplementation v) @(v)) ) of
-   (Coercion, Coercion) -> scalarsSameInAbstraction @v
+                (VSCCoercion @(VectorSpaceImplementation v) @(v)) ) of
+   (VSCCoercion, VSCCoercion) -> scalarsSameInAbstraction @v
       (coerce (transposeTensor @(VectorSpaceImplementation v) @w))
   )
 
@@ -1141,7 +1141,7 @@
    = scalarsSameInAbstraction @v
        ( case ( abstractTensorProductsCoercion @v @u
               , abstractTensorProductsCoercion @v @w ) of
-           (Coercion, Coercion)
+           (VSCCoercion, VSCCoercion)
               -> coerce (fmapTensor @(VectorSpaceImplementation v) @u @w) )
 
 abstractVS_fzipTensorsWith :: ∀ v u w x . ( AbstractTensorSpace v
@@ -1153,18 +1153,18 @@
        ( case ( abstractTensorProductsCoercion @v @u
               , abstractTensorProductsCoercion @v @w
               , abstractTensorProductsCoercion @v @x ) of
-           (Coercion, Coercion, Coercion)
+           (VSCCoercion, VSCCoercion, VSCCoercion)
               -> coerce (fzipTensorWith @(VectorSpaceImplementation v) @u @w @x)
         )
 
 abstractVS_coerceFmapTensorProduct :: ∀ v u w p .
          ( AbstractTensorSpace v
-         ) => p v -> Coercion u w -> Coercion (TensorProduct v u) (TensorProduct v w)
+         ) => p v -> VSCCoercion u w -> VSCCoercion (TensorProduct v u) (TensorProduct v w)
 abstractVS_coerceFmapTensorProduct _ crc
       = case ( abstractTensorProductsCoercion @v @u
              , abstractTensorProductsCoercion @v @w
              , coerceFmapTensorProduct @(VectorSpaceImplementation v) [] crc ) of
-          (Coercion, Coercion, Coercion) -> Coercion
+          (VSCCoercion, VSCCoercion, VSCCoercion) -> VSCCoercion
 
 abstractVS_dualSpaceWitness :: ∀ v . (AbstractLinearSpace v
         , LinearSpace v
@@ -1182,8 +1182,8 @@
 abstractVS_linearId = case dualSpaceWitness @(VectorSpaceImplementation v) of
  DualSpaceWitness -> case coerceFmapTensorProduct
                              @(DualVector (VectorSpaceImplementation v)) []
-                             (Coercion @v @(VectorSpaceImplementation v)) of
-   Coercion -> coerce (linearId @(VectorSpaceImplementation v))
+                             (VSCCoercion @v @(VectorSpaceImplementation v)) of
+   VSCCoercion -> coerce (linearId @(VectorSpaceImplementation v))
 
 abstractVS_tensorId :: ∀ v w . ( AbstractLinearSpace v
            , LinearSpace (VectorSpaceImplementation v)
@@ -1193,21 +1193,21 @@
   (case (dualSpaceWitness @w, dualSpaceWitness @(VectorSpaceImplementation v)) of
      (DualSpaceWitness, DualSpaceWitness)
        -> case coerceFmapTensorProduct @(DualVector w) []
-                 $ Coercion @(TensorProduct (VectorSpaceImplementation v) w)
+                 $ VSCCoercion @(TensorProduct (VectorSpaceImplementation v) w)
                             @(VectorSpaceImplementation v ⊗ w)
                   . abstractTensorProductsCoercion @v @w
-                  . Coercion @(v ⊗ w) @(TensorProduct v w) of
-         Coercion
+                  . VSCCoercion @(v ⊗ w) @(TensorProduct v w) of
+         VSCCoercion
            -> case ( coerceFmapTensorProduct 
                       @(DualVector (VectorSpaceImplementation v)) []
-                      (Coercion :: Coercion
+                      (VSCCoercion :: VSCCoercion
                           (Tensor (Scalar v) (DualVector w) (Tensor (Scalar v) v w))
                           (Tensor (Scalar v)
                                   (DualVector w)
                                   (Tensor (Scalar v)
                                           (VectorSpaceImplementation v) w)))
                    ) of
-            Coercion
+            VSCCoercion
                -> coerce (tensorId @(VectorSpaceImplementation v) @w)
        )
 
@@ -1233,7 +1233,7 @@
            => Bilinear (DualVector (v⊗u)) (v⊗u) (Scalar v)
 abstractVS_applyTensorFunctional = scalarsSameInAbstraction @v
  (case abstractTensorProductsCoercion @v @u of
-   Coercion -> coerce (applyTensorFunctional @(VectorSpaceImplementation v) @u))
+   VSCCoercion -> coerce (applyTensorFunctional @(VectorSpaceImplementation v) @u))
 
 abstractVS_applyTensorLinMap :: ∀ v u w .
        ( AbstractLinearSpace v
@@ -1243,12 +1243,12 @@
                          => Bilinear ((v⊗u)+>w) (v⊗u) w
 abstractVS_applyTensorLinMap = scalarsSameInAbstraction @v
  ( case abstractTensorProductsCoercion @v @u of
-   Coercion -> coerce (applyTensorLinMap @(VectorSpaceImplementation v) @u @w) )
+   VSCCoercion -> coerce (applyTensorLinMap @(VectorSpaceImplementation v) @u @w) )
 
 abstractSubbasisCoercion :: ∀ v .
        Coercible (SubBasis v) (SubBasis (VectorSpaceImplementation v))
-     => Coercion (SubBasis v) (SubBasis (VectorSpaceImplementation v))
-abstractSubbasisCoercion = Coercion
+     => VSCCoercion (SubBasis v) (SubBasis (VectorSpaceImplementation v))
+abstractSubbasisCoercion = VSCCoercion
 
 precomposeCoercion :: Coercion a b -> Coercion (b -> c) (a -> c)
 precomposeCoercion Coercion = Coercion
@@ -1276,14 +1276,15 @@
        ( AbstractLinearSpace v, FiniteDimensional (VectorSpaceImplementation v)
        , Coercible (SubBasis v) (SubBasis (VectorSpaceImplementation v)) )
           => SubBasis v
-abstractVS_entireBasis = sym (abstractSubbasisCoercion @v)
+abstractVS_entireBasis = symVSC (abstractSubbasisCoercion @v)
             $ entireBasis @(VectorSpaceImplementation v)
 
 abstractVS_enumerateSubBasis :: ∀ v .
        ( AbstractLinearSpace v, FiniteDimensional (VectorSpaceImplementation v)
        , Coercible (SubBasis v) (SubBasis (VectorSpaceImplementation v)) )
           => SubBasis v -> [v]
-abstractVS_enumerateSubBasis = precomposeCoercion (abstractSubbasisCoercion @v)
+abstractVS_enumerateSubBasis = precomposeCoercion
+               (getVSCCoercion $ abstractSubbasisCoercion @v)
     $ coerce (enumerateSubBasis @(VectorSpaceImplementation v))
 
 abstractVS_decomposeLinMap :: ∀ v w .
@@ -1293,9 +1294,10 @@
        , LSpace w, Scalar w ~ Scalar v )
                    => (v +> w) -> (SubBasis v, DList w)
 abstractVS_decomposeLinMap = scalarsSameInAbstraction @v
-   ( postcomposeCoercion (firstCoercion $ sym (abstractSubbasisCoercion @v))
+   ( postcomposeCoercion (firstCoercion $ sym
+            (getVSCCoercion $ abstractSubbasisCoercion @v))
       $ case abstractTensorProductsCoercion @v @w of
-         Coercion -> ( coerce (decomposeLinMap @(VectorSpaceImplementation v) @w)
+         VSCCoercion -> ( coerce (decomposeLinMap @(VectorSpaceImplementation v) @w)
                          :: (v +> w) -> ( SubBasis (VectorSpaceImplementation v)
                                         , DList w ) )
      )
@@ -1306,9 +1308,10 @@
        , LSpace w, Scalar w ~ Scalar v )
    => SubBasis v -> (v +> w) -> Either (SubBasis v, DList w) (DList w)
 abstractVS_decomposeLinMapWithin = scalarsSameInAbstraction @v
- ( precomposeCoercion (abstractSubbasisCoercion @v)
+ ( precomposeCoercion (getVSCCoercion $ abstractSubbasisCoercion @v)
     . postcomposeCoercion (postcomposeCoercion
-        . leftCoercion . firstCoercion $ sym (abstractSubbasisCoercion @v))
+        . leftCoercion . firstCoercion $ sym
+              (getVSCCoercion $ abstractSubbasisCoercion @v))
       $ coerce (decomposeLinMapWithin @(VectorSpaceImplementation v) @w)
   )
 
@@ -1317,7 +1320,7 @@
        , Coercible (SubBasis v) (SubBasis (VectorSpaceImplementation v)) )
    => SubBasis v -> [Scalar v] -> (v, [Scalar v])
 abstractVS_recomposeSB = scalarsSameInAbstraction @v
- ( precomposeCoercion (abstractSubbasisCoercion @v)
+ ( precomposeCoercion (getVSCCoercion $ abstractSubbasisCoercion @v)
   $ coerce (recomposeSB @(VectorSpaceImplementation v))
   )
 
@@ -1327,9 +1330,9 @@
        , FiniteDimensional w, Scalar w ~ Scalar v )
    => SubBasis v -> SubBasis w -> [Scalar v] -> (v ⊗ w, [Scalar v])
 abstractVS_recomposeSBTensor = scalarsSameInAbstraction @v
- ( precomposeCoercion (abstractSubbasisCoercion @v)
+ ( precomposeCoercion (getVSCCoercion $ abstractSubbasisCoercion @v)
   $ case abstractTensorProductsCoercion @v @w of
-     Coercion -> coerce (recomposeSBTensor @(VectorSpaceImplementation v) @w)
+     VSCCoercion -> coerce (recomposeSBTensor @(VectorSpaceImplementation v) @w)
   )
 
 abstractVS_recomposeLinMap :: ∀ v w . ( AbstractLinearSpace v
@@ -1338,7 +1341,7 @@
        , LSpace w, Scalar w ~ Scalar v )
    => SubBasis v -> [w] -> (v +> w, [w])
 abstractVS_recomposeLinMap = scalarsSameInAbstraction @v
- ( precomposeCoercion (abstractSubbasisCoercion @v)
+ ( precomposeCoercion (getVSCCoercion $ abstractSubbasisCoercion @v)
   $ coerce (recomposeLinMap @(VectorSpaceImplementation v) @w)
   )
 
@@ -1371,7 +1374,7 @@
    => DualVector v -+> v
 abstractVS_uncanonicallyFromDual = scalarsSameInAbstraction @v
  ( case abstractDualVectorCoercion @v of
-            Coercion -> coerce (uncanonicallyFromDual @(VectorSpaceImplementation v))
+            VSCCoercion -> coerce (uncanonicallyFromDual @(VectorSpaceImplementation v))
   )
 
 abstractVS_uncanonicallyToDual :: ∀ v . ( AbstractLinearSpace v
@@ -1379,7 +1382,7 @@
    => v -+> DualVector v
 abstractVS_uncanonicallyToDual = scalarsSameInAbstraction @v
  ( case abstractDualVectorCoercion @v of
-            Coercion -> coerce (uncanonicallyToDual @(VectorSpaceImplementation v))
+            VSCCoercion -> coerce (uncanonicallyToDual @(VectorSpaceImplementation v))
   )
 
 abstractVS_tensorEquality :: ∀ v w . ( AbstractLinearSpace v
@@ -1388,7 +1391,7 @@
                        => (v ⊗ w) -> (v ⊗ w) -> Bool
 abstractVS_tensorEquality = scalarsSameInAbstraction @v
  ( case abstractTensorProductsCoercion @v @w of
-    Coercion -> coerce (tensorEquality @(VectorSpaceImplementation v) @w)
+    VSCCoercion -> coerce (tensorEquality @(VectorSpaceImplementation v) @w)
   )
 
 abstractVS_dualBasisCandidates :: ∀ v . ( AbstractLinearSpace v
@@ -1396,7 +1399,7 @@
       => [(Int, v)] -> Forest (Int, DualVector v)
 abstractVS_dualBasisCandidates = scalarsSameInAbstraction @v
  ( case abstractDualVectorCoercion @v of
-            Coercion -> coerce (dualBasisCandidates @(VectorSpaceImplementation v))
+            VSCCoercion -> coerce (dualBasisCandidates @(VectorSpaceImplementation v))
   )
 
 abstractVS_tensorDualBasisCandidates :: ∀ v w . ( AbstractLinearSpace v
@@ -1412,7 +1415,7 @@
                  , abstractTensorProductsCoercion @v @(DualVector w)
                  , abstractTensorProductsCoercion @v @w
                  ) of
-       (Coercion, Coercion, Coercion)
+       (VSCCoercion, VSCCoercion, VSCCoercion)
           -> coerce (tensorDualBasisCandidates @(VectorSpaceImplementation v) @w)
   )
 
@@ -1432,9 +1435,9 @@
                , coerceFmapTensorProduct @(VectorSpaceImplementation v) []
                    crdv
                , coerceFmapTensorProduct @(VectorSpaceImplementation v) []
-                   (Coercion @v @(VectorSpaceImplementation v))
+                   (VSCCoercion @v @(VectorSpaceImplementation v))
                ) of
-     (Coercion, Coercion, Coercion, Coercion)
+     (VSCCoercion, VSCCoercion, VSCCoercion, VSCCoercion)
         -> coerce (symTensorDualBasisCandidates @(VectorSpaceImplementation v))
   )
 
@@ -1566,7 +1569,7 @@
      "AbstractTensorSpace" -> InstanceD Nothing <$> cxt <*>
                           [t|AbstractTensorSpace $a|] <*> [d|
          $(varP 'abstractTensorProductsCoercion)
-                  = Coercion
+                  = VSCCoercion
       |]
      "LinearSpace" -> InstanceD Nothing <$> cxt <*>
                           [t|LinearSpace $a|] <*> [d|
diff --git a/Math/LinearMap/Coercion.hs b/Math/LinearMap/Coercion.hs
new file mode 100644
--- /dev/null
+++ b/Math/LinearMap/Coercion.hs
@@ -0,0 +1,15 @@
+-- |
+-- Module      : Math.LinearMap.Coercion
+-- Copyright   : (c) Justus Sagemüller 2022
+-- License     : GPL v3
+-- 
+-- Maintainer  : (@) jsag $ hvl.no
+-- Stability   : experimental
+-- Portability : portable
+-- 
+
+module Math.LinearMap.Coercion
+   ( VSCCoercion(..)
+   ) where
+
+import Math.LinearMap.Category.Class
diff --git a/Math/VectorSpace/Docile.hs b/Math/VectorSpace/Docile.hs
--- a/Math/VectorSpace/Docile.hs
+++ b/Math/VectorSpace/Docile.hs
@@ -54,6 +54,8 @@
 import Prelude ()
 import qualified Prelude as Hask
 
+import Data.Kind (Type)
+
 import Control.Category.Constrained.Prelude hiding ((^))
 import Control.Arrow.Constrained
 import Control.Monad.Trans.State
@@ -498,7 +500,7 @@
   --   need to contain any information, it can simply have the full finite
   --   basis as its only value. Even for large sparse spaces, it should only
   --   have a very coarse structure that can be shared by many vectors.
-  data SubBasis v :: *
+  data SubBasis v :: Type
   
   entireBasis :: SubBasis v
   
@@ -955,7 +957,7 @@
           = case ( dualFinitenessWitness :: DualFinitenessWitness u
                  , dualSpaceWitness :: DualSpaceWitness v )  of
      (DualFinitenessWitness DualSpaceWitness, DualSpaceWitness) -> \(LinMapBasis bu bv)
-                   -> arr (fmap asLinearMap) . enumerateSubBasis $ TensorBasis bu bv
+                   -> arr (fmap $ getVSCCoercion asLinearMap) . enumerateSubBasis $ TensorBasis bu bv
   subbasisDimension (LinMapBasis bu bv) 
           = case ( dualFinitenessWitness :: DualFinitenessWitness u ) of
      (DualFinitenessWitness _) -> subbasisDimension bu * subbasisDimension bv
diff --git a/linearmap-category.cabal b/linearmap-category.cabal
--- a/linearmap-category.cabal
+++ b/linearmap-category.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                linearmap-category
-version:             0.4.3.0
+version:             0.5.0.0
 synopsis:            Native, complete, matrix-free linear algebra.
 description:         The term /numerical linear algebra/ is often used almost
                      synonymous with /matrix modifications/. However, what's interesting
@@ -40,6 +40,7 @@
 library
   exposed-modules:     Math.LinearMap.Category
                        Math.LinearMap.Category.Instances.Deriving
+                       Math.LinearMap.Coercion
                        Math.VectorSpace.ZeroDimensional
                        Math.VectorSpace.Dual
                        Math.VectorSpace.MiscUtil.MultiConstraints