module IR.Pattern.Matrix where

import Common.Identifiers (
  Identifier (..),
 )
import qualified IR.IR as I
import qualified IR.Pattern.Vector as PV


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


singleCol :: [I.Alt t] -> PatMat t
singleCol :: [Alt t] -> PatMat t
singleCol [Alt t]
ps =
  let m :: Int
m = [Alt t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alt t]
ps
      pvs :: [PatVec t]
pvs = [Alt t -> PatVec t
forall t. Alt t -> PatVec t
PV.singleton Alt t
p | Alt t
p <- [Alt t]
ps]
   in PatMat :: forall t. Int -> Int -> [PatVec t] -> PatMat t
PatMat{nrow :: Int
nrow = Int
m, ncol :: Int
ncol = Int
1, toList :: [PatVec t]
toList = [PatVec t]
pvs}


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


fromPatVec :: PV.PatVec t -> PatMat t
fromPatVec :: PatVec t -> PatMat t
fromPatVec PatVec t
pv = PatMat :: forall t. Int -> Int -> [PatVec t] -> PatMat t
PatMat{nrow :: Int
nrow = Int
1, ncol :: Int
ncol = PatVec t -> Int
forall t. PatVec t -> Int
PV.ncol PatVec t
pv, toList :: [PatVec t]
toList = [PatVec t
pv]}


fromPatVecs :: [PV.PatVec t] -> PatMat t
fromPatVecs :: [PatVec t] -> PatMat t
fromPatVecs [] = String -> PatMat t
forall a. HasCallStack => String -> a
error String
"Not enough information to construct pattern matrix"
fromPatVecs [PatVec t]
pvs =
  let emptyPatMat :: PatMat t
emptyPatMat = Int -> PatMat t
forall t. Int -> PatMat t
emptyWithCols (Int -> PatMat t) -> Int -> PatMat t
forall a b. (a -> b) -> a -> b
$ let PatVec t
pv : [PatVec t]
_ = [PatVec t]
pvs in PatVec t -> Int
forall t. PatVec t -> Int
PV.ncol PatVec t
pv
   in (PatMat t -> PatVec t -> PatMat t)
-> PatMat t -> [PatVec t] -> PatMat t
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\PatMat t
pm PatVec t
pv -> PatMat t -> PatMat t -> PatMat t
forall t. PatMat t -> PatMat t -> PatMat t
extend PatMat t
pm (PatVec t -> PatMat t
forall t. PatVec t -> PatMat t
fromPatVec PatVec t
pv)) PatMat t
forall t. PatMat t
emptyPatMat [PatVec t]
pvs


emptyWithCols :: Int -> PatMat t
emptyWithCols :: Int -> PatMat t
emptyWithCols Int
n = PatMat :: forall t. Int -> Int -> [PatVec t] -> PatMat t
PatMat{nrow :: Int
nrow = Int
0, ncol :: Int
ncol = Int
n, toList :: [PatVec t]
toList = []}


hd :: PatMat t -> PV.PatVec t
hd :: PatMat t -> PatVec t
hd = [PatVec t] -> PatVec t
forall a. [a] -> a
head ([PatVec t] -> PatVec t)
-> (PatMat t -> [PatVec t]) -> PatMat t -> PatVec t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatMat t -> [PatVec t]
forall t. PatMat t -> [PatVec t]
toList


extend :: PatMat t -> PatMat t -> PatMat t
extend :: PatMat t -> PatMat t -> PatMat t
extend PatMat t
pm1 PatMat t
pm2 =
  let m' :: Int
m' = PatMat t -> Int
forall t. PatMat t -> Int
nrow PatMat t
pm1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PatMat t -> Int
forall t. PatMat t -> Int
nrow PatMat t
pm2
      n' :: Int
n' = PatMat t -> Int
forall t. PatMat t -> Int
ncol PatMat t
pm1
      l' :: [PatVec t]
l' = PatMat t -> [PatVec t]
forall t. PatMat t -> [PatVec t]
toList PatMat t
pm1 [PatVec t] -> [PatVec t] -> [PatVec t]
forall a. [a] -> [a] -> [a]
++ PatMat t -> [PatVec t]
forall t. PatMat t -> [PatVec t]
toList PatMat t
pm2
   in PatMat :: forall t. Int -> Int -> [PatVec t] -> PatMat t
