{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UndecidableInstances #-}

module Agda.TypeChecking.Serialise.Instances.Common (SerialisedRange(..)) where

import qualified Control.Exception as E
import Control.Monad              ( (<=<), (<$!>) )
import Control.Monad.IO.Class     ( MonadIO(..) )
import Control.Monad.Except       ( MonadError(..) )
import Control.Monad.Reader       ( MonadReader(..), asks )
import Control.Monad.State.Strict ( gets, modify )

import Data.Array.IArray
import Data.Word
import qualified Data.Foldable as Fold
import Data.Hashable
import Data.Int (Int32)

import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.IntSet as IntSet
import Data.IntSet (IntSet)
import qualified Data.Set as Set
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Strict.Tuple (Pair(..))
import qualified Data.Text      as T
import qualified Data.Text.Lazy as TL
import Data.Typeable
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HMap

import Data.Void

import Agda.Syntax.Common
import Agda.Syntax.Builtin
import Agda.Syntax.Concrete.Name as C
import qualified Agda.Syntax.Concrete as C
import qualified Agda.Syntax.Abstract as A
import Agda.Syntax.Position as P
import Agda.Syntax.Literal
import Agda.Syntax.TopLevelModuleName
import Agda.Interaction.FindFile
import Agda.Interaction.Library

import Agda.TypeChecking.Serialise.Base

import Agda.Utils.BiMap (BiMap)
import qualified Agda.Utils.BiMap as BiMap
import Agda.Utils.List1 (List1)
import qualified Agda.Utils.List1 as List1
import Agda.Utils.List2 (List2(List2))
import qualified Agda.Utils.List2 as List2
import qualified Agda.Utils.Maybe.Strict as Strict
import Agda.Utils.Trie (Trie(..))
import Agda.Utils.WithDefault

import Agda.Utils.Impossible
import Agda.Utils.CallStack

instance {-# OVERLAPPING #-} EmbPrj String where
  icod_ :: String -> S Int32
icod_   = String -> S Int32
icodeString
  value :: Int32 -> R String
value Int32
i = (Array Int32 String -> Int32 -> String
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int32
i) (Array Int32 String -> String)
-> StateT St IO (Array Int32 String) -> R String
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (St -> Array Int32 String) -> StateT St IO (Array Int32 String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> Array Int32 String
stringE

instance EmbPrj TL.Text where
  icod_ :: Text -> S Int32
icod_   = (Dict -> HashTable Text Int32)
-> (Dict -> IORef FreshAndReuse) -> Text -> S Int32
forall k.
(Eq k, Hashable k) =>
(Dict -> HashTable k Int32)
-> (Dict -> IORef FreshAndReuse) -> k -> S Int32
icodeX Dict -> HashTable Text Int32
lTextD Dict -> IORef FreshAndReuse
lTextC
  value :: Int32 -> R Text
value Int32
i = (Array Int32 Text -> Int32 -> Text
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int32
i) (Array Int32 Text -> Text)
-> StateT St IO (Array Int32 Text) -> R Text
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (St -> Array Int32 Text) -> StateT St IO (Array Int32 Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> Array Int32 Text
lTextE

instance EmbPrj T.Text where
  icod_ :: Text -> S Int32
icod_   = (Dict -> HashTable Text Int32)
-> (Dict -> IORef FreshAndReuse) -> Text -> S Int32
forall k.
(Eq k, Hashable k) =>
(Dict -> HashTable k Int32)
-> (Dict -> IORef FreshAndReuse) -> k -> S Int32
icodeX Dict -> HashTable Text Int32
sTextD Dict -> IORef FreshAndReuse
sTextC
  value :: Int32 -> R Text
value Int32
i = (Array Int32 Text -> Int32 -> Text
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int32
i) (Array Int32 Text -> Text)
-> StateT St IO (Array Int32 Text) -> R Text
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (St -> Array Int32 Text) -> StateT St IO (Array Int32 Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> Array Int32 Text
sTextE

instance EmbPrj Integer where
  icod_ :: Integer -> S Int32
icod_   = Integer -> S Int32
icodeInteger
  value :: Int32 -> R Integer
value Int32
i = (Array Int32 Integer -> Int32 -> Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int32
i) (Array Int32 Integer -> Integer)
-> StateT St IO (Array Int32 Integer) -> R Integer
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (St -> Array Int32 Integer) -> StateT St IO (Array Int32 Integer)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> Array Int32 Integer
integerE

instance EmbPrj Word64 where
  icod_ :: Word64 -> S Int32
icod_ Word64
i = (Int32 -> Int32 -> Int32)
-> Arrows (Domains (Int32 -> Int32 -> Int32)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' (Int32 -> Int32 -> Int32
forall a. HasCallStack => a
undefined :: Int32 -> Int32 -> Int32) (Word64 -> Int32
int32 Word64
q) (Word64 -> Int32
int32 Word64
r)
    where (Word64
q, Word64
r) = Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
quotRem Word64
i (Word64
2 Word64 -> Integer -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
32)
          int32 :: Word64 -> Int32
          int32 :: Word64 -> Int32
int32 = Word64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

  value :: Int32 -> R Word64
value = ([Int32] -> R Word64) -> Int32 -> R Word64
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R Word64
valu where
    valu :: [Int32] -> R Word64
valu [Int32
a, Int32
b] = Word64 -> R Word64
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> R Word64) -> Word64 -> R Word64
forall a b. (a -> b) -> a -> b
$! Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
mod (Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
a) Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
mod (Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
b) Word64
n
    valu [Int32]
_      = R Word64
forall a. R a
malformed
    n :: Word64
n = Word64
2 Word64 -> Integer -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
32

instance EmbPrj Int32 where
  icod_ :: Int32 -> S Int32
icod_ Int32
i = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
i
  value :: Int32 -> R Int32
value Int32
i = Int32 -> R Int32
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
i

instance EmbPrj Int where
  icod_ :: Int -> S Int32
icod_ Int
i = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> S Int32) -> Int32 -> S Int32
forall a b. (a -> b) -> a -> b
$! Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
  value :: Int32 -> R Int
value Int32
i = Int -> R Int
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> R Int) -> Int -> R Int
forall a b. (a -> b) -> a -> b
$! Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i

instance EmbPrj Char where
  icod_ :: Char -> S Int32
icod_ Char
c = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> S Int32) -> Int32 -> S Int32
forall a b. (a -> b) -> a -> b
$! Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c
  value :: Int32 -> R Char
value Int32
i = Char -> R Char
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> R Char) -> Char -> R Char
forall a b. (a -> b) -> a -> b
$! Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger Int32
i

instance EmbPrj Double where
  icod_ :: Double -> S Int32
icod_   = Double -> S Int32
icodeDouble
  value :: Int32 -> R Double
value Int32
i = (Array Int32 Double -> Int32 -> Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int32
i) (Array Int32 Double -> Double)
-> StateT St IO (Array Int32 Double) -> R Double
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (St -> Array Int32 Double) -> StateT St IO (Array Int32 Double)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> Array Int32 Double
doubleE

instance EmbPrj Void where
  icod_ :: Void -> S Int32
icod_ = Void -> S Int32
forall a. Void -> a
absurd
  value :: Int32 -> R Void
value = ([Int32] -> R Void) -> Int32 -> R Void
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R Void
forall {p} {a}. p -> R a
valu where valu :: p -> R a
valu p
_ = R a
forall a. R a
malformed

instance EmbPrj () where
  icod_ :: () -> S Int32
icod_ () = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
0

  value :: Int32 -> R ()
value Int32
0 = () -> R ()
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  value Int32
_ = R ()
forall a. R a
malformed

instance (EmbPrj a, EmbPrj b) => EmbPrj (a, b) where
  icod_ :: (a, b) -> S Int32
icod_ (a
a, b
b) = (a -> b -> (a, b)) -> Arrows (Domains (a -> b -> (a, b))) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' (,) a
a b
b

  value :: Int32 -> R (a, b)
value = (a -> b -> (a, b)) -> Int32 -> R (CoDomain (a -> b -> (a, b)))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN (,)

instance (EmbPrj a, EmbPrj b) => EmbPrj (Pair a b) where
  icod_ :: Pair a b -> S Int32
