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

-- | Frontend AST
module Kempe.AST ( ConsAnn (..)
                 , Atom (..)
                 , BuiltinFn (..)
                 , KempeDecl (..)
                 , Pattern (..)
                 , Declarations
                 , Module (..)
                 , ABI (..)
                 , BuiltinTy (..)
                 , KempeTy (..)
                 , StackType (..)
                 , MonoStackType
                 , prettyMonoStackType
                 , freeVars
                 , 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           Data.List.NonEmpty      (NonEmpty)
import qualified Data.List.NonEmpty      as NE
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.AST.Size
import           Kempe.Name
import           Numeric.Natural
import           Prettyprinter           (Doc, Pretty (pretty), align, braces, brackets, colon, concatWith, dquotes, fillSep, hsep, parens, pipe, sep, vsep, (<+>))
import           Prettyprinter.Ext


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

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)

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"

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)

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