PatMat{nrow :: Int
nrow = Int
m', ncol :: Int
ncol = Int
n', toList :: [PatVec t]
toList = [PatVec t]
l'}


specializeLit :: I.Literal -> PatMat t -> PatMat t
specializeLit :: Literal -> PatMat t -> PatMat t
specializeLit Literal
lit PatMat t
pm =
  let pms :: [PatMat t]
pms = (PatVec t -> PatMat t) -> [PatVec t] -> [PatMat t]
forall a b. (a -> b) -> [a] -> [b]
map PatVec t -> PatMat t
forall t. PatVec t -> PatMat t
specializeLit' (PatMat t -> [PatVec t]
forall t. PatMat t -> [PatVec t]
toList PatMat t
pm) in (PatMat t -> PatMat t -> PatMat t)
-> PatMat t -> [PatMat t] -> PatMat t
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PatMat t -> PatMat t -> PatMat t
forall t. PatMat t -> PatMat t -> PatMat t
extend PatMat t
forall t. PatMat t
noRow [PatMat t]
pms
 where
  noRow :: PatMat t
noRow = Int -> PatMat t
forall t. Int -> PatMat t
emptyWithCols (PatMat t -> Int
forall t. PatMat t -> Int
ncol PatMat t
pm Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  specializeLit' :: PatVec t -> PatMat t
specializeLit' PatVec t
pv =
    let wildCase :: PatMat t
wildCase = PatVec t -> PatMat t
forall t. PatVec t -> PatMat t
fromPatVec (PatVec t -> PatMat t) -> PatVec t -> PatMat t
forall a b. (a -> b) -> a -> b
$ PatVec t -> PatVec t
forall t. PatVec t -> PatVec t
PV.tl PatVec t
pv
     in case PatVec t -> Alt t
forall t. PatVec t -> Alt t
PV.hd PatVec t
pv of
          I.AltLit Literal
lit' t
_ ->
            if Literal
lit' Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Literal
lit then PatVec t -> PatMat t
forall t. PatVec t -> PatMat t
fromPatVec (PatVec t -> PatMat t) -> PatVec t -> PatMat t
forall a b. (a -> b) -> a -> b
$ PatVec t -> PatVec t
forall t. PatVec t -> PatVec t
PV.tl PatVec t
pv else PatMat t
forall t. PatMat t
noRow
          I.AltBinder Binder t
_ -> PatMat t
wildCase
          I.AltData{} -> PatMat t
forall t. PatMat t
noRow


specializeCons :: Int -> Identifier -> PatMat t -> PatMat t
specializeCons :: Int -> Identifier -> PatMat t -> PatMat t
specializeCons Int
arity Identifier
i PatMat t
pm =
  let pms :: [PatMat t]
pms = (PatVec t -> PatMat t) -> [PatVec t] -> [PatMat t]
forall a b. (a -> b) -> [a] -> [b]
map PatVec t -> PatMat t
forall t. PatVec t -> PatMat t
specializeCons' (PatMat t -> [PatVec t]
forall t. PatMat t -> [PatVec t]
toList PatMat t
pm) in (PatMat t -> PatMat t -> PatMat t)
-> PatMat t -> [PatMat t] -> PatMat t
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PatMat t -> PatMat t -> PatMat t
forall t. PatMat t -> PatMat t -> PatMat t
extend PatMat t
forall t. PatMat t
noRow [PatMat t]
pms
 where
  noRow :: PatMat t
noRow = Int -> PatMat t
forall t. Int -> PatMat t
emptyWithCols (Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PatMat t -> Int
forall t. PatMat t -> Int
ncol PatMat t
pm Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  specializeCons' :: PatVec t -> PatMat t
specializeCons' PatVec t
pv = case PatVec t -> Alt t
forall t. PatVec t -> Alt t
PV.hd PatVec t
pv of
    I.AltLit Literal
_ t
_ -> PatMat t
forall t. PatMat t
noRow
    I.AltBinder b :: Binder t
b@I.BindAnon{} ->
      let pv1 :: PatVec t
pv1 = [Alt t] -> PatVec t
forall t. [Alt t] -> PatVec t
PV.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
b)
          pv2 :: PatVec t