icod_ (a
a :!: b
b) = (a -> b -> Pair a b)
-> Arrows (Domains (a -> b -> Pair a b)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' a -> b -> Pair a b
forall a b. a -> b -> Pair a b
(:!:) a
a b
b

  value :: Int32 -> R (Pair a b)
value = (a -> b -> Pair a b) -> Int32 -> R (CoDomain (a -> b -> Pair a b))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN a -> b -> Pair a b
forall a b. a -> b -> Pair a b
(:!:)

instance (EmbPrj a, EmbPrj b, EmbPrj c) => EmbPrj (a, b, c) where
  icod_ :: (a, b, c) -> S Int32
icod_ (a
a, b
b, c
c) = (a -> b -> c -> (a, b, c))
-> Arrows (Domains (a -> b -> c -> (a, b, c))) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' (,,) a
a b
b c
c

  value :: Int32 -> R (a, b, c)
value = (a -> b -> c -> (a, b, c))
-> Int32 -> R (CoDomain (a -> b -> c -> (a, b, c)))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN (,,)

instance (EmbPrj a, EmbPrj b) => EmbPrj (Either a b) where
  icod_ :: Either a b -> S Int32
icod_ (Left  a
x) = Int32
-> (a -> Either a Any)
-> Arrows (Domains (a -> Either a Any)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 a -> Either a Any
forall a b. a -> Either a b
Left a
x
  icod_ (Right b
x) = Int32
-> (b -> Either Any b)
-> Arrows (Domains (b -> Either Any b)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 b -> Either Any b
forall a b. b -> Either a b
Right b
x

  value :: Int32 -> R (Either a b)
value = ([Int32] -> R (Either a b)) -> Int32 -> R (Either a b)
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R (Either a b)
forall {a} {b}. (EmbPrj a, EmbPrj b) => [Int32] -> R (Either a b)
valu where
    valu :: [Int32] -> R (Either a b)
valu [Int32
0, Int32
x] = (a -> Either a b)
-> Arrows
     (Constant Int32 (Domains (a -> Either a b)))
     (R (CoDomain (a -> Either a b)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN a -> Either a b
forall a b. a -> Either a b
Left  Int32
x
    valu [Int32
1, Int32
x] = (b -> Either a b)
-> Arrows
     (Constant Int32 (Domains (b -> Either a b)))
     (R (CoDomain (b -> Either a b)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN b -> Either a b
forall a b. b -> Either a b
Right Int32
x
    valu [Int32]
_   = R (Either a b)
forall a. R a
malformed

instance EmbPrj a => EmbPrj (Maybe a) where
  icod_ :: Maybe a -> S Int32
icod_ Maybe a
Nothing  = Maybe Any -> Arrows (Domains (Maybe Any)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Maybe Any
forall a. Maybe a
Nothing
  icod_ (Just a
x) = (a -> Maybe a) -> Arrows (Domains (a -> Maybe a)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' a -> Maybe a
forall a. a -> Maybe a
Just a
x

  value :: Int32 -> R (Maybe a)
value = ([Int32] -> R (Maybe a)) -> Int32 -> R (Maybe a)
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R (Maybe a)
forall {a}. EmbPrj a => [Int32] -> StateT St IO (Maybe a)
valu where
    valu :: [Int32]
-> Arrows
     (Constant Int32 (Domains (Maybe a))) (R (CoDomain (Maybe a)))
valu []  = Maybe a
-> Arrows
     (Constant Int32 (Domains (Maybe a))) (R (CoDomain (Maybe a)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Maybe a
forall a. Maybe a
Nothing
    valu [Int32
x] = (a -> Maybe a)
-> Arrows
     (Constant Int32 (Domains (a -> Maybe a)))
     (R (CoDomain (a -> Maybe a)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN a -> Maybe a
forall a. a -> Maybe a
Just Int32
x
    valu [Int32]
_   = StateT St IO (Maybe a)
Arrows
  (Constant Int32 (Domains (Maybe a))) (R (CoDomain (Maybe a)))
forall a. R a
malformed

instance EmbPrj a => EmbPrj (Strict.Maybe a) where
  icod_ :: Maybe a -> S Int32
icod_ Maybe a
m = Maybe a -> S Int32
forall a. EmbPrj a => a -> S Int32
icode (Maybe a -> Maybe a
forall lazy strict. Strict lazy strict => strict -> lazy
Strict.toLazy Maybe a
m)
  value :: Int32 -> R (Maybe a)
value Int32
m = Maybe a -> Maybe a
forall lazy strict. Strict lazy strict => lazy -> strict
Strict.toStrict (Maybe a -> Maybe a) -> StateT St IO (Maybe a) -> R (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Int32 -> StateT St IO (Maybe a)
forall a. EmbPrj a => Int32 -> R a
value Int32
m

instance EmbPrj Bool where
  icod_ :: Bool -> S Int32
icod_ Bool
False = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
0
  icod_ Bool
True  = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
1

  value :: Int32 -> R Bool
value Int32
0 = Bool -> R Bool
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  value Int32
1 = Bool -> R Bool
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  value Int32
_ = R Bool
forall a. R a
malformed

instance EmbPrj FileType where
  icod_ :: FileType -> S Int32
icod_ FileType
AgdaFileType  = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
0
  icod_ FileType
MdFileType    = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
1
  icod_ FileType
RstFileType   = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
2
  icod_ FileType
TexFileType   = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
3
  icod_ FileType
OrgFileType   = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
4
  icod_ FileType
TypstFileType = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
5

  value :: Int32 -> R FileType
value = \case
    Int32
0 -> FileType -> R FileType
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
AgdaFileType
    Int32
1 -> FileType -> R FileType
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
MdFileType
    Int32
2 -> FileType -> R FileType
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
RstFileType
    Int32
3 -> FileType -> R FileType
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
TexFileType
    Int32
4 -> FileType -> R FileType
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
OrgFileType
    Int32
5 -> FileType -> R FileType
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
TypstFileType
    Int32
_ -> R FileType
forall a. R a
malformed

instance EmbPrj Cubical where
  icod_ :: Cubical -> S Int32
icod_ Cubical
CErased = Cubical -> Arrows (Domains Cubical) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN'  Cubical
CErased
  icod_ Cubical
CFull   = Int32 -> Cubical -> Arrows (Domains Cubical) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 Cubical
CFull

  value :: Int32 -> R Cubical
value = ([Int32] -> R Cubical) -> Int32 -> R Cubical
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase (([Int32] -> R Cubical) -> Int32 -> R Cubical)
-> ([Int32] -> R Cubical) -> Int32 -> R Cubical
forall a b. (a -> b) -> a -> b
$ \case
    []  -> Cubical
-> Arrows (Constant Int32 (Domains Cubical)) (R (CoDomain Cubical))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Cubical
CErased
    [Int32
0] -> Cubical
-> Arrows (Constant Int32 (Domains Cubical)) (R (CoDomain Cubical))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Cubical
CFull
    [Int32]
_   -> R Cubical
forall a. R a
malformed

instance EmbPrj Language where
  icod_ :: Language -> S Int32
icod_ Language
WithoutK    = Language -> Arrows (Domains Language) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN'  Language
WithoutK
  icod_ Language
WithK       = Int32 -> Language -> Arrows (Domains Language) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 Language
WithK
  icod_ (Cubical Cubical
a) = Int32
-> (Cubical -> Language)
-> Arrows (Domains (Cubical -> Language)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 Cubical -> Language
Cubical Cubical
a

  value :: Int32 -> R Language
value = ([Int32] -> R Language) -> Int32 -> R Language
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase (([Int32] -> R Language) -> Int32 -> R Language)
-> ([Int32] -> R Language) -> Int32 -> R Language
forall a b. (a -> b) -> a -> b
$ \case
    []     -> Language
-> Arrows
     (Constant Int32 (Domains Language)) (R (CoDomain Language))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Language
WithoutK
    [Int32
0]    -> Language
-> Arrows
     (Constant Int32 (Domains Language)) (R (CoDomain Language))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Language
WithK
    [Int32
1, Int32
a] -> (Cubical -> Language)
-> Arrows
     (Constant Int32 (Domains (Cubical -> Language)))
     (R (CoDomain (Cubical -> Language)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Cubical -> Language
Cubical Int32
a
    [Int32]
_      -> R Language
forall a. R a
malformed

instance EmbPrj a => EmbPrj (Position' a) where
  icod_ :: Position' a -> S Int32
icod_ (P.Pn a
file Int32
pos Int32
line Int32
col) = (a -> Int32 -> Int32 -> Int32 -> Position' a)
-> Arrows
     (Domains (a -> Int32 -> Int32 -> Int32 -> Position' a)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' a -> Int32 -> Int32 -> Int32 -> Position' a
forall a. a -> Int32 -> Int32 -> Int32 -> Position' a
P.Pn a
file Int32
pos Int32
line Int32
col

  value :: Int32 -> R (Position' a)
value = (a -> Int32 -> Int32 -> Int32 -> Position' a)
-> Int32
-> R (CoDomain (a -> Int32 -> Int32 -> Int32 -> Position' a))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN a -> Int32 -> Int32 -> Int32 -> Position' a
forall a. a -> Int32 -> Int32 -> Int32 -> Position' a
P.Pn

instance (EmbPrj a, Typeable b) => EmbPrj (WithDefault' a b) where
  icod_ :: WithDefault' a b -> S Int32
icod_ = \case
    WithDefault' a b
Default -> WithDefault' Any Any
-> Arrows (Domains (WithDefault' Any Any)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' WithDefault' Any Any
forall a (b :: Bool). WithDefault' a b
Default
    Value a
b -> (a -> WithDefault' a Any)
-> Arrows (Domains (a -> WithDefault' a Any)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' a -> WithDefault' a Any
forall a (b :: Bool). a -> WithDefault' a b
Value a
b

  value :: Int32 -> R (WithDefault' a b)
value = ([Int32] -> R (WithDefault' a b)) -> Int32 -> R (WithDefault' a b)
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase (([Int32] -> R (WithDefault' a b))
 -> Int32 -> R (WithDefault' a b))
-> ([Int32] -> R (WithDefault' a b))
-> Int32
-> R (WithDefault' a b)
forall a b. (a -> b) -> a -> b
$ \case
    []  -> WithDefault' a b
-> Arrows
     (Constant Int32 (Domains (WithDefault' a b)))
     (R (CoDomain (WithDefault' a b)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN WithDefault' a b
forall a (b :: Bool). WithDefault' a b
Default
    [Int32
a] -> (a -> WithDefault' a b)
-> Arrows
     (Constant Int32 (Domains (a -> WithDefault' a b)))
     (R (CoDomain (a -> WithDefault' a b)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN a -> WithDefault' a b
forall a (b :: Bool). a -> WithDefault' a b
Value Int32
a
    [Int32]
_ -> R (WithDefault' a b)
forall a. R a
malformed

instance EmbPrj TopLevelModuleName where
  icod_ :: TopLevelModuleName -> S Int32
icod_ (TopLevelModuleName Range
a ModuleNameHash
b TopLevelModuleNameParts
c) = (Range
 -> ModuleNameHash -> TopLevelModuleNameParts -> TopLevelModuleName)
-> Arrows
     (Domains
        (Range
         -> ModuleNameHash
         -> TopLevelModuleNameParts
         -> TopLevelModuleName))
     (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Range
-> ModuleNameHash -> TopLevelModuleNameParts -> TopLevelModuleName
forall range.
range
-> ModuleNameHash
-> TopLevelModuleNameParts
-> TopLevelModuleName' range
TopLevelModuleName Range
a ModuleNameHash
b TopLevelModuleNameParts
c

  value :: Int32 -> R TopLevelModuleName
value = (Range
 -> ModuleNameHash -> TopLevelModuleNameParts -> TopLevelModuleName)
-> Int32
-> R (CoDomain
        (Range
         -> ModuleNameHash
         -> TopLevelModuleNameParts
         -> TopLevelModuleName))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Range
-> ModuleNameHash -> TopLevelModuleNameParts -> TopLevelModuleName
forall range.
range
-> ModuleNameHash
-> TopLevelModuleNameParts
-> TopLevelModuleName' range
TopLevelModuleName

instance {-# OVERLAPPABLE #-} EmbPrj a => EmbPrj [a] where
  icod_ :: [a] -> S Int32
icod_ [a]
xs = Node -> S Int32
icodeNode (Node -> S Int32) -> ReaderT Dict IO Node -> S Int32
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [a] -> ReaderT Dict IO Node
go [a]
xs where
    go :: [a] -> S Node
    go :: [a] -> ReaderT Dict IO Node
go []     = Node -> ReaderT Dict IO Node
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
Empty
    go (a
a:[a]
as) = do {Int32
n <- a -> S Int32
forall a. EmbPrj a => a -> S Int32
icode a
a; Node
ns <- [a] -> ReaderT Dict IO Node
go [a]
as; Node -> ReaderT Dict IO Node
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node -> ReaderT Dict IO Node) -> Node -> ReaderT Dict IO Node
forall a b. (a -> b) -> a -> b
$! Int32 -> Node -> Node
Cons Int32
n Node
ns}

  value :: Int32 -> R [a]
value = ([Int32] -> R [a]) -> Int32 -> R [a]
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase ((Int32 -> StateT St IO a) -> [Int32] -> R [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int32 -> StateT St IO a
forall a. EmbPrj a => Int32 -> R a
value)

instance EmbPrj a => EmbPrj (List1 a) where
  icod_ :: List1 a -> S Int32
icod_ = [a] -> S Int32
forall a. EmbPrj a => a -> S Int32
icod_ ([a] -> S Int32) -> (List1 a -> [a]) -> List1 a -> S Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 a -> [a]
List1 a -> [Item (List1 a)]
forall l. IsList l => l -> [Item l]
List1.toList
  value :: Int32 -> R (List1 a)
value = R (List1 a)
-> (List1 a -> R (List1 a)) -> Maybe (List1 a) -> R (List1 a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe R (List1 a)
forall a. R a
malformed List1 a -> R (List1 a)
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (List1 a) -> R (List1 a))
-> ([a] -> Maybe (List1 a)) -> [a] -> R (List1 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (List1 a)
forall a. [a] -> Maybe (NonEmpty a)
List1.nonEmpty ([a] -> R (List1 a))
-> (Int32 -> StateT St IO [a]) -> Int32 -> R (List1 a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Int32 -> StateT St IO [a]
forall a. EmbPrj a => Int32 -> R a
value

instance EmbPrj a => EmbPrj (List2 a) where
  icod_ :: List2 a -> S Int32
icod_ = [a] -> S Int32
forall a. EmbPrj a => a -> S Int32
icod_ ([a] -> S Int32) -> (List2 a -> [a]) -> List2 a -> S Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List2 a -> [a]
List2 a -> [Item (List2 a)]
forall l. IsList l => l -> [Item l]
List2.toList
  value :: Int32 -> R (List2 a)
value = R (List2 a)
-> (List2 a -> R (List2 a)) -> Maybe (List2 a) -> R (List2 a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe R (List2 a)
forall a. R a
malformed List2 a -> R (List2 a)
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (List2 a) -> R (List2 a))
-> ([a] -> Maybe (List2 a)) -> [a] -> R (List2 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (List2 a)
forall a. [a] -> Maybe (List2 a)
List2.fromListMaybe ([a] -> R (List2 a))
-> (Int32 -> StateT St IO [a]) -> Int32 -> R (List2 a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Int32 -> StateT St IO [a]
forall a. EmbPrj a => Int32 -> R a
value

instance (EmbPrj k, EmbPrj v, EmbPrj (BiMap.Tag v)) =>
         EmbPrj (BiMap k v) where
  icod_ :: BiMap k v -> S Int32
icod_ BiMap k v
m = ([(k, v)], [(Tag v, k)]) -> S Int32
forall a. EmbPrj a => a -> S Int32
icode (BiMap k v -> ([(k, v)], [(Tag v, k)])
forall k v. BiMap k v -> ([(k, v)], [(Tag v, k)])
BiMap.toDistinctAscendingLists BiMap k v
m)
  value :: Int32 -> R (BiMap k v)
value Int32
m = ([(k, v)], [(Tag v, k)]) -> BiMap k v
forall k v. ([(k, v)], [(Tag v, k)]) -> BiMap k v
BiMap.fromDistinctAscendingLists (([(k, v)], [(Tag v, k)]) -> BiMap k v)
-> StateT St IO ([(k, v)], [(Tag v, k)]) -> R (BiMap k v)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Int32 -> StateT St IO ([(k, v)], [(Tag v, k)])
forall a. EmbPrj a => Int32 -> R a
value Int32
m


-- | Encode a list of key-value pairs as a flat list.
mapPairsIcode :: (EmbPrj k, EmbPrj v) => [(k, v)] -> S Int32
mapPairsIcode :: forall k v. (EmbPrj k, EmbPrj v) => [(k, v)] -> S Int32
mapPairsIcode [(k, v)]
xs = Node -> S Int32
icodeNode (Node -> S Int32) -> ReaderT Dict IO Node -> S Int32
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node -> [(k, v)] -> ReaderT Dict IO Node
forall {a} {a}.
(EmbPrj a, EmbPrj a) =>
Node -> [(a, a)] -> ReaderT Dict IO Node
convert Node
Empty [(k, v)]
xs where
  -- As we need to call `convert' in the tail position, the resulting list is
  -- written (and read) in reverse order, with the highest pair first in the
  -- resulting list.
  convert :: Node -> [(a, a)] -> ReaderT Dict IO Node
convert !Node
ys [] = Node -> ReaderT Dict IO Node
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
ys
  convert  Node
ys ((a
start, a
entry):[(a, a)]
xs) = do
    Int32
start <- a -> S Int32
forall a. EmbPrj a => a -> S Int32
icode a
start
    Int32
entry <- a -> S Int32
forall a. EmbPrj a => a -> S Int32
icode a
entry
    Node -> [(a, a)] -> ReaderT Dict IO Node
convert (Int32 -> Node -> Node
Cons Int32
start (Int32 -> Node -> Node
Cons Int32
entry Node
ys)) [(a, a)]
xs

mapPairsValue :: (EmbPrj k, EmbPrj v) => [Int32] -> R [(k, v)]
mapPairsValue :: forall k v. (EmbPrj k, EmbPrj v) => [Int32] -> R [(k, v)]
mapPairsValue = [(k, v)] -> [Int32] -> StateT St IO [(k, v)]
forall {a} {b}.
(EmbPrj a, EmbPrj b) =>
[(a, b)] -> [Int32] -> StateT St IO [(a, b)]
convert [] where
  convert :: [(a, b)] -> [Int32] -> StateT St IO [(a, b)]
convert [(a, b)]
ys [] = [(a, b)] -> StateT St IO [(a, b)]
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(a, b)]
ys
  convert [(a, b)]
ys (Int32
start:Int32
entry:[Int32]
xs) = do
    !a
start <- Int32 -> R a
forall a. EmbPrj a => Int32 -> R a
value Int32
start
    !b
entry <- Int32 -> R b
forall a. EmbPrj a => Int32 -> R a
value Int32
entry
    [(a, b)] -> [Int32] -> StateT St IO [(a, b)]
convert ((a
start, b
entry)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
ys) [Int32]
xs
  convert [(a, b)]
_ [Int32]
_ = StateT St IO [(a, b)]
forall a. R a
malformed

instance (Ord a, EmbPrj a, EmbPrj b) => EmbPrj (Map a b) where
  icod_ :: Map a b -> S Int32
icod_ Map a b
m = [(a, b)] -> S Int32
forall k v. (EmbPrj k, EmbPrj v) => [(k, v)] -> S Int32
mapPairsIcode (Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a b
m)
  value :: Int32 -> R (Map a b)
value = ([Int32] -> R (Map a b)) -> Int32 -> R (Map a b)
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase (([(a, b)] -> Map a b
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(a, b)] -> Map a b) -> StateT St IO [(a, b)] -> R (Map a b)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) (StateT St IO [(a, b)] -> R (Map a b))
-> ([Int32] -> StateT St IO [(a, b)]) -> [Int32] -> R (Map a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int32] -> StateT St IO [(a, b)]
forall k v. (EmbPrj k, EmbPrj v) => [Int32] -> R [(k, v)]
mapPairsValue)

instance (Ord a, EmbPrj a) => EmbPrj (Set a) where
  icod_ :: Set a -> S Int32
icod_ Set a
s = [a] -> S Int32
forall a. EmbPrj a => a -> S Int32
icode (Set a -> [a]
forall a. Set a -> [a]
Set.toAscList Set a
s)
  value :: Int32 -> R (Set a)
value Int32
s = [a] -> Set a
forall a. [a] -> Set a
Set.fromDistinctAscList ([a] -> Set a) -> StateT St IO [a] -> R (Set a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Int32 -> StateT St IO [a]
forall a. EmbPrj a => Int32 -> R a
value Int32
s

instance EmbPrj IntSet where
  icod_ :: IntSet -> S Int32
icod_ IntSet
s = [Int] -> S Int32
forall a. EmbPrj a => a -> S Int32
icode (IntSet -> [Int]
IntSet.toAscList IntSet
s)
  value :: Int32 -> R IntSet
value Int32
s = [Int] -> IntSet
IntSet.fromDistinctAscList ([Int] -> IntSet) -> StateT St IO [Int] -> R IntSet
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Int32 -> StateT St IO [Int]
forall a. EmbPrj a => Int32 -> R a
value Int32
s

instance (Ord a, EmbPrj a, EmbPrj b) => EmbPrj (Trie a b) where
  icod_ :: Trie a b -> S Int32
icod_ (Trie Maybe b
a Map a (Trie a b)
b)= (Maybe b -> Map a (Trie a b) -> Trie a b)
-> Arrows
     (Domains (Maybe b -> Map a (Trie a b) -> Trie a b)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Maybe b -> Map a (Trie a b) -> Trie a b
forall k v. Maybe v -> Map k (Trie k v) -> Trie k v
Trie Maybe b
a Map a (Trie a b)
b

  value :: Int32 -> R (Trie a b)
value = (Maybe b -> Map a (Trie a b) -> Trie a b)
-> Int32 -> R (CoDomain (Maybe b -> Map a (Trie a b) -> Trie a b))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Maybe b -> Map a (Trie a b) -> Trie a b
forall k v. Maybe v -> Map k (Trie k v) -> Trie k v
Trie

instance EmbPrj a => EmbPrj (Seq a) where
  icod_ :: Seq a -> S Int32
icod_ Seq a
s = [a] -> S Int32
forall a. EmbPrj a => a -> S Int32
icode (Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList Seq a
s)
  value :: Int32 -> R (Seq a)
value Int32
s = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> StateT St IO [a] -> R (Seq a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Int32 -> StateT St IO [a]
forall a. EmbPrj a => Int32 -> R a
value Int32
s

instance EmbPrj a => EmbPrj (P.Interval' a) where
  icod_ :: Interval' a -> S Int32
icod_ (P.Interval Position' a
p Position' a
q) = (Position' a -> Position' a -> Interval' a)
-> Arrows
     (Domains (Position' a -> Position' a -> Interval' a)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Position' a -> Position' a -> Interval' a
forall a. Position' a -> Position' a -> Interval' a
P.Interval Position' a
p Position' a
q

  value :: Int32 -> R (Interval' a)
value = (Position' a -> Position' a -> Interval' a)
-> Int32
-> R (CoDomain (Position' a -> Position' a -> Interval' a))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Position' a -> Position' a -> Interval' a
forall a. Position' a -> Position' a -> Interval' a
P.Interval

instance EmbPrj RangeFile where
  icod_ :: RangeFile -> S Int32
icod_ (RangeFile AbsolutePath
_ Maybe TopLevelModuleName
Nothing)  = S Int32
forall a. HasCallStack => a
__IMPOSSIBLE__
  icod_ (RangeFile AbsolutePath
_ (Just TopLevelModuleName
a)) = TopLevelModuleName -> S Int32
forall a. EmbPrj a => a -> S Int32
icode TopLevelModuleName
a

  value :: Int32 -> R RangeFile
value Int32
r = do
    TopLevelModuleName
m :: TopLevelModuleName
            <- Int32 -> R TopLevelModuleName
forall a. EmbPrj a => Int32 -> R a
value Int32
r
    ModuleToSource
mf      <- (St -> ModuleToSource) -> StateT St IO ModuleToSource
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> ModuleToSource
modFile
    [AbsolutePath]
incs    <- (St -> [AbsolutePath]) -> StateT St IO [AbsolutePath]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> [AbsolutePath]
includes
    (Either FindError SourceFile
r, ModuleToSource
mf) <- IO (Either FindError SourceFile, ModuleToSource)
-> StateT St IO (Either FindError SourceFile, ModuleToSource)
forall a. IO a -> StateT St IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either FindError SourceFile, ModuleToSource)
 -> StateT St IO (Either FindError SourceFile, ModuleToSource))
-> IO (Either FindError SourceFile, ModuleToSource)
-> StateT St IO (Either FindError SourceFile, ModuleToSource)
forall a b. (a -> b) -> a -> b
$ [AbsolutePath]
-> TopLevelModuleName
-> ModuleToSource
-> IO (Either FindError SourceFile, ModuleToSource)
findFile'' [AbsolutePath]
incs TopLevelModuleName
m ModuleToSource
mf
    (St -> St) -> R ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((St -> St) -> R ()) -> (St -> St) -> R ()
forall a b. (a -> b) -> a -> b
$ \St
s -> St
s { modFile = mf }
    case Either FindError SourceFile
r of
      Left FindError
err -> IO RangeFile -> R RangeFile
forall a. IO a -> StateT St IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RangeFile -> R RangeFile) -> IO RangeFile -> R RangeFile
forall a b. (a -> b) -> a -> b
$ ErrorCall -> IO RangeFile
forall e a. Exception e => e -> IO a
E.throwIO (ErrorCall -> IO RangeFile) -> ErrorCall -> IO RangeFile
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
E.ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"file not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FindError -> String
forall a. Show a => a -> String
show FindError
err
      Right SourceFile
f  -> let !sfp :: AbsolutePath
sfp = SourceFile -> AbsolutePath
srcFilePath SourceFile
f in RangeFile -> R RangeFile
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RangeFile -> R RangeFile) -> RangeFile -> R RangeFile
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> Maybe TopLevelModuleName -> RangeFile
RangeFile AbsolutePath
sfp (TopLevelModuleName -> Maybe TopLevelModuleName
forall a. a -> Maybe a
Just TopLevelModuleName
m)

-- | Ranges are always deserialised as 'noRange'.

instance EmbPrj Range where
  icod_ :: Range -> S Int32
icod_ Range
_ = () -> Arrows (Domains ()) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' ()
  value :: Int32 -> R Range
value Int32
_ = Range -> R Range
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Range
forall a. Range' a
noRange

-- | Ranges that should be serialised properly.

newtype SerialisedRange = SerialisedRange { SerialisedRange -> Range
underlyingRange :: Range }

instance EmbPrj SerialisedRange where
  icod_ :: SerialisedRange -> S Int32
icod_ (SerialisedRange Range
r) = (SrcFile -> [IntervalWithoutFile] -> Range)
-> Arrows
     (Domains (SrcFile -> [IntervalWithoutFile] -> Range)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' SrcFile -> [IntervalWithoutFile] -> Range
forall a. a -> [IntervalWithoutFile] -> Range' a
P.intervalsToRange (Range -> SrcFile
P.rangeFile Range
r) (Range -> [IntervalWithoutFile]
forall a. Range' a -> [IntervalWithoutFile]
P.rangeIntervals Range
r)

  value :: Int32 -> R SerialisedRange
value Int32
i = Range -> SerialisedRange
SerialisedRange (Range -> SerialisedRange) -> R Range -> R SerialisedRange
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (SrcFile -> [IntervalWithoutFile] -> Range)
-> Int32
-> R (CoDomain (SrcFile -> [IntervalWithoutFile] -> Range))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN SrcFile -> [IntervalWithoutFile] -> Range
forall a. a -> [IntervalWithoutFile] -> Range' a
P.intervalsToRange Int32
i

instance EmbPrj C.Name where
  icod_ :: Name -> S Int32
icod_ (C.NoName Range
a NameId
b)     = Int32
-> (Range -> NameId -> Name)
-> Arrows (Domains (Range -> NameId -> Name)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 Range -> NameId -> Name
C.NoName Range
a NameId
b
  icod_ (C.Name Range
r NameInScope
nis NameParts
xs)  = Int32
-> (Range -> NameInScope -> NameParts -> Name)
-> Arrows
     (Domains (Range -> NameInScope -> NameParts -> Name)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 Range -> NameInScope -> NameParts -> Name
C.Name Range
r NameInScope
nis NameParts
xs

  value :: Int32 -> R Name
value = ([Int32] -> R Name) -> Int32 -> R Name
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R Name
valu where
    valu :: [Int32] -> R Name
valu [Int32
0, Int32
a, Int32
b]       = (Range -> NameId -> Name)
-> Arrows
     (Constant Int32 (Domains (Range -> NameId -> Name)))
     (R (CoDomain (Range -> NameId -> Name)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> NameId -> Name
C.NoName Int32
a Int32
b
    valu [Int32
1, Int32
r, Int32
nis, Int32
xs] = (Range -> NameInScope -> NameParts -> Name)
-> Arrows
     (Constant
        Int32 (Domains (Range -> NameInScope -> NameParts -> Name)))
     (R (CoDomain (Range -> NameInScope -> NameParts -> Name)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> NameInScope -> NameParts -> Name
C.Name   Int32
r Int32
nis Int32
xs
    valu [Int32]
_               = R Name
forall a. R a
malformed

instance EmbPrj NamePart where
  icod_ :: NamePart -> S Int32
icod_ NamePart
Hole   = NamePart -> Arrows (Domains NamePart) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' NamePart
Hole
  icod_ (Id String
a) = (String -> NamePart)
-> Arrows (Domains (String -> NamePart)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' String -> NamePart
Id String
a

  value :: Int32 -> R NamePart
value = ([Int32] -> R NamePart) -> Int32 -> R NamePart
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R NamePart
valu where
    valu :: [Int32]
-> Arrows
     (Constant Int32 (Domains NamePart)) (R (CoDomain NamePart))
valu []  = NamePart
-> Arrows
     (Constant Int32 (Domains NamePart)) (R (CoDomain NamePart))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN NamePart
Hole
    valu [Int32
a] = (String -> NamePart)
-> Arrows
     (Constant Int32 (Domains (String -> NamePart)))
     (R (CoDomain (String -> NamePart)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN String -> NamePart
Id Int32
a
    valu [Int32]
_   = R NamePart
Arrows (Constant Int32 (Domains NamePart)) (R (CoDomain NamePart))
forall a. R a
malformed

instance EmbPrj NameInScope where
  icod_ :: NameInScope -> S Int32
icod_ NameInScope
InScope    = NameInScope -> Arrows (Domains NameInScope) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' NameInScope
InScope
  icod_ NameInScope
NotInScope = Int32 -> NameInScope -> Arrows (Domains NameInScope) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 NameInScope
NotInScope

  value :: Int32 -> R NameInScope
value = ([Int32] -> R NameInScope) -> Int32 -> R NameInScope
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R NameInScope
forall {a}. (Eq a, Num a) => [a] -> R NameInScope
valu where
    valu :: [a]
-> Arrows
     (Constant Int32 (Domains NameInScope)) (R (CoDomain NameInScope))
valu []  = NameInScope
-> Arrows
     (Constant Int32 (Domains NameInScope)) (R (CoDomain NameInScope))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN NameInScope
InScope
    valu [a
0] = NameInScope
-> Arrows
     (Constant Int32 (Domains NameInScope)) (R (CoDomain NameInScope))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN NameInScope
NotInScope
    valu [a]
_   = R NameInScope
Arrows
  (Constant Int32 (Domains NameInScope)) (R (CoDomain NameInScope))
forall a. R a
malformed

instance EmbPrj C.QName where
  icod_ :: QName -> S Int32
icod_ (Qual    Name
a QName
b) = (Name -> QName -> QName)
-> Arrows (Domains (Name -> QName -> QName)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Name -> QName -> QName
Qual Name
a QName
b
  icod_ (C.QName Name
a  ) = (Name -> QName) -> Arrows (Domains (Name -> QName)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Name -> QName
C.QName Name
a

  value :: Int32 -> R QName
value = ([Int32] -> R QName) -> Int32 -> R QName
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R QName
valu where
    valu :: [Int32] -> R QName
valu [Int32
a, Int32
b] = (Name -> QName -> QName)
-> Arrows
     (Constant Int32 (Domains (Name -> QName -> QName)))
     (R (CoDomain (Name -> QName -> QName)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Name -> QName -> QName
Qual    Int32
a Int32
b
    valu [Int32
a]    = (Name -> QName)
-> Arrows
     (Constant Int32 (Domains (Name -> QName)))
     (R (CoDomain (Name -> QName)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Name -> QName
C.QName Int32
a
    valu [Int32]
_      = R QName
forall a. R a
malformed

instance (EmbPrj a, EmbPrj b) => EmbPrj (ImportedName' a b) where
  icod_ :: ImportedName' a b -> S Int32
icod_ (ImportedModule b
a) = Int32
-> (b -> ImportedName' Any b)
-> Arrows (Domains (b -> ImportedName' Any b)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 b -> ImportedName' Any b
forall n m. m -> ImportedName' n m
ImportedModule b
a
  icod_ (ImportedName a
a)   = Int32
-> (a -> ImportedName' a Any)
-> Arrows (Domains (a -> ImportedName' a Any)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
2 a -> ImportedName' a Any
forall n m. n -> ImportedName' n m
ImportedName a
a

  value :: Int32 -> R (ImportedName' a b)
value = ([Int32] -> R (ImportedName' a b))
-> Int32 -> R (ImportedName' a b)
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R (ImportedName' a b)
forall {m} {n}.
(EmbPrj m, EmbPrj n) =>
[Int32] -> R (ImportedName' n m)
valu where
    valu :: [Int32] -> R (ImportedName' n m)
valu [Int32
1, Int32
a] = (m -> ImportedName' n m)
-> Arrows
     (Constant Int32 (Domains (m -> ImportedName' n m)))
     (R (CoDomain (m -> ImportedName' n m)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN m -> ImportedName' n m
forall n m. m -> ImportedName' n m
ImportedModule Int32
a
    valu [Int32
2, Int32
a] = (n -> ImportedName' n m)
-> Arrows
     (Constant Int32 (Domains (n -> ImportedName' n m)))
     (R (CoDomain (n -> ImportedName' n m)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN n -> ImportedName' n m
forall n m. n -> ImportedName' n m
ImportedName Int32
a
    valu [Int32]
_ = R (ImportedName' n m)
forall a. R a
malformed

instance EmbPrj Associativity where
  icod_ :: Associativity -> S Int32
icod_ Associativity
LeftAssoc  = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
0
  icod_ Associativity
RightAssoc = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
1
  icod_ Associativity
NonAssoc   = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
2

  value :: Int32 -> R Associativity
value = \case
    Int32
0 -> Associativity -> R Associativity
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Associativity
LeftAssoc
    Int32
1 -> Associativity -> R Associativity
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Associativity
RightAssoc
    Int32
2 -> Associativity -> R Associativity
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Associativity
NonAssoc
    Int32
_ -> R Associativity
forall a. R a
malformed

instance EmbPrj FixityLevel where
  icod_ :: FixityLevel -> S Int32
icod_ FixityLevel
Unrelated   = FixityLevel -> Arrows (Domains FixityLevel) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' FixityLevel
Unrelated
  icod_ (Related Double
a) = (Double -> FixityLevel)
-> Arrows (Domains (Double -> FixityLevel)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Double -> FixityLevel
Related Double
a

  value :: Int32 -> R FixityLevel
value = ([Int32] -> R FixityLevel) -> Int32 -> R FixityLevel
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R FixityLevel
valu where
    valu :: [Int32]
-> Arrows
     (Constant Int32 (Domains FixityLevel)) (R (CoDomain FixityLevel))
valu []  = FixityLevel
-> Arrows
     (Constant Int32 (Domains FixityLevel)) (R (CoDomain FixityLevel))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN FixityLevel
Unrelated
    valu [Int32
a] = (Double -> FixityLevel)
-> Arrows
     (Constant Int32 (Domains (Double -> FixityLevel)))
     (R (CoDomain (Double -> FixityLevel)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Double -> FixityLevel
Related Int32
a
    valu [Int32]
_   = R FixityLevel
Arrows
  (Constant Int32 (Domains FixityLevel)) (R (CoDomain FixityLevel))
forall a. R a
malformed

instance EmbPrj Fixity where
  icod_ :: Fixity -> S Int32
icod_ (Fixity Range
a FixityLevel
b Associativity
c) = (Range -> FixityLevel -> Associativity -> Fixity)
-> Arrows
     (Domains (Range -> FixityLevel -> Associativity -> Fixity))
     (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Range -> FixityLevel -> Associativity -> Fixity
Fixity Range
a FixityLevel
b Associativity
c

  value :: Int32 -> R Fixity
value = (Range -> FixityLevel -> Associativity -> Fixity)
-> Int32
-> R (CoDomain (Range -> FixityLevel -> Associativity -> Fixity))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Range -> FixityLevel -> Associativity -> Fixity
Fixity

instance EmbPrj Fixity' where
  icod_ :: Fixity' -> S Int32
icod_ (Fixity' Fixity
a Notation
b Range
r) = (Fixity -> Notation -> Fixity')
-> Arrows (Domains (Fixity -> Notation -> Fixity')) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' (\ Fixity
a Notation
b -> Fixity -> Notation -> Range -> Fixity'
Fixity' Fixity
a Notation
b Range
r) Fixity
a Notation
b  -- discard theNameRange

  value :: Int32 -> R Fixity'
value = (Fixity -> Notation -> Fixity')
-> Int32 -> R (CoDomain (Fixity -> Notation -> Fixity'))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN (\ Fixity
f Notation
n -> Fixity -> Notation -> Range -> Fixity'
Fixity' Fixity
f Notation
n Range
forall a. Range' a
noRange)

instance EmbPrj BoundVariablePosition where
  icod_ :: BoundVariablePosition -> S Int32
icod_ (BoundVariablePosition Int
a Int
b) = (Int -> Int -> BoundVariablePosition)
-> Arrows (Domains (Int -> Int -> BoundVariablePosition)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Int -> Int -> BoundVariablePosition
BoundVariablePosition Int
a Int
b

  value :: Int32 -> R BoundVariablePosition
value = (Int -> Int -> BoundVariablePosition)
-> Int32 -> R (CoDomain (Int -> Int -> BoundVariablePosition))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Int -> Int -> BoundVariablePosition
BoundVariablePosition

instance EmbPrj NotationPart where
  icod_ :: NotationPart -> S Int32
icod_ (VarPart Range
a Ranged BoundVariablePosition
b)  = Int32
-> (Range -> Ranged BoundVariablePosition -> NotationPart)
-> Arrows
     (Domains (Range -> Ranged BoundVariablePosition -> NotationPart))
     (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 Range -> Ranged BoundVariablePosition -> NotationPart
VarPart Range
a Ranged BoundVariablePosition
b
  icod_ (HolePart Range
a NamedArg (Ranged Int)
b) = Int32
-> (Range -> NamedArg (Ranged Int) -> NotationPart)
-> Arrows
     (Domains (Range -> NamedArg (Ranged Int) -> NotationPart))
     (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 Range -> NamedArg (Ranged Int) -> NotationPart
HolePart Range
a NamedArg (Ranged Int)
b
  icod_ (WildPart Ranged BoundVariablePosition
a)   = Int32
-> (Ranged BoundVariablePosition -> NotationPart)
-> Arrows
     (Domains (Ranged BoundVariablePosition -> NotationPart)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
2 Ranged BoundVariablePosition -> NotationPart
WildPart Ranged BoundVariablePosition
a
  icod_ (IdPart RString
a)     = (RString -> NotationPart)
-> Arrows (Domains (RString -> NotationPart)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' RString -> NotationPart
IdPart RString
a

  value :: Int32 -> R NotationPart
value = ([Int32] -> R NotationPart) -> Int32 -> R NotationPart
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R NotationPart
valu where
    valu :: [Int32] -> R NotationPart
valu [Int32
0, Int32
a, Int32
b] = (Range -> Ranged BoundVariablePosition -> NotationPart)
-> Arrows
     (Constant
        Int32
        (Domains (Range -> Ranged BoundVariablePosition -> NotationPart)))
     (R (CoDomain
           (Range -> Ranged BoundVariablePosition -> NotationPart)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> Ranged BoundVariablePosition -> NotationPart
VarPart Int32
a Int32
b
    valu [Int32
1, Int32
a, Int32
b] = (Range -> NamedArg (Ranged Int) -> NotationPart)
-> Arrows
     (Constant
        Int32 (Domains (Range -> NamedArg (Ranged Int) -> NotationPart)))
     (R (CoDomain (Range -> NamedArg (Ranged Int) -> NotationPart)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> NamedArg (Ranged Int) -> NotationPart
HolePart Int32
a Int32
b
    valu [Int32
2, Int32
a]    = (Ranged BoundVariablePosition -> NotationPart)
-> Arrows
     (Constant
        Int32 (Domains (Ranged BoundVariablePosition -> NotationPart)))
     (R (CoDomain (Ranged BoundVariablePosition -> NotationPart)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Ranged BoundVariablePosition -> NotationPart
WildPart Int32
a
    valu [Int32
a]       = (RString -> NotationPart)
-> Arrows
     (Constant Int32 (Domains (RString -> NotationPart)))
     (R (CoDomain (RString -> NotationPart)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN RString -> NotationPart
IdPart Int32
a
    valu [Int32]
_         = R NotationPart
forall a. R a
malformed

instance EmbPrj MetaId where
  icod_ :: MetaId -> S Int32
icod_ (MetaId Word64
a ModuleNameHash
b) = (Word64, ModuleNameHash) -> S Int32
forall a. EmbPrj a => a -> S Int32
icode (Word64
a, ModuleNameHash
b)

  value :: Int32 -> R MetaId
value Int32
m = (Word64 -> ModuleNameHash -> MetaId)
-> (Word64, ModuleNameHash) -> MetaId
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word64 -> ModuleNameHash -> MetaId
MetaId ((Word64, ModuleNameHash) -> MetaId)
-> StateT St IO (Word64, ModuleNameHash) -> R MetaId
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Int32 -> StateT St IO (Word64, ModuleNameHash)
forall a. EmbPrj a => Int32 -> R a
value Int32
m

instance EmbPrj A.QName where
  icod_ :: QName -> S Int32
icod_ n :: QName
n@(A.QName ModuleName
a Name
b) = (Dict -> HashTable QNameId Int32)
-> (Dict -> IORef FreshAndReuse) -> QNameId -> S Int32 -> S Int32
forall a.
(Ord a, Hashable a) =>
(Dict -> HashTable a Int32)
-> (Dict -> IORef FreshAndReuse) -> a -> S Int32 -> S Int32
icodeMemo Dict -> HashTable QNameId Int32
qnameD Dict -> IORef FreshAndReuse
qnameC (QName -> QNameId
qnameId QName
n) (S Int32 -> S Int32) -> S Int32 -> S Int32
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Name -> QName)
-> Arrows (Domains (ModuleName -> Name -> QName)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' ModuleName -> Name -> QName
A.QName ModuleName
a Name
b

  value :: Int32 -> R QName
value = (ModuleName -> Name -> QName)
-> Int32 -> R (CoDomain (ModuleName -> Name -> QName))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN ModuleName -> Name -> QName
A.QName

instance EmbPrj A.AmbiguousQName where
  icod_ :: AmbiguousQName -> S Int32
icod_ (A.AmbQ List1 QName
a) = List1 QName -> S Int32
forall a. EmbPrj a => a -> S Int32
icode List1 QName
a
  value :: Int32 -> R AmbiguousQName
value Int32
n          = List1 QName -> AmbiguousQName
A.AmbQ (List1 QName -> AmbiguousQName)
-> StateT St IO (List1 QName) -> R AmbiguousQName
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Int32 -> StateT St IO (List1 QName)
forall a. EmbPrj a => Int32 -> R a
value Int32
n

instance EmbPrj A.ModuleName where
  icod_ :: ModuleName -> S Int32
icod_ (A.MName [Name]
a) = [Name] -> S Int32
forall a. EmbPrj a => a -> S Int32
icode [Name]
a
  value :: Int32 -> R ModuleName
value Int32
n           = [Name] -> ModuleName
A.MName ([Name] -> ModuleName) -> StateT St IO [Name] -> R ModuleName
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Int32 -> StateT St IO [Name]
forall a. EmbPrj a => Int32 -> R a
value Int32
n

instance EmbPrj A.Name where
  icod_ :: Name -> S Int32
icod_ (A.Name NameId
a Name
b Name
c Range
d Fixity'
e Bool
f) = (Dict -> HashTable NameId Int32)
-> (Dict -> IORef FreshAndReuse) -> NameId -> S Int32 -> S Int32
forall a.
(Ord a, Hashable a) =>
(Dict -> HashTable a Int32)
-> (Dict -> IORef FreshAndReuse) -> a -> S Int32 -> S Int32
icodeMemo Dict -> HashTable NameId Int32
nameD Dict -> IORef FreshAndReuse
nameC NameId
a (S Int32 -> S Int32) -> S Int32 -> S Int32
forall a b. (a -> b) -> a -> b
$
    (NameId
 -> Name -> Name -> SerialisedRange -> Fixity' -> Bool -> Name)
-> Arrows
     (Domains
        (NameId
         -> Name -> Name -> SerialisedRange -> Fixity' -> Bool -> Name))
     (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' (\ NameId
a Name
b Name
c -> NameId -> Name -> Name -> Range -> Fixity' -> Bool -> Name
A.Name NameId
a Name
b Name
c (Range -> Fixity' -> Bool -> Name)
-> (SerialisedRange -> Range)
-> SerialisedRange
-> Fixity'
-> Bool
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedRange -> Range
underlyingRange) NameId
a Name
b Name
c (Range -> SerialisedRange
SerialisedRange Range
d) Fixity'
e Bool
f

  value :: Int32 -> R Name
value = (NameId
 -> Name -> Name -> SerialisedRange -> Fixity' -> Bool -> Name)
-> Int32
-> R (CoDomain
        (NameId
         -> Name -> Name -> SerialisedRange -> Fixity' -> Bool -> Name))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN (\NameId
a Name
b Name
c SerialisedRange
d -> NameId -> Name -> Name -> Range -> Fixity' -> Bool -> Name
A.Name NameId
a Name
b Name
c (SerialisedRange -> Range
underlyingRange SerialisedRange
d))

instance EmbPrj a => EmbPrj (C.FieldAssignment' a) where
  icod_ :: FieldAssignment' a -> S Int32
icod_ (C.FieldAssignment Name
a a
b) = (Name -> a -> FieldAssignment' a)
-> Arrows (Domains (Name -> a -> FieldAssignment' a)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Name -> a -> FieldAssignment' a
forall a. Name -> a -> FieldAssignment' a
C.FieldAssignment Name
a a
b

  value :: Int32 -> R (FieldAssignment' a)
value = (Name -> a -> FieldAssignment' a)
-> Int32 -> R (CoDomain (Name -> a -> FieldAssignment' a))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Name -> a -> FieldAssignment' a
forall a. Name -> a -> FieldAssignment' a
C.FieldAssignment

instance (EmbPrj s, EmbPrj t) => EmbPrj (Named s t) where
  icod_ :: Named s t -> S Int32
icod_ (Named Maybe s
a t
b) = (Maybe s -> t -> Named s t)
-> Arrows (Domains (Maybe s -> t -> Named s t)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Maybe s -> t -> Named s t
forall name a. Maybe name -> a -> Named name a
Named Maybe s
a t
b

  value :: Int32 -> R (Named s t)
value = (Maybe s -> t -> Named s t)
-> Int32 -> R (CoDomain (Maybe s -> t -> Named s t))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Maybe s -> t -> Named s t
forall name a. Maybe name -> a -> Named name a
Named

instance EmbPrj a => EmbPrj (Ranged a) where
  icod_ :: Ranged a -> S Int32
icod_ (Ranged Range
r a
x) = (Range -> a -> Ranged a)
-> Arrows (Domains (Range -> a -> Ranged a)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Range -> a -> Ranged a
forall a. Range -> a -> Ranged a
Ranged Range
r a
x

  value :: Int32 -> R (Ranged a)
value = (Range -> a -> Ranged a)
-> Int32 -> R (CoDomain (Range -> a -> Ranged a))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Range -> a -> Ranged a
forall a. Range -> a -> Ranged a
Ranged

instance EmbPrj ArgInfo where
  icod_ :: ArgInfo -> S Int32
icod_ (ArgInfo Hiding
h Modality
r Origin
o FreeVariables
fv Annotation
ann) = (Hiding
 -> Modality -> Origin -> FreeVariables -> Annotation -> ArgInfo)
-> Arrows
     (Domains
        (Hiding
         -> Modality -> Origin -> FreeVariables -> Annotation -> ArgInfo))
     (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Hiding
-> Modality -> Origin -> FreeVariables -> Annotation -> ArgInfo
ArgInfo Hiding
h Modality
r Origin
o FreeVariables
fv Annotation
ann

  value :: Int32 -> R ArgInfo
value = (Hiding
 -> Modality -> Origin -> FreeVariables -> Annotation -> ArgInfo)
-> Int32
-> R (CoDomain
        (Hiding
         -> Modality -> Origin -> FreeVariables -> Annotation -> ArgInfo))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Hiding
-> Modality -> Origin -> FreeVariables -> Annotation -> ArgInfo
ArgInfo

instance EmbPrj ModuleNameHash where
  icod_ :: ModuleNameHash -> S Int32
icod_ (ModuleNameHash Word64
a) = (Word64 -> ModuleNameHash)
-> Arrows (Domains (Word64 -> ModuleNameHash)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Word64 -> ModuleNameHash
ModuleNameHash Word64
a

  value :: Int32 -> R ModuleNameHash
value = (Word64 -> ModuleNameHash)
-> Int32 -> R (CoDomain (Word64 -> ModuleNameHash))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Word64 -> ModuleNameHash
ModuleNameHash

instance EmbPrj NameId where
  icod_ :: NameId -> S Int32
icod_ (NameId Word64
a ModuleNameHash
b) = (Word64 -> ModuleNameHash -> NameId)
-> Arrows (Domains (Word64 -> ModuleNameHash -> NameId)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Word64 -> ModuleNameHash -> NameId
NameId Word64
a ModuleNameHash
b

  value :: Int32 -> R NameId
value = (Word64 -> ModuleNameHash -> NameId)
-> Int32 -> R (CoDomain (Word64 -> ModuleNameHash -> NameId))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Word64 -> ModuleNameHash -> NameId
NameId

instance EmbPrj OpaqueId where
  icod_ :: OpaqueId -> S Int32
icod_ (OpaqueId Word64
a ModuleNameHash
b) = (Word64 -> ModuleNameHash -> OpaqueId)
-> Arrows
     (Domains (Word64 -> ModuleNameHash -> OpaqueId)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Word64 -> ModuleNameHash -> OpaqueId
OpaqueId Word64
a ModuleNameHash
b

  value :: Int32 -> R OpaqueId
value = (Word64 -> ModuleNameHash -> OpaqueId)
-> Int32 -> R (CoDomain (Word64 -> ModuleNameHash -> OpaqueId))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Word64 -> ModuleNameHash -> OpaqueId
OpaqueId

instance (Eq k, Hashable k, EmbPrj k, EmbPrj v) => EmbPrj (HashMap k v) where
  icod_ :: HashMap k v -> S Int32
icod_ HashMap k v
m = [(k, v)] -> S Int32
forall k v. (EmbPrj k, EmbPrj v) => [(k, v)] -> S Int32
mapPairsIcode (HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList HashMap k v
m)
  value :: Int32 -> R (HashMap k v)
value = ([Int32] -> R (HashMap k v)) -> Int32 -> R (HashMap k v)
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase (([(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList ([(k, v)] -> HashMap k v)
-> StateT St IO [(k, v)] -> R (HashMap k v)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) (StateT St IO [(k, v)] -> R (HashMap k v))
-> ([Int32] -> StateT St IO [(k, v)]) -> [Int32] -> R (HashMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int32] -> StateT St IO [(k, v)]
forall k v. (EmbPrj k, EmbPrj v) => [Int32] -> R [(k, v)]
mapPairsValue)

instance EmbPrj a => EmbPrj (WithHiding a) where
  icod_ :: WithHiding a -> S Int32
icod_ (WithHiding Hiding
a a
b) = (Hiding -> a -> WithHiding a)
-> Arrows (Domains (Hiding -> a -> WithHiding a)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Hiding -> a -> WithHiding a
forall a. Hiding -> a -> WithHiding a
WithHiding Hiding
a a
b

  value :: Int32 -> R (WithHiding a)
value = (Hiding -> a -> WithHiding a)
-> Int32 -> R (CoDomain (Hiding -> a -> WithHiding a))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Hiding -> a -> WithHiding a
forall a. Hiding -> a -> WithHiding a
WithHiding

instance EmbPrj a => EmbPrj (Arg a) where
  icod_ :: Arg a -> S Int32
icod_ (Arg ArgInfo
i a
e) = (ArgInfo -> a -> Arg a)
-> Arrows (Domains (ArgInfo -> a -> Arg a)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' ArgInfo -> a -> Arg a
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
i a
e

  value :: Int32 -> R (Arg a)
value = (ArgInfo -> a -> Arg a)
-> Int32 -> R (CoDomain (ArgInfo -> a -> Arg a))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN ArgInfo -> a -> Arg a
forall e. ArgInfo -> e -> Arg e
Arg

instance EmbPrj a => EmbPrj (HasEta' a) where
  icod_ :: HasEta' a -> S Int32
icod_ HasEta' a
YesEta    = HasEta' Any -> Arrows (Domains (HasEta' Any)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' HasEta' Any
forall a. HasEta' a
YesEta
  icod_ (NoEta a
a) = (a -> HasEta' a) -> Arrows (Domains (a -> HasEta' a)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' a -> HasEta' a
forall a. a -> HasEta' a
NoEta a
a

  value :: Int32 -> R (HasEta' a)
value = ([Int32] -> R (HasEta' a)) -> Int32 -> R (HasEta' a)
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R (HasEta' a)
forall {a}. EmbPrj a => [Int32] -> StateT St IO (HasEta' a)
valu where
    valu :: [Int32]
-> Arrows
     (Constant Int32 (Domains (HasEta' a))) (R (CoDomain (HasEta' a)))
valu []  = HasEta' a
-> Arrows
     (Constant Int32 (Domains (HasEta' a))) (R (CoDomain (HasEta' a)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN HasEta' a
forall a. HasEta' a
YesEta
    valu [Int32
a] = (a -> HasEta' a)
-> Arrows
     (Constant Int32 (Domains (a -> HasEta' a)))
     (R (CoDomain (a -> HasEta' a)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN a -> HasEta' a
forall a. a -> HasEta' a
NoEta Int32
a
    valu [Int32]
_   = StateT St IO (HasEta' a)
Arrows
  (Constant Int32 (Domains (HasEta' a))) (R (CoDomain (HasEta' a)))
forall a. R a
malformed

instance EmbPrj PatternOrCopattern

instance EmbPrj Induction where
  icod_ :: Induction -> S Int32
icod_ Induction
Inductive   = Induction -> Arrows (Domains Induction) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Induction
Inductive
  icod_ Induction
CoInductive = Int32 -> Induction -> Arrows (Domains Induction) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 Induction
CoInductive

  value :: Int32 -> R Induction
value = ([Int32] -> R Induction) -> Int32 -> R Induction
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R Induction
forall {a}. (Eq a, Num a) => [a] -> R Induction
valu where
    valu :: [a]
-> Arrows
     (Constant Int32 (Domains Induction)) (R (CoDomain Induction))
valu []  = Induction
-> Arrows
     (Constant Int32 (Domains Induction)) (R (CoDomain Induction))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Induction
Inductive
    valu [a
1] = Induction
-> Arrows
     (Constant Int32 (Domains Induction)) (R (CoDomain Induction))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Induction
CoInductive
    valu [a]
_   = R Induction
Arrows
  (Constant Int32 (Domains Induction)) (R (CoDomain Induction))
forall a. R a
malformed

instance EmbPrj Hiding where
  icod_ :: Hiding -> S Int32
icod_ Hiding
Hidden                = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0
  icod_ Hiding
NotHidden             = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
1
  icod_ (Instance Overlappable
NoOverlap)  = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
2
  icod_ (Instance Overlappable
YesOverlap) = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
3

  value :: Int32 -> R Hiding
value Int32
0 = Hiding -> R Hiding
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Hiding
Hidden
  value Int32
1 = Hiding -> R Hiding
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Hiding
NotHidden
  value Int32
2 = Hiding -> R Hiding
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Overlappable -> Hiding
Instance Overlappable
NoOverlap)
  value Int32
3 = Hiding -> R Hiding
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Overlappable -> Hiding
Instance Overlappable
YesOverlap)
  value Int32
_ = R Hiding
forall a. R a
malformed

instance EmbPrj Q0Origin where
  icod_ :: Q0Origin -> S Int32
icod_ = \case
    Q0Origin
Q0Inferred -> Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0
    Q0 Range
_       -> Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
1
    Q0Erased Range
_ -> Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
2

  value :: Int32 -> R Q0Origin
value = \case
    Int32
0 -> Q0Origin -> R Q0Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Q0Origin -> R Q0Origin) -> Q0Origin -> R Q0Origin
forall a b. (a -> b) -> a -> b
$ Q0Origin
Q0Inferred
    Int32
1 -> Q0Origin -> R Q0Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Q0Origin -> R Q0Origin) -> Q0Origin -> R Q0Origin
forall a b. (a -> b) -> a -> b
$ Range -> Q0Origin
Q0       Range
forall a. Range' a
noRange
    Int32
2 -> Q0Origin -> R Q0Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Q0Origin -> R Q0Origin) -> Q0Origin -> R Q0Origin
forall a b. (a -> b) -> a -> b
$ Range -> Q0Origin
Q0Erased Range
forall a. Range' a
noRange
    Int32
_ -> R Q0Origin
forall a. R a
malformed

instance EmbPrj Q1Origin where
  icod_ :: Q1Origin -> S Int32
icod_ = \case
    Q1Origin
Q1Inferred -> Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0
    Q1 Range
_       -> Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
1
    Q1Linear Range
_ -> Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
2

  value :: Int32 -> R Q1Origin
value = \case
    Int32
0 -> Q1Origin -> R Q1Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Q1Origin -> R Q1Origin) -> Q1Origin -> R Q1Origin
forall a b. (a -> b) -> a -> b
$ Q1Origin
Q1Inferred
    Int32
1 -> Q1Origin -> R Q1Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Q1Origin -> R Q1Origin) -> Q1Origin -> R Q1Origin
forall a b. (a -> b) -> a -> b
$ Range -> Q1Origin
Q1       Range
forall a. Range' a
noRange
    Int32
2 -> Q1Origin -> R Q1Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Q1Origin -> R Q1Origin) -> Q1Origin -> R Q1Origin
forall a b. (a -> b) -> a -> b
$ Range -> Q1Origin
Q1Linear Range
forall a. Range' a
noRange
    Int32
_ -> R Q1Origin
forall a. R a
malformed

instance EmbPrj QωOrigin where
  icod_ :: QωOrigin -> S Int32
icod_ = \case
    QωOrigin
QωInferred -> Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0
    Qω Range
_       -> Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
1
    QωPlenty Range
_ -> Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
2

  value :: Int32 -> R QωOrigin
value = \case
    Int32
0 -> QωOrigin -> R QωOrigin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (QωOrigin -> R QωOrigin) -> QωOrigin -> R QωOrigin
forall a b. (a -> b) -> a -> b
$ QωOrigin
QωInferred
    Int32
1 -> QωOrigin -> R QωOrigin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (QωOrigin -> R QωOrigin) -> QωOrigin -> R QωOrigin
forall a b. (a -> b) -> a -> b
$ Range -> QωOrigin
Qω       Range
forall a. Range' a
noRange
    Int32
2 -> QωOrigin -> R QωOrigin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (QωOrigin -> R QωOrigin) -> QωOrigin -> R QωOrigin
forall a b. (a -> b) -> a -> b
$ Range -> QωOrigin
QωPlenty Range
forall a. Range' a
noRange
    Int32
_ -> R QωOrigin
forall a. R a
malformed

instance EmbPrj Quantity where
  icod_ :: Quantity -> S Int32
icod_ = \case
    Quantity0 Q0Origin
a -> Int32
-> (Q0Origin -> Quantity)
-> Arrows (Domains (Q0Origin -> Quantity)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 Q0Origin -> Quantity
Quantity0 Q0Origin
a
    Quantity1 Q1Origin
a -> Int32
-> (Q1Origin -> Quantity)
-> Arrows (Domains (Q1Origin -> Quantity)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 Q1Origin -> Quantity
Quantity1 Q1Origin
a
    Quantityω QωOrigin
a -> (QωOrigin -> Quantity)
-> Arrows (Domains (QωOrigin -> Quantity)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN'  QωOrigin -> Quantity
Quantityω QωOrigin
a  -- default quantity, shorter code

  value :: Int32 -> R Quantity
value = ([Int32] -> R Quantity) -> Int32 -> R Quantity
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase (([Int32] -> R Quantity) -> Int32 -> R Quantity)
-> ([Int32] -> R Quantity) -> Int32 -> R Quantity
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
0, Int32
a] -> (Q0Origin -> Quantity)
-> Arrows
     (Constant Int32 (Domains (Q0Origin -> Quantity)))
     (R (CoDomain (Q0Origin -> Quantity)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Q0Origin -> Quantity
Quantity0 Int32
a
    [Int32
1, Int32
a] -> (Q1Origin -> Quantity)
-> Arrows
     (Constant Int32 (Domains (Q1Origin -> Quantity)))
     (R (CoDomain (Q1Origin -> Quantity)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Q1Origin -> Quantity
Quantity1 Int32
a
    [Int32
a]    -> (QωOrigin -> Quantity)
-> Arrows
     (Constant Int32 (Domains (QωOrigin -> Quantity)))
     (R (CoDomain (QωOrigin -> Quantity)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN QωOrigin -> Quantity
Quantityω Int32
a
    [Int32]
_      -> R Quantity
forall a. R a
malformed

-- -- ALT: forget quantity origin when serializing?
-- instance EmbPrj Quantity where
--   icod_ Quantity0 = return 0
--   icod_ Quantity1 = return 1
--   icod_ Quantityω = return 2

--   value 0 = return Quantity0
--   value 1 = return Quantity1
--   value 2 = return Quantityω
--   value _ = malformed

instance EmbPrj Cohesion where
  icod_ :: Cohesion -> S Int32
icod_ Cohesion
Flat       = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0
  icod_ Cohesion
Continuous = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
1
  icod_ Cohesion
Squash     = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
2

  value :: Int32 -> R Cohesion
value Int32
0 = Cohesion -> R Cohesion
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Cohesion
Flat
  value Int32
1 = Cohesion -> R Cohesion
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Cohesion
Continuous
  value Int32
2 = Cohesion -> R Cohesion
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Cohesion
Squash
  value Int32
_ = R Cohesion
forall a. R a
malformed

instance EmbPrj Modality where
  icod_ :: Modality -> S Int32
icod_ (Modality Relevance
a Quantity
b Cohesion
c) = (Relevance -> Quantity -> Cohesion -> Modality)
-> Arrows
     (Domains (Relevance -> Quantity -> Cohesion -> Modality)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Relevance -> Quantity -> Cohesion -> Modality
Modality Relevance
a Quantity
b Cohesion
c

  value :: Int32 -> R Modality
value = ([Int32] -> R Modality) -> Int32 -> R Modality
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase (([Int32] -> R Modality) -> Int32 -> R Modality)
-> ([Int32] -> R Modality) -> Int32 -> R Modality
forall a b. (a -> b) -> a -> b
$ \case
    [Int32
a, Int32
b, Int32
c] -> (Relevance -> Quantity -> Cohesion -> Modality)
-> Arrows
     (Constant
        Int32 (Domains (Relevance -> Quantity -> Cohesion -> Modality)))
     (R (CoDomain (Relevance -> Quantity -> Cohesion -> Modality)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Relevance -> Quantity -> Cohesion -> Modality
Modality Int32
a Int32
b Int32
c
    [Int32]
_ -> R Modality
forall a. R a
malformed

instance EmbPrj Relevance where
  icod_ :: Relevance -> S Int32
icod_ Relevance
Relevant       = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0
  icod_ Relevance
Irrelevant     = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
1
  icod_ Relevance
NonStrict      = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
2

  value :: Int32 -> R Relevance
value Int32
0 = Relevance -> R Relevance
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Relevance
Relevant
  value Int32
1 = Relevance -> R Relevance
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Relevance
Irrelevant
  value Int32
2 = Relevance -> R Relevance
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Relevance
NonStrict
  value Int32
_ = R Relevance
forall a. R a
malformed

instance EmbPrj Annotation where
  icod_ :: Annotation -> S Int32
icod_ (Annotation Lock
l) = (Lock -> Annotation)
-> Arrows (Domains (Lock -> Annotation)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Lock -> Annotation
Annotation Lock
l

  value :: Int32 -> R Annotation
value = (Lock -> Annotation) -> Int32 -> R (CoDomain (Lock -> Annotation))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Lock -> Annotation
Annotation

instance EmbPrj Lock where
  icod_ :: Lock -> S Int32
icod_ Lock
IsNotLock          = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
0
  icod_ (IsLock LockOrigin
LockOTick) = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
1
  icod_ (IsLock LockOrigin
LockOLock) = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
2

  value :: Int32 -> R Lock
value Int32
0 = Lock -> R Lock
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Lock
IsNotLock
  value Int32
1 = Lock -> R Lock
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LockOrigin -> Lock
IsLock LockOrigin
LockOTick)
  value Int32
2 = Lock -> R Lock
forall a. a -> StateT St IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LockOrigin -> Lock
IsLock LockOrigin
LockOLock)
  value Int32
_ = R Lock
forall a. R a
malformed

instance EmbPrj Origin where
  icod_ :: Origin -> S Int32
icod_ Origin
UserWritten = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0
  icod_ Origin
Inserted    = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
1
  icod_ Origin
Reflected   = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
2
  icod_ Origin
CaseSplit   = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
3
  icod_ Origin
Substitution = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
4
  icod_ Origin
ExpandedPun = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
5
  icod_ Origin
Generalization = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
6

  value :: Int32 -> R Origin
value Int32
0 = Origin -> R Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Origin
UserWritten
  value Int32
1 = Origin -> R Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Origin
Inserted
  value Int32
2 = Origin -> R Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Origin
Reflected
  value Int32
3 = Origin -> R Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Origin
CaseSplit
  value Int32
4 = Origin -> R Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Origin
Substitution
  value Int32
5 = Origin -> R Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Origin
ExpandedPun
  value Int32
6 = Origin -> R Origin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Origin
Generalization
  value Int32
_ = R Origin
forall a. R a
malformed

instance EmbPrj a => EmbPrj (WithOrigin a) where
  icod_ :: WithOrigin a -> S Int32
icod_ (WithOrigin Origin
a a
b) = (Origin -> a -> WithOrigin a)
-> Arrows (Domains (Origin -> a -> WithOrigin a)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Origin -> a -> WithOrigin a
forall a. Origin -> a -> WithOrigin a
WithOrigin Origin
a a
b

  value :: Int32 -> R (WithOrigin a)
value = (Origin -> a -> WithOrigin a)
-> Int32 -> R (CoDomain (Origin -> a -> WithOrigin a))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN Origin -> a -> WithOrigin a
forall a. Origin -> a -> WithOrigin a
WithOrigin

instance EmbPrj FreeVariables where
  icod_ :: FreeVariables -> S Int32
icod_ FreeVariables
UnknownFVs   = FreeVariables -> Arrows (Domains FreeVariables) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' FreeVariables
UnknownFVs
  icod_ (KnownFVs IntSet
a) = (IntSet -> FreeVariables)
-> Arrows (Domains (IntSet -> FreeVariables)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' IntSet -> FreeVariables
KnownFVs IntSet
a

  value :: Int32 -> R FreeVariables
value = ([Int32] -> R FreeVariables) -> Int32 -> R FreeVariables
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R FreeVariables
valu where
    valu :: [Int32]
-> Arrows
     (Constant Int32 (Domains FreeVariables))
     (R (CoDomain FreeVariables))
valu []  = FreeVariables
-> Arrows
     (Constant Int32 (Domains FreeVariables))
     (R (CoDomain FreeVariables))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN FreeVariables
UnknownFVs
    valu [Int32
a] = (IntSet -> FreeVariables)
-> Arrows
     (Constant Int32 (Domains (IntSet -> FreeVariables)))
     (R (CoDomain (IntSet -> FreeVariables)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN IntSet -> FreeVariables
KnownFVs Int32
a
    valu [Int32]
_   = R FreeVariables
Arrows
  (Constant Int32 (Domains FreeVariables))
  (R (CoDomain FreeVariables))
forall a. R a
malformed

instance EmbPrj ConOrigin where
  icod_ :: ConOrigin -> S Int32
icod_ ConOrigin
ConOSystem = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0
  icod_ ConOrigin
ConOCon    = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
1
  icod_ ConOrigin
ConORec    = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
2
  icod_ ConOrigin
ConOSplit  = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
3

  value :: Int32 -> R ConOrigin
value Int32
0 = ConOrigin -> R ConOrigin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ConOrigin
ConOSystem
  value Int32
1 = ConOrigin -> R ConOrigin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ConOrigin
ConOCon
  value Int32
2 = ConOrigin -> R ConOrigin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ConOrigin
ConORec
  value Int32
3 = ConOrigin -> R ConOrigin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ConOrigin
ConOSplit
  value Int32
_ = R ConOrigin
forall a. R a
malformed

instance EmbPrj ProjOrigin where
  icod_ :: ProjOrigin -> S Int32
icod_ ProjOrigin
ProjPrefix  = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0
  icod_ ProjOrigin
ProjPostfix = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
1
  icod_ ProjOrigin
ProjSystem  = Int32 -> S Int32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
2

  value :: Int32 -> R ProjOrigin
value Int32
0 = ProjOrigin -> R ProjOrigin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProjOrigin
ProjPrefix
  value Int32
1 = ProjOrigin -> R ProjOrigin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProjOrigin
ProjPostfix
  value Int32
2 = ProjOrigin -> R ProjOrigin
forall a. a -> StateT St IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProjOrigin
ProjSystem
  value Int32
_ = R ProjOrigin
forall a. R a
malformed

instance EmbPrj Agda.Syntax.Literal.Literal where
  icod_ :: Literal -> S Int32
icod_ (LitNat    Integer
a)   = (Integer -> Literal)
-> Arrows (Domains (Integer -> Literal)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' Integer -> Literal
LitNat Integer
a
  icod_ (LitFloat  Double
a)   = Int32
-> (Double -> Literal)
-> Arrows (Domains (Double -> Literal)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 Double -> Literal
LitFloat Double
a
  icod_ (LitString Text
a)   = Int32
-> (Text -> Literal)
-> Arrows (Domains (Text -> Literal)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
2 Text -> Literal
LitString Text
a
  icod_ (LitChar   Char
a)   = Int32
-> (Char -> Literal)
-> Arrows (Domains (Char -> Literal)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
3 Char -> Literal
LitChar Char
a
  icod_ (LitQName  QName
a)   = Int32
-> (QName -> Literal)
-> Arrows (Domains (QName -> Literal)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
5 QName -> Literal
LitQName QName
a
  icod_ (LitMeta   TopLevelModuleName
a MetaId
b) = Int32
-> (TopLevelModuleName -> MetaId -> Literal)
-> Arrows
     (Domains (TopLevelModuleName -> MetaId -> Literal)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
6 TopLevelModuleName -> MetaId -> Literal
LitMeta TopLevelModuleName
a MetaId
b
  icod_ (LitWord64 Word64
a)   = Int32
-> (Word64 -> Literal)
-> Arrows (Domains (Word64 -> Literal)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
7 Word64 -> Literal
LitWord64 Word64
a

  value :: Int32 -> R Literal
value = ([Int32] -> R Literal) -> Int32 -> R Literal
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R Literal
valu where
    valu :: [Int32] -> R Literal
valu [Int32
a]       = (Integer -> Literal)
-> Arrows
     (Constant Int32 (Domains (Integer -> Literal)))
     (R (CoDomain (Integer -> Literal)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Integer -> Literal
LitNat    Int32
a
    valu [Int32
1, Int32
a]    = (Double -> Literal)
-> Arrows
     (Constant Int32 (Domains (Double -> Literal)))
     (R (CoDomain (Double -> Literal)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Double -> Literal
LitFloat  Int32
a
    valu [Int32
2, Int32
a]    = (Text -> Literal)
-> Arrows
     (Constant Int32 (Domains (Text -> Literal)))
     (R (CoDomain (Text -> Literal)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Text -> Literal
LitString Int32
a
    valu [Int32
3, Int32
a]    = (Char -> Literal)
-> Arrows
     (Constant Int32 (Domains (Char -> Literal)))
     (R (CoDomain (Char -> Literal)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Char -> Literal
LitChar   Int32
a
    valu [Int32
5, Int32
a]    = (QName -> Literal)
-> Arrows
     (Constant Int32 (Domains (QName -> Literal)))
     (R (CoDomain (QName -> Literal)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN QName -> Literal
LitQName  Int32
a
    valu [Int32
6, Int32
a, Int32
b] = (TopLevelModuleName -> MetaId -> Literal)
-> Arrows
     (Constant
        Int32 (Domains (TopLevelModuleName -> MetaId -> Literal)))
     (R (CoDomain (TopLevelModuleName -> MetaId -> Literal)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN TopLevelModuleName -> MetaId -> Literal
LitMeta   Int32
a Int32
b
    valu [Int32
7, Int32
a]    = (Word64 -> Literal)
-> Arrows
     (Constant Int32 (Domains (Word64 -> Literal)))
     (R (CoDomain (Word64 -> Literal)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Word64 -> Literal
LitWord64 Int32
a
    valu [Int32]
_            = R Literal
forall a. R a
malformed

instance EmbPrj IsAbstract where
  icod_ :: IsAbstract -> S Int32
icod_ IsAbstract
AbstractDef = Int32 -> IsAbstract -> Arrows (Domains IsAbstract) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 IsAbstract
AbstractDef
  icod_ IsAbstract
ConcreteDef = IsAbstract -> Arrows (Domains IsAbstract) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' IsAbstract
ConcreteDef

  value :: Int32 -> R IsAbstract
value = ([Int32] -> R IsAbstract) -> Int32 -> R IsAbstract
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R IsAbstract
forall {a}. (Eq a, Num a) => [a] -> R IsAbstract
valu where
    valu :: [a]
-> Arrows
     (Constant Int32 (Domains IsAbstract)) (R (CoDomain IsAbstract))
valu [a
0] = IsAbstract
-> Arrows
     (Constant Int32 (Domains IsAbstract)) (R (CoDomain IsAbstract))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN IsAbstract
AbstractDef
    valu []  = IsAbstract
-> Arrows
     (Constant Int32 (Domains IsAbstract)) (R (CoDomain IsAbstract))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN IsAbstract
ConcreteDef
    valu [a]
_   = R IsAbstract
Arrows
  (Constant Int32 (Domains IsAbstract)) (R (CoDomain IsAbstract))
forall a. R a
malformed

instance EmbPrj IsOpaque where
  icod_ :: IsOpaque -> S Int32
icod_ (OpaqueDef OpaqueId
a)  = (OpaqueId -> IsOpaque)
-> Arrows (Domains (OpaqueId -> IsOpaque)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' OpaqueId -> IsOpaque
OpaqueDef OpaqueId
a
  icod_ IsOpaque
TransparentDef = IsOpaque -> Arrows (Domains IsOpaque) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' IsOpaque
TransparentDef

  value :: Int32 -> R IsOpaque
value = ([Int32] -> R IsOpaque) -> Int32 -> R IsOpaque
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R IsOpaque
valu where
    valu :: [Int32] -> R IsOpaque
valu [Int32
a] = (OpaqueId -> IsOpaque)
-> Arrows
     (Constant Int32 (Domains (OpaqueId -> IsOpaque)))
     (R (CoDomain (OpaqueId -> IsOpaque)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN OpaqueId -> IsOpaque
OpaqueDef Int32
a
    valu []  = IsOpaque
-> Arrows
     (Constant Int32 (Domains IsOpaque)) (R (CoDomain IsOpaque))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN IsOpaque
TransparentDef
    valu [Int32]
_   = R IsOpaque
forall a. R a
malformed

instance EmbPrj SrcLoc where
  icod_ :: SrcLoc -> S Int32
icod_ (SrcLoc String
p String
m String
f Int
sl Int
sc Int
el Int
ec) = (String -> String -> String -> Int -> Int -> Int -> Int -> SrcLoc)
-> Arrows
     (Domains
        (String -> String -> String -> Int -> Int -> Int -> Int -> SrcLoc))
     (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' String -> String -> String -> Int -> Int -> Int -> Int -> SrcLoc
SrcLoc String
p String
m String
f Int
sl Int
sc Int
el Int
ec
  value :: Int32 -> R SrcLoc
value = (String -> String -> String -> Int -> Int -> Int -> Int -> SrcLoc)
-> Int32
-> R (CoDomain
        (String -> String -> String -> Int -> Int -> Int -> Int -> SrcLoc))
forall t.
(VALU t (IsBase t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Int32 -> R (CoDomain t)
valueN String -> String -> String -> Int -> Int -> Int -> Int -> SrcLoc
SrcLoc

instance EmbPrj CallStack where
  icod_ :: CallStack -> S Int32
icod_ = [(String, SrcLoc)] -> S Int32
forall a. EmbPrj a => a -> S Int32
icode ([(String, SrcLoc)] -> S Int32)
-> (CallStack -> [(String, SrcLoc)]) -> CallStack -> S Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> [(String, SrcLoc)]
getCallStack
  value :: Int32 -> R CallStack
value = ([(String, SrcLoc)] -> CallStack)
-> StateT St IO [(String, SrcLoc)] -> R CallStack
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>) [(String, SrcLoc)] -> CallStack
fromCallSiteList (StateT St IO [(String, SrcLoc)] -> R CallStack)
-> (Int32 -> StateT St IO [(String, SrcLoc)])
-> Int32
-> R CallStack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> StateT St IO [(String, SrcLoc)]
forall a. EmbPrj a => Int32 -> R a
value

instance EmbPrj Impossible where
  icod_ :: Impossible -> S Int32
icod_ (Impossible CallStack
a)              = Int32
-> (CallStack -> Impossible)
-> Arrows (Domains (CallStack -> Impossible)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 CallStack -> Impossible
Impossible CallStack
a
  icod_ (Unreachable CallStack
a)             = Int32
-> (CallStack -> Impossible)
-> Arrows (Domains (CallStack -> Impossible)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 CallStack -> Impossible
Unreachable CallStack
a
  icod_ (ImpMissingDefinitions [String]
a String
b) = Int32
-> ([String] -> String -> Impossible)
-> Arrows (Domains ([String] -> String -> Impossible)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
2 [String] -> String -> Impossible
ImpMissingDefinitions [String]
a String
b

  value :: Int32 -> R Impossible
value = ([Int32] -> R Impossible) -> Int32 -> R Impossible
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R Impossible
valu where
    valu :: [Int32] -> R Impossible
valu [Int32
0, Int32
a]    = (CallStack -> Impossible)
-> Arrows
     (Constant Int32 (Domains (CallStack -> Impossible)))
     (R (CoDomain (CallStack -> Impossible)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN CallStack -> Impossible
Impossible  Int32
a
    valu [Int32
1, Int32
a]    = (CallStack -> Impossible)
-> Arrows
     (Constant Int32 (Domains (CallStack -> Impossible)))
     (R (CoDomain (CallStack -> Impossible)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN CallStack -> Impossible
Unreachable Int32
a
    valu [Int32
2, Int32
a, Int32
b] = ([String] -> String -> Impossible)
-> Arrows
     (Constant Int32 (Domains ([String] -> String -> Impossible)))
     (R (CoDomain ([String] -> String -> Impossible)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN [String] -> String -> Impossible
ImpMissingDefinitions Int32
a Int32
b
    valu [Int32]
_         = R Impossible
forall a. R a
malformed

instance EmbPrj ExpandedEllipsis where
  icod_ :: ExpandedEllipsis -> S Int32
icod_ ExpandedEllipsis
NoEllipsis = ExpandedEllipsis -> Arrows (Domains ExpandedEllipsis) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Int32)
icodeN' ExpandedEllipsis
NoEllipsis
  icod_ (ExpandedEllipsis Range
a Int
b) = Int32
-> (Range -> Int -> ExpandedEllipsis)
-> Arrows (Domains (Range -> Int -> ExpandedEllipsis)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 Range -> Int -> ExpandedEllipsis
ExpandedEllipsis Range
a Int
b

  value :: Int32 -> R ExpandedEllipsis
value = ([Int32] -> R ExpandedEllipsis) -> Int32 -> R ExpandedEllipsis
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R ExpandedEllipsis
valu where
    valu :: [Int32]
-> Arrows
     (Constant Int32 (Domains ExpandedEllipsis))
     (R (CoDomain ExpandedEllipsis))
valu []      = ExpandedEllipsis
-> Arrows
     (Constant Int32 (Domains ExpandedEllipsis))
     (R (CoDomain ExpandedEllipsis))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN ExpandedEllipsis
NoEllipsis
    valu [Int32
1,Int32
a,Int32
b] = (Range -> Int -> ExpandedEllipsis)
-> Arrows
     (Constant Int32 (Domains (Range -> Int -> ExpandedEllipsis)))
     (R (CoDomain (Range -> Int -> ExpandedEllipsis)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN Range -> Int -> ExpandedEllipsis
ExpandedEllipsis Int32
a Int32
b
    valu [Int32]
_       = R ExpandedEllipsis
Arrows
  (Constant Int32 (Domains ExpandedEllipsis))
  (R (CoDomain ExpandedEllipsis))
forall a. R a
malformed

instance EmbPrj OptionsPragma where
  icod_ :: OptionsPragma -> S Int32
icod_ (OptionsPragma [String]
a Range
b) = ([String], Range) -> S Int32
forall a. EmbPrj a => a -> S Int32
icod_ ([String]
a, Range
b)

  value :: Int32 -> R OptionsPragma
value Int32
op = ([String] -> Range -> OptionsPragma)
-> ([String], Range) -> OptionsPragma
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [String] -> Range -> OptionsPragma
OptionsPragma (([String], Range) -> OptionsPragma)
-> StateT St IO ([String], Range) -> R OptionsPragma
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Int32 -> StateT St IO ([String], Range)
forall a. EmbPrj a => Int32 -> R a
value Int32
op

instance EmbPrj BuiltinId
instance EmbPrj PrimitiveId

instance EmbPrj SomeBuiltin where
  icod_ :: SomeBuiltin -> S Int32
icod_ (BuiltinName BuiltinId
x)   = Int32
-> (BuiltinId -> SomeBuiltin)
-> Arrows (Domains (BuiltinId -> SomeBuiltin)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
0 BuiltinId -> SomeBuiltin
BuiltinName BuiltinId
x
  icod_ (PrimitiveName PrimitiveId
x) = Int32
-> (PrimitiveId -> SomeBuiltin)
-> Arrows (Domains (PrimitiveId -> SomeBuiltin)) (S Int32)
forall t.
(ICODE t (IsBase t), StrictCurrying (Domains t) (S Int32),
 All EmbPrj (Domains t)) =>
Int32 -> t -> Arrows (Domains t) (S Int32)
icodeN Int32
1 PrimitiveId -> SomeBuiltin
PrimitiveName PrimitiveId
x

  value :: Int32 -> R SomeBuiltin
value = ([Int32] -> R SomeBuiltin) -> Int32 -> R SomeBuiltin
forall a. EmbPrj a => ([Int32] -> R a) -> Int32 -> R a
vcase [Int32] -> R SomeBuiltin
valu where
    valu :: [Int32] -> R SomeBuiltin
valu [Int32
0, Int32
x] = (BuiltinId -> SomeBuiltin)
-> Arrows
     (Constant Int32 (Domains (BuiltinId -> SomeBuiltin)))
     (R (CoDomain (BuiltinId -> SomeBuiltin)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN BuiltinId -> SomeBuiltin
BuiltinName Int32
x
    valu [Int32
1, Int32
x] = (PrimitiveId -> SomeBuiltin)
-> Arrows
     (Constant Int32 (Domains (PrimitiveId -> SomeBuiltin)))
     (R (CoDomain (PrimitiveId -> SomeBuiltin)))
forall t.
(VALU t (IsBase t),
 StrictCurrying (Constant Int32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Int32 (Domains t)) (R (CoDomain t))
valuN PrimitiveId -> SomeBuiltin
PrimitiveName Int32
x
    valu [Int32]
_      = R SomeBuiltin
forall a. R a
malformed