{-# 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 (..)
                 , Declarations
                 , Module (..)
                 , freeVars
                 , MonoStackType
                 , SizeEnv
                 , Size
                 , size
                 , sizeStack
                 , size'
                 , cSize
                 , prettyMonoStackType
                 , prettyTyped
                 , prettyTypedModule
                 , prettyFancyModule
                 , prettyModule
                 , flipStackType
                 -- * I resent this...
                 , voidStackType
                 ) where

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

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 { Pattern c b -> c
patternKind :: c, Pattern c b -> TyName c
patternName :: 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, Eq (Pattern c b)
Eq (Pattern c b)
-> (Pattern c b -> Pattern c b -> Ordering)
-> (Pattern c b -> Pattern c b -> Bool)
-> (Pattern c b -> Pattern c b -> Bool)
-> (Pattern c b -> Pattern c b -> Bool)
-> (Pattern c b -> Pattern c b -> Bool)
-> (Pattern c b -> Pattern c b -> Pattern c b)
-> (Pattern c b -> Pattern c b -> Pattern c b)
-> Ord (Pattern c b)
Pattern c b -> Pattern c b -> Bool
Pattern c b -> Pattern c b -> Ordering
Pattern c b -> Pattern c b -> Pattern c 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 c b. (Ord b, Ord c) => Eq (Pattern c b)
forall c b. (Ord b, Ord c) => Pattern c b -> Pattern c b -> Bool
forall c b.
(Ord b, Ord c) =>
Pattern c b -> Pattern c b -> Ordering
forall c b.
(Ord b, Ord c) =>
Pattern c b -> Pattern c b -> Pattern c b
min :: Pattern c b -> Pattern c b -> Pattern c b
$cmin :: forall c b.
(Ord b, Ord c) =>
Pattern c b -> Pattern c b -> Pattern c b
max :: Pattern c b -> Pattern c b -> Pattern c b
$cmax :: forall c b.
(Ord b, Ord c) =>
Pattern c b -> Pattern c b -> Pattern c b
>= :: Pattern c b -> Pattern c b -> Bool
$c>= :: forall c b. (Ord b, Ord c) => Pattern c b -> Pattern c b -> Bool
> :: Pattern c b -> Pattern c b -> Bool
$c> :: forall c b. (Ord b, Ord c) => Pattern c b -> Pattern c b -> Bool
<= :: Pattern c b -> Pattern c b -> Bool
$c<= :: forall c b. (Ord b, Ord c) => Pattern c b -> Pattern c b -> Bool
< :: Pattern c b -> Pattern c b -> Bool
$c< :: forall c b. (Ord b, Ord c) => Pattern c b -> Pattern c b -> Bool
compare :: Pattern c b -> Pattern c b -> Ordering
$ccompare :: forall c b.
(Ord b, Ord c) =>
Pattern c b -> Pattern c b -> Ordering
$cp1Ord :: forall c b. (Ord b, Ord c) => Eq (Pattern c b)
Ord, (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 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

prettyTypedPattern :: Pattern (StackType ()) (StackType ()) -> Doc ann
prettyTypedPattern :: Pattern (StackType ()) (StackType ()) -> Doc ann
prettyTypedPattern (PatternCons StackType ()
ty TyName (StackType ())
tn) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (TyName (StackType ()) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TyName (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)
prettyTypedPattern Pattern (StackType ()) (StackType ())
p                   = Pattern (StackType ()) (StackType ()) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern (StackType ()) (StackType ())
p

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"
    pretty (Case a
_ NonEmpty (Pattern c a, [Atom c a])
ls)     = Doc ann
"case" 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
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (NonEmpty (Doc ann) -> [Doc ann]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (Doc ann) -> [Doc ann])
-> NonEmpty (Doc ann) -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ ((Pattern c a, [Atom c a]) -> Doc ann)
-> NonEmpty (Pattern c a, [Atom c a]) -> NonEmpty (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pattern c a -> [Atom c a] -> Doc ann)
-> (Pattern c a, [Atom c a]) -> Doc ann
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Pattern c a -> [Atom c a] -> Doc ann
forall c a ann. Pattern c a -> [Atom c a] -> Doc ann
prettyLeaf) NonEmpty (Pattern c a, [Atom c a])
ls)))

prettyLeaf :: Pattern c a -> [Atom c a] -> Doc ann
prettyLeaf :: Pattern c a -> [Atom c a] -> Doc ann
prettyLeaf Pattern c a
p [Atom c a]
as = Doc ann
forall ann. Doc ann
pipe Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Pattern c a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern c a
p 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
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))