pv2 = PatVec t -> PatVec t
forall t. PatVec t -> PatVec t
PV.tl PatVec t
pv
       in PatVec t -> PatMat t
forall t. PatVec t -> PatMat t
fromPatVec (PatVec t -> PatMat t) -> PatVec t -> PatMat t
forall a b. (a -> b) -> a -> b
$ PatVec t -> PatVec t -> PatVec t
forall t. PatVec t -> PatVec t -> PatVec t
PV.extend PatVec t
pv1 PatVec t
pv2
    I.AltBinder Binder t
_ -> PatMat t
forall t. PatMat t
noRow
    I.AltData (I.DConId Identifier
i') [] t
_ ->
      if Identifier
i' Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
i then PatVec t -> PatMat t
forall t. PatVec t -> PatMat t
fromPatVec (PatVec t -> PatMat t) -> PatVec t -> PatMat t
forall a b. (a -> b) -> a -> b
$ PatVec t -> PatVec t
forall t. PatVec t -> PatVec t
PV.tl PatVec t
pv else PatMat t
forall t. PatMat t
noRow
    I.AltData (I.DConId Identifier
i') [Alt t]
ps t
_ ->
      if Identifier
i' Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
i
        then
          let pv1 :: PatVec t
pv1 = [Alt t] -> PatVec t
forall t. [Alt t] -> PatVec t
PV.fromList [Alt t]
ps
              pv2 :: PatVec t
pv2 = PatVec t -> PatVec t
forall t. PatVec t -> PatVec t
PV.tl PatVec t
pv
           in PatVec t -> PatMat t
forall t. PatVec t -> PatMat t
fromPatVec (PatVec t -> PatMat t) -> PatVec t -> PatMat t
forall a b. (a -> b) -> a -> b
$ PatVec t -> PatVec t -> PatVec t
forall t. PatVec t -> PatVec t -> PatVec t
PV.extend PatVec t
pv1 PatVec t
pv2
        else PatMat t
forall t. PatMat t
noRow


defaultize :: PatMat t -> PatMat t
defaultize :: PatMat t -> PatMat t
defaultize PatMat t
pm =
  let pms :: [PatMat t]
pms = (PatVec t -> PatMat t) -> [PatVec t] -> [PatMat t]
forall a b. (a -> b) -> [a] -> [b]
map PatVec t -> PatMat t
forall t. PatVec t -> PatMat t
defaultize' (PatMat t -> [PatVec t]
forall t. PatMat t -> [PatVec t]
toList PatMat t
pm) in (PatMat t -> PatMat t -> PatMat t)
-> PatMat t -> [PatMat t] -> PatMat t
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PatMat t -> PatMat t -> PatMat t
forall t. PatMat t -> PatMat t -> PatMat t
extend PatMat t
forall t. PatMat t
noRow [PatMat t]
pms
 where
  noRow :: PatMat t
noRow = Int -> PatMat t
forall t. Int -> PatMat t
emptyWithCols (PatMat t -> Int
forall t. PatMat t -> Int
ncol PatMat t
pm Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  defaultize' :: PatVec t -> PatMat t
defaultize' PatVec t
pv =
    let wildCase :: PatMat t
wildCase = PatVec t -> PatMat t
forall t. PatVec t -> PatMat t
fromPatVec (PatVec t -> PatMat t) -> PatVec t -> PatMat t
forall a b. (a -> b) -> a -> b
$ PatVec t -> PatVec t
forall t. PatVec t -> PatVec t
PV.tl PatVec t
pv
     in case PatVec t -> Alt t
forall t. PatVec t -> Alt t
PV.hd PatVec t
pv of
          I.AltLit{} -> PatMat t
forall t. PatMat t
noRow
          I.AltBinder{} -> PatMat t
wildCase
          I.AltData{} -> PatMat t
forall t. PatMat t
noRow