{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

module Unison.Pattern where

import Data.List (intercalate)
import Data.Map qualified as Map
import Data.Set qualified as Set
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration.ConstructorId (ConstructorId)
import Unison.LabeledDependency (LabeledDependency)
import Unison.LabeledDependency qualified as LD
import Unison.Prelude
import Unison.Reference (Reference)
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Type qualified as Type

data Pattern loc
  = Unbound loc
  | Var loc
  | Boolean loc !Bool
  | Int loc !Int64
  | Nat loc !Word64
  | Float loc !Double
  | Text loc !Text
  | Char loc !Char
  | Constructor loc !ConstructorReference [Pattern loc]
  | As loc (Pattern loc)
  | EffectPure loc (Pattern loc)
  | EffectBind loc !ConstructorReference [Pattern loc] (Pattern loc)
  | SequenceLiteral loc [Pattern loc]
  | SequenceOp loc (Pattern loc) !SeqOp (Pattern loc)
  deriving (Eq (Pattern loc)
Eq (Pattern loc) =>
(Pattern loc -> Pattern loc -> Ordering)
-> (Pattern loc -> Pattern loc -> Bool)
-> (Pattern loc -> Pattern loc -> Bool)
-> (Pattern loc -> Pattern loc -> Bool)
-> (Pattern loc -> Pattern loc -> Bool)
-> (Pattern loc -> Pattern loc -> Pattern loc)
-> (Pattern loc -> Pattern loc -> Pattern loc)
-> Ord (Pattern loc)
Pattern loc -> Pattern loc -> Bool
Pattern loc -> Pattern loc -> Ordering
Pattern loc -> Pattern loc -> Pattern loc
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall loc. Ord loc => Eq (Pattern loc)
forall loc. Ord loc => Pattern loc -> Pattern loc -> Bool
forall loc. Ord loc => Pattern loc -> Pattern loc -> Ordering
forall loc. Ord loc => Pattern loc -> Pattern loc -> Pattern loc
$ccompare :: forall loc. Ord loc => Pattern loc -> Pattern loc -> Ordering
compare :: Pattern loc -> Pattern loc -> Ordering
$c< :: forall loc. Ord loc => Pattern loc -> Pattern loc -> Bool
< :: Pattern loc -> Pattern loc -> Bool
$c<= :: forall loc. Ord loc => Pattern loc -> Pattern loc -> Bool
<= :: Pattern loc -> Pattern loc -> Bool
$c> :: forall loc. Ord loc => Pattern loc -> Pattern loc -> Bool
> :: Pattern loc -> Pattern loc -> Bool
$c>= :: forall loc. Ord loc => Pattern loc -> Pattern loc -> Bool
>= :: Pattern loc -> Pattern loc -> Bool
$cmax :: forall loc. Ord loc => Pattern loc -> Pattern loc -> Pattern loc
max :: Pattern loc -> Pattern loc -> Pattern loc
$cmin :: forall loc. Ord loc => Pattern loc -> Pattern loc -> Pattern loc
min :: Pattern loc -> Pattern loc -> Pattern loc
Ord, (forall x. Pattern loc -> Rep (Pattern loc) x)
-> (forall x. Rep (Pattern loc) x -> Pattern loc)
-> Generic (Pattern loc)
forall x. Rep (Pattern loc) x -> Pattern loc
forall x. Pattern loc -> Rep (Pattern loc) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall loc x. Rep (Pattern loc) x -> Pattern loc
forall loc x. Pattern loc -> Rep (Pattern loc) x
$cfrom :: forall loc x. Pattern loc -> Rep (Pattern loc) x
from :: forall x. Pattern loc -> Rep (Pattern loc) x
$cto :: forall loc x. Rep (Pattern loc) x -> Pattern loc
to :: forall x. Rep (Pattern loc) x -> Pattern loc
Generic, (forall a b. (a -> b) -> Pattern a -> Pattern b)
-> (forall a b. a -> Pattern b -> Pattern a) -> Functor Pattern
forall a b. a -> Pattern b -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Pattern a -> Pattern b
fmap :: forall a b. (a -> b) -> Pattern a -> Pattern b
$c<$ :: forall a b. a -> Pattern b -> Pattern a
<$ :: forall a b. a -> Pattern b -> Pattern a
Functor, (forall m. Monoid m => Pattern m -> m)
-> (forall m a. Monoid m => (a -> m) -> Pattern a -> m)
-> (forall m a. Monoid m => (a -> m) -> Pattern a -> m)
-> (forall a b. (a -> b -> b) -> b -> Pattern a -> b)
-> (forall a b. (a -> b -> b) -> b -> Pattern a -> b)
-> (forall b a. (b -> a -> b) -> b -> Pattern a -> b)
-> (forall b a. (b -> a -> b) -> b -> Pattern a -> b)
-> (forall a. (a -> a -> a) -> Pattern a -> a)
-> (forall a. (a -> a -> a) -> Pattern a -> a)
-> (forall a. Pattern a -> [a])
-> (forall a. Pattern a -> Bool)
-> (forall a. Pattern a -> Int)
-> (forall a. Eq a => a -> Pattern a -> Bool)
-> (forall a. Ord a => Pattern a -> a)
-> (forall a. Ord a => Pattern a -> a)
-> (forall a. Num a => Pattern a -> a)
-> (forall a. Num a => Pattern a -> a)
-> Foldable Pattern
forall a. Eq a => a -> Pattern a -> Bool
forall a. Num a => Pattern a -> a
forall a. Ord a => Pattern a -> a
forall m. Monoid m => Pattern m -> m
forall a. Pattern a -> Bool
forall a. Pattern a -> Int
forall a. Pattern a -> [a]
forall a. (a -> a -> a) -> Pattern a -> a
forall m a. Monoid m => (a -> m) -> Pattern a -> m
forall b a. (b -> a -> b) -> b -> Pattern a -> b
forall a b. (a -> b -> b) -> b -> Pattern a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Pattern m -> m
fold :: forall m. Monoid m => Pattern m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Pattern a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Pattern a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Pattern a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Pattern a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Pattern a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Pattern a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Pattern a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Pattern a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Pattern a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Pattern a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Pattern a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Pattern a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Pattern a -> a
foldr1 :: forall a. (a -> a -> a) -> Pattern a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Pattern a -> a
foldl1 :: forall a. (a -> a -> a) -> Pattern a -> a
$ctoList :: forall a. Pattern a -> [a]
toList :: forall a. Pattern a -> [a]
$cnull :: forall a. Pattern a -> Bool
null :: forall a. Pattern a -> Bool
$clength :: forall a. Pattern a -> Int
length :: forall a. Pattern a -> Int
$celem :: forall a. Eq a => a -> Pattern a -> Bool
elem :: forall a. Eq a => a -> Pattern a -> Bool
$cmaximum :: forall a. Ord a => Pattern a -> a
maximum :: forall a. Ord a => Pattern a -> a
$cminimum :: forall a. Ord a => Pattern a -> a
minimum :: forall a. Ord a => Pattern a -> a
$csum :: forall a. Num a => Pattern a -> a
sum :: forall a. Num a => Pattern a -> a
$cproduct :: forall a. Num a => Pattern a -> a
product :: forall a. Num a => Pattern a -> a
Foldable, Functor Pattern
Foldable Pattern
(Functor Pattern, Foldable Pattern) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Pattern a -> f (Pattern b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Pattern (f a) -> f (Pattern a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Pattern a -> m (Pattern b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Pattern (m a) -> m (Pattern a))
-> Traversable Pattern
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Pattern (m a) -> m (Pattern a)
forall (f :: * -> *) a.
Applicative f =>
Pattern (f a) -> f (Pattern a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Pattern a -> m (Pattern b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Pattern a -> f (Pattern b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Pattern a -> f (Pattern b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Pattern a -> f (Pattern b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Pattern (f a) -> f (Pattern a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Pattern (f a) -> f (Pattern a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Pattern a -> m (Pattern b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Pattern a -> m (Pattern b)
$csequence :: forall (m :: * -> *) a. Monad m => Pattern (m a) -> m (Pattern a)
sequence :: forall (m :: * -> *) a. Monad m => Pattern (m a) -> m (Pattern a)
Traversable)

data SeqOp
  = Cons
  | Snoc
  | Concat
  deriving (SeqOp -> SeqOp -> Bool
(SeqOp -> SeqOp -> Bool) -> (SeqOp -> SeqOp -> Bool) -> Eq SeqOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SeqOp -> SeqOp -> Bool
== :: SeqOp -> SeqOp -> Bool
$c/= :: SeqOp -> SeqOp -> Bool
/= :: SeqOp -> SeqOp -> Bool
Eq, Int -> SeqOp -> ShowS
[SeqOp] -> ShowS
SeqOp -> String
(Int -> SeqOp -> ShowS)
-> (SeqOp -> String) -> ([SeqOp] -> ShowS) -> Show SeqOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SeqOp -> ShowS
showsPrec :: Int -> SeqOp -> ShowS
$cshow :: SeqOp -> String
show :: SeqOp -> String
$cshowList :: [SeqOp] -> ShowS
showList :: [SeqOp] -> ShowS
Show, Eq SeqOp
Eq SeqOp =>
(SeqOp -> SeqOp -> Ordering)
-> (SeqOp -> SeqOp -> Bool)
-> (SeqOp -> SeqOp -> Bool)
-> (SeqOp -> SeqOp -> Bool)
-> (SeqOp -> SeqOp -> Bool)
-> (SeqOp -> SeqOp -> SeqOp)
-> (SeqOp -> SeqOp -> SeqOp)
-> Ord SeqOp
SeqOp -> SeqOp -> Bool
SeqOp -> SeqOp -> Ordering
SeqOp -> SeqOp -> SeqOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SeqOp -> SeqOp -> Ordering
compare :: SeqOp -> SeqOp -> Ordering
$c< :: SeqOp -> SeqOp -> Bool
< :: SeqOp -> SeqOp -> Bool
$c<= :: SeqOp -> SeqOp -> Bool
<= :: SeqOp -> SeqOp -> Bool
$c> :: SeqOp -> SeqOp -> Bool
> :: SeqOp -> SeqOp -> Bool
$c>= :: SeqOp -> SeqOp -> Bool
>= :: SeqOp -> SeqOp -> Bool
$cmax :: SeqOp -> SeqOp -> SeqOp
max :: SeqOp -> SeqOp -> SeqOp
$cmin :: SeqOp -> SeqOp -> SeqOp
min :: SeqOp -> SeqOp -> SeqOp
Ord, (forall x. SeqOp -> Rep SeqOp x)
-> (forall x. Rep SeqOp x -> SeqOp) -> Generic SeqOp
forall x. Rep SeqOp x -> SeqOp
forall x. SeqOp -> Rep SeqOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SeqOp -> Rep SeqOp x
from :: forall x. SeqOp -> Rep SeqOp x
$cto :: forall x. Rep SeqOp x -> SeqOp
to :: forall x. Rep SeqOp x -> SeqOp
Generic)

updateDependencies :: Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies :: forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies Map Referent Referent
tms Pattern loc
p = case Pattern loc
p of
  Unbound {} -> Pattern loc
p
  Var {} -> Pattern loc
p
  Boolean {} -> Pattern loc
p
  Int {} -> Pattern loc
p
  Nat {} -> Pattern loc
p
  Float {} -> Pattern loc
p
  Text {} -> Pattern loc
p
  Char {} -> Pattern loc
p
  Constructor loc
loc ConstructorReference
r [Pattern loc]
ps -> case Referent -> Map Referent Referent -> Maybe Referent
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ConstructorReference -> ConstructorType -> Referent
Referent.Con ConstructorReference
r ConstructorType
CT.Data) Map Referent Referent
tms of
    Just (Referent.Con ConstructorReference
r ConstructorType
CT.Data) -> loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Constructor loc
loc ConstructorReference
r (Map Referent Referent -> Pattern loc -> Pattern loc
forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies Map Referent Referent
tms (Pattern loc -> Pattern loc) -> [Pattern loc] -> [Pattern loc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern loc]
ps)
    Maybe Referent
_ -> loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Constructor loc
loc ConstructorReference
r (Map Referent Referent -> Pattern loc -> Pattern loc
forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies Map Referent Referent
tms (Pattern loc -> Pattern loc) -> [Pattern loc] -> [Pattern loc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern loc]
ps)
  As loc
loc Pattern loc
p -> loc -> Pattern loc -> Pattern loc
forall loc. loc -> Pattern loc -> Pattern loc
As loc
loc (Map Referent Referent -> Pattern loc -> Pattern loc
forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies Map Referent Referent
tms Pattern loc
p)
  EffectPure loc
loc Pattern loc
p -> loc -> Pattern loc -> Pattern loc
forall loc. loc -> Pattern loc -> Pattern loc
EffectPure loc
loc (Map Referent Referent -> Pattern loc -> Pattern loc
forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies Map Referent Referent
tms Pattern loc
p)
  EffectBind loc
loc ConstructorReference
r [Pattern loc]
pats Pattern loc
k -> case Referent -> Map Referent Referent -> Maybe Referent
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ConstructorReference -> ConstructorType -> Referent
Referent.Con ConstructorReference
r ConstructorType
CT.Effect) Map Referent Referent
tms of
    Just (Referent.Con ConstructorReference
r ConstructorType
CT.Effect) ->
      loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
forall loc.
loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
EffectBind loc
loc ConstructorReference
r (Map Referent Referent -> Pattern loc -> Pattern loc
forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies Map Referent Referent
tms (Pattern loc -> Pattern loc) -> [Pattern loc] -> [Pattern loc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern loc]
pats) (Map Referent Referent -> Pattern loc -> Pattern loc
forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies Map Referent Referent
tms Pattern loc
k)
    Maybe Referent
_ ->
      loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
forall loc.
loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
EffectBind loc
loc ConstructorReference
r (Map Referent Referent -> Pattern loc -> Pattern loc
forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies Map Referent Referent
tms (Pattern loc -> Pattern loc) -> [Pattern loc] -> [Pattern loc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern loc]
pats) (Map Referent Referent -> Pattern loc -> Pattern loc
forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies Map Referent Referent
tms Pattern loc
k)
  SequenceLiteral loc
loc [Pattern loc]
ps -> loc -> [Pattern loc] -> Pattern loc
forall loc. loc -> [Pattern loc] -> Pattern loc
SequenceLiteral loc
loc (Map Referent Referent -> Pattern loc -> Pattern loc
forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies Map Referent Referent
tms (Pattern loc -> Pattern loc) -> [Pattern loc] -> [Pattern loc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern loc]
ps)
  SequenceOp loc
loc Pattern loc
lhs SeqOp
op Pattern loc
rhs ->
    loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
forall loc.
loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
SequenceOp loc
loc (Map Referent Referent -> Pattern loc -> Pattern loc
forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies Map Referent Referent
tms Pattern loc
lhs) SeqOp
op (Map Referent Referent -> Pattern loc -> Pattern loc
forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
updateDependencies Map Referent Referent
tms Pattern loc
rhs)

hasSubpattern :: Pattern loc -> Pattern loc -> Bool
hasSubpattern :: forall loc. Pattern loc -> Pattern loc -> Bool
hasSubpattern (Unbound {}) Pattern loc
_ = Bool
True
hasSubpattern (Var {}) Pattern loc
_ = Bool
True
hasSubpattern Pattern loc
needle Pattern loc
haystack = Pattern loc
needle Pattern loc -> Pattern loc -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern loc
haystack Bool -> Bool -> Bool
|| Pattern loc -> Bool
go Pattern loc
haystack
  where
    go :: Pattern loc -> Bool
go Unbound {} = Bool
False
    go Var {} = Bool
False
    go Int {} = Bool
False
    go Nat {} = Bool
False
    go Float {} = Bool
False
    go Boolean {} = Bool
False
    go Text {} = Bool
False
    go Char {} = Bool
False
    go (Constructor loc
_ ConstructorReference
_ [Pattern loc]
ps) = (Pattern loc -> Bool) -> [Pattern loc] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern loc -> Pattern loc -> Bool
forall loc. Pattern loc -> Pattern loc -> Bool
hasSubpattern Pattern loc
needle) [Pattern loc]
ps
    go (As loc
_ Pattern loc
p) = Pattern loc -> Pattern loc -> Bool
forall loc. Pattern loc -> Pattern loc -> Bool
hasSubpattern Pattern loc
needle Pattern loc
p
    go (EffectPure loc
_ Pattern loc
p) = Pattern loc -> Pattern loc -> Bool
forall loc. Pattern loc -> Pattern loc -> Bool
hasSubpattern Pattern loc
needle Pattern loc
p
    go (EffectBind loc
_ ConstructorReference
_ [Pattern loc]
ps Pattern loc
p) = (Pattern loc -> Bool) -> [Pattern loc] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern loc -> Pattern loc -> Bool
forall loc. Pattern loc -> Pattern loc -> Bool
hasSubpattern Pattern loc
needle) [Pattern loc]
ps Bool -> Bool -> Bool
|| Pattern loc -> Pattern loc -> Bool
forall loc. Pattern loc -> Pattern loc -> Bool
hasSubpattern Pattern loc
needle Pattern loc
p
    go (SequenceLiteral loc
_ [Pattern loc]
ps) = (Pattern loc -> Bool) -> [Pattern loc] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern loc -> Pattern loc -> Bool
forall loc. Pattern loc -> Pattern loc -> Bool
hasSubpattern Pattern loc
needle) [Pattern loc]
ps
    go (SequenceOp loc
_ Pattern loc
ph SeqOp
_ Pattern loc
pt) = Pattern loc -> Pattern loc -> Bool
forall loc. Pattern loc -> Pattern loc -> Bool
hasSubpattern Pattern loc
needle Pattern loc
ph Bool -> Bool -> Bool
|| Pattern loc -> Pattern loc -> Bool
forall loc. Pattern loc -> Pattern loc -> Bool
hasSubpattern Pattern loc
needle Pattern loc
pt

instance Show (Pattern loc) where
  show :: Pattern loc -> String
show (Unbound loc
_) = String
"Unbound"
  show (Var loc
_) = String
"Var"
  show (Boolean loc
_ Bool
x) = String
"Boolean " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Bool -> String
forall a. Show a => a -> String
show Bool
x
  show (Int loc
_ Int64
x) = String
"Int " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int64 -> String
forall a. Show a => a -> String
show Int64
x
  show (Nat loc
_ Word64
x) = String
"Nat " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
x
  show (Float loc
_ Double
x) = String
"Float " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
x
  show (Text loc
_ Text
t) = String
"Text " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t
  show (Char loc
_ Char
c) = String
"Char " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
c
  show (Constructor loc
_ (ConstructorReference Reference' Text Hash
r Word64
i) [Pattern loc]
ps) =
    String
"Constructor " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords [Reference' Text Hash -> String
forall a. Show a => a -> String
show Reference' Text Hash
r, Word64 -> String
forall a. Show a => a -> String
show Word64
i, [Pattern loc] -> String
forall a. Show a => a -> String
show [Pattern loc]
ps]
  show (As loc
_ Pattern loc
p) = String
"As " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pattern loc -> String
forall a. Show a => a -> String
show Pattern loc
p
  show (EffectPure loc
_ Pattern loc
k) = String
"EffectPure " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pattern loc -> String
forall a. Show a => a -> String
show Pattern loc
k
  show (EffectBind loc
_ (ConstructorReference Reference' Text Hash
r Word64
i) [Pattern loc]
ps Pattern loc
k) =
    String
"EffectBind " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords [Reference' Text Hash -> String
forall a. Show a => a -> String
show Reference' Text Hash
r, Word64 -> String
forall a. Show a => a -> String
show Word64
i, [Pattern loc] -> String
forall a. Show a => a -> String
show [Pattern loc]
ps, Pattern loc -> String
forall a. Show a => a -> String
show Pattern loc
k]
  show (SequenceLiteral loc
_ [Pattern loc]
ps) = String
"Sequence " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Pattern loc -> String) -> [Pattern loc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pattern loc -> String
forall a. Show a => a -> String
show [Pattern loc]
ps)
  show (SequenceOp loc
_ Pattern loc
ph SeqOp
op Pattern loc
pt) = String
"Sequence " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pattern loc -> String
forall a. Show a => a -> String
show Pattern loc
ph String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SeqOp -> String
forall a. Show a => a -> String
show SeqOp
op String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pattern loc -> String
forall a. Show a => a -> String
show Pattern loc
pt

application :: Pattern loc -> Bool
application :: forall a. Pattern a -> Bool
application (Constructor loc
_ ConstructorReference
_ (Pattern loc
_ : [Pattern loc]
_)) = Bool
True
application Pattern loc
_ = Bool
False

loc :: Pattern loc -> loc
loc :: forall loc. Pattern loc -> loc
loc = \case
  Unbound loc
loc -> loc
loc
  Var loc
loc -> loc
loc
  Boolean loc
loc Bool
_ -> loc
loc
  Int loc
loc Int64
_ -> loc
loc
  Nat loc
loc Word64
_ -> loc
loc
  Float loc
loc Double
_ -> loc
loc
  Text loc
loc Text
_ -> loc
loc
  Char loc
loc Char
_ -> loc
loc
  Constructor loc
loc ConstructorReference
_ [Pattern loc]
_ -> loc
loc
  As loc
loc Pattern loc
_ -> loc
loc
  EffectPure loc
loc Pattern loc
_ -> loc
loc
  EffectBind loc
loc ConstructorReference
_ [Pattern loc]
_ Pattern loc
_ -> loc
loc
  SequenceLiteral loc
loc [Pattern loc]
_ -> loc
loc
  SequenceOp loc
loc Pattern loc
_ SeqOp
_ Pattern loc
_ -> loc
loc

setLoc :: Pattern loc -> loc -> Pattern loc
setLoc :: forall loc. Pattern loc -> loc -> Pattern loc
setLoc Pattern loc
p loc
loc = case Pattern loc
p of
  EffectBind loc
_ ConstructorReference
a [Pattern loc]
b Pattern loc
c -> loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
forall loc.
loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
EffectBind loc
loc ConstructorReference
a [Pattern loc]
b Pattern loc
c
  EffectPure loc
_ Pattern loc
a -> loc -> Pattern loc -> Pattern loc
forall loc. loc -> Pattern loc -> Pattern loc
EffectPure loc
loc Pattern loc
a
  As loc
_ Pattern loc
a -> loc -> Pattern loc -> Pattern loc
forall loc. loc -> Pattern loc -> Pattern loc
As loc
loc Pattern loc
a
  Constructor loc
_ ConstructorReference
a [Pattern loc]
b -> loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Constructor loc
loc ConstructorReference
a [Pattern loc]
b
  SequenceLiteral loc
_ [Pattern loc]
ps -> loc -> [Pattern loc] -> Pattern loc
forall loc. loc -> [Pattern loc] -> Pattern loc
SequenceLiteral loc
loc [Pattern loc]
ps
  SequenceOp loc
_ Pattern loc
ph SeqOp
op Pattern loc
pt -> loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
forall loc.
loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
SequenceOp loc
loc Pattern loc
ph SeqOp
op Pattern loc
pt
  Pattern loc
x -> (loc -> loc) -> Pattern loc -> Pattern loc
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (loc -> loc -> loc
forall a b. a -> b -> a
const loc
loc) Pattern loc
x

instance Eq (Pattern loc) where
  Unbound loc
_ == :: Pattern loc -> Pattern loc -> Bool
== Unbound loc
_ = Bool
True
  Var loc
_ == Var loc
_ = Bool
True
  Char loc
_ Char
c == Char loc
_ Char
d = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
d
  Boolean loc
_ Bool
b == Boolean loc
_ Bool
b2 = Bool
b Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b2
  Int loc
_ Int64
n == Int loc
_ Int64
m = Int64
n Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
m
  Nat loc
_ Word64
n == Nat loc
_ Word64
m = Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
m
  Float loc
_ Double
f == Float loc
_ Double
g = Double
f Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
g
  Constructor loc
_ ConstructorReference
r [Pattern loc]
args == Constructor loc
_ ConstructorReference
s [Pattern loc]
brgs = ConstructorReference
r ConstructorReference -> ConstructorReference -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorReference
s Bool -> Bool -> Bool
&& [Pattern loc]
args [Pattern loc] -> [Pattern loc] -> Bool
forall a. Eq a => a -> a -> Bool
== [Pattern loc]
brgs
  EffectPure loc
_ Pattern loc
p == EffectPure loc
_ Pattern loc
q = Pattern loc
p Pattern loc -> Pattern loc -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern loc
q
  EffectBind loc
_ ConstructorReference
r [Pattern loc]
ps Pattern loc
k == EffectBind loc
_ ConstructorReference
r2 [Pattern loc]
ps2 Pattern loc
k2 = ConstructorReference
r ConstructorReference -> ConstructorReference -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorReference
r2 Bool -> Bool -> Bool
&& [Pattern loc]
ps [Pattern loc] -> [Pattern loc] -> Bool
forall a. Eq a => a -> a -> Bool
== [Pattern loc]
ps2 Bool -> Bool -> Bool
&& Pattern loc
k Pattern loc -> Pattern loc -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern loc
k2
  As loc
_ Pattern loc
p == As loc
_ Pattern loc
q = Pattern loc
p Pattern loc -> Pattern loc -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern loc
q
  Text loc
_ Text
t == Text loc
_ Text
t2 = Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t2
  SequenceLiteral loc
_ [Pattern loc]
ps == SequenceLiteral loc
_ [Pattern loc]
ps2 = [Pattern loc]
ps [Pattern loc] -> [Pattern loc] -> Bool
forall a. Eq a => a -> a -> Bool
== [Pattern loc]
ps2
  SequenceOp loc
_ Pattern loc
ph SeqOp
op Pattern loc
pt == SequenceOp loc
_ Pattern loc
ph2 SeqOp
op2 Pattern loc
pt2 = Pattern loc
ph Pattern loc -> Pattern loc -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern loc
ph2 Bool -> Bool -> Bool
&& SeqOp
op SeqOp -> SeqOp -> Bool
forall a. Eq a => a -> a -> Bool
== SeqOp
op2 Bool -> Bool -> Bool
&& Pattern loc
pt Pattern loc -> Pattern loc -> Bool
forall a. Eq a => a -> a -> Bool
== Pattern loc
pt2
  Pattern loc
_ == Pattern loc
_ = Bool
False

foldMap' :: (Monoid m) => (Pattern loc -> m) -> Pattern loc -> m
foldMap' :: forall m loc. Monoid m => (Pattern loc -> m) -> Pattern loc -> m
foldMap' Pattern loc -> m
f Pattern loc
p = case Pattern loc
p of
  Unbound loc
_ -> Pattern loc -> m
f Pattern loc
p
  Var loc
_ -> Pattern loc -> m
f Pattern loc
p
  Boolean loc
_ Bool
_ -> Pattern loc -> m
f Pattern loc
p
  Int loc
_ Int64
_ -> Pattern loc -> m
f Pattern loc
p
  Nat loc
_ Word64
_ -> Pattern loc -> m
f Pattern loc
p
  Float loc
_ Double
_ -> Pattern loc -> m
f Pattern loc
p
  Text loc
_ Text
_ -> Pattern loc -> m
f Pattern loc
p
  Char loc
_ Char
_ -> Pattern loc -> m
f Pattern loc
p
  Constructor loc
_ ConstructorReference
_ [Pattern loc]
ps -> Pattern loc -> m
f Pattern loc
p m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Pattern loc -> m) -> [Pattern loc] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Pattern loc -> m) -> Pattern loc -> m
forall m loc. Monoid m => (Pattern loc -> m) -> Pattern loc -> m
foldMap' Pattern loc -> m
f) [Pattern loc]
ps
  As loc
_ Pattern loc
p' -> Pattern loc -> m
f Pattern loc
p m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Pattern loc -> m) -> Pattern loc -> m
forall m loc. Monoid m => (Pattern loc -> m) -> Pattern loc -> m
foldMap' Pattern loc -> m
f Pattern loc
p'
  EffectPure loc
_ Pattern loc
p' -> Pattern loc -> m
f Pattern loc
p m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Pattern loc -> m) -> Pattern loc -> m
forall m loc. Monoid m => (Pattern loc -> m) -> Pattern loc -> m
foldMap' Pattern loc -> m
f Pattern loc
p'
  EffectBind loc
