{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Frontend AST
module Kempe.AST ( BuiltinTy (..)
                 , KempeTy (..)
                 , StackType (..)
                 , ConsAnn (..)
                 , Atom (..)
                 , BuiltinFn (..)
                 , KempeDecl (..)
                 , Pattern (..)
                 , ABI (..)
                 , Module
                 , freeVars
                 , MonoStackType
                 , size
                 , sizeStack
                 , prettyMonoStackType
                 , prettyTyped
                 , prettyTypedModule
                 , prettyFancyModule
                 , prettyModule
                 , flipStackType
                 -- * I resent this...
                 , voidStackType
                 ) where

import           Control.DeepSeq         (NFData)
import           Data.Bifoldable         (Bifoldable (bifoldMap))
import           Data.Bifunctor          (Bifunctor (..))
import           Data.Bitraversable      (Bitraversable (..))
import qualified Data.ByteString.Lazy    as BSL
import           Data.Functor            (void)
import           Data.Int                (Int64, Int8)
import           Data.List.NonEmpty      (NonEmpty)
import qualified Data.List.NonEmpty      as NE
import           Data.Monoid             (Sum (..))
import qualified Data.Set                as S
import           Data.Text.Lazy.Encoding (decodeUtf8)
import           Data.Word               (Word8)
import           GHC.Generics            (Generic)
import           Kempe.Name
import           Numeric.Natural
import           Prettyprinter           (Doc, Pretty (pretty), align, braces, brackets, colon, concatWith, fillSep, hsep, parens, pipe, sep, (<+>))

data BuiltinTy = TyInt
               | TyBool
               | TyInt8
               | TyWord
               deriving ((forall x. BuiltinTy -> Rep BuiltinTy x)
-> (forall x. Rep BuiltinTy x -> BuiltinTy) -> Generic BuiltinTy
forall x. Rep BuiltinTy x -> BuiltinTy
forall x. BuiltinTy -> Rep BuiltinTy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuiltinTy x -> BuiltinTy
$cfrom :: forall x. BuiltinTy -> Rep BuiltinTy x
Generic, BuiltinTy -> ()
(BuiltinTy -> ()) -> NFData BuiltinTy
forall a. (a -> ()) -> NFData a
rnf :: BuiltinTy -> ()
$crnf :: BuiltinTy -> ()
NFData, BuiltinTy -> BuiltinTy -> Bool
(BuiltinTy -> BuiltinTy -> Bool)
-> (BuiltinTy -> BuiltinTy -> Bool) -> Eq BuiltinTy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuiltinTy -> BuiltinTy -> Bool
$c/= :: BuiltinTy -> BuiltinTy -> Bool
== :: BuiltinTy -> BuiltinTy -> Bool
$c== :: BuiltinTy -> BuiltinTy -> Bool
Eq, Eq BuiltinTy
Eq BuiltinTy
-> (BuiltinTy -> BuiltinTy -> Ordering)
-> (BuiltinTy -> BuiltinTy -> Bool)
-> (BuiltinTy -> BuiltinTy -> Bool)
-> (BuiltinTy -> BuiltinTy -> Bool)
-> (BuiltinTy -> BuiltinTy -> Bool)
-> (BuiltinTy -> BuiltinTy -> BuiltinTy)
-> (BuiltinTy -> BuiltinTy -> BuiltinTy)
-> Ord BuiltinTy
BuiltinTy -> BuiltinTy -> Bool
BuiltinTy -> BuiltinTy -> Ordering
BuiltinTy -> BuiltinTy -> BuiltinTy
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
min :: BuiltinTy -> BuiltinTy -> BuiltinTy
$cmin :: BuiltinTy -> BuiltinTy -> BuiltinTy
max :: BuiltinTy -> BuiltinTy -> BuiltinTy
$cmax :: BuiltinTy -> BuiltinTy -> BuiltinTy
>= :: BuiltinTy -> BuiltinTy -> Bool
$c>= :: BuiltinTy -> BuiltinTy -> Bool
> :: BuiltinTy -> BuiltinTy -> Bool
$c> :: BuiltinTy -> BuiltinTy -> Bool
<= :: BuiltinTy -> BuiltinTy -> Bool
$c<= :: BuiltinTy -> BuiltinTy -> Bool
< :: BuiltinTy -> BuiltinTy -> Bool
$c< :: BuiltinTy -> BuiltinTy -> Bool
compare :: BuiltinTy -> BuiltinTy -> Ordering
$ccompare :: BuiltinTy -> BuiltinTy -> Ordering
$cp1Ord :: Eq BuiltinTy
Ord)

instance Pretty BuiltinTy where
    pretty :: BuiltinTy -> Doc ann
pretty BuiltinTy
TyInt  = Doc ann
"Int"
    pretty BuiltinTy
TyBool = Doc ann
"Bool"
    pretty BuiltinTy
TyInt8 = Doc ann
"Int8"
    pretty BuiltinTy
TyWord = Doc ann
"Word"

-- equality for sum types &c.

data KempeTy a = TyBuiltin a BuiltinTy
               | TyNamed a (TyName a)
               | TyVar a (Name a)
               | TyApp a (KempeTy a) (KempeTy a) -- type applied to another, e.g. Just Int
               deriving ((forall x. KempeTy a -> Rep (KempeTy a) x)
-> (forall x. Rep (KempeTy a) x -> KempeTy a)
-> Generic (KempeTy a)
forall x. Rep (KempeTy a) x -> KempeTy a
forall x. KempeTy a -> Rep (KempeTy a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (KempeTy a) x -> KempeTy a
forall a x. KempeTy a -> Rep (KempeTy a) x
$cto :: forall a x. Rep (KempeTy a) x -> KempeTy a
$cfrom :: forall a x. KempeTy a -> Rep (KempeTy a) x
Generic, KempeTy a -> ()
(KempeTy a -> ()) -> NFData (KempeTy a)
forall a. NFData a => KempeTy a -> ()
forall a. (a -> ()) -> NFData a
rnf :: KempeTy a -> ()
$crnf :: forall a. NFData a => KempeTy a -> ()
NFData, a -> KempeTy b -> KempeTy a
(a -> b) -> KempeTy a -> KempeTy b
(forall a b. (a -> b) -> KempeTy a -> KempeTy b)
-> (forall a b. a -> KempeTy b -> KempeTy a) -> Functor KempeTy
forall a b. a -> KempeTy b -> KempeTy a
forall a b. (a -> b) -> KempeTy a -> KempeTy b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> KempeTy b -> KempeTy a
$c<$ :: forall a b. a -> KempeTy b -> KempeTy a
fmap :: (a -> b) -> KempeTy a -> KempeTy b
$cfmap :: forall a b. (a -> b) -> KempeTy a -> KempeTy b
Functor, KempeTy a -> KempeTy a -> Bool
(KempeTy a -> KempeTy a -> Bool)
-> (KempeTy a -> KempeTy a -> Bool) -> Eq (KempeTy a)
forall a. Eq a => KempeTy a -> KempeTy a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KempeTy a -> KempeTy a -> Bool
$c/= :: forall a. Eq a => KempeTy a -> KempeTy a -> Bool
== :: KempeTy a -> KempeTy a -> Bool
$c== :: forall a. Eq a => KempeTy a -> KempeTy a -> Bool
Eq, Eq (KempeTy a)
Eq (KempeTy a)
-> (KempeTy a -> KempeTy a -> Ordering)
-> (KempeTy a -> KempeTy a -> Bool)
-> (KempeTy a -> KempeTy a -> Bool)
-> (KempeTy a -> KempeTy a -> Bool)
-> (KempeTy a -> KempeTy a -> Bool)
-> (KempeTy a -> KempeTy a -> KempeTy a)
-> (KempeTy a -> KempeTy a -> KempeTy a)
-> Ord (KempeTy a)
KempeTy a -> KempeTy a -> Bool
KempeTy a -> KempeTy a -> Ordering
KempeTy a -> KempeTy a -> KempeTy 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 (KempeTy a)
forall a. Ord a => KempeTy a -> KempeTy a -> Bool
forall a. Ord a => KempeTy a -> KempeTy a -> Ordering
forall a. Ord a => KempeTy a -> KempeTy a -> KempeTy a
min :: KempeTy a -> KempeTy a -> KempeTy a
$cmin :: forall a. Ord a => KempeTy a -> KempeTy a -> KempeTy a
max :: KempeTy a -> KempeTy a -> KempeTy a
$cmax :: forall a. Ord a => KempeTy a -> KempeTy a -> KempeTy a
>= :: KempeTy a -> KempeTy a -> Bool
$c>= :: forall a. Ord a => KempeTy a -> KempeTy a -> Bool
> :: KempeTy a -> KempeTy a -> Bool
$c> :: forall a. Ord a => KempeTy a -> KempeTy a -> Bool
<= :: KempeTy a -> KempeTy a -> Bool
$c<= :: forall a. Ord a => KempeTy a -> KempeTy a -> Bool
< :: KempeTy a -> KempeTy a -> Bool
$c< :: forall a. Ord a => KempeTy a -> KempeTy a -> Bool
compare :: KempeTy a -> KempeTy a -> Ordering
$ccompare :: forall a. Ord a => KempeTy a -> KempeTy a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (KempeTy a)
Ord) -- questionable eq instance but eh

data StackType b = StackType { StackType b -> Set (Name b)
quantify :: S.Set (Name b)
                             , StackType b -> [KempeTy b]
inTypes  :: [KempeTy b]
                             , StackType b -> [KempeTy b]
outTypes :: [KempeTy b]
                             } deriving ((forall x. StackType b -> Rep (StackType b) x)
-> (forall x. Rep (StackType b) x -> StackType b)
-> Generic (StackType b)
forall x. Rep (StackType b) x -> StackType b
forall x. StackType b -> Rep (StackType b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall b x. Rep (StackType b) x -> StackType b
forall b x. StackType b -> Rep (StackType b) x
$cto :: forall b x. Rep (StackType b) x -> StackType b
$cfrom :: forall b x. StackType b -> Rep (StackType b) x
Generic, StackType b -> ()
(StackType b -> ()) -> NFData (StackType b)
forall b. NFData b => StackType b -> ()
forall a. (a -> ()) -> NFData a
rnf :: StackType b -> ()
$crnf :: forall b. NFData b => StackType b -> ()
NFData, StackType b -> StackType b -> Bool
(StackType b -> StackType b -> Bool)
-> (StackType b -> StackType b -> Bool) -> Eq (StackType b)
forall b. Eq b => StackType b -> StackType b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackType b -> StackType b -> Bool
$c/= :: forall b. Eq b => StackType b -> StackType b -> Bool
== :: StackType b -> StackType b -> Bool
$c== :: forall b. Eq b => StackType b -> StackType b -> Bool
Eq, Eq (StackType b)
Eq (StackType b)
-> (StackType b -> StackType b -> Ordering)
-> (StackType b -> StackType b -> Bool)
-> (StackType b -> StackType b -> Bool)
-> (StackType b -> StackType b -> Bool)
-> (StackType b -> StackType b -> Bool)
-> (StackType b -> StackType b -> StackType b)
-> (StackType b -> StackType b -> StackType b)
-> Ord (StackType b)
StackType b -> StackType b -> Bool
StackType b -> StackType b -> Ordering
StackType b -> StackType b -> StackType b
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 b. Ord b => Eq (StackType b)
forall b. Ord b => StackType b -> StackType b -> Bool
forall b. Ord b => StackType b -> StackType b -> Ordering
forall b. Ord b => StackType b -> StackType b -> StackType b
min :: StackType b -> StackType b -> StackType b
$cmin :: forall b. Ord b => StackType b -> StackType b -> StackType b
max :: StackType b -> StackType b -> StackType b
$cmax :: forall b. Ord b => StackType b -> StackType b -> StackType b
>= :: StackType b -> StackType b -> Bool
$c>= :: forall b. Ord b => StackType b -> StackType b -> Bool
> :: StackType b -> StackType b -> Bool
$c> :: forall b. Ord b => StackType b -> StackType b -> Bool
<= :: StackType b -> StackType b -> Bool
$c<= :: forall b. Ord b => StackType b -> StackType b -> Bool
< :: StackType b -> StackType b -> Bool
$c< :: forall b. Ord b => StackType b -> StackType b -> Bool
compare :: StackType b -> StackType b -> Ordering
$ccompare :: forall b. Ord b => StackType b -> StackType b -> Ordering
$cp1Ord :: forall b. Ord b => Eq (StackType b)
Ord)

type MonoStackType = ([KempeTy ()], [KempeTy ()])

-- | Annotation carried on constructors to keep size information through the IR
-- generation phase.
data ConsAnn a = ConsAnn { ConsAnn a -> Int64
tySz :: Int64, ConsAnn a -> Word8
tag :: Word8, ConsAnn a -> a
consTy :: a }
    deriving (a -> ConsAnn b -> ConsAnn a
(a -> b) -> ConsAnn a -> ConsAnn b
(forall a b. (a -> b) -> ConsAnn a -> ConsAnn b)
-> (forall a b. a -> ConsAnn b -> ConsAnn a) -> Functor ConsAnn
forall a b. a -> ConsAnn b -> ConsAnn a
forall a b. (a -> b) -> ConsAnn a -> ConsAnn b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ConsAnn b -> ConsAnn a
$c<$ :: forall a b. a -> ConsAnn b -> ConsAnn a
fmap :: (a -> b) -> ConsAnn a -> ConsAnn b
$cfmap :: forall a b. (a -> b) -> ConsAnn a -> ConsAnn b
Functor, ConsAnn a -> Bool
(a -> m) -> ConsAnn a -> m
(a -> b -> b) -> b -> ConsAnn a -> b
(forall m. Monoid m => ConsAnn m -> m)
-> (forall m a. Monoid m => (a -> m) -> ConsAnn a -> m)
-> (forall m a. Monoid m => (a -> m) -> ConsAnn a -> m)
-> (forall a b. (a -> b -> b) -> b -> ConsAnn a -> b)
-> (forall a b. (a -> b -> b) -> b -> ConsAnn a -> b)
-> (forall b a. (b -> a -> b) -> b -> ConsAnn a -> b)
-> (forall b a. (b -> a -> b) -> b -> ConsAnn a -> b)
-> (forall a. (a -> a -> a) -> ConsAnn a -> a)
-> (forall a. (a -> a -> a) -> ConsAnn a -> a)
-> (forall a. ConsAnn a -> [a])
-> (forall a. ConsAnn a -> Bool)
-> (forall a. ConsAnn a -> Int)
-> (forall a. Eq a => a -> ConsAnn a -> Bool)
-> (forall a. Ord a => ConsAnn a -> a)
-> (forall a. Ord a => ConsAnn a -> a)
-> (forall a. Num a => ConsAnn a -> a)
-> (forall a. Num a => ConsAnn a -> a)
-> Foldable ConsAnn
forall a. Eq a => a -> ConsAnn a -> Bool
forall a. Num a => ConsAnn a -> a
forall a. Ord a => ConsAnn a -> a
forall m. Monoid m => ConsAnn m -> m
forall a. ConsAnn a -> Bool
forall a. ConsAnn a -> Int
forall a. ConsAnn a -> [a]
forall a. (a -> a -> a) -> ConsAnn a -> a
forall m a. Monoid m => (a -> m) -> ConsAnn a -> m
forall b a. (b -> a -> b) -> b -> ConsAnn a -> b
forall a b. (a -> b -> b) -> b -> ConsAnn 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
product :: ConsAnn a -> a
$cproduct :: forall a. Num a => ConsAnn a -> a
sum :: ConsAnn a -> a
$csum :: forall a. Num a => ConsAnn a -> a
minimum :: ConsAnn a -> a
$cminimum :: forall a. Ord a => ConsAnn a -> a
maximum :: ConsAnn a -> a
$cmaximum :: forall a. Ord a => ConsAnn a -> a
elem :: a -> ConsAnn a -> Bool
$celem :: forall a. Eq a => a -> ConsAnn a -> Bool
length :: ConsAnn a -> Int
$clength :: forall a. ConsAnn a -> Int
null :: ConsAnn a -> Bool
$cnull :: forall a. ConsAnn a -> Bool
toList :: ConsAnn a -> [a]
$ctoList :: forall a. ConsAnn a -> [a]
foldl1 :: (a -> a -> a) -> ConsAnn a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ConsAnn a -> a
foldr1 :: (a -> a -> a) -> ConsAnn a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> ConsAnn a -> a
foldl' :: (b -> a -> b) -> b -> ConsAnn a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ConsAnn a -> b
foldl :: (b -> a -> b) -> b -> ConsAnn a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ConsAnn a -> b
foldr' :: (a -> b -> b) -> b -> ConsAnn a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ConsAnn a -> b
foldr :: (a -> b -> b) -> b -> ConsAnn a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> ConsAnn a -> b
foldMap' :: (a -> m) -> ConsAnn a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ConsAnn a -> m
foldMap :: (a -> m) -> ConsAnn a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ConsAnn a -> m
fold :: ConsAnn m -> m
$cfold :: forall m. Monoid m => ConsAnn m -> m
Foldable, Functor ConsAnn
Foldable ConsAnn
Functor ConsAnn
-> Foldable ConsAnn
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ConsAnn a -> f (ConsAnn b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ConsAnn (f a) -> f (ConsAnn a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ConsAnn a -> m (ConsAnn b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ConsAnn (m a) -> m (ConsAnn a))
-> Traversable ConsAnn
(a -> f b) -> ConsAnn a -> f (ConsAnn b)
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 => ConsAnn (m a) -> m (ConsAnn a)
forall (f :: * -> *) a.
Applicative f =>
ConsAnn (f a) -> f (ConsAnn a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConsAnn a -> m (ConsAnn b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ConsAnn a -> f (ConsAnn b)
sequence :: ConsAnn (m a) -> m (ConsAnn a)
$csequence :: forall (m :: * -> *) a. Monad m => ConsAnn (m a) -> m (ConsAnn a)
mapM :: (a -> m b) -> ConsAnn a -> m (ConsAnn b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConsAnn a -> m (ConsAnn b)
sequenceA :: ConsAnn (f a) -> f (ConsAnn a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ConsAnn (f a) -> f (ConsAnn a)
traverse :: (a -> f b) -> ConsAnn a -> f (ConsAnn b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ConsAnn a -> f (ConsAnn b)
$cp2Traversable :: Foldable ConsAnn
$cp1Traversable :: Functor ConsAnn
Traversable, (forall x. ConsAnn a -> Rep (ConsAnn a) x)
-> (forall x. Rep (ConsAnn a) x -> ConsAnn a)
-> Generic (ConsAnn a)
forall x. Rep (ConsAnn a) x -> ConsAnn a
forall x. ConsAnn a -> Rep (ConsAnn a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ConsAnn a) x -> ConsAnn a
forall a x. ConsAnn a -> Rep (ConsAnn a) x
$cto :: forall a x. Rep (ConsAnn a) x -> ConsAnn a
$cfrom :: forall a x. ConsAnn a -> Rep (ConsAnn a) x
Generic, ConsAnn a -> ()
(ConsAnn a -> ()) -> NFData (ConsAnn a)
forall a. NFData a => ConsAnn a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ConsAnn a -> ()
$crnf :: forall a. NFData a => ConsAnn a -> ()
NFData)

instance Pretty a => Pretty (ConsAnn a) where
    pretty :: ConsAnn a -> Doc ann
pretty (ConsAnn Int64
tSz Word8
b a
ty) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann
"tySz" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
tSz Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"tag" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
b Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"type" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
ty)

prettyMonoStackType :: MonoStackType -> Doc a
prettyMonoStackType :: MonoStackType -> Doc a
prettyMonoStackType ([KempeTy ()]
is, [KempeTy ()]
os) = [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep ((KempeTy () -> Doc a) -> [KempeTy ()] -> [Doc a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KempeTy () -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty [KempeTy ()]
is) Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"--" Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep ((KempeTy () -> Doc a) -> [KempeTy ()] -> [Doc a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KempeTy () -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty [KempeTy ()]
os)

instance Pretty (StackType a) where
    pretty :: StackType a -> Doc ann
pretty (StackType Set (Name a)
_ [KempeTy a]
ins [KempeTy a]
outs) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ((KempeTy a -> Doc ann) -> [KempeTy a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KempeTy a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [KempeTy a]
ins) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"--" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ((KempeTy a -> Doc ann) -> [KempeTy a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KempeTy a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [KempeTy a]
outs)

voidStackType :: StackType a -> StackType ()
voidStackType :: StackType a -> StackType ()
voidStackType (StackType Set (Name a)
vars [KempeTy a]
ins [KempeTy a]
outs) = Set (Name ()) -> [KempeTy ()] -> [KempeTy ()] -> StackType ()
forall b. Set (Name b) -> [KempeTy b] -> [KempeTy b] -> StackType b
StackType ((Name a -> Name ()) -> Set (Name a) -> Set (Name ())
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Set (Name a)
vars) (KempeTy a -> KempeTy ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (KempeTy a -> KempeTy ()) -> [KempeTy a] -> [KempeTy ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KempeTy a]
ins) (KempeTy a -> KempeTy ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (KempeTy a -> KempeTy ()) -> [KempeTy a] -> [KempeTy ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KempeTy a]
outs)

instance Pretty (KempeTy a) where
    pretty :: KempeTy a -> Doc ann
pretty (TyBuiltin a
_ BuiltinTy
b)  = BuiltinTy -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty BuiltinTy
b
    pretty (TyNamed a
_ TyName a
tn)   = TyName a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TyName a
tn
    pretty (TyVar a
_ TyName a
n)      = TyName a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TyName a
n
    pretty (TyApp a
_ KempeTy a
ty KempeTy a
ty') = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (KempeTy a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty KempeTy a
ty Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> KempeTy a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty KempeTy a
ty')

data Pattern c b = PatternInt b Integer
                 | PatternCons c (TyName c) -- a constructed pattern
                 | PatternWildcard b
                 | PatternBool b Bool
                 deriving (Pattern c b -> Pattern c b -> Bool
(Pattern c b -> Pattern c b -> Bool)
-> (Pattern c b -> Pattern c b -> Bool) -> Eq (Pattern c b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c b. (Eq b, Eq c) => Pattern c b -> Pattern c b -> Bool
/= :: Pattern c b -> Pattern c b -> Bool
$c/= :: forall c b. (Eq b, Eq c) => Pattern c b -> Pattern c b -> Bool
== :: Pattern c b -> Pattern c b -> Bool
$c== :: forall c b. (Eq b, Eq c) => Pattern c b -> Pattern c b -> Bool
Eq, (forall x. Pattern c b -> Rep (Pattern c b) x)
-> (forall x. Rep (Pattern c b) x -> Pattern c b)
-> Generic (Pattern c b)
forall x. Rep (Pattern c b) x -> Pattern c b
forall x. Pattern c b -> Rep (Pattern c b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c b x. Rep (Pattern c b) x -> Pattern c b
forall c b x. Pattern c b -> Rep (Pattern c b) x
$cto :: forall c b x. Rep (Pattern c b) x -> Pattern c b
$cfrom :: forall c b x. Pattern c b -> Rep (Pattern c b) x
Generic, Pattern c b -> ()
(Pattern c b -> ()) -> NFData (Pattern c b)
forall a. (a -> ()) -> NFData a
forall c b. (NFData b, NFData c) => Pattern c b -> ()
rnf :: Pattern c b -> ()
$crnf :: forall c b. (NFData b, NFData c) => Pattern c b -> ()
NFData, a -> Pattern c b -> Pattern c a
(a -> b) -> Pattern c a -> Pattern c b
(forall a b. (a -> b) -> Pattern c a -> Pattern c b)
-> (forall a b. a -> Pattern c b -> Pattern c a)
-> Functor (Pattern c)
forall a b. a -> Pattern c b -> Pattern c a
forall a b. (a -> b) -> Pattern c a -> Pattern c b
forall c a b. a -> Pattern c b -> Pattern c a
forall c a b. (a -> b) -> Pattern c a -> Pattern c b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Pattern c b -> Pattern c a
$c<$ :: forall c a b. a -> Pattern c b -> Pattern c a
fmap :: (a -> b) -> Pattern c a -> Pattern c b
$cfmap :: forall c a b. (a -> b) -> Pattern c a -> Pattern c b
Functor, Pattern c a -> Bool
(a -> m) -> Pattern c a -> m
(a -> b -> b) -> b -> Pattern c a -> b
(forall m. Monoid m => Pattern c m -> m)
-> (forall m a. Monoid m => (a -> m) -> Pattern c a -> m)
-> (forall m a. Monoid m => (a -> m) -> Pattern c a -> m)
-> (forall a b. (a -> b -> b) -> b -> Pattern c a -> b)
-> (forall a b. (a -> b -> b) -> b -> Pattern c a -> b)
-> (forall b a. (b -> a -> b) -> b -> Pattern c a -> b)
-> (forall b a. (b -> a -> b) -> b -> Pattern c a -> b)
-> (forall a. (a -> a -> a) -> Pattern c a -> a)
-> (forall a. (a -> a -> a) -> Pattern c a -> a)
-> (forall a. Pattern c a -> [a])
-> (forall a. Pattern c a -> Bool)
-> (forall a. Pattern c a -> Int)
-> (forall a. Eq a => a -> Pattern c a -> Bool)
-> (forall a. Ord a => Pattern c a -> a)
-> (forall a. Ord a => Pattern c a -> a)
-> (forall a. Num a => Pattern c a -> a)
-> (forall a. Num a => Pattern c a -> a)
-> Foldable (Pattern c)
forall a. Eq a => a -> Pattern c a -> Bool
forall a. Num a => Pattern c a -> a
forall a. Ord a => Pattern c a -> a
forall m. Monoid m => Pattern c m -> m
forall a. Pattern c a -> Bool
forall a. Pattern c a -> Int
forall a. Pattern c a -> [a]
forall a. (a -> a -> a) -> Pattern c a -> a
forall c a. Eq a => a -> Pattern c a -> Bool
forall c a. Num a => Pattern c a -> a
forall c a. Ord a => Pattern c a -> a
forall m a. Monoid m => (a -> m) -> Pattern c a -> m
forall c m. Monoid m => Pattern c m -> m
forall c a. Pattern c a -> Bool
forall c a. Pattern c a -> Int
forall c a. Pattern c a -> [a]
forall b a. (b -> a -> b) -> b -> Pattern c a -> b
forall a b. (a -> b -> b) -> b -> Pattern c a -> b
forall c a. (a -> a -> a) -> Pattern c a -> a
forall c m a. Monoid m => (a -> m) -> Pattern c a -> m
forall c b a. (b -> a -> b) -> b -> Pattern c a -> b
forall c a b. (a -> b -> b) -> b -> Pattern c 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
product :: Pattern c a -> a
$cproduct :: forall c a. Num a => Pattern c a -> a
sum :: Pattern c a -> a
$csum :: forall c a. Num a => Pattern c a -> a
minimum :: Pattern c a -> a
$cminimum :: forall c a. Ord a => Pattern c a -> a
maximum :: Pattern c a -> a
$cmaximum :: forall c a. Ord a => Pattern c a -> a
elem :: a -> Pattern c a -> Bool
$celem :: forall c a. Eq a => a -> Pattern c a -> Bool
length :: Pattern c a -> Int
$clength :: forall c a. Pattern c a -> Int
null :: Pattern c a -> Bool
$cnull :: forall c a. Pattern c a -> Bool
toList :: Pattern c a -> [a]
$ctoList :: forall c a. Pattern c a -> [a]
foldl1 :: (a -> a -> a) -> Pattern c a -> a
$cfoldl1 :: forall c a. (a -> a -> a) -> Pattern c a -> a
foldr1 :: (a -> a -> a) -> Pattern c a -> a
$cfoldr1 :: forall c a. (a -> a -> a) -> Pattern c a -> a
foldl' :: (b -> a -> b) -> b -> Pattern c a -> b
$cfoldl' :: forall c b a. (b -> a -> b) -> b -> Pattern c a -> b
foldl :: (b -> a -> b) -> b -> Pattern c a -> b
$cfoldl :: forall c b a. (b -> a -> b) -> b -> Pattern c a -> b
foldr' :: (a -> b -> b) -> b -> Pattern c a -> b
$cfoldr' :: forall c a b. (a -> b -> b) -> b -> Pattern c a -> b
foldr :: (a -> b -> b) -> b -> Pattern c a -> b
$cfoldr :: forall c a b. (a -> b -> b) -> b -> Pattern c a -> b
foldMap' :: (a -> m) -> Pattern c a -> m
$cfoldMap' :: forall c m a. Monoid m => (a -> m) -> Pattern c a -> m
foldMap :: (a -> m) -> Pattern c a -> m
$cfoldMap :: forall c m a. Monoid m => (a -> m) -> Pattern c a -> m
fold :: Pattern c m -> m
$cfold :: forall c m. Monoid m => Pattern c m -> m
Foldable, Functor (Pattern c)
Foldable (Pattern c)
Functor (Pattern c)
-> Foldable (Pattern c)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Pattern c a -> f (Pattern c b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Pattern c (f a) -> f (Pattern c a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Pattern c a -> m (Pattern c b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Pattern c (m a) -> m (Pattern c a))
-> Traversable (Pattern c)
(a -> f b) -> Pattern c a -> f (Pattern c b)
forall c. Functor (Pattern c)
forall c. Foldable (Pattern c)
forall c (m :: * -> *) a.
Monad m =>
Pattern c (m a) -> m (Pattern c a)
forall c (f :: * -> *) a.
Applicative f =>
Pattern c (f a) -> f (Pattern c a)
forall c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Pattern c a -> m (Pattern c b)
forall c (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Pattern c a -> f (Pattern c b)
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 c (m a) -> m (Pattern c a)
forall (f :: * -> *) a.
Applicative f =>
Pattern c (f a) -> f (Pattern c a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Pattern c a -> m (Pattern c b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Pattern c a -> f (Pattern c b)
sequence :: Pattern c (m a) -> m (Pattern c a)
$csequence :: forall c (m :: * -> *) a.
Monad m =>
Pattern c (m a) -> m (Pattern c a)
mapM :: (a -> m b) -> Pattern c a -> m (Pattern c b)
$cmapM :: forall c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Pattern c a -> m (Pattern c b)
sequenceA :: Pattern c (f a) -> f (Pattern c a)
$csequenceA :: forall c (f :: * -> *) a.
Applicative f =>
Pattern c (f a) -> f (Pattern c a)
traverse :: (a -> f b) -> Pattern c a -> f (Pattern c b)
$ctraverse :: forall c (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Pattern c a -> f (Pattern c b)
$cp2Traversable :: forall c. Foldable (Pattern c)
$cp1Traversable :: forall c. Functor (Pattern c)
Traversable)

instance Bifunctor Pattern where
    second :: (b -> c) -> Pattern a b -> Pattern a c
second = (b -> c) -> Pattern a b -> Pattern a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    first :: (a -> b) -> Pattern a c -> Pattern b c
first a -> b
f (PatternCons a
l TyName a
tn)  = b -> TyName b -> Pattern b c
forall c b. c -> TyName c -> Pattern c b
PatternCons (a -> b
f a
l) ((a -> b) -> TyName a -> TyName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TyName a
tn)
    first a -> b
_ (PatternInt c
l Integer
i)    = c -> Integer -> Pattern b c
forall c b. b -> Integer -> Pattern c b
PatternInt c
l Integer
i
    first a -> b
_ (PatternWildcard c
l) = c -> Pattern b c
forall c b. b -> Pattern c b
PatternWildcard c
l
    first a -> b
_ (PatternBool c
l Bool
b)   = c -> Bool -> Pattern b c
forall c b. b -> Bool -> Pattern c b
PatternBool c
l Bool
b

instance Bifoldable Pattern where
    bifoldMap :: (a -> m) -> (b -> m) -> Pattern a b -> m
bifoldMap a -> m
_ b -> m
g (PatternInt b
l Integer
i)    = (b -> m) -> Pattern Any b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (b -> Integer -> Pattern Any b
forall c b. b -> Integer -> Pattern c b
PatternInt b
l Integer
i)
    bifoldMap a -> m
_ b -> m
g (PatternWildcard b
l) = (b -> m) -> Pattern Any b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (b -> Pattern Any b
forall c b. b -> Pattern c b
PatternWildcard b
l)
    bifoldMap a -> m
_ b -> m
g (PatternBool b
l Bool
b)   = (b -> m) -> Pattern Any b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (b -> Bool -> Pattern Any b
forall c b. b -> Bool -> Pattern c b
PatternBool b
l Bool
b)
    bifoldMap a -> m
f b -> m
_ (PatternCons a
l TyName a
tn)  = a -> m
f a
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> TyName a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f TyName a
tn

instance Bitraversable Pattern where
    bitraverse :: (a -> f c) -> (b -> f d) -> Pattern a b -> f (Pattern c d)
bitraverse a -> f c
_ b -> f d
g (PatternInt b
l Integer
i)    = (b -> f d) -> Pattern c b -> f (Pattern c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (b -> Integer -> Pattern c b
forall c b. b -> Integer -> Pattern c b
PatternInt b
l Integer
i)
    bitraverse a -> f c
_ b -> f d
g (PatternWildcard b
l) = (b -> f d) -> Pattern c b -> f (Pattern c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (b -> Pattern c b
forall c b. b -> Pattern c b
PatternWildcard b
l)
    bitraverse a -> f c
_ b -> f d
g (PatternBool b
l Bool
b)   = (b -> f d) -> Pattern c b -> f (Pattern c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (b -> Bool -> Pattern c b
forall c b. b -> Bool -> Pattern c b
PatternBool b
l Bool
b)
    bitraverse a -> f c
f b -> f d
_ (PatternCons a
l TyName a
cn)  = c -> TyName c -> Pattern c d
forall c b. c -> TyName c -> Pattern c b
PatternCons (c -> TyName c -> Pattern c d)
-> f c -> f (TyName c -> Pattern c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
l f (TyName c -> Pattern c d) -> f (TyName c) -> f (Pattern c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> TyName a -> f (TyName c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f c
f TyName a
cn

instance Pretty (Pattern c a) where
    pretty :: Pattern c a -> Doc ann
pretty (PatternInt a
_ Integer
i)   = Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
    pretty (PatternBool a
_ Bool
b)  = Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Bool
b
    pretty PatternWildcard{}  = Doc ann
"_"
    pretty (PatternCons c
_ TyName c
tn) = TyName c -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TyName c
tn

instance Pretty (Atom c a) where
    pretty :: Atom c a -> Doc ann
pretty (AtName a
_ Name a
n)    = Name a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Name a
n
    pretty (Dip a
_ [Atom c a]
as)      = Doc ann
"dip(" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep ((Atom c a -> Doc ann) -> [Atom c a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Atom c a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Atom c a]
as) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
    pretty (AtBuiltin a
_ BuiltinFn
b) = BuiltinFn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty BuiltinFn
b
    pretty (AtCons c
_ TyName c
tn)   = TyName c -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TyName c
tn
    pretty (If a
_ [Atom c a]
as [Atom c a]
as')   = Doc ann
"if(" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep ((Atom c a -> Doc ann) -> [Atom c a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Atom c a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Atom c a]
as)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep ((Atom c a -> Doc ann) -> [Atom c a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Atom c a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Atom c a]
as')) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
    pretty (IntLit a
_ Integer
i)    = Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
    pretty (BoolLit a
_ Bool
b)   = Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Bool
b
    pretty (WordLit a
_ Natural
w)   = Natural -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Natural
w Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"u"
    pretty (Int8Lit a
_ Int8
i)   = Int8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int8
i Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"i8"

prettyTyped :: Atom (StackType ()) (StackType ()) -> Doc ann
prettyTyped :: Atom (StackType ()) (StackType ()) -> Doc ann
prettyTyped (AtName StackType ()
ty Name (StackType ())
n)    = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Name (StackType ()) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Name (StackType ())
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> StackType () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty StackType ()
ty)
prettyTyped (Dip StackType ()
_ [Atom (StackType ()) (StackType ())]
as)       = Doc ann
"dip(" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep (Atom (StackType ()) (StackType ()) -> Doc ann
forall ann. Atom (StackType ()) (StackType ()) -> Doc ann
prettyTyped (Atom (StackType ()) (StackType ()) -> Doc ann)
-> [Atom (StackType ()) (StackType ())] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Atom (StackType ()) (StackType ())]
as) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
prettyTyped (AtBuiltin StackType ()
ty BuiltinFn
b) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (BuiltinFn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty BuiltinFn
b Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> StackType () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty StackType ()
ty)
prettyTyped (AtCons StackType ()
ty Name (StackType ())
tn)   = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Name (StackType ()) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Name (StackType ())
tn Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> StackType () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty StackType ()
ty)
prettyTyped (If StackType ()
_ [Atom (StackType ()) (StackType ())]
as [Atom (StackType ()) (StackType ())]
as')    = Doc ann
"if(" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep (Atom (StackType ()) (StackType ()) -> Doc ann
forall ann. Atom (StackType ()) (StackType ()) -> Doc ann
prettyTyped (Atom (StackType ()) (StackType ()) -> Doc ann)
-> [Atom (StackType ()) (StackType ())] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Atom (StackType ()) (StackType ())]
as)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep (Atom (StackType ()) (StackType ()) -> Doc ann
forall ann. Atom (StackType ()) (StackType ()) -> Doc ann
prettyTyped (Atom (StackType ()) (StackType ()) -> Doc ann)
-> [Atom (StackType ()) (StackType ())] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Atom (StackType ()) (StackType ())]
as')) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
prettyTyped (IntLit StackType ()
_ Integer
i)     = Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
prettyTyped (BoolLit StackType ()
_ Bool
b)    = Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Bool
b
prettyTyped (Int8Lit StackType ()
_ Int8
i)    = Int8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int8
i Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"i8"
prettyTyped (WordLit StackType ()
_ Natural
n)    = Natural -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Natural
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"u"

data Atom c b = AtName b (Name b)
              | Case b (NonEmpty (Pattern c b, [Atom c b]))
              | If b [Atom c b] [Atom c b]
              | Dip b [Atom c b]
              | IntLit b Integer
              | WordLit b Natural
              | Int8Lit b Int8
              | BoolLit b Bool
              | AtBuiltin b BuiltinFn
              | AtCons c (TyName c)
              deriving (Atom c b -> Atom c b -> Bool
(Atom c b -> Atom c b -> Bool)
-> (Atom c b -> Atom c b -> Bool) -> Eq (Atom c b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c b. (Eq b, Eq c) => Atom c b -> Atom c b -> Bool
/= :: Atom c b -> Atom c b -> Bool
$c/= :: forall c b. (Eq b, Eq c) => Atom c b -> Atom c b -> Bool
== :: Atom c b -> Atom c b -> Bool
$c== :: forall c b. (Eq b, Eq c) => Atom c b -> Atom c b -> Bool
Eq, (forall x. Atom c b -> Rep (Atom c b) x)
-> (forall x. Rep (Atom c b) x -> Atom c b) -> Generic (Atom c b)
forall x. Rep (Atom c b) x -> Atom c b
forall x. Atom c b -> Rep (Atom c b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c b x. Rep (Atom c b) x -> Atom c b
forall c b x. Atom c b -> Rep (Atom c b) x
$cto :: forall c b x. Rep (Atom c b) x -> Atom c b
$cfrom :: forall c b x. Atom c b -> Rep (Atom c b) x
Generic, Atom c b -> ()
(Atom c b -> ()) -> NFData (Atom c b)
forall a. (a -> ()) -> NFData a
forall c b. (NFData b, NFData c) => Atom c b -> ()
rnf :: Atom c b -> ()
$crnf :: forall c b. (NFData b, NFData c) => Atom c b -> ()
NFData, a -> Atom c b -> Atom c a
(a -> b) -> Atom c a -> Atom c b
(forall a b. (a -> b) -> Atom c a -> Atom c b)
-> (forall a b. a -> Atom c b -> Atom c a) -> Functor (Atom c)
forall a b. a -> Atom c b -> Atom c a
forall a b. (a -> b) -> Atom c a -> Atom c b
forall c a b. a -> Atom c b -> Atom c a
forall c a b. (a -> b) -> Atom c a -> Atom c b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Atom c b -> Atom c a
$c<$ :: forall c a b. a -> Atom c b -> Atom c a
fmap :: (a -> b) -> Atom c a -> Atom c b
$cfmap :: forall c a b. (a -> b) -> Atom c a -> Atom c b
Functor, Atom c a -> Bool
(a -> m) -> Atom c a -> m
(a -> b -> b) -> b -> Atom c a -> b
(forall m. Monoid m => Atom c m -> m)
-> (forall m a. Monoid m => (a -> m) -> Atom c a -> m)
-> (forall m a. Monoid m => (a -> m) -> Atom c a -> m)
-> (forall a b. (a -> b -> b) -> b -> Atom c a -> b)
-> (forall a b. (a -> b -> b) -> b -> Atom c a -> b)
-> (forall b a. (b -> a -> b) -> b -> Atom c a -> b)
-> (forall b a. (b -> a -> b) -> b -> Atom c a -> b)
-> (forall a. (a -> a -> a) -> Atom c a -> a)
-> (forall a. (a -> a -> a) -> Atom c a -> a)
-> (forall a. Atom c a -> [a])
-> (forall a. Atom c a -> Bool)
-> (forall a. Atom c a -> Int)
-> (forall a. Eq a => a -> Atom c a -> Bool)
-> (forall a. Ord a => Atom c a -> a)
-> (forall a. Ord a => Atom c a -> a)
-> (forall a. Num a => Atom c a -> a)
-> (forall a. Num a => Atom c a -> a)
-> Foldable (Atom c)
forall a. Eq a => a -> Atom c a -> Bool
forall a. Num a => Atom c a -> a
forall a. Ord a => Atom c a -> a
forall m. Monoid m => Atom c m -> m
forall a. Atom c a -> Bool
forall a. Atom c a -> Int
forall a. Atom c a -> [a]
forall a. (a -> a -> a) -> Atom c a -> a
forall c a. Eq a => a -> Atom c a -> Bool
forall c a. Num a => Atom c a -> a
forall c a. Ord a => Atom c a -> a
forall m a. Monoid m => (a -> m) -> Atom c a -> m
forall c m. Monoid m => Atom c m -> m
forall c a. Atom c a -> Bool
forall c a. Atom c a -> Int
forall c a. Atom c a -> [a]
forall b a. (b -> a -> b) -> b -> Atom c a -> b
forall a b. (a -> b -> b) -> b -> Atom c a -> b
forall c a. (a -> a -> a) -> Atom c a -> a
forall c m a. Monoid m => (a -> m) -> Atom c a -> m
forall c b a. (b -> a -> b) -> b -> Atom c a -> b
forall c a b. (a -> b -> b) -> b -> Atom c 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
product :: Atom c a -> a
$cproduct :: forall c a. Num a => Atom c a -> a
sum :: Atom c a -> a
$csum :: forall c a. Num a => Atom c a -> a
minimum :: Atom c a -> a
$cminimum :: forall c a. Ord a => Atom c a -> a
maximum :: Atom c a -> a
$cmaximum :: forall c a. Ord a => Atom c a -> a
elem :: a -> Atom c a -> Bool
$celem :: forall c a. Eq a => a -> Atom c a -> Bool
length :: Atom c a -> Int
$clength :: forall c a. Atom c a -> Int
null :: Atom c a -> Bool
$cnull :: forall c a. Atom c a -> Bool
toList :: Atom c a -> [a]
$ctoList :: forall c a. Atom c a -> [a]
foldl1 :: (a -> a -> a) -> Atom c a -> a
$cfoldl1 :: forall c a. (a -> a -> a) -> Atom c a -> a
foldr1 :: (a -> a -> a) -> Atom c a -> a
$cfoldr1 :: forall c a. (a -> a -> a) -> Atom c a -> a
foldl' :: (b -> a -> b) -> b -> Atom c a -> b
$cfoldl' :: forall c b a. (b -> a -> b) -> b -> Atom c a -> b
foldl :: (b -> a -> b) -> b -> Atom c a -> b
$cfoldl :: forall c b a. (b -> a -> b) -> b -> Atom c a -> b
foldr' :: (a -> b -> b) -> b -> Atom c a -> b
$cfoldr' :: forall c a b. (a -> b -> b) -> b -> Atom c a -> b
foldr :: (a -> b -> b) -> b -> Atom c a -> b
$cfoldr :: forall c a b. (a -> b -> b) -> b -> Atom c a -> b
foldMap' :: (a -> m) -> Atom c a -> m
$cfoldMap' :: forall c m a. Monoid m => (a -> m) -> Atom c a -> m
foldMap :: (a -> m) -> Atom c a -> m
$cfoldMap :: forall c m a. Monoid m => (a -> m) -> Atom c a -> m
fold :: Atom c m -> m
$cfold :: forall c m. Monoid m => Atom c m -> m
Foldable, Functor (Atom c)
Foldable (Atom c)
Functor (Atom c)
-> Foldable (Atom c)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Atom c a -> f (Atom c b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Atom c (f a) -> f (Atom c a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Atom c a -> m (Atom c b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Atom c (m a) -> m (Atom c a))
-> Traversable (Atom c)
(a -> f b) -> Atom c a -> f (Atom c b)
forall c. Functor (Atom c)
forall c. Foldable (Atom c)
forall c (m :: * -> *) a. Monad m => Atom c (m a) -> m (Atom c a)
forall c (f :: * -> *) a.
Applicative f =>
Atom c (f a) -> f (Atom c a)
forall c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Atom c a -> m (Atom c b)
forall c (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Atom c a -> f (Atom c b)
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 => Atom c (m a) -> m (Atom c a)
forall (f :: * -> *) a.
Applicative f =>
Atom c (f a) -> f (Atom c a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Atom c a -> m (Atom c b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Atom c a -> f (Atom c b)
sequence :: Atom c (m a) -> m (Atom c a)
$csequence :: forall c (m :: * -> *) a. Monad m => Atom c (m a) -> m (Atom c a)
mapM :: (a -> m b) -> Atom c a -> m (Atom c b)
$cmapM :: forall c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Atom c a -> m (Atom c b)
sequenceA :: Atom c (f a) -> f (Atom c a)
$csequenceA :: forall c (f :: * -> *) a.
Applicative f =>
Atom c (f a) -> f (Atom c a)
traverse :: (a -> f b) -> Atom c a -> f (Atom c b)
$ctraverse :: forall c (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Atom c a -> f (Atom c b)
$cp2Traversable :: forall c. Foldable (Atom c)
$cp1Traversable :: forall c. Functor (Atom c)
Traversable)

instance Bifunctor Atom where
    second :: (b -> c) -> Atom a b -> Atom a c
second = (b -> c) -> Atom a b -> Atom a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    first :: (a -> b) -> Atom a c -> Atom b c
first a -> b
f (AtCons a
l TyName a
n)    = b -> TyName b -> Atom b c
forall c b. c -> TyName c -> Atom c b
AtCons (a -> b
f a
l) ((a -> b) -> TyName a -> TyName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TyName a
n)
    first a -> b
_ (AtName c
l Name c
n)    = c -> Name c -> Atom b c
forall c b. b -> Name b -> Atom c b
AtName c
l Name c
n
    first a -> b
_ (IntLit c
l Integer
i)    = c -> Integer -> Atom b c
forall c b. b -> Integer -> Atom c b
IntLit c
l Integer
i
    first a -> b
_ (WordLit c
l Natural
w)   = c -> Natural -> Atom b c
forall c b. b -> Natural -> Atom c b
WordLit c
l Natural
w
    first a -> b
_ (Int8Lit c
l Int8
i)   = c -> Int8 -> Atom b c
forall c b. b -> Int8 -> Atom c b
Int8Lit c
l Int8
i
    first a -> b
_ (BoolLit c
l Bool
b)   = c -> Bool -> Atom b c
forall c b. b -> Bool -> Atom c b
BoolLit c
l Bool
b
    first a -> b
_ (AtBuiltin c
l BuiltinFn
b) = c -> BuiltinFn -> Atom b c
forall c b. b -> BuiltinFn -> Atom c b
AtBuiltin c
l BuiltinFn
b
    first a -> b
f (Dip c
l [Atom a c]
as)      = c -> [Atom b c] -> Atom b c
forall c b. b -> [Atom c b] -> Atom c b
Dip c
l ((Atom a c -> Atom b c) -> [Atom a c] -> [Atom b c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Atom a c -> Atom b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) [Atom a c]
as)
    first a -> b
f (If c
l [Atom a c]
as [Atom a c]
as')   = c -> [Atom b c] -> [Atom b c] -> Atom b c
forall c b. b -> [Atom c b] -> [Atom c b] -> Atom c b
If c
l ((Atom a c -> Atom b c) -> [Atom a c] -> [Atom b c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Atom a c -> Atom b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) [Atom a c]
as) ((Atom a c -> Atom b c) -> [Atom a c] -> [Atom b c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Atom a c -> Atom b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) [Atom a c]
as')
    first a -> b
f (Case c
l NonEmpty (Pattern a c, [Atom a c])
ls)     =
        let (NonEmpty (Pattern a c)
ps, NonEmpty [Atom a c]
aLs) = NonEmpty (Pattern a c, [Atom a c])
-> (NonEmpty (Pattern a c), NonEmpty [Atom a c])
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NE.unzip NonEmpty (Pattern a c, [Atom a c])
ls
            in c -> NonEmpty (Pattern b c, [Atom b c]) -> Atom b c
forall c b. b -> NonEmpty (Pattern c b, [Atom c b]) -> Atom c b
Case c
l (NonEmpty (Pattern b c, [Atom b c]) -> Atom b c)
-> NonEmpty (Pattern b c, [Atom b c]) -> Atom b c
forall a b. (a -> b) -> a -> b
$ NonEmpty (Pattern b c)
-> NonEmpty [Atom b c] -> NonEmpty (Pattern b c, [Atom b c])
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip ((Pattern a c -> Pattern b c)
-> NonEmpty (Pattern a c) -> NonEmpty (Pattern b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Pattern a c -> Pattern b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) NonEmpty (Pattern a c)
ps) (([Atom a c] -> [Atom b c])
-> NonEmpty [Atom a c] -> NonEmpty [Atom b c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Atom a c -> Atom b c) -> [Atom a c] -> [Atom b c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Atom a c -> Atom b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f)) NonEmpty [Atom a c]
aLs)

instance Bifoldable Atom where
    bifoldMap :: (a -> m) -> (b -> m) -> Atom a b -> m
bifoldMap a -> m
_ b -> m
g (AtName b
x Name b
n)    = (b -> m) -> Atom Any b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (b -> Name b -> Atom Any b
forall c b. b -> Name b -> Atom c b
AtName b
x Name b
n)
    bifoldMap a -> m
_ b -> m
g (IntLit b
l Integer
i)    = (b -> m) -> Atom Any b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (b -> Integer -> Atom Any b
forall c b. b -> Integer -> Atom c b
IntLit b
l Integer
i)
    bifoldMap a -> m
_ b -> m
g (Int8Lit b
l Int8
i)   = (b -> m) -> Atom Any b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (b -> Int8 -> Atom Any b
forall c b. b -> Int8 -> Atom c b
Int8Lit b
l Int8
i)
    bifoldMap a -> m
_ b -> m
g (WordLit b
l Natural
w)   = (b -> m) -> Atom Any b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (b -> Natural -> Atom Any b
forall c b. b -> Natural -> Atom c b
WordLit b
l Natural
w)
    bifoldMap a -> m
_ b -> m
g (BoolLit b
l Bool
b)   = (b -> m) -> Atom Any b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (b -> Bool -> Atom Any b
forall c b. b -> Bool -> Atom c b
BoolLit b
l Bool
b)
    bifoldMap a -> m
_ b -> m
g (AtBuiltin b
l BuiltinFn
b) = (b -> m) -> Atom Any b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (b -> BuiltinFn -> Atom Any b
forall c b. b -> BuiltinFn -> Atom c b
AtBuiltin b
l BuiltinFn
b)
    bifoldMap a -> m
f b -> m
_ (AtCons a
l TyName a
c)    = a -> m
f a
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> TyName a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f TyName a
c
    bifoldMap a -> m
f b -> m
g (Dip b
l [Atom a b]
as)      = b -> m
g b
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Atom a b -> m) -> [Atom a b] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> Atom a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) [Atom a b]
as
    bifoldMap a -> m
f b -> m
g (If b
l [Atom a b]
as [Atom a b]
as')   = b -> m
g b
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Atom a b -> m) -> [Atom a b] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> Atom a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) [Atom a b]
as m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Atom a b -> m) -> [Atom a b] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> Atom a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) [Atom a b]
as'
    bifoldMap a -> m
f b -> m
g (Case b
l NonEmpty (Pattern a b, [Atom a b])
ls)     =
        let (NonEmpty (Pattern a b)
ps, NonEmpty [Atom a b]
as) = NonEmpty (Pattern a b, [Atom a b])
-> (NonEmpty (Pattern a b), NonEmpty [Atom a b])
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NE.unzip NonEmpty (Pattern a b, [Atom a b])
ls
            in b -> m
g b
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Pattern a b -> m) -> NonEmpty (Pattern a b) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> Pattern a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) NonEmpty (Pattern a b)
ps m -> m -> m
forall a. Semigroup a => a -> a -> a
<> ([Atom a b] -> m) -> NonEmpty [Atom a b] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Atom a b -> m) -> [Atom a b] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> Atom a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g)) NonEmpty [Atom a b]
as

instance Bitraversable Atom where
    bitraverse :: (a -> f c) -> (b -> f d) -> Atom a b -> f (Atom c d)
bitraverse a -> f c
_ b -> f d
g (AtName b
x Name b
n)    = (b -> f d) -> Atom c b -> f (Atom c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (b -> Name b -> Atom c b
forall c b. b -> Name b -> Atom c b
AtName b
x Name b
n)
    bitraverse a -> f c
_ b -> f d
g (IntLit b
l Integer
i)    = (b -> f d) -> Atom c b -> f (Atom c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (b -> Integer -> Atom c b
forall c b. b -> Integer -> Atom c b
IntLit b
l Integer
i)
    bitraverse a -> f c
_ b -> f d
g (Int8Lit b
l Int8
i)   = (b -> f d) -> Atom c b -> f (Atom c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (b -> Int8 -> Atom c b
forall c b. b -> Int8 -> Atom c b
Int8Lit b
l Int8
i)
    bitraverse a -> f c
_ b -> f d
g (WordLit b
l Natural
w)   = (b -> f d) -> Atom c b -> f (Atom c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (b -> Natural -> Atom c b
forall c b. b -> Natural -> Atom c b
WordLit b
l Natural
w)
    bitraverse a -> f c
_ b -> f d
g (BoolLit b
l Bool
b)   = (b -> f d) -> Atom c b -> f (Atom c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (b -> Bool -> Atom c b
forall c b. b -> Bool -> Atom c b
BoolLit b
l Bool
b)
    bitraverse a -> f c
_ b -> f d
g (AtBuiltin b
l BuiltinFn
b) = (b -> f d) -> Atom c b -> f (Atom c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (b -> BuiltinFn -> Atom c b
forall c b. b -> BuiltinFn -> Atom c b
AtBuiltin b
l BuiltinFn
b)
    bitraverse a -> f c
f b -> f d
_ (AtCons a
l TyName a
c)    = c -> TyName c -> Atom c d
forall c b. c -> TyName c -> Atom c b
AtCons (c -> TyName c -> Atom c d) -> f c -> f (TyName c -> Atom c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
l f (TyName c -> Atom c d) -> f (TyName c) -> f (Atom c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> TyName a -> f (TyName c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f c
f TyName a
c
    bitraverse a -> f c
f b -> f d
g (Dip b
l [Atom a b]
as)      = d -> [Atom c d] -> Atom c d
forall c b. b -> [Atom c b] -> Atom c b
Dip (d -> [Atom c d] -> Atom c d) -> f d -> f ([Atom c d] -> Atom c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
l f ([Atom c d] -> Atom c d) -> f [Atom c d] -> f (Atom c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Atom a b -> f (Atom c d)) -> [Atom a b] -> f [Atom c d]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c) -> (b -> f d) -> Atom a b -> f (Atom c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) [Atom a b]
as
    bitraverse a -> f c
f b -> f d
g (If b
l [Atom a b]
as [Atom a b]
as')   = d -> [Atom c d] -> [Atom c d] -> Atom c d
forall c b. b -> [Atom c b] -> [Atom c b] -> Atom c b
If (d -> [Atom c d] -> [Atom c d] -> Atom c d)
-> f d -> f ([Atom c d] -> [Atom c d] -> Atom c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
l f ([Atom c d] -> [Atom c d] -> Atom c d)
-> f [Atom c d] -> f ([Atom c d] -> Atom c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Atom a b -> f (Atom c d)) -> [Atom a b] -> f [Atom c d]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c) -> (b -> f d) -> Atom a b -> f (Atom c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) [Atom a b]
as f ([Atom c d] -> Atom c d) -> f [Atom c d] -> f (Atom c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Atom a b -> f (Atom c d)) -> [Atom a b] -> f [Atom c d]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c) -> (b -> f d) -> Atom a b -> f (Atom c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) [Atom a b]
as'
    bitraverse a -> f c
f b -> f d
g (Case b
l NonEmpty (Pattern a b, [Atom a b])
ls)     =
        let (NonEmpty (Pattern a b)
ps, NonEmpty [Atom a b]
as) = NonEmpty (Pattern a b, [Atom a b])
-> (NonEmpty (Pattern a b), NonEmpty [Atom a b])
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NE.unzip NonEmpty (Pattern a b, [Atom a b])
ls
            in d -> NonEmpty (Pattern c d, [Atom c d]) -> Atom c d
forall c b. b -> NonEmpty (Pattern c b, [Atom c b]) -> Atom c b
Case (d -> NonEmpty (Pattern c d, [Atom c d]) -> Atom c d)
-> f d -> f (NonEmpty (Pattern c d, [Atom c d]) -> Atom c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
l f (NonEmpty (Pattern c d, [Atom c d]) -> Atom c d)
-> f (NonEmpty (Pattern c d, [Atom c d])) -> f (Atom c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (NonEmpty (Pattern c d)
-> NonEmpty [Atom c d] -> NonEmpty (Pattern c d, [Atom c d])
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip (NonEmpty (Pattern c d)
 -> NonEmpty [Atom c d] -> NonEmpty (Pattern c d, [Atom c d]))
-> f (NonEmpty (Pattern c d))
-> f (NonEmpty [Atom c d] -> NonEmpty (Pattern c d, [Atom c d]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern a b -> f (Pattern c d))
-> NonEmpty (Pattern a b) -> f (NonEmpty (Pattern c d))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c) -> (b -> f d) -> Pattern a b -> f (Pattern c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) NonEmpty (Pattern a b)
ps f (NonEmpty [Atom c d] -> NonEmpty (Pattern c d, [Atom c d]))
-> f (NonEmpty [Atom c d])
-> f (NonEmpty (Pattern c d, [Atom c d]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Atom a b] -> f [Atom c d])
-> NonEmpty [Atom a b] -> f (NonEmpty [Atom c d])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Atom a b -> f (Atom c d)) -> [Atom a b] -> f [Atom c d]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c) -> (b -> f d) -> Atom a b -> f (Atom c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g)) NonEmpty [Atom a b]
as)

data BuiltinFn = Drop
               | Swap
               | Dup
               | IntPlus
               | IntMinus
               | IntTimes
               | IntDiv
               | IntMod
               | IntEq
               | IntLeq
               | IntLt
               | IntGeq
               | IntGt
               | IntNeq
               | IntShiftR
               | IntShiftL
               | IntXor
               | WordPlus
               | WordTimes
               | WordMinus
               | WordDiv
               | WordMod
               | WordShiftR
               | WordShiftL
               | WordXor
               | And
               | Or
               | Xor
               | IntNeg
               | Popcount
               deriving (BuiltinFn -> BuiltinFn -> Bool
(BuiltinFn -> BuiltinFn -> Bool)
-> (BuiltinFn -> BuiltinFn -> Bool) -> Eq BuiltinFn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuiltinFn -> BuiltinFn -> Bool
$c/= :: BuiltinFn -> BuiltinFn -> Bool
== :: BuiltinFn -> BuiltinFn -> Bool
$c== :: BuiltinFn -> BuiltinFn -> Bool
Eq, (forall x. BuiltinFn -> Rep BuiltinFn x)
-> (forall x. Rep BuiltinFn x -> BuiltinFn) -> Generic BuiltinFn
forall x. Rep BuiltinFn x -> BuiltinFn
forall x. BuiltinFn -> Rep BuiltinFn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuiltinFn x -> BuiltinFn
$cfrom :: forall x. BuiltinFn -> Rep BuiltinFn x
Generic, BuiltinFn -> ()
(BuiltinFn -> ()) -> NFData BuiltinFn
forall a. (a -> ()) -> NFData a
rnf :: BuiltinFn -> ()
$crnf :: BuiltinFn -> ()
NFData)

instance Pretty BuiltinFn where
    pretty :: BuiltinFn -> Doc ann
pretty BuiltinFn
Drop       = Doc ann
"drop"
    pretty BuiltinFn
Swap       = Doc ann
"swap"
    pretty BuiltinFn
Dup        = Doc ann
"dup"
    pretty BuiltinFn
IntPlus    = Doc ann
"+"
    pretty BuiltinFn
IntMinus   = Doc ann
"-"
    pretty BuiltinFn
IntTimes   = Doc ann
"*"
    pretty BuiltinFn
IntDiv     = Doc ann
"/"
    pretty BuiltinFn
IntMod     = Doc ann
"%"
    pretty BuiltinFn
IntEq      = Doc ann
"="
    pretty BuiltinFn
IntLeq     = Doc ann
"<="
    pretty BuiltinFn
IntLt      = Doc ann
"<"
    pretty BuiltinFn
IntShiftR  = Doc ann
">>"
    pretty BuiltinFn
IntShiftL  = Doc ann
"<<"
    pretty BuiltinFn
WordPlus   = Doc ann
"+~"
    pretty BuiltinFn
WordTimes  = Doc ann
"*~"
    pretty BuiltinFn
WordShiftL = Doc ann
"<<~"
    pretty BuiltinFn
WordShiftR = Doc ann
">>~"
    pretty BuiltinFn
IntXor     = Doc ann
"xori"
    pretty BuiltinFn
WordXor    = Doc ann
"xoru"
    pretty BuiltinFn
IntGeq     = Doc ann
">="
    pretty BuiltinFn
IntGt      = Doc ann
">"
    pretty BuiltinFn
IntNeq     = Doc ann
"!="
    pretty BuiltinFn
WordMinus  = Doc ann
"-~"
    pretty BuiltinFn
WordDiv    = Doc ann
"/~"
    pretty BuiltinFn
WordMod    = Doc ann
"%~"
    pretty BuiltinFn
And        = Doc ann
"&"
    pretty BuiltinFn
Or         = Doc ann
"||"
    pretty BuiltinFn
Xor        = Doc ann
"xor"
    pretty BuiltinFn
IntNeg     = Doc ann
"~"
    pretty BuiltinFn
Popcount   = Doc ann
"popcount"

data ABI = Cabi
         | Kabi
         deriving (ABI -> ABI -> Bool
(ABI -> ABI -> Bool) -> (ABI -> ABI -> Bool) -> Eq ABI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ABI -> ABI -> Bool
$c/= :: ABI -> ABI -> Bool
== :: ABI -> ABI -> Bool
$c== :: ABI -> ABI -> Bool
Eq, (forall x. ABI -> Rep ABI x)
-> (forall x. Rep ABI x -> ABI) -> Generic ABI
forall x. Rep ABI x -> ABI
forall x. ABI -> Rep ABI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ABI x -> ABI
$cfrom :: forall x. ABI -> Rep ABI x
Generic, ABI -> ()
(ABI -> ()) -> NFData ABI
forall a. (a -> ()) -> NFData a
rnf :: ABI -> ()
$crnf :: ABI -> ()
NFData)

instance Pretty ABI where
    pretty :: ABI -> Doc ann
pretty ABI
Cabi = Doc ann
"cabi"
    pretty ABI
Kabi = Doc ann
"kabi"

prettyKempeDecl :: (Atom c b -> Doc ann) -> KempeDecl a c b -> Doc ann
prettyKempeDecl :: (Atom c b -> Doc ann) -> KempeDecl a c b -> Doc ann
prettyKempeDecl Atom c b -> Doc ann
atomizer (FunDecl b
_ Name b
n [KempeTy a]
is [KempeTy a]
os [Atom c b]
as) = Name b -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Name b
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ((KempeTy a -> Doc ann) -> [KempeTy a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KempeTy a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [KempeTy a]
is) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"--" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ((KempeTy a -> Doc ann) -> [KempeTy a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KempeTy a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [KempeTy a]
os) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep (Atom c b -> Doc ann
atomizer (Atom c b -> Doc ann) -> [Atom c b] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Atom c b]
as)))
prettyKempeDecl Atom c b -> Doc ann
_ (Export b
_ ABI
abi Name b
n)              = Doc ann
"%foreign" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ABI -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ABI
abi Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name b -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Name b
n
prettyKempeDecl Atom c b -> Doc ann
_ (ExtFnDecl b
_ Name b
n [KempeTy a]
is [KempeTy a]
os ByteString
b)       = Name b -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Name b
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ((KempeTy a -> Doc ann) -> [KempeTy a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KempeTy a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [KempeTy a]
is) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"--" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ((KempeTy a -> Doc ann) -> [KempeTy a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KempeTy a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [KempeTy a]
os) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"$cfun" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Text
decodeUtf8 ByteString
b)
prettyKempeDecl Atom c b -> Doc ann
_ (TyDecl a
_ TyName a
tn [TyName a]
ns [(Name b, [KempeTy a])]
ls)           = Doc ann
"type" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TyName a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TyName a
tn Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((TyName a -> Doc ann) -> [TyName a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyName a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [TyName a]
ns) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ((Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\Doc ann
x Doc ann
y -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
pipe Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
y) ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ ((Name b, [KempeTy a]) -> Doc ann)
-> [(Name b, [KempeTy a])] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Name b -> [KempeTy a] -> Doc ann)
-> (Name b, [KempeTy a]) -> Doc ann
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name b -> [KempeTy a] -> Doc ann
forall a b ann. TyName a -> [KempeTy b] -> Doc ann
prettyTyLeaf) [(Name b, [KempeTy a])]
ls)

instance Pretty (KempeDecl a b c) where
    pretty :: KempeDecl a b c -> Doc ann
pretty = (Atom b c -> Doc ann) -> KempeDecl a b c -> Doc ann
forall c b ann a.
(Atom c b -> Doc ann) -> KempeDecl a c b -> Doc ann
prettyKempeDecl Atom b c -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

prettyTyLeaf :: TyName a -> [KempeTy b] -> Doc ann
prettyTyLeaf :: TyName a -> [KempeTy b] -> Doc ann
prettyTyLeaf TyName a
cn [KempeTy b]
vars = TyName a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TyName a
cn Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((KempeTy b -> Doc ann) -> [KempeTy b] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KempeTy b -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [KempeTy b]
vars)

-- TODO: separate annotations for TyName in TyDecl
data KempeDecl a c b = TyDecl a (TyName a) [Name a] [(TyName b, [KempeTy a])]
                     | FunDecl b (Name b) [KempeTy a] [KempeTy a] [Atom c b]
                     | ExtFnDecl b (Name b) [KempeTy a] [KempeTy a] BSL.ByteString -- ShortByteString?
                     | Export b ABI (Name b)
                     deriving (KempeDecl a c b -> KempeDecl a c b -> Bool
(KempeDecl a c b -> KempeDecl a c b -> Bool)
-> (KempeDecl a c b -> KempeDecl a c b -> Bool)
-> Eq (KempeDecl a c b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a c b.
(Eq a, Eq b, Eq c) =>
KempeDecl a c b -> KempeDecl a c b -> Bool
/= :: KempeDecl a c b -> KempeDecl a c b -> Bool
$c/= :: forall a c b.
(Eq a, Eq b, Eq c) =>
KempeDecl a c b -> KempeDecl a c b -> Bool
== :: KempeDecl a c b -> KempeDecl a c b -> Bool
$c== :: forall a c b.
(Eq a, Eq b, Eq c) =>
KempeDecl a c b -> KempeDecl a c b -> Bool
Eq, (forall x. KempeDecl a c b -> Rep (KempeDecl a c b) x)
-> (forall x. Rep (KempeDecl a c b) x -> KempeDecl a c b)
-> Generic (KempeDecl a c b)
forall x. Rep (KempeDecl a c b) x -> KempeDecl a c b
forall x. KempeDecl a c b -> Rep (KempeDecl a c b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a c b x. Rep (KempeDecl a c b) x -> KempeDecl a c b
forall a c b x. KempeDecl a c b -> Rep (KempeDecl a c b) x
$cto :: forall a c b x. Rep (KempeDecl a c b) x -> KempeDecl a c b
$cfrom :: forall a c b x. KempeDecl a c b -> Rep (KempeDecl a c b) x
Generic, KempeDecl a c b -> ()
(KempeDecl a c b -> ()) -> NFData (KempeDecl a c b)
forall a. (a -> ()) -> NFData a
forall a c b.
(NFData a, NFData b, NFData c) =>
KempeDecl a c b -> ()
rnf :: KempeDecl a c b -> ()
$crnf :: forall a c b.
(NFData a, NFData b, NFData c) =>
KempeDecl a c b -> ()
NFData, a -> KempeDecl a c b -> KempeDecl a c a
(a -> b) -> KempeDecl a c a -> KempeDecl a c b
(forall a b. (a -> b) -> KempeDecl a c a -> KempeDecl a c b)
-> (forall a b. a -> KempeDecl a c b -> KempeDecl a c a)
-> Functor (KempeDecl a c)
forall a b. a -> KempeDecl a c b -> KempeDecl a c a
forall a b. (a -> b) -> KempeDecl a c a -> KempeDecl a c b
forall a c a b. a -> KempeDecl a c b -> KempeDecl a c a
forall a c a b. (a -> b) -> KempeDecl a c a -> KempeDecl a c b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> KempeDecl a c b -> KempeDecl a c a
$c<$ :: forall a c a b. a -> KempeDecl a c b -> KempeDecl a c a
fmap :: (a -> b) -> KempeDecl a c a -> KempeDecl a c b
$cfmap :: forall a c a b. (a -> b) -> KempeDecl a c a -> KempeDecl a c b
Functor, KempeDecl a c a -> Bool
(a -> m) -> KempeDecl a c a -> m
(a -> b -> b) -> b -> KempeDecl a c a -> b
(forall m. Monoid m => KempeDecl a c m -> m)
-> (forall m a. Monoid m => (a -> m) -> KempeDecl a c a -> m)
-> (forall m a. Monoid m => (a -> m) -> KempeDecl a c a -> m)
-> (forall a b. (a -> b -> b) -> b -> KempeDecl a c a -> b)
-> (forall a b. (a -> b -> b) -> b -> KempeDecl a c a -> b)
-> (forall b a. (b -> a -> b) -> b -> KempeDecl a c a -> b)
-> (forall b a. (b -> a -> b) -> b -> KempeDecl a c a -> b)
-> (forall a. (a -> a -> a) -> KempeDecl a c a -> a)
-> (forall a. (a -> a -> a) -> KempeDecl a c a -> a)
-> (forall a. KempeDecl a c a -> [a])
-> (forall a. KempeDecl a c a -> Bool)
-> (forall a. KempeDecl a c a -> Int)
-> (forall a. Eq a => a -> KempeDecl a c a -> Bool)
-> (forall a. Ord a => KempeDecl a c a -> a)
-> (forall a. Ord a => KempeDecl a c a -> a)
-> (forall a. Num a => KempeDecl a c a -> a)
-> (forall a. Num a => KempeDecl a c a -> a)
-> Foldable (KempeDecl a c)
forall a. Eq a => a -> KempeDecl a c a -> Bool
forall a. Num a => KempeDecl a c a -> a
forall a. Ord a => KempeDecl a c a -> a
forall m. Monoid m => KempeDecl a c m -> m
forall a. KempeDecl a c a -> Bool
forall a. KempeDecl a c a -> Int
forall a. KempeDecl a c a -> [a]
forall a. (a -> a -> a) -> KempeDecl a c a -> a
forall m a. Monoid m => (a -> m) -> KempeDecl a c a -> m
forall b a. (b -> a -> b) -> b -> KempeDecl a c a -> b
forall a b. (a -> b -> b) -> b -> KempeDecl a c a -> b
forall a c a. Eq a => a -> KempeDecl a c a -> Bool
forall a c a. Num a => KempeDecl a c a -> a
forall a c a. Ord a => KempeDecl a c a -> a
forall a c m. Monoid m => KempeDecl a c m -> m
forall a c a. KempeDecl a c a -> Bool
forall a c a. KempeDecl a c a -> Int
forall a c a. KempeDecl a c a -> [a]
forall a c a. (a -> a -> a) -> KempeDecl a c a -> a
forall a c m a. Monoid m => (a -> m) -> KempeDecl a c a -> m
forall a c b a. (b -> a -> b) -> b -> KempeDecl a c a -> b
forall a c a b. (a -> b -> b) -> b -> KempeDecl a c 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
product :: KempeDecl a c a -> a
$cproduct :: forall a c a. Num a => KempeDecl a c a -> a
sum :: KempeDecl a c a -> a
$csum :: forall a c a. Num a => KempeDecl a c a -> a
minimum :: KempeDecl a c a -> a
$cminimum :: forall a c a. Ord a => KempeDecl a c a -> a
maximum :: KempeDecl a c a -> a
$cmaximum :: forall a c a. Ord a => KempeDecl a c a -> a
elem :: a -> KempeDecl a c a -> Bool
$celem :: forall a c a. Eq a => a -> KempeDecl a c a -> Bool
length :: KempeDecl a c a -> Int
$clength :: forall a c a. KempeDecl a c a -> Int
null :: KempeDecl a c a -> Bool
$cnull :: forall a c a. KempeDecl a c a -> Bool
toList :: KempeDecl a c a -> [a]
$ctoList :: forall a c a. KempeDecl a c a -> [a]
foldl1 :: (a -> a -> a) -> KempeDecl a c a -> a
$cfoldl1 :: forall a c a. (a -> a -> a) -> KempeDecl a c a -> a
foldr1 :: (a -> a -> a) -> KempeDecl a c a -> a
$cfoldr1 :: forall a c a. (a -> a -> a) -> KempeDecl a c a -> a
foldl' :: (b -> a -> b) -> b -> KempeDecl a c a -> b
$cfoldl' :: forall a c b a. (b -> a -> b) -> b -> KempeDecl a c a -> b
foldl :: (b -> a -> b) -> b -> KempeDecl a c a -> b
$cfoldl :: forall a c b a. (b -> a -> b) -> b -> KempeDecl a c a -> b
foldr' :: (a -> b -> b) -> b -> KempeDecl a c a -> b
$cfoldr' :: forall a c a b. (a -> b -> b) -> b -> KempeDecl a c a -> b
foldr :: (a -> b -> b) -> b -> KempeDecl a c a -> b
$cfoldr :: forall a c a b. (a -> b -> b) -> b -> KempeDecl a c a -> b
foldMap' :: (a -> m) -> KempeDecl a c a -> m
$cfoldMap' :: forall a c m a. Monoid m => (a -> m) -> KempeDecl a c a -> m
foldMap :: (a -> m) -> KempeDecl a c a -> m
$cfoldMap :: forall a c m a. Monoid m => (a -> m) -> KempeDecl a c a -> m
fold :: KempeDecl a c m -> m
$cfold :: forall a c m. Monoid m => KempeDecl a c m -> m
Foldable, Functor (KempeDecl a c)
Foldable (KempeDecl a c)
Functor (KempeDecl a c)
-> Foldable (KempeDecl a c)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> KempeDecl a c a -> f (KempeDecl a c b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    KempeDecl a c (f a) -> f (KempeDecl a c a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> KempeDecl a c a -> m (KempeDecl a c b))
-> (forall (m :: * -> *) a.
    Monad m =>
    KempeDecl a c (m a) -> m (KempeDecl a c a))
-> Traversable (KempeDecl a c)
(a -> f b) -> KempeDecl a c a -> f (KempeDecl a c b)
forall a c. Functor (KempeDecl a c)
forall a c. Foldable (KempeDecl a c)
forall a c (m :: * -> *) a.
Monad m =>
KempeDecl a c (m a) -> m (KempeDecl a c a)
forall a c (f :: * -> *) a.
Applicative f =>
KempeDecl a c (f a) -> f (KempeDecl a c a)
forall a c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> KempeDecl a c a -> m (KempeDecl a c b)
forall a c (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> KempeDecl a c a -> f (KempeDecl a c b)
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 =>
KempeDecl a c (m a) -> m (KempeDecl a c a)
forall (f :: * -> *) a.
Applicative f =>
KempeDecl a c (f a) -> f (KempeDecl a c a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> KempeDecl a c a -> m (KempeDecl a c b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> KempeDecl a c a -> f (KempeDecl a c b)
sequence :: KempeDecl a c (m a) -> m (KempeDecl a c a)
$csequence :: forall a c (m :: * -> *) a.
Monad m =>
KempeDecl a c (m a) -> m (KempeDecl a c a)
mapM :: (a -> m b) -> KempeDecl a c a -> m (KempeDecl a c b)
$cmapM :: forall a c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> KempeDecl a c a -> m (KempeDecl a c b)
sequenceA :: KempeDecl a c (f a) -> f (KempeDecl a c a)
$csequenceA :: forall a c (f :: * -> *) a.
Applicative f =>
KempeDecl a c (f a) -> f (KempeDecl a c a)
traverse :: (a -> f b) -> KempeDecl a c a -> f (KempeDecl a c b)
$ctraverse :: forall a c (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> KempeDecl a c a -> f (KempeDecl a c b)
$cp2Traversable :: forall a c. Foldable (KempeDecl a c)
$cp1Traversable :: forall a c. Functor (KempeDecl a c)
Traversable)

instance Bifunctor (KempeDecl a) where
    first :: (a -> b) -> KempeDecl a a c -> KempeDecl a b c
first a -> b
_ (TyDecl a
x TyName a
tn [TyName a]
ns [(TyName c, [KempeTy a])]
ls)        = a
-> TyName a
-> [TyName a]
-> [(TyName c, [KempeTy a])]
-> KempeDecl a b c
forall a c b.
a
-> TyName a
-> [TyName a]
-> [(TyName b, [KempeTy a])]
-> KempeDecl a c b
TyDecl a
x TyName a
tn [TyName a]
ns [(TyName c, [KempeTy a])]
ls
    first a -> b
f (FunDecl c
l TyName c
n [KempeTy a]
tys [KempeTy a]
tys' [Atom a c]
as)  = c
-> TyName c
-> [KempeTy a]
-> [KempeTy a]
-> [Atom b c]
-> KempeDecl a b c
forall a c b.
b
-> TyName b
-> [KempeTy a]
-> [KempeTy a]
-> [Atom c b]
-> KempeDecl a c b
FunDecl c
l TyName c
n [KempeTy a]
tys [KempeTy a]
tys' ((Atom a c -> Atom b c) -> [Atom a c] -> [Atom b c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Atom a c -> Atom b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) [Atom a c]
as)
    first a -> b
_ (ExtFnDecl c
l TyName c
n [KempeTy a]
tys [KempeTy a]
tys' ByteString
b) = c
-> TyName c
-> [KempeTy a]
-> [KempeTy a]
-> ByteString
-> KempeDecl a b c
forall a c b.
b
-> TyName b
-> [KempeTy a]
-> [KempeTy a]
-> ByteString
-> KempeDecl a c b
ExtFnDecl c
l TyName c
n [KempeTy a]
tys [KempeTy a]
tys' ByteString
b
    first a -> b
_ (Export c
l ABI
abi TyName c
n)           = c -> ABI -> TyName c -> KempeDecl a b c
forall a c b. b -> ABI -> TyName b -> KempeDecl a c b
Export c
l ABI
abi TyName c
n
    second :: (b -> c) -> KempeDecl a a b -> KempeDecl a a c
second = (b -> c) -> KempeDecl a a b -> KempeDecl a a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance Bifoldable (KempeDecl a) where
    bifoldMap :: (a -> m) -> (b -> m) -> KempeDecl a a b -> m
bifoldMap a -> m
_ b -> m
g (TyDecl a
x TyName a
tn [TyName a]
ns [(TyName b, [KempeTy a])]
ls)        = (b -> m) -> KempeDecl a Any b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (a
-> TyName a
-> [TyName a]
-> [(TyName b, [KempeTy a])]
-> KempeDecl a Any b
forall a c b.
a
-> TyName a
-> [TyName a]
-> [(TyName b, [KempeTy a])]
-> KempeDecl a c b
TyDecl a
x TyName a
tn [TyName a]
ns [(TyName b, [KempeTy a])]
ls)
    bifoldMap a -> m
_ b -> m
g (ExtFnDecl b
l TyName b
n [KempeTy a]
tys [KempeTy a]
tys' ByteString
b) = (b -> m) -> KempeDecl a Any b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (b
-> TyName b
-> [KempeTy a]
-> [KempeTy a]
-> ByteString
-> KempeDecl a Any b
forall a c b.
b
-> TyName b
-> [KempeTy a]
-> [KempeTy a]
-> ByteString
-> KempeDecl a c b
ExtFnDecl b
l TyName b
n [KempeTy a]
tys [KempeTy a]
tys' ByteString
b)
    bifoldMap a -> m
_ b -> m
g (Export b
l ABI
abi TyName b
n)           = (b -> m) -> KempeDecl Any Any b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (b -> ABI -> TyName b -> KempeDecl Any Any b
forall a c b. b -> ABI -> TyName b -> KempeDecl a c b
Export b
l ABI
abi TyName b
n)
    bifoldMap a -> m
f b -> m
g (FunDecl b
x TyName b
n [KempeTy a]
_ [KempeTy a]
_ [Atom a b]
a)        = b -> m
g b
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (b -> m) -> TyName b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g TyName b
n m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Atom a b -> m) -> [Atom a b] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> Atom a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) [Atom a b]
a

instance Bitraversable (KempeDecl a) where
    bitraverse :: (a -> f c) -> (b -> f d) -> KempeDecl a a b -> f (KempeDecl a c d)
bitraverse a -> f c
_ b -> f d
g (TyDecl a
l TyName a
tn [TyName a]
ns [(TyName b, [KempeTy a])]
ls)        = (b -> f d) -> KempeDecl a c b -> f (KempeDecl a c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (a
-> TyName a
-> [TyName a]
-> [(TyName b, [KempeTy a])]
-> KempeDecl a c b
forall a c b.
a
-> TyName a
-> [TyName a]
-> [(TyName b, [KempeTy a])]
-> KempeDecl a c b
TyDecl a
l TyName a
tn [TyName a]
ns [(TyName b, [KempeTy a])]
ls)
    bitraverse a -> f c
f b -> f d
g (FunDecl b
x TyName b
n [KempeTy a]
tys [KempeTy a]
tys' [Atom a b]
a)   = d
-> Name d
-> [KempeTy a]
-> [KempeTy a]
-> [Atom c d]
-> KempeDecl a c d
forall a c b.
b
-> TyName b
-> [KempeTy a]
-> [KempeTy a]
-> [Atom c b]
-> KempeDecl a c b
FunDecl (d
 -> Name d
 -> [KempeTy a]
 -> [KempeTy a]
 -> [Atom c d]
 -> KempeDecl a c d)
-> f d
-> f (Name d
      -> [KempeTy a] -> [KempeTy a] -> [Atom c d] -> KempeDecl a c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
x f (Name d
   -> [KempeTy a] -> [KempeTy a] -> [Atom c d] -> KempeDecl a c d)
-> f (Name d)
-> f ([KempeTy a] -> [KempeTy a] -> [Atom c d] -> KempeDecl a c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b -> f d) -> TyName b -> f (Name d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g TyName b
n f ([KempeTy a] -> [KempeTy a] -> [Atom c d] -> KempeDecl a c d)
-> f [KempeTy a]
-> f ([KempeTy a] -> [Atom c d] -> KempeDecl a c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [KempeTy a] -> f [KempeTy a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [KempeTy a]
tys f ([KempeTy a] -> [Atom c d] -> KempeDecl a c d)
-> f [KempeTy a] -> f ([Atom c d] -> KempeDecl a c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [KempeTy a] -> f [KempeTy a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [KempeTy a]
tys' f ([Atom c d] -> KempeDecl a c d)
-> f [Atom c d] -> f (KempeDecl a c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Atom a b -> f (Atom c d)) -> [Atom a b] -> f [Atom c d]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c) -> (b -> f d) -> Atom a b -> f (Atom c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) [Atom a b]
a
    bitraverse a -> f c
_ b -> f d
g (ExtFnDecl b
l TyName b
n [KempeTy a]
tys [KempeTy a]
tys' ByteString
b) = (b -> f d) -> KempeDecl a c b -> f (KempeDecl a c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (b
-> TyName b
-> [KempeTy a]
-> [KempeTy a]
-> ByteString
-> KempeDecl a c b
forall a c b.
b
-> TyName b
-> [KempeTy a]
-> [KempeTy a]
-> ByteString
-> KempeDecl a c b
ExtFnDecl b
l TyName b
n [KempeTy a]
tys [KempeTy a]
tys' ByteString
b)
    bitraverse a -> f c
_ b -> f d
g (Export b
l ABI
abi TyName b
n)           = (b -> f d) -> KempeDecl a c b -> f (KempeDecl a c d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (b -> ABI -> TyName b -> KempeDecl a c b
forall a c b. b -> ABI -> TyName b -> KempeDecl a c b
Export b
l ABI
abi TyName b
n)

prettyModuleGeneral :: (Atom c b -> Doc ann) -> Module a c b -> Doc ann
prettyModuleGeneral :: (Atom c b -> Doc ann) -> Module a c b -> Doc ann
prettyModuleGeneral Atom c b -> Doc ann
atomizer = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ([Doc ann] -> Doc ann)
-> (Module a c b -> [Doc ann]) -> Module a c b -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KempeDecl a c b -> Doc ann) -> Module a c b -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Atom c b -> Doc ann) -> KempeDecl a c b -> Doc ann
forall c b ann a.
(Atom c b -> Doc ann) -> KempeDecl a c b -> Doc ann
prettyKempeDecl Atom c b -> Doc ann
atomizer)

prettyFancyModule :: Module () (ConsAnn (StackType ())) (StackType ()) -> Doc ann
prettyFancyModule :: Module () (ConsAnn (StackType ())) (StackType ()) -> Doc ann
prettyFancyModule = Module () (StackType ()) (StackType ()) -> Doc ann
forall ann. Module () (StackType ()) (StackType ()) -> Doc ann
prettyTypedModule (Module () (StackType ()) (StackType ()) -> Doc ann)
-> (Module () (ConsAnn (StackType ())) (StackType ())
    -> Module () (StackType ()) (StackType ()))
-> Module () (ConsAnn (StackType ())) (StackType ())
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KempeDecl () (ConsAnn (StackType ())) (StackType ())
 -> KempeDecl () (StackType ()) (StackType ()))
-> Module () (ConsAnn (StackType ())) (StackType ())
-> Module () (StackType ()) (StackType ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ConsAnn (StackType ()) -> StackType ())
-> KempeDecl () (ConsAnn (StackType ())) (StackType ())
-> KempeDecl () (StackType ()) (StackType ())
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ConsAnn (StackType ()) -> StackType ()
forall a. ConsAnn a -> a
consTy)

prettyTypedModule :: Module () (StackType ()) (StackType ()) -> Doc ann
prettyTypedModule :: Module () (StackType ()) (StackType ()) -> Doc ann
prettyTypedModule = (Atom (StackType ()) (StackType ()) -> Doc ann)
-> Module () (StackType ()) (StackType ()) -> Doc ann
forall c b ann a. (Atom c b -> Doc ann) -> Module a c b -> Doc ann
prettyModuleGeneral Atom (StackType ()) (StackType ()) -> Doc ann
forall ann. Atom (StackType ()) (StackType ()) -> Doc ann
prettyTyped

prettyModule :: Module a c b -> Doc ann
prettyModule :: Module a c b -> Doc ann
prettyModule = (Atom c b -> Doc ann) -> Module a c b -> Doc ann
forall c b ann a. (Atom c b -> Doc ann) -> Module a c b -> Doc ann
prettyModuleGeneral Atom c b -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

type Module a c b = [KempeDecl a c b]

extrVars :: KempeTy a -> [Name a]
extrVars :: KempeTy a -> [Name a]
extrVars TyBuiltin{}      = []
extrVars TyNamed{}        = []
extrVars (TyVar a
_ Name a
n)      = [Name a
n]
extrVars (TyApp a
_ KempeTy a
ty KempeTy a
ty') = KempeTy a -> [Name a]
forall a. KempeTy a -> [Name a]
extrVars KempeTy a
ty [Name a] -> [Name a] -> [Name a]
forall a. [a] -> [a] -> [a]
++ KempeTy a -> [Name a]
forall a. KempeTy a -> [Name a]
extrVars KempeTy a
ty'

freeVars :: [KempeTy a] -> S.Set (Name a)
freeVars :: [KempeTy a] -> Set (Name a)
freeVars [KempeTy a]
tys = [Name a] -> Set (Name a)
forall a. Ord a => [a] -> Set a
S.fromList ((KempeTy a -> [Name a]) -> [KempeTy a] -> [Name a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap KempeTy a -> [Name a]
forall a. KempeTy a -> [Name a]
extrVars [KempeTy a]
tys)

-- | Don't call this on ill-kinded types; it won't throw any error.
size :: KempeTy a -> Int64
size :: KempeTy a -> Int64
size (TyBuiltin a
_ BuiltinTy
TyInt)      = Int64
8 -- since we're only targeting x86_64 and aarch64 we have 64-bit 'Int's
size (TyBuiltin a
_ BuiltinTy
TyBool)     = Int64
1
size (TyBuiltin a
_ BuiltinTy
TyInt8)     = Int64
1
size (TyBuiltin a
_ BuiltinTy
TyWord)     = Int64
8
size TyVar{}                  = [Char] -> Int64
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error: type variables should not be present at this stage."
size TyNamed{}                = Int64
forall a. HasCallStack => a
undefined
size (TyApp a
_ TyNamed{} KempeTy a
ty)   = Int64
forall a. HasCallStack => a
undefined
size (TyApp a
_ ty :: KempeTy a
ty@TyApp{} KempeTy a
ty') = KempeTy a -> Int64
forall a. KempeTy a -> Int64
size KempeTy a
ty Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ KempeTy a -> Int64
forall a. KempeTy a -> Int64
size KempeTy a
ty'
size (TyApp a
_ TyBuiltin{} KempeTy a
_)  = [Char] -> Int64
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error: ill-kinded type!"
size (TyApp a
_ TyVar{} KempeTy a
_)      = [Char] -> Int64
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error: type variables should not be present at this stage."

sizeStack :: [KempeTy a] -> Int64
sizeStack :: [KempeTy a] -> Int64
sizeStack = Sum Int64 -> Int64
forall a. Sum a -> a
getSum (Sum Int64 -> Int64)
-> ([KempeTy a] -> Sum Int64) -> [KempeTy a] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KempeTy a -> Sum Int64) -> [KempeTy a] -> Sum Int64
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int64 -> Sum Int64
forall a. a -> Sum a
Sum (Int64 -> Sum Int64)
-> (KempeTy a -> Int64) -> KempeTy a -> Sum Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KempeTy a -> Int64
forall a. KempeTy a -> Int64
size)

-- | Used in "Kempe.Monomorphize" for patterns
flipStackType :: StackType () -> StackType ()
flipStackType :: StackType () -> StackType ()
flipStackType (StackType Set (Name ())
vars [KempeTy ()]
is [KempeTy ()]
os) = Set (Name ()) -> [KempeTy ()] -> [KempeTy ()] -> StackType ()
forall b. Set (Name b) -> [KempeTy b] -> [KempeTy b] -> StackType b
StackType Set (Name ())
vars [KempeTy ()]
os [KempeTy ()]
is