Use non-GADT patterns

clash-prelude/src/Clash/Sized/RTree.hs

@@ -17,15 +17,15 @@ Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 
 {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise -fplugin GHC.TypeLits.KnownNat.Solver #-}
 
-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
-
 module Clash.Sized.RTree
   ( -- * 'RTree' data type
-    RTree (LR, BR)
+    RTree (LR, BR, LR_, BR_)
     -- * Construction
   , treplicate
   , trepeat
     -- * Accessors
+  , thead
+  , tlast
     -- ** Indexing
   , indexTree
   , tindices
@@ -63,9 +63,7 @@ import Data.Foldable               (toList)
 import Data.Kind                   (Type)
 import Data.Singletons             (Apply, TyFun, type (@@))
 import Data.Proxy                  (Proxy (..))
-import Data.Type.Equality          ((:~:) (..))
-import GHC.TypeLits                (KnownNat, Nat, type (+), type (^), type (*),
-                                    sameNat)
+import GHC.TypeLits                (KnownNat, Nat, type (+), type (^), type (*))
 import Language.Haskell.TH.Syntax  (Lift(..))
 #if MIN_VERSION_template_haskell(2,16,0)
 import Language.Haskell.TH.Compat
@@ -75,7 +73,7 @@ import Test.QuickCheck             (Arbitrary (..), CoArbitrary (..))
 
 import Clash.Annotations.Primitive (hasBlackBox)
 import Clash.Class.BitPack         (BitPack (..), packXWith)
-import Clash.Promoted.Nat          (SNat (..), SNatLE (..), UNat (..), compareSNat,
+import Clash.Promoted.Nat          (SNat (..), UNat (..),
                                     pow2SNat, snatToNum, subSNat, toUNat)
 import Clash.Promoted.Nat.Literals (d1)
 import Clash.Sized.Index           (Index)
@@ -553,7 +551,7 @@ lazyT = tzipWith (flip const) (trepeat ())
 -- The operator must be associative.
 --
 -- <<doc/scanlPar.svg>>
-scanlPar :: 
+scanlPar ::
   KnownNat n =>
   -- | Must be associative
   (a -> a -> a) ->
@@ -568,7 +566,7 @@ scanlPar op v = scanlInductiveRTree op (v2t v)
 -- 10 :> 9 :> 7 :> 4 :> Nil
 --
 -- The operator must be associative.
-scanrPar :: 
+scanrPar ::
   KnownNat n =>
    -- | Must be associative
   (a -> a -> a) ->
@@ -577,23 +575,37 @@ scanrPar ::
 scanrPar op v = scanrInductiveRTree op (v2t v)
 {-# INLINE scanrPar #-}
 
+-- |
+--
+-- >>> thead $ BR (BR (LR 1) (LR 2)) (BR (LR 3) (LR 4))
+-- 1
+thead :: RTree n a -> a
+thead (LR_ x) = x
+thead (BR_ x _) = thead x
+
+-- |
+--
+-- >>> tlast $ BR (BR (LR 1) (LR 2)) (BR (LR 3) (LR 4))
+-- 4
+tlast :: RTree n a -> a
+tlast (LR_ x) = x
+tlast (BR_ _ y) = tlast y
+
 scanlInductiveRTree ::
   forall a n.
   KnownNat n =>
   (a -> a -> a) ->
   RTree n a ->
   Vec (2^n) a
 scanlInductiveRTree op tr =
-  -- I have to use sameNat and compareSNat both; the type checker cannot infer
-  -- that n <= 0 means n ~ 0.
-  case (sameNat (Proxy @n) (Proxy @0), compareSNat (SNat @n) (SNat @0), tr) of
-    (Just Refl, _, LR x) -> x :> Nil
-    (_, SNatGT, BR x y) ->
-        let
-          x' = scanlInductiveRTree op x
-          y' = scanlInductiveRTree op y
-          l = x' !! (length x'-1) -- 'last' doesn't work here
-        in x' ++ map (l `op`) y'
+  case tr of
+    (LR_ x) -> x :> Nil
+    (BR_ x y) ->
+      let
+        x' = scanlInductiveRTree op x
+        y' = scanlInductiveRTree op y
+        l = x' !! (length x'-1) -- 'last' doesn't work here
+      in x' ++ map (l `op`) y'
 
 scanrInductiveRTree ::
   forall a n.
@@ -602,11 +614,9 @@ scanrInductiveRTree ::
   RTree n a ->
   Vec (2^n) a
 scanrInductiveRTree op tr =
-  -- I have to use sameNat and compareSNat both; the type checker cannot infer
-  -- that n <= 0 means n ~ 0.
-  case (sameNat (Proxy @n) (Proxy @0), compareSNat (SNat @n) (SNat @0), tr) of
-    (Just Refl, _, LR x) -> x :> Nil
-    (_, SNatGT, BR x y) ->
+  case tr of
+    (LR_ x) -> x :> Nil
+    (BR_ x y) ->
         let
           x' = scanrInductiveRTree op x
           y' = scanrInductiveRTree op y