_ ConstructorReference
_ [Pattern loc]
ps Pattern loc
p' -> Pattern loc -> m
f Pattern loc
p m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Pattern loc -> m) -> [Pattern loc] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Pattern loc -> m) -> Pattern loc -> m
forall m loc. Monoid m => (Pattern loc -> m) -> Pattern loc -> m
foldMap' Pattern loc -> m
f) [Pattern loc]
ps m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Pattern loc -> m) -> Pattern loc -> m
forall m loc. Monoid m => (Pattern loc -> m) -> Pattern loc -> m
foldMap' Pattern loc -> m
f Pattern loc
p'
  SequenceLiteral loc
_ [Pattern loc]
ps -> Pattern loc -> m
f Pattern loc
p m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Pattern loc -> m) -> [Pattern loc] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Pattern loc -> m) -> Pattern loc -> m
forall m loc. Monoid m => (Pattern loc -> m) -> Pattern loc -> m
foldMap' Pattern loc -> m
f) [Pattern loc]
ps
  SequenceOp loc
_ Pattern loc
p1 SeqOp
_ Pattern loc
p2 -> Pattern loc -> m
f Pattern loc
p m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Pattern loc -> m) -> Pattern loc -> m
forall m loc. Monoid m => (Pattern loc -> m) -> Pattern loc -> m
foldMap' Pattern loc -> m
f Pattern loc
p1 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Pattern loc -> m) -> Pattern loc -> m
forall m loc. Monoid m => (Pattern loc -> m) -> Pattern loc -> m
foldMap' Pattern loc -> m
f Pattern loc
p2

