module IR.Pattern.Vector where

import qualified IR.IR as I


data PatVec t = PatVec
  { PatVec t -> Int
ncol :: Int
  , PatVec t -> [Alt t]
toList :: [I.Alt t]
  }
  deriving (PatVec t -> PatVec t -> Bool
(PatVec t -> PatVec t -> Bool)
-> (PatVec t -> PatVec t -> Bool) -> Eq (PatVec t)
forall t. Eq t => PatVec t -> PatVec t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatVec t -> PatVec t -> Bool
$c/= :: forall t. Eq t => PatVec t -> PatVec t -> Bool
== :: PatVec t -> PatVec t -> Bool
$c== :: forall t. Eq t => PatVec t -> PatVec t -> Bool
Eq, Int -> PatVec t -> ShowS
[PatVec t] -> ShowS
PatVec t -> String
(Int -> PatVec t -> ShowS)
-> (PatVec t -> String) -> ([PatVec t] -> ShowS) -> Show (PatVec t)
forall t. Show t => Int -> PatVec t -> ShowS
forall t. Show t => [PatVec t] -> ShowS
forall t. Show t => PatVec t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatVec t] -> ShowS
$cshowList :: forall t. Show t => [PatVec t] -> ShowS
show :: PatVec t -> String
$cshow :: forall t. Show t => PatVec t -> String
showsPrec :: Int -> PatVec t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> PatVec t -> ShowS
Show)


fromList :: [I.Alt t] -> PatVec t
fromList :: [Alt t] -> PatVec t
fromList [Alt t]
ps = let n :: Int
n = [Alt t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alt t]
ps in PatVec :: forall t. Int -> [Alt t] -> PatVec t
PatVec{ncol :: Int
ncol = Int
n, toList :: [Alt t]
toList = [Alt t]
ps}


singleton :: I.Alt t -> PatVec t
singleton :: Alt t -> PatVec t
singleton Alt t
p = PatVec :: forall t. Int -> [Alt t] -> PatVec t
PatVec{ncol :: Int
ncol = Int
1, toList :: [Alt t]
toList = [Alt t
p]}


extend :: PatVec t -> PatVec t -> PatVec t
extend :: PatVec t -> PatVec t -> PatVec t
extend PatVec t
pv1 PatVec t
pv2 =
  let n' :: Int
n' = PatVec t -> Int
forall t. PatVec t -> Int
ncol PatVec t
pv1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PatVec t -> Int
forall t. PatVec t -> Int
ncol PatVec t
pv2
      l' :: [Alt t]
l' = PatVec t -> [Alt t]
forall t. PatVec t -> [Alt t]
toList PatVec t
pv1 [Alt t] -> [Alt t] -> [Alt t]
forall a. [a] -> [a] -> [a]
++ PatVec t -> [Alt t]
forall t. PatVec t -> [Alt t]
toList PatVec t
pv2
   in PatVec :: forall t. Int -> [Alt t] -> PatVec t
PatVec{ncol :: Int
ncol = Int
n', toList :: [Alt t]
toList = [Alt t]
l'}


hd :: PatVec t -> I.Alt t
hd :: PatVec t -> Alt t
hd PatVec t
pv = case PatVec t -> [Alt t]
forall t. PatVec t -> [Alt t]
toList PatVec t
pv of
  (Alt t
x : [Alt t]
_) -> Alt t
x
  [Alt t]
_ -> String -> Alt t
forall a. HasCallStack => String -> a
error String
"head on empty list"


tl :: PatVec t -> PatVec t
tl :: PatVec t -> PatVec t
tl PatVec t
pv = PatVec :: forall t. Int -> [Alt t] -> PatVec t
PatVec{ncol :: Int
ncol = PatVec t -> Int
forall t. PatVec t -> Int
ncol PatVec t
pv Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, toList :: [Alt t]
toList = [Alt t] -> [Alt t]
forall a. [a] -> [a]
tail ([Alt t] -> [Alt t]) -> [Alt t] -> [Alt t]
forall a b. (a -> b) -> a -> b
$ PatVec t -> [Alt t]
forall t. PatVec t -> [Alt t]
toList PatVec t
pv}


-- TODO: double check that this is correct
specialize :: PatVec t -> PatVec t
specialize :: PatVec t -> PatVec t
specialize PatVec t
pv = case PatVec t -> Alt t
forall t. PatVec t -> Alt t
hd PatVec t
pv of
  I.AltLit Literal
_ t
_ -> PatVec t -> PatVec t
forall t. PatVec t -> PatVec t
tl PatVec t
pv
  I.AltData DConId
_ [] t
_ -> PatVec t -> PatVec t
forall t. PatVec t -> PatVec t
tl PatVec t
pv
  I.AltData DConId
_ [Alt t]
ps t
_ -> PatVec t -> PatVec t -> PatVec t
forall t. PatVec t -> PatVec t -> PatVec t
extend ([Alt t] -> PatVec t
forall t. [Alt t] -> PatVec t
fromList [Alt t]
ps) (PatVec t -> PatVec t
forall t. PatVec t -> PatVec t
tl PatVec t
pv)
  I.AltBinder Binder t
_ -> String -> PatVec t
forall a. HasCallStack => String -> a
error String
"wrong usage"


specializeWild :: Int -> PatVec t -> PatVec t
specializeWild :: Int -> PatVec t -> PatVec t
specializeWild Int
arity PatVec t
pv = case PatVec t -> Alt t
forall t. PatVec t -> Alt t
hd PatVec t
pv of
  I.AltBinder Binder t
b -> PatVec t
wildCase
   where
    wildCase :: PatVec t
wildCase =
      let binder :: Binder t
binder = t -> Binder t
forall t. t -> Binder t
I.BindAnon (t -> Binder t) -> t -> Binder t
forall a b. (a -> b) -> a -> b
$ Binder t -> t
forall (c :: * -> *) a. Carrier c => c a -> a
I.extract Binder t
b
          pv1 :: PatVec t
pv1 = [Alt t] -> PatVec t
forall t. [Alt t] -> PatVec t
fromList ([Alt t] -> PatVec t) -> [Alt t] -> PatVec t
forall a b. (a -> b) -> a -> b
$ Int -> Alt t -> [Alt t]
forall a. Int -> a -> [a]
replicate Int
arity (Binder t -> Alt t
forall t. Binder t -> Alt t
I.AltBinder Binder t
binder)
          pv2 :: PatVec t
pv2 = PatVec t -> PatVec t
forall t. PatVec t -> PatVec t
tl PatVec t
pv
       in PatVec t -> PatVec t -> PatVec t
forall t. PatVec t -> PatVec t -> PatVec t
extend PatVec t
pv1 PatVec t
pv2
  Alt t
_ -> String -> PatVec t
forall a. HasCallStack => String -> a
error String
"wrong usage"