prettyTypedLeaf :: Pattern (StackType ()) (StackType ()) -> [Atom (StackType ()) (StackType ())] -> Doc ann
prettyTypedLeaf :: Pattern (StackType ()) (StackType ())
-> [Atom (StackType ()) (StackType ())] -> Doc ann
prettyTypedLeaf Pattern (StackType ()) (StackType ())
p [Atom (StackType ()) (StackType ())]
as = Doc ann
forall ann. Doc ann
pipe Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Pattern (StackType ()) (StackType ()) -> Doc ann
forall ann. Pattern (StackType ()) (StackType ()) -> Doc ann
prettyTypedPattern Pattern (StackType ()) (StackType ())
p 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
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep ((Atom (StackType ()) (StackType ()) -> Doc ann)
-> [Atom (StackType ()) (StackType ())] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Atom (StackType ()) (StackType ()) -> Doc ann
forall ann. Atom (StackType ()) (StackType ()) -> Doc ann
prettyTyped [Atom (StackType ()) (StackType ())]
as))

prettyTyped :: Atom (StackType ()) (StackType ()) -> Doc ann
prettyTyped :: Atom (StackType ()) (StackType ()) -> Doc ann
prettyTyped (AtName StackType ()
ty TyName (StackType ())
n)    = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (TyName (StackType ()) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TyName (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 TyName (StackType ())
tn)   = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (TyName (StackType ()) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TyName (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
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
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"
prettyTyped (Case StackType ()
_ NonEmpty
  (Pattern (StackType ()) (StackType ()),
   [Atom (StackType ()) (StackType ())])
ls)      = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann
"case" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (NonEmpty (Doc ann) -> [Doc ann]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (Doc ann) -> [Doc ann])
-> NonEmpty (Doc ann) -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ ((Pattern (StackType ()) (StackType ()),
  [Atom (StackType ()) (StackType ())])
 -> Doc ann)
-> NonEmpty
     (Pattern (StackType ()) (StackType ()),
      [Atom (StackType ()) (StackType ())])
-> NonEmpty (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pattern (StackType ()) (StackType ())
 -> [Atom (StackType ()) (StackType ())] -> Doc ann)
-> (Pattern (StackType ()) (StackType ()),
    [Atom (StackType ()) (StackType ())])
-> Doc ann
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Pattern (StackType ()) (StackType ())
-> [Atom (StackType ()) (StackType ())] -> Doc ann
forall ann.
Pattern (StackType ()) (StackType ())
-> [Atom (StackType ()) (StackType ())] -> Doc ann
prettyTypedLeaf) NonEmpty
  (Pattern (StackType ()) (StackType ()),
   [Atom (StackType ()) (StackType ())])
ls))

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, Eq (Atom c b)
Eq (Atom c b)
-> (Atom c b -> Atom c b -> Ordering)
-> (Atom c b -> Atom c b -> Bool)
-> (Atom c b -> Atom c b -> Bool)
-> (Atom c b -> Atom c b -> Bool)
-> (Atom c b -> Atom c b -> Bool)
-> (Atom c b -> Atom c b -> Atom c b)
-> (Atom c b -> Atom c b -> Atom c b)
-> Ord (Atom c b)
Atom c b -> Atom c b -> Bool
Atom c b -> Atom c b -> Ordering
Atom c b -> Atom c b -> Atom c 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 c b. (Ord b, Ord c) => Eq (Atom c b)
forall c b. (Ord b, Ord c) => Atom c b -> Atom c b -> Bool
forall c b. (Ord b, Ord c) => Atom c b -> Atom c b -> Ordering
forall c b. (Ord b, Ord c) => Atom c b -> Atom c b -> Atom c b
min :: Atom c b -> Atom c b -> Atom c b
$cmin :: forall c b. (Ord b, Ord c) => Atom c b -> Atom c b -> Atom c b
max :: Atom c b -> Atom c b -> Atom c b
$cmax :: forall c b. (Ord b, Ord c) => Atom c b -> Atom c b -> Atom c b
>= :: Atom c b -> Atom c b -> Bool
$c>= :: forall c b. (Ord b, Ord c) => Atom c b -> Atom c b -> Bool
> :: Atom c b -> Atom c b -> Bool
$c> :: forall c b. (Ord b, Ord c) => Atom c b -> Atom c b -> Bool
<= :: Atom c b -> Atom c b -> Bool
$c<= :: forall c b. (Ord b, Ord c) => Atom c b -> Atom c b -> Bool
< :: Atom c b -> Atom c b -> Bool
$c< :: forall c b. (Ord b, Ord c) => Atom c b -> Atom c b -> Bool
compare :: Atom c b -> Atom c b -> Ordering
$ccompare :: forall c b. (Ord b, Ord c) => Atom c b -> Atom c b -> Ordering
$cp1Ord :: forall c b. (Ord b, Ord c) => Eq (Atom c b)
Ord, (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)

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, Eq BuiltinFn
Eq BuiltinFn
-> (BuiltinFn -> BuiltinFn -> Ordering)
-> (BuiltinFn -> BuiltinFn -> Bool)
-> (BuiltinFn -> BuiltinFn -> Bool)
-> (BuiltinFn -> BuiltinFn -> Bool)
-> (BuiltinFn -> BuiltinFn -> Bool)
-> (BuiltinFn -> BuiltinFn -> BuiltinFn)
-> (BuiltinFn -> BuiltinFn -> BuiltinFn)
-> Ord BuiltinFn
BuiltinFn -> BuiltinFn -> Bool
BuiltinFn -> BuiltinFn -> Ordering
BuiltinFn -> BuiltinFn -> BuiltinFn
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 :: BuiltinFn -> BuiltinFn -> BuiltinFn
$cmin :: BuiltinFn -> BuiltinFn -> BuiltinFn
max :: BuiltinFn -> BuiltinFn -> BuiltinFn
$cmax :: BuiltinFn -> BuiltinFn -> BuiltinFn
>= :: BuiltinFn -> BuiltinFn -> Bool
$c>= :: BuiltinFn -> BuiltinFn -> Bool
> :: BuiltinFn -> BuiltinFn -> Bool
$c> :: BuiltinFn -> BuiltinFn -> Bool
<= :: BuiltinFn -> BuiltinFn -> Bool
$c<= :: BuiltinFn -> BuiltinFn -> Bool
< :: BuiltinFn -> BuiltinFn -> Bool
$c< :: BuiltinFn -> BuiltinFn -> Bool
compare :: BuiltinFn -> BuiltinFn -> Ordering
$ccompare :: BuiltinFn -> BuiltinFn -> Ordering
$cp1Ord :: Eq BuiltinFn
Ord, (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, Eq ABI
Eq ABI
-> (ABI -> ABI -> Ordering)
-> (ABI -> ABI -> Bool)
-> (ABI -> ABI -> Bool)
-> (ABI -> ABI -> Bool)
-> (ABI -> ABI -> Bool)
-> (ABI -> ABI -> ABI)
-> (ABI -> ABI -> ABI)
-> Ord ABI
ABI -> ABI -> Bool
ABI -> ABI -> Ordering
ABI -> ABI -> ABI
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 :: ABI -> ABI -> ABI
$cmin :: ABI -> ABI -> ABI
max :: ABI -> ABI -> ABI
$cmax :: ABI -> ABI -> ABI
>= :: ABI -> ABI -> Bool
$c>= :: ABI -> ABI -> Bool
> :: ABI -> ABI -> Bool
$c> :: ABI -> ABI -> Bool
<= :: ABI -> ABI -> Bool
$c<= :: ABI -> ABI -> Bool
< :: ABI -> ABI -> Bool
$c< :: ABI -> ABI -> Bool
compare :: ABI -> ABI -> Ordering
$ccompare :: ABI -> ABI -> Ordering
$cp1Ord :: Eq ABI
Ord, (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
forall ann. Doc ann -> Doc ann
align (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
forall ann. Doc ann -> Doc ann
align (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
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (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, Eq (KempeDecl a c b)
Eq (KempeDecl a c b)
-> (KempeDecl a c b -> KempeDecl a c b -> Ordering)
-> (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)
-> (KempeDecl a c b -> KempeDecl a c b -> Bool)
-> (KempeDecl a c b -> KempeDecl a c b -> KempeDecl a c b)
-> (KempeDecl a c b -> KempeDecl a c b -> KempeDecl a c b)
-> Ord (KempeDecl a c b)
KempeDecl a c b -> KempeDecl a c b -> Bool
KempeDecl a c b -> KempeDecl a c b -> Ordering
KempeDecl a c b -> KempeDecl a c b -> KempeDecl a c 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 a c b. (Ord a, Ord b, Ord c) => Eq (KempeDecl a c b)
forall a c b.
(Ord a, Ord b, Ord c) =>
KempeDecl a c b -> KempeDecl a c b -> Bool
forall a c b.
(Ord a, Ord b, Ord c) =>
KempeDecl a c b -> KempeDecl a c b -> Ordering
forall a c b.
(Ord a, Ord b, Ord c) =>
KempeDecl a c b -> KempeDecl a c b -> KempeDecl a c b
min :: KempeDecl a c b -> KempeDecl a c b -> KempeDecl a c b
$cmin :: forall a c b.
(Ord a, Ord b, Ord c) =>
KempeDecl a c b -> KempeDecl a c b -> KempeDecl a c b
max :: KempeDecl a c b -> KempeDecl a c b -> KempeDecl a c b
$cmax :: forall a c b.
(Ord a, Ord b, Ord c) =>
KempeDecl a c b -> KempeDecl a c b -> KempeDecl a c b
>= :: KempeDecl a c b -> KempeDecl a c b -> Bool
$c>= :: forall a c b.
(Ord a, Ord b, Ord c) =>
KempeDecl a c b -> KempeDecl a c b -> Bool
> :: KempeDecl a c b -> KempeDecl a c b -> Bool
$c> :: forall a c b.
(Ord a, Ord b, Ord c) =>
KempeDecl a c b -> KempeDecl a c b -> Bool
<= :: KempeDecl a c b -> KempeDecl a c b -> Bool
$c<= :: forall a c b.
(Ord a, Ord b, Ord c) =>
KempeDecl a c b -> KempeDecl a c b -> Bool
< :: KempeDecl a c b -> KempeDecl a c b -> Bool
$c< :: forall a c b.
(Ord a, Ord b, Ord c) =>
KempeDecl a c b -> KempeDecl a c b -> Bool
compare :: KempeDecl a c b -> KempeDecl a c b -> Ordering
$ccompare :: forall a c b.
(Ord a, Ord b, Ord c) =>
KempeDecl a c b -> KempeDecl a c b -> Ordering
$cp1Ord :: forall a c b. (Ord a, Ord b, Ord c) => Eq (KempeDecl a c b)
Ord, (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

prettyDeclarationsGeneral :: (Atom c b -> Doc ann) -> Declarations a c b -> Doc ann
prettyDeclarationsGeneral :: (Atom c b -> Doc ann) -> Declarations a c b -> Doc ann
prettyDeclarationsGeneral Atom c b -> Doc ann
atomizer = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sepDecls ([Doc ann] -> Doc ann)
-> (Declarations a c b -> [Doc ann])
-> Declarations a c b
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KempeDecl a c b -> Doc ann) -> Declarations 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)

prettyImport :: BSL.ByteString -> Doc ann
prettyImport :: ByteString -> Doc ann
prettyImport ByteString
b = Doc ann
"import" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Text
decodeUtf8 ByteString
b))

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 (Module [] [KempeDecl a c b]
ds) = (Atom c b -> Doc ann) -> [KempeDecl a c b] -> Doc ann
forall c b ann a.
(Atom c b -> Doc ann) -> Declarations a c b -> Doc ann
prettyDeclarationsGeneral Atom c b -> Doc ann
atomizer [KempeDecl a c b]
ds
prettyModuleGeneral Atom c b -> Doc ann
atomizer (Module [ByteString]
is [KempeDecl a c b]
ds) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines ((ByteString -> Doc ann) -> [ByteString] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Doc ann
forall ann. ByteString -> Doc ann
prettyImport [ByteString]
is) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<##> (Atom c b -> Doc ann) -> [KempeDecl a c b] -> Doc ann
forall c b ann a.
(Atom c b -> Doc ann) -> Declarations a c b -> Doc ann
prettyDeclarationsGeneral Atom c b -> Doc ann
atomizer [KempeDecl a c b]
ds

prettyFancyModule :: Declarations () (ConsAnn (StackType ())) (StackType ()) -> Doc ann
prettyFancyModule :: Declarations () (ConsAnn (StackType ())) (StackType ()) -> Doc ann
prettyFancyModule = Declarations () (StackType ()) (StackType ()) -> Doc ann
forall ann.
Declarations () (StackType ()) (StackType ()) -> Doc ann
prettyTypedModule (Declarations () (StackType ()) (StackType ()) -> Doc ann)
-> (Declarations () (ConsAnn (StackType ())) (StackType ())
    -> Declarations () (StackType ()) (StackType ()))
-> Declarations () (ConsAnn (StackType ())) (StackType ())
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KempeDecl () (ConsAnn (StackType ())) (StackType ())
 -> KempeDecl () (StackType ()) (StackType ()))
-> Declarations () (ConsAnn (StackType ())) (StackType ())
-> Declarations () (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 :: Declarations () (StackType ()) (StackType ()) -> Doc ann
prettyTypedModule :: Declarations () (StackType ()) (StackType ()) -> Doc ann
prettyTypedModule = (Atom (StackType ()) (StackType ()) -> Doc ann)
-> Declarations () (StackType ()) (StackType ()) -> Doc ann
forall c b ann a.
(Atom c b -> Doc ann) -> Declarations a c b -> Doc ann
prettyDeclarationsGeneral 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 Declarations a c b = [KempeDecl a c b]

data Module a c b = Module { Module a c b -> [ByteString]
importFps :: [BSL.ByteString]
                           , Module a c b -> [KempeDecl a c b]
body      :: [KempeDecl a c b]
                           } deriving ((forall x. Module a c b -> Rep (Module a c b) x)
-> (forall x. Rep (Module a c b) x -> Module a c b)
-> Generic (Module a c b)
forall x. Rep (Module a c b) x -> Module a c b
forall x. Module a c b -> Rep (Module 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 (Module a c b) x -> Module a c b
forall a c b x. Module a c b -> Rep (Module a c b) x
$cto :: forall a c b x. Rep (Module a c b) x -> Module a c b
$cfrom :: forall a c b x. Module a c b -> Rep (Module a c b) x
Generic, Module a c b -> ()
(Module a c b -> ()) -> NFData (Module a c b)
forall a. (a -> ()) -> NFData a
forall a c b. (NFData a, NFData b, NFData c) => Module a c b -> ()
rnf :: Module a c b -> ()
$crnf :: forall a c b. (NFData a, NFData b, NFData c) => Module a c b -> ()
NFData)

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)

-- machinery for assigning a constructor to a function of its concrete types
-- (and then curry forward...)

type Size = [Int64] -> Int64
type SizeEnv = IM.IntMap Size

-- the kempe sizing system is kind of fucked (it mostly works tho)

-- | Don't call this on ill-kinded types; it won't throw any error.
size :: SizeEnv -> KempeTy a -> Size
size :: SizeEnv -> KempeTy a -> Size
size SizeEnv
_ (TyBuiltin a
_ BuiltinTy
TyInt)                 = Int64 -> Size
forall a b. a -> b -> a
const Int64
8
size SizeEnv
_ (TyBuiltin a
_ BuiltinTy
TyBool)                = Int64 -> Size
forall a b. a -> b -> a
const Int64
1
size SizeEnv
_ (TyBuiltin a
_ BuiltinTy
TyInt8)                = Int64 -> Size
forall a b. a -> b -> a
const Int64
1
size SizeEnv
_ (TyBuiltin a
_ BuiltinTy
TyWord)                = Int64 -> Size
forall a b. a -> b -> a
const Int64
8
size SizeEnv
_ TyVar{}                             = [Char] -> Size
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error: type variables should not be present at this stage."
size SizeEnv
env (TyNamed a
_ (Name Text
_ (Unique Int
k) a
_)) = Size -> Int -> SizeEnv -> Size
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault ([Char] -> Size
forall a. HasCallStack => [Char] -> a
error [Char]
"Size not in map!") Int
k SizeEnv
env
size SizeEnv
env (TyApp a
_ KempeTy a
ty KempeTy a
ty')                  = \[Int64]
tys -> SizeEnv -> KempeTy a -> Size
forall a. SizeEnv -> KempeTy a -> Size
size SizeEnv
env KempeTy a
ty (SizeEnv -> KempeTy a -> Size
forall a. SizeEnv -> KempeTy a -> Size
size SizeEnv
env KempeTy a
ty' [] Int64 -> [Int64] -> [Int64]
forall a. a -> [a] -> [a]
: [Int64]
tys)

cSize :: Size -> Int64
cSize :: Size -> Int64
cSize = (Size -> Size
forall a b. (a -> b) -> a -> b
$ [])

size' :: SizeEnv -> KempeTy a -> Int64
size' :: SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env = Size -> Int64
cSize (Size -> Int64) -> (KempeTy a -> Size) -> KempeTy a -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeEnv -> KempeTy a -> Size
forall a. SizeEnv -> KempeTy a -> Size
size SizeEnv
env

sizeStack :: SizeEnv -> [KempeTy a] -> Int64
sizeStack :: SizeEnv -> [KempeTy a] -> Int64
sizeStack SizeEnv
env = 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
. SizeEnv -> KempeTy a -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env)

-- | 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