generalizedDependencies ::
  (Ord r) =>
  (Reference -> r) ->
  (Reference -> ConstructorId -> r) ->
  (Reference -> r) ->
  (Reference -> ConstructorId -> r) ->
  (Reference -> r) ->
  Pattern loc ->
  Set r
generalizedDependencies :: forall r loc.
Ord r =>
(Reference' Text Hash -> r)
-> (Reference' Text Hash -> Word64 -> r)
-> (Reference' Text Hash -> r)
-> (Reference' Text Hash -> Word64 -> r)
-> (Reference' Text Hash -> r)
-> Pattern loc
-> Set r
generalizedDependencies Reference' Text Hash -> r
literalType Reference' Text Hash -> Word64 -> r
dataConstructor Reference' Text Hash -> r
dataType Reference' Text Hash -> Word64 -> r
effectConstructor Reference' Text Hash -> r
effectType =
  [r] -> Set r
forall a. Ord a => [a] -> Set a
Set.fromList
    ([r] -> Set r) -> (Pattern loc -> [r]) -> Pattern loc -> Set r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern loc -> [r]) -> Pattern loc -> [r]
forall m loc. Monoid m => (Pattern loc -> m) -> Pattern loc -> m
foldMap'
      ( \case
          Unbound loc
_ -> [r]
forall a. Monoid a => a
mempty
          Var loc
_ -> [r]
forall a. Monoid a => a
mempty
          As loc
_ Pattern loc
_ -> [r]
forall a. Monoid a => a
mempty
          Constructor loc
_ (ConstructorReference Reference' Text Hash
r Word64
cid) [Pattern loc]
_ -> [Reference' Text Hash -> r
dataType Reference' Text Hash
r, Reference' Text Hash -> Word64 -> r
dataConstructor Reference' Text Hash
r Word64
cid]
          EffectPure loc
_ Pattern loc
_ -> [Reference' Text Hash -> r
effectType Reference' Text Hash
Type.effectRef]
          EffectBind loc
_ (ConstructorReference Reference' Text Hash
r Word64
cid) [Pattern loc]
_ Pattern loc
_ ->
            [Reference' Text Hash -> r
effectType Reference' Text Hash
Type.effectRef, Reference' Text Hash -> r
effectType Reference' Text Hash
r, Reference' Text Hash -> Word64 -> r
effectConstructor Reference' Text Hash
r Word64
cid]
          SequenceLiteral loc
_ [Pattern loc]
_ -> [Reference' Text Hash -> r
literalType Reference' Text Hash
Type.listRef]
          SequenceOp {} -> [Reference' Text Hash -> r
literalType Reference' Text Hash
Type.listRef]
          Boolean loc
_ Bool
_ -> [Reference' Text Hash -> r
literalType Reference' Text Hash
Type.booleanRef]
          Int loc
_ Int64
_ -> [Reference' Text Hash -> r
literalType Reference' Text Hash
Type.intRef]
          Nat loc
_ Word64
_ -> [Reference' Text Hash -> r
literalType Reference' Text Hash
Type.natRef]
          Float loc
_ Double
_ -> [Reference' Text Hash -> r
literalType Reference' Text Hash
Type.floatRef]
          Text loc
_ Text
_ -> [Reference' Text Hash -> r
literalType Reference' Text Hash
Type.textRef]
          Char loc
_ Char
_ -> [Reference' Text Hash -> r
literalType Reference' Text Hash
Type.charRef]
      )

labeledDependencies :: Pattern loc -> Set LabeledDependency
labeledDependencies :: forall loc. Pattern loc -> Set LabeledDependency
labeledDependencies =
  (Reference' Text Hash -> LabeledDependency)
-> (Reference' Text Hash -> Word64 -> LabeledDependency)
-> (Reference' Text Hash -> LabeledDependency)
-> (Reference' Text Hash -> Word64 -> LabeledDependency)
-> (Reference' Text Hash -> LabeledDependency)
-> Pattern loc
-> Set LabeledDependency
forall r loc.
Ord r =>
(Reference' Text Hash -> r)
-> (Reference' Text Hash -> Word64 -> r)
-> (Reference' Text Hash -> r)
-> (Reference' Text Hash -> Word64 -> r)
-> (Reference' Text Hash -> r)
-> Pattern loc
-> Set r
generalizedDependencies
    Reference' Text Hash -> LabeledDependency
LD.typeRef
    (\Reference' Text Hash
r Word64
i -> ConstructorReference -> LabeledDependency
LD.dataConstructor (Reference' Text Hash -> Word64 -> ConstructorReference
forall r. r -> Word64 -> GConstructorReference r
ConstructorReference Reference' Text Hash
r Word64
i))
    Reference' Text Hash -> LabeledDependency
LD.typeRef
    (\Reference' Text Hash
r Word64
i -> ConstructorReference -> LabeledDependency
LD.effectConstructor (Reference' Text Hash -> Word64 -> ConstructorReference
forall r. r -> Word64 -> GConstructorReference r
ConstructorReference Reference' Text Hash
r Word64
i))
    Reference' Text Hash -> LabeledDependency
LD.typeRef