{-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} module Inferno.Types.Value where import Control.Monad.Except (MonadError) import Control.Monad.Fix (MonadFix) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (MonadReader, ReaderT (..)) import Data.Int (Int64) import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as Text import Data.Word (Word16, Word32, Word64) import GHC.TypeLits (Symbol) import Inferno.Types.Syntax (ExtIdent, Ident (..), InfernoType) import Inferno.Types.VersionControl (VCObjectHash) import Numeric (showHex) import Prettyprinter ( Pretty (pretty), align, comma, encloseSep, lbracket, rbracket, tupled, (<+>), ) import System.Posix.Types (EpochTime) data Value custom m = VInt Int64 | VDouble Double | VWord16 Word16 | VWord32 Word32 | VWord64 Word64 | VEpochTime EpochTime | VText Text | VEnum VCObjectHash Ident | VArray [Value custom m] | VTuple [Value custom m] | VOne (Value custom m) | VEmpty | VFun (Value custom m -> m (Value custom m)) | VTypeRep InfernoType | VCustom custom instance Eq c => Eq (Value c m) where (VInt Int64 i1) == :: Value c m -> Value c m -> Bool == (VInt Int64 i2) = Int64 i1 forall a. Eq a => a -> a -> Bool == Int64 i2 (VDouble Double v1) == (VDouble Double v2) = Double v1 forall a. Eq a => a -> a -> Bool == Double v2 (VWord16 Word16 w1) == (VWord16 Word16 w2) = Word16 w1 forall a. Eq a => a -> a -> Bool == Word16 w2 (VWord32 Word32 w1) == (VWord32 Word32 w2) = Word32 w1 forall a. Eq a => a -> a -> Bool == Word32 w2 (VWord64 Word64 w1) == (VWord64 Word64 w2) = Word64 w1 forall a. Eq a => a -> a -> Bool == Word64 w2 (VEpochTime EpochTime t1) == (VEpochTime EpochTime t2) = EpochTime t1 forall a. Eq a => a -> a -> Bool == EpochTime t2 (VText Text t1) == (VText Text t2) = Text t1 forall a. Eq a => a -> a -> Bool == Text t2 (VEnum VCObjectHash h1 Ident e1) == (VEnum VCObjectHash h2 Ident e2) = VCObjectHash h1 forall a. Eq a => a -> a -> Bool == VCObjectHash h2 Bool -> Bool -> Bool && Ident e1 forall a. Eq a => a -> a -> Bool == Ident e2 (VOne Value c m v1) == (VOne Value c m v2) = Value c m v1 forall a. Eq a => a -> a -> Bool == Value c m v2 Value c m VEmpty == Value c m VEmpty = Bool True (VArray [Value c m] a1) == (VArray [Value c m] a2) = forall (t :: * -> *) a. Foldable t => t a -> Int length [Value c m] a1 forall a. Eq a => a -> a -> Bool == forall (t :: * -> *) a. Foldable t => t a -> Int length [Value c m] a2 Bool -> Bool -> Bool && (forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr (Bool -> Bool -> Bool (&&) forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry forall a. Eq a => a -> a -> Bool (==))) Bool True forall a b. (a -> b) -> a -> b $ forall a b. [a] -> [b] -> [(a, b)] zip [Value c m] a1 [Value c m] a2) (VTuple [Value c m] a1) == (VTuple [Value c m] a2) = forall (t :: * -> *) a. Foldable t => t a -> Int length [Value c m] a1 forall a. Eq a => a -> a -> Bool == forall (t :: * -> *) a. Foldable t => t a -> Int length [Value c m] a2 Bool -> Bool -> Bool && (forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr (Bool -> Bool -> Bool (&&) forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry forall a. Eq a => a -> a -> Bool (==))) Bool True forall a b. (a -> b) -> a -> b $ forall a b. [a] -> [b] -> [(a, b)] zip [Value c m] a1 [Value c m] a2) (VTypeRep InfernoType t1) == (VTypeRep InfernoType t2) = InfernoType t1 forall a. Eq a => a -> a -> Bool == InfernoType t2 (VCustom c c1) == (VCustom c c2) = c c1 forall a. Eq a => a -> a -> Bool == c c2 Value c m _ == Value c m _ = Bool False instance Pretty c => Pretty (Value c m) where pretty :: forall ann. Value c m -> Doc ann pretty = \case VInt Int64 n -> forall a ann. Pretty a => a -> Doc ann pretty Int64 n VDouble Double n -> forall a ann. Pretty a => a -> Doc ann pretty Double n VWord16 Word16 w -> Doc ann "0x" forall a. Semigroup a => a -> a -> a <> (forall a ann. Pretty a => a -> Doc ann pretty forall a b. (a -> b) -> a -> b $ forall a. (Integral a, Show a) => a -> ShowS showHex Word16 w String "") VWord32 Word32 w -> Doc ann "0x" forall a. Semigroup a => a -> a -> a <> (forall a ann. Pretty a => a -> Doc ann pretty forall a b. (a -> b) -> a -> b $ forall a. (Integral a, Show a) => a -> ShowS showHex Word32 w String "") VWord64 Word64 w -> Doc ann "0x" forall a. Semigroup a => a -> a -> a <> (forall a ann. Pretty a => a -> Doc ann pretty forall a b. (a -> b) -> a -> b $ forall a. (Integral a, Show a) => a -> ShowS showHex Word64 w String "") VText Text t -> forall a ann. Pretty a => a -> Doc ann pretty forall a b. (a -> b) -> a -> b $ String -> Text Text.pack forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show Text t VEnum VCObjectHash _ (Ident Text s) -> Doc ann "#" forall a. Semigroup a => a -> a -> a <> forall a ann. Pretty a => a -> Doc ann pretty Text s VArray [Value c m] vs -> forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann encloseSep forall ann. Doc ann lbracket forall ann. Doc ann rbracket forall ann. Doc ann comma forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map forall a ann. Pretty a => a -> Doc ann pretty [Value c m] vs VTuple [Value c m] vs -> forall ann. [Doc ann] -> Doc ann tupled forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map forall a ann. Pretty a => a -> Doc ann pretty [Value c m] vs VOne Value c m v -> Doc ann "Some" forall ann. Doc ann -> Doc ann -> Doc ann <+> forall ann. Doc ann -> Doc ann align (forall a ann. Pretty a => a -> Doc ann pretty Value c m v) Value c m VEmpty -> Doc ann "None" VFun {} -> Doc ann "<<function>>" VEpochTime EpochTime t -> forall a ann. Pretty a => a -> Doc ann pretty forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show EpochTime t forall a. Semigroup a => a -> a -> a <> String "s" VTypeRep InfernoType t -> Doc ann "@" forall a. Semigroup a => a -> a -> a <> forall a ann. Pretty a => a -> Doc ann pretty InfernoType t VCustom c c -> forall a ann. Pretty a => a -> Doc ann pretty c c newtype ImplEnvM m c a = ImplEnvM {forall (m :: * -> *) c a. ImplEnvM m c a -> ReaderT (Map ExtIdent (Value c (ImplEnvM m c))) m a unImplEnvM :: ReaderT (Map.Map ExtIdent (Value c (ImplEnvM m c))) m a} deriving (forall a. a -> ImplEnvM m c a forall a b. ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c a forall a b. ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c b forall a b. ImplEnvM m c (a -> b) -> ImplEnvM m c a -> ImplEnvM m c b forall a b c. (a -> b -> c) -> ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c c forall (f :: * -> *). Functor f -> (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f forall {m :: * -> *} {c}. Applicative m => Functor (ImplEnvM m c) forall (m :: * -> *) c a. Applicative m => a -> ImplEnvM m c a forall (m :: * -> *) c a b. Applicative m => ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c a forall (m :: * -> *) c a b. Applicative m => ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c b forall (m :: * -> *) c a b. Applicative m => ImplEnvM m c (a -> b) -> ImplEnvM m c a -> ImplEnvM m c b forall (m :: * -> *) c a b c. Applicative m => (a -> b -> c) -> ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c c <* :: forall a b. ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c a $c<* :: forall (m :: * -> *) c a b. Applicative m => ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c a *> :: forall a b. ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c b $c*> :: forall (m :: * -> *) c a b. Applicative m => ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c b liftA2 :: forall a b c. (a -> b -> c) -> ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c c $cliftA2 :: forall (m :: * -> *) c a b c. Applicative m => (a -> b -> c) -> ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c c <*> :: forall a b. ImplEnvM m c (a -> b) -> ImplEnvM m c a -> ImplEnvM m c b $c<*> :: forall (m :: * -> *) c a b. Applicative m => ImplEnvM m c (a -> b) -> ImplEnvM m c a -> ImplEnvM m c b pure :: forall a. a -> ImplEnvM m c a $cpure :: forall (m :: * -> *) c a. Applicative m => a -> ImplEnvM m c a Applicative, forall a b. a -> ImplEnvM m c b -> ImplEnvM m c a forall a b. (a -> b) -> ImplEnvM m c a -> ImplEnvM m c b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f forall (m :: * -> *) c a b. Functor m => a -> ImplEnvM m c b -> ImplEnvM m c a forall (m :: * -> *) c a b. Functor m => (a -> b) -> ImplEnvM m c a -> ImplEnvM m c b <$ :: forall a b. a -> ImplEnvM m c b -> ImplEnvM m c a $c<$ :: forall (m :: * -> *) c a b. Functor m => a -> ImplEnvM m c b -> ImplEnvM m c a fmap :: forall a b. (a -> b) -> ImplEnvM m c a -> ImplEnvM m c b $cfmap :: forall (m :: * -> *) c a b. Functor m => (a -> b) -> ImplEnvM m c a -> ImplEnvM m c b Functor, forall a. a -> ImplEnvM m c a forall a b. ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c b forall a b. ImplEnvM m c a -> (a -> ImplEnvM m c b) -> ImplEnvM m c b forall (m :: * -> *). Applicative m -> (forall a b. m a -> (a -> m b) -> m b) -> (forall a b. m a -> m b -> m b) -> (forall a. a -> m a) -> Monad m forall {m :: * -> *} {c}. Monad m => Applicative (ImplEnvM m c) forall (m :: * -> *) c a. Monad m => a -> ImplEnvM m c a forall (m :: * -> *) c a b. Monad m => ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c b forall (m :: * -> *) c a b. Monad m => ImplEnvM m c a -> (a -> ImplEnvM m c b) -> ImplEnvM m c b return :: forall a. a -> ImplEnvM m c a $creturn :: forall (m :: * -> *) c a. Monad m => a -> ImplEnvM m c a >> :: forall a b. ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c b $c>> :: forall (m :: * -> *) c a b. Monad m => ImplEnvM m c a -> ImplEnvM m c b -> ImplEnvM m c b >>= :: forall a b. ImplEnvM m c a -> (a -> ImplEnvM m c b) -> ImplEnvM m c b $c>>= :: forall (m :: * -> *) c a b. Monad m => ImplEnvM m c a -> (a -> ImplEnvM m c b) -> ImplEnvM m c b Monad, MonadReader (Map.Map ExtIdent (Value c (ImplEnvM m c))), MonadError e, forall a. (a -> ImplEnvM m c a) -> ImplEnvM m c a forall (m :: * -> *). Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m forall {m :: * -> *} {c}. MonadFix m => Monad (ImplEnvM m c) forall (m :: * -> *) c a. MonadFix m => (a -> ImplEnvM m c a) -> ImplEnvM m c a mfix :: forall a. (a -> ImplEnvM m c a) -> ImplEnvM m c a $cmfix :: forall (m :: * -> *) c a. MonadFix m => (a -> ImplEnvM m c a) -> ImplEnvM m c a MonadFix, forall a. IO a -> ImplEnvM m c a forall (m :: * -> *). Monad m -> (forall a. IO a -> m a) -> MonadIO m forall {m :: * -> *} {c}. MonadIO m => Monad (ImplEnvM m c) forall (m :: * -> *) c a. MonadIO m => IO a -> ImplEnvM m c a liftIO :: forall a. IO a -> ImplEnvM m c a $cliftIO :: forall (m :: * -> *) c a. MonadIO m => IO a -> ImplEnvM m c a MonadIO) runImplEnvM :: Map.Map ExtIdent (Value c (ImplEnvM m c)) -> ImplEnvM m c a -> m a runImplEnvM :: forall c (m :: * -> *) a. Map ExtIdent (Value c (ImplEnvM m c)) -> ImplEnvM m c a -> m a runImplEnvM Map ExtIdent (Value c (ImplEnvM m c)) env = forall a b c. (a -> b -> c) -> b -> a -> c flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a runReaderT Map ExtIdent (Value c (ImplEnvM m c)) env forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) c a. ImplEnvM m c a -> ReaderT (Map ExtIdent (Value c (ImplEnvM m c))) m a unImplEnvM newtype ImplicitCast (lbl :: Symbol) a b c = ImplicitCast (a -> b -> c)