{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
module PlutusIR.Compiler.Provenance where
import PlutusIR
import PlutusCore.Pretty qualified as PLC
import Data.Hashable
import Data.Set qualified as S
import GHC.Generics (Generic)
import Prettyprinter ((<+>))
import Prettyprinter qualified as PP
data Provenance a = Original a
| LetBinding Recursivity (Provenance a)
| TermBinding String (Provenance a)
| TypeBinding String (Provenance a)
| DatatypeComponent DatatypeComponent (Provenance a)
| MultipleSources (S.Set (Provenance a))
deriving stock (Int -> Provenance a -> ShowS
[Provenance a] -> ShowS
Provenance a -> String
(Int -> Provenance a -> ShowS)
-> (Provenance a -> String)
-> ([Provenance a] -> ShowS)
-> Show (Provenance a)
forall a. Show a => Int -> Provenance a -> ShowS
forall a. Show a => [Provenance a] -> ShowS
forall a. Show a => Provenance a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Provenance a -> ShowS
showsPrec :: Int -> Provenance a -> ShowS
$cshow :: forall a. Show a => Provenance a -> String
show :: Provenance a -> String
$cshowList :: forall a. Show a => [Provenance a] -> ShowS
showList :: [Provenance a] -> ShowS
Show, Provenance a -> Provenance a -> Bool
(Provenance a -> Provenance a -> Bool)
-> (Provenance a -> Provenance a -> Bool) -> Eq (Provenance a)
forall a. Eq a => Provenance a -> Provenance a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Provenance a -> Provenance a -> Bool
== :: Provenance a -> Provenance a -> Bool
$c/= :: forall a. Eq a => Provenance a -> Provenance a -> Bool
/= :: Provenance a -> Provenance a -> Bool
Eq, Eq (Provenance a)
Eq (Provenance a) =>
(Provenance a -> Provenance a -> Ordering)
-> (Provenance a -> Provenance a -> Bool)
-> (Provenance a -> Provenance a -> Bool)
-> (Provenance a -> Provenance a -> Bool)
-> (Provenance a -> Provenance a -> Bool)
-> (Provenance a -> Provenance a -> Provenance a)
-> (Provenance a -> Provenance a -> Provenance a)
-> Ord (Provenance a)
Provenance a -> Provenance a -> Bool
Provenance a -> Provenance a -> Ordering
Provenance a -> Provenance a -> Provenance a
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 a. Ord a => Eq (Provenance a)
forall a. Ord a => Provenance a -> Provenance a -> Bool
forall a. Ord a => Provenance a -> Provenance a -> Ordering
forall a. Ord a => Provenance a -> Provenance a -> Provenance a
$ccompare :: forall a. Ord a => Provenance a -> Provenance a -> Ordering
compare :: Provenance a -> Provenance a -> Ordering
$c< :: forall a. Ord a => Provenance a -> Provenance a -> Bool
< :: Provenance a -> Provenance a -> Bool
$c<= :: forall a. Ord a => Provenance a -> Provenance a -> Bool
<= :: Provenance a -> Provenance a -> Bool
$c> :: forall a. Ord a => Provenance a -> Provenance a -> Bool
> :: Provenance a -> Provenance a -> Bool
$c>= :: forall a. Ord a => Provenance a -> Provenance a -> Bool
>= :: Provenance a -> Provenance a -> Bool
$cmax :: forall a. Ord a => Provenance a -> Provenance a -> Provenance a
max :: Provenance a -> Provenance a -> Provenance a
$cmin :: forall a. Ord a => Provenance a -> Provenance a -> Provenance a
min :: Provenance a -> Provenance a -> Provenance a
Ord, (forall m. Monoid m => Provenance m -> m)
-> (forall m a. Monoid m => (a -> m) -> Provenance a -> m)
-> (forall m a. Monoid m => (a -> m) -> Provenance a -> m)
-> (forall a b. (a -> b -> b) -> b -> Provenance a -> b)
-> (forall a b. (a -> b -> b) -> b -> Provenance a -> b)
-> (forall b a. (b -> a -> b) -> b -> Provenance a -> b)
-> (forall b a. (b -> a -> b) -> b -> Provenance a -> b)
-> (forall a. (a -> a -> a) -> Provenance a -> a)
-> (forall a. (a -> a -> a) -> Provenance a -> a)
-> (forall a. Provenance a -> [a])
-> (forall a. Provenance a -> Bool)
-> (forall a. Provenance a -> Int)
-> (forall a. Eq a => a -> Provenance a -> Bool)
-> (forall a. Ord a => Provenance a -> a)
-> (forall a. Ord a => Provenance a -> a)
-> (forall a. Num a => Provenance a -> a)
-> (forall a. Num a => Provenance a -> a)
-> Foldable Provenance
forall a. Eq a => a -> Provenance a -> Bool
forall a. Num a => Provenance a -> a
forall a. Ord a => Provenance a -> a
forall m. Monoid m => Provenance m -> m
forall a. Provenance a -> Bool
forall a. Provenance a -> Int
forall a. Provenance a -> [a]
forall a. (a -> a -> a) -> Provenance a -> a
forall m a. Monoid m => (a -> m) -> Provenance a -> m
forall b a. (b -> a -> b) -> b -> Provenance a -> b
forall a b. (a -> b -> b) -> b -> Provenance 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 => Provenance m -> m
fold :: forall m. Monoid m => Provenance m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Provenance a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Provenance a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Provenance a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Provenance a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Provenance a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Provenance a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Provenance a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Provenance a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Provenance a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Provenance a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Provenance a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Provenance a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Provenance a -> a
foldr1 :: forall a. (a -> a -> a) -> Provenance a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Provenance a -> a
foldl1 :: forall a. (a -> a -> a) -> Provenance a -> a
$ctoList :: forall a. Provenance a -> [a]
toList :: forall a. Provenance a -> [a]
$cnull :: forall a. Provenance a -> Bool
null :: forall a. Provenance a -> Bool
$clength :: forall a. Provenance a -> Int
length :: forall a. Provenance a -> Int
$celem :: forall a. Eq a => a -> Provenance a -> Bool
elem :: forall a. Eq a => a -> Provenance a -> Bool
$cmaximum :: forall a. Ord a => Provenance a -> a
maximum :: forall a. Ord a => Provenance a -> a
$cminimum :: forall a. Ord a => Provenance a -> a
minimum :: forall a. Ord a => Provenance a -> a
$csum :: forall a. Num a => Provenance a -> a
sum :: forall a. Num a => Provenance a -> a
$cproduct :: forall a. Num a => Provenance a -> a
product :: forall a. Num a => Provenance a -> a
Foldable, (forall x. Provenance a -> Rep (Provenance a) x)
-> (forall x. Rep (Provenance a) x -> Provenance a)
-> Generic (Provenance a)
forall x. Rep (Provenance a) x -> Provenance a
forall x. Provenance a -> Rep (Provenance a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Provenance a) x -> Provenance a
forall a x. Provenance a -> Rep (Provenance a) x
$cfrom :: forall a x. Provenance a -> Rep (Provenance a) x
from :: forall x. Provenance a -> Rep (Provenance a) x
$cto :: forall a x. Rep (Provenance a) x -> Provenance a
to :: forall x. Rep (Provenance a) x -> Provenance a
Generic)
deriving anyclass (Eq (Provenance a)
Eq (Provenance a) =>
(Int -> Provenance a -> Int)
-> (Provenance a -> Int) -> Hashable (Provenance a)
Int -> Provenance a -> Int
Provenance a -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Hashable a => Eq (Provenance a)
forall a. Hashable a => Int -> Provenance a -> Int
forall a. Hashable a => Provenance a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Provenance a -> Int
hashWithSalt :: Int -> Provenance a -> Int
$chash :: forall a. Hashable a => Provenance a -> Int
hash :: Provenance a -> Int
Hashable)
instance Ord a => Semigroup (Provenance a) where
Provenance a
x <> :: Provenance a -> Provenance a -> Provenance a
<> Provenance a
y = Set (Provenance a) -> Provenance a
forall a. Set (Provenance a) -> Provenance a
MultipleSources (Provenance a -> Set (Provenance a)
forall {a}. Provenance a -> Set (Provenance a)
toSet Provenance a
x Set (Provenance a) -> Set (Provenance a) -> Set (Provenance a)
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Provenance a -> Set (Provenance a)
forall {a}. Provenance a -> Set (Provenance a)
toSet Provenance a
y)
where
toSet :: Provenance a -> Set (Provenance a)
toSet = \case
MultipleSources Set (Provenance a)
ps -> Set (Provenance a)
ps
Provenance a
other -> Provenance a -> Set (Provenance a)
forall a. a -> Set a
S.singleton Provenance a
other
instance Ord a => Monoid (Provenance a) where
mempty :: Provenance a
mempty = Provenance a
forall a. Provenance a
noProvenance
noProvenance :: Provenance a
noProvenance :: forall a. Provenance a
noProvenance = Set (Provenance a) -> Provenance a
forall a. Set (Provenance a) -> Provenance a
MultipleSources Set (Provenance a)
forall a. Set a
S.empty
data DatatypeComponent = Constructor
| ConstructorType
| Destructor
| DestructorType
| DatatypeType
| PatternFunctor
deriving stock (Int -> DatatypeComponent -> ShowS
[DatatypeComponent] -> ShowS
DatatypeComponent -> String
(Int -> DatatypeComponent -> ShowS)
-> (DatatypeComponent -> String)
-> ([DatatypeComponent] -> ShowS)
-> Show DatatypeComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DatatypeComponent -> ShowS
showsPrec :: Int -> DatatypeComponent -> ShowS
$cshow :: DatatypeComponent -> String
show :: DatatypeComponent -> String
$cshowList :: [DatatypeComponent] -> ShowS
showList :: [DatatypeComponent] -> ShowS
Show, DatatypeComponent -> DatatypeComponent -> Bool
(DatatypeComponent -> DatatypeComponent -> Bool)
-> (DatatypeComponent -> DatatypeComponent -> Bool)
-> Eq DatatypeComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DatatypeComponent -> DatatypeComponent -> Bool
== :: DatatypeComponent -> DatatypeComponent -> Bool
$c/= :: DatatypeComponent -> DatatypeComponent -> Bool
/= :: DatatypeComponent -> DatatypeComponent -> Bool
Eq, Eq DatatypeComponent
Eq DatatypeComponent =>
(DatatypeComponent -> DatatypeComponent -> Ordering)
-> (DatatypeComponent -> DatatypeComponent -> Bool)
-> (DatatypeComponent -> DatatypeComponent -> Bool)
-> (DatatypeComponent -> DatatypeComponent -> Bool)
-> (DatatypeComponent -> DatatypeComponent -> Bool)
-> (DatatypeComponent -> DatatypeComponent -> DatatypeComponent)
-> (DatatypeComponent -> DatatypeComponent -> DatatypeComponent)
-> Ord DatatypeComponent
DatatypeComponent -> DatatypeComponent -> Bool
DatatypeComponent -> DatatypeComponent -> Ordering
DatatypeComponent -> DatatypeComponent -> DatatypeComponent
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 :: DatatypeComponent -> DatatypeComponent -> Ordering
compare :: DatatypeComponent -> DatatypeComponent -> Ordering
$c< :: DatatypeComponent -> DatatypeComponent -> Bool
< :: DatatypeComponent -> DatatypeComponent -> Bool
$c<= :: DatatypeComponent -> DatatypeComponent -> Bool
<= :: DatatypeComponent -> DatatypeComponent -> Bool
$c> :: DatatypeComponent -> DatatypeComponent -> Bool
> :: DatatypeComponent -> DatatypeComponent -> Bool
$c>= :: DatatypeComponent -> DatatypeComponent -> Bool
>= :: DatatypeComponent -> DatatypeComponent -> Bool
$cmax :: DatatypeComponent -> DatatypeComponent -> DatatypeComponent
max :: DatatypeComponent -> DatatypeComponent -> DatatypeComponent
$cmin :: DatatypeComponent -> DatatypeComponent -> DatatypeComponent
min :: DatatypeComponent -> DatatypeComponent -> DatatypeComponent
Ord, (forall x. DatatypeComponent -> Rep DatatypeComponent x)
-> (forall x. Rep DatatypeComponent x -> DatatypeComponent)
-> Generic DatatypeComponent
forall x. Rep DatatypeComponent x -> DatatypeComponent
forall x. DatatypeComponent -> Rep DatatypeComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DatatypeComponent -> Rep DatatypeComponent x
from :: forall x. DatatypeComponent -> Rep DatatypeComponent x
$cto :: forall x. Rep DatatypeComponent x -> DatatypeComponent
to :: forall x. Rep DatatypeComponent x -> DatatypeComponent
Generic)
deriving anyclass (Eq DatatypeComponent
Eq DatatypeComponent =>
(Int -> DatatypeComponent -> Int)
-> (DatatypeComponent -> Int) -> Hashable DatatypeComponent
Int -> DatatypeComponent -> Int
DatatypeComponent -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> DatatypeComponent -> Int
hashWithSalt :: Int -> DatatypeComponent -> Int
$chash :: DatatypeComponent -> Int
hash :: DatatypeComponent -> Int
Hashable)
instance PP.Pretty DatatypeComponent where
pretty :: forall ann. DatatypeComponent -> Doc ann
pretty = \case
DatatypeComponent
Constructor -> Doc ann
"constructor"
DatatypeComponent
ConstructorType -> Doc ann
"constructor type"
DatatypeComponent
Destructor -> Doc ann
"destructor"
DatatypeComponent
DestructorType -> Doc ann
"destructor type"
DatatypeComponent
DatatypeType -> Doc ann
"datatype type"
DatatypeComponent
PatternFunctor -> Doc ann
"pattern functor"
data GeneratedKind = RecursiveLet
deriving stock (Int -> GeneratedKind -> ShowS
[GeneratedKind] -> ShowS
GeneratedKind -> String
(Int -> GeneratedKind -> ShowS)
-> (GeneratedKind -> String)
-> ([GeneratedKind] -> ShowS)
-> Show GeneratedKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeneratedKind -> ShowS
showsPrec :: Int -> GeneratedKind -> ShowS
$cshow :: GeneratedKind -> String
show :: GeneratedKind -> String
$cshowList :: [GeneratedKind] -> ShowS
showList :: [GeneratedKind] -> ShowS
Show, GeneratedKind -> GeneratedKind -> Bool
(GeneratedKind -> GeneratedKind -> Bool)
-> (GeneratedKind -> GeneratedKind -> Bool) -> Eq GeneratedKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeneratedKind -> GeneratedKind -> Bool
== :: GeneratedKind -> GeneratedKind -> Bool
$c/= :: GeneratedKind -> GeneratedKind -> Bool
/= :: GeneratedKind -> GeneratedKind -> Bool
Eq)
instance PP.Pretty GeneratedKind where
pretty :: forall ann. GeneratedKind -> Doc ann
pretty = \case
GeneratedKind
RecursiveLet -> Doc ann
"recursive let"
setProvenance :: Functor f => Provenance b -> f a -> f (Provenance b)
setProvenance :: forall (f :: * -> *) b a.
Functor f =>
Provenance b -> f a -> f (Provenance b)
setProvenance = Provenance b -> f a -> f (Provenance b)
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$)
original :: Functor f => f a -> f (Provenance a)
original :: forall (f :: * -> *) a. Functor f => f a -> f (Provenance a)
original = (a -> Provenance a) -> f a -> f (Provenance a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Provenance a
forall a. a -> Provenance a
Original
instance PP.Pretty a => PP.Pretty (Provenance a) where
pretty :: forall ann. Provenance a -> Doc ann
pretty = \case
DatatypeComponent DatatypeComponent
c Provenance a
p -> DatatypeComponent -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DatatypeComponent -> Doc ann
PP.pretty DatatypeComponent
c Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
";" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"from" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Provenance a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Provenance a -> Doc ann
PLC.pretty Provenance a
p
Original a
p -> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PLC.pretty a
p
LetBinding Recursivity
r Provenance a
p ->
let
rstr :: Doc ann
rstr = case Recursivity
r of
Recursivity
NonRec -> Doc ann
"non-recursive"
Recursivity
Rec -> Doc ann
"recursive"
in Doc ann
"(" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
rstr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
")" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"let binding" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
";" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"from" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Provenance a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Provenance a -> Doc ann
PLC.pretty Provenance a
p
TermBinding String
n Provenance a
p -> Doc ann
"term binding" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"of" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PLC.pretty String
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
";" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"from" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Provenance a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Provenance a -> Doc ann
PLC.pretty Provenance a
p
TypeBinding String
n Provenance a
p -> Doc ann
"type binding" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"of" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PLC.pretty String
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
";" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"from" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Provenance a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Provenance a -> Doc ann
PLC.pretty Provenance a
p
MultipleSources Set (Provenance a)
p1 -> case Set (Provenance a) -> [Provenance a]
forall a. Set a -> [a]
S.toList Set (Provenance a)
p1 of
[] -> Doc ann
"<unknown>"
[Provenance a]
l -> [Provenance a] -> Doc ann
forall ann. [Provenance a] -> Doc ann
forall a ann. Pretty a => [a] -> Doc ann
PLC.prettyList [Provenance a]
l