{-# LANGUAGE CPP #-}
module Transformations.Derive (derive) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import qualified Control.Monad.State as S (State, evalState, gets, modify)
import Data.List (intercalate, intersperse)
import Data.Maybe (fromJust, isJust)
import qualified Data.Set as Set (deleteMin, union)
import Curry.Base.Ident
import Curry.Base.SpanInfo
import Curry.Syntax
import Base.CurryTypes (fromPredType)
import Base.Messages (internalError)
import Base.Types
import Base.TypeSubst (instanceType)
import Base.Typing (typeOf)
import Base.Utils (snd3, mapAccumM)
import Env.Instance
import Env.OpPrec
import Env.TypeConstructor
import Env.Value
data DVState = DVState
{ DVState -> ModuleIdent
moduleIdent :: ModuleIdent
, DVState -> TCEnv
tyConsEnv :: TCEnv
, DVState -> ValueEnv
valueEnv :: ValueEnv
, DVState -> InstEnv
instEnv :: InstEnv
, DVState -> OpPrecEnv
opPrecEnv :: OpPrecEnv
, DVState -> Integer
nextId :: Integer
}
type DVM = S.State DVState
derive :: TCEnv -> ValueEnv -> InstEnv -> OpPrecEnv -> Module PredType
-> Module PredType
derive :: TCEnv
-> ValueEnv
-> InstEnv
-> OpPrecEnv
-> Module PredType
-> Module PredType
derive tcEnv :: TCEnv
tcEnv vEnv :: ValueEnv
vEnv inEnv :: InstEnv
inEnv pEnv :: OpPrecEnv
pEnv (Module spi :: SpanInfo
spi ps :: [ModulePragma]
ps m :: ModuleIdent
m es :: Maybe ExportSpec
es is :: [ImportDecl]
is ds :: [Decl PredType]
ds) = SpanInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl PredType]
-> Module PredType
forall a.
SpanInfo
-> [ModulePragma]
-> ModuleIdent
-> Maybe ExportSpec
-> [ImportDecl]
-> [Decl a]
-> Module a
Module SpanInfo
spi [ModulePragma]
ps ModuleIdent
m Maybe ExportSpec
es [ImportDecl]
is ([Decl PredType] -> Module PredType)
-> [Decl PredType] -> Module PredType
forall a b. (a -> b) -> a -> b
$
[Decl PredType]
ds [Decl PredType] -> [Decl PredType] -> [Decl PredType]
forall a. [a] -> [a] -> [a]
++ [[Decl PredType]] -> [Decl PredType]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (State DVState [[Decl PredType]] -> DVState -> [[Decl PredType]]
forall s a. State s a -> s -> a
S.evalState ((Decl PredType -> StateT DVState Identity [Decl PredType])
-> [Decl PredType] -> State DVState [[Decl PredType]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Decl PredType -> StateT DVState Identity [Decl PredType]
deriveInstances [Decl PredType]
tds) DVState
initState)
where tds :: [Decl PredType]
tds = (Decl PredType -> Bool) -> [Decl PredType] -> [Decl PredType]
forall a. (a -> Bool) -> [a] -> [a]
filter Decl PredType -> Bool
forall a. Decl a -> Bool
isTypeDecl [Decl PredType]
ds
initState :: DVState
initState = ModuleIdent
-> TCEnv -> ValueEnv -> InstEnv -> OpPrecEnv -> Integer -> DVState
DVState ModuleIdent
m TCEnv
tcEnv ValueEnv
vEnv InstEnv
inEnv OpPrecEnv
pEnv 1
getModuleIdent :: DVM ModuleIdent
getModuleIdent :: DVM ModuleIdent
getModuleIdent = (DVState -> ModuleIdent) -> DVM ModuleIdent
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets DVState -> ModuleIdent
moduleIdent
getTyConsEnv :: DVM TCEnv
getTyConsEnv :: DVM TCEnv
getTyConsEnv = (DVState -> TCEnv) -> DVM TCEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets DVState -> TCEnv
tyConsEnv
getValueEnv :: DVM ValueEnv
getValueEnv :: DVM ValueEnv
getValueEnv = (DVState -> ValueEnv) -> DVM ValueEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets DVState -> ValueEnv
valueEnv
getInstEnv :: DVM InstEnv
getInstEnv :: DVM InstEnv
getInstEnv = (DVState -> InstEnv) -> DVM InstEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets DVState -> InstEnv
instEnv
getPrecEnv :: DVM OpPrecEnv
getPrecEnv :: DVM OpPrecEnv
getPrecEnv = (DVState -> OpPrecEnv) -> DVM OpPrecEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets DVState -> OpPrecEnv
opPrecEnv
getNextId :: DVM Integer
getNextId :: DVM Integer
getNextId = do
Integer
nid <- (DVState -> Integer) -> DVM Integer
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets DVState -> Integer
nextId
(DVState -> DVState) -> StateT DVState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((DVState -> DVState) -> StateT DVState Identity ())
-> (DVState -> DVState) -> StateT DVState Identity ()
forall a b. (a -> b) -> a -> b
$ \s :: DVState
s -> DVState
s { nextId :: Integer
nextId = Integer -> Integer
forall a. Enum a => a -> a
succ Integer
nid }
Integer -> DVM Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
nid
type ConstrInfo = (Int, QualIdent, Maybe [Ident], [Type])
deriveInstances :: Decl PredType -> DVM [Decl PredType]
deriveInstances :: Decl PredType -> StateT DVState Identity [Decl PredType]
deriveInstances (DataDecl _ tc :: Ident
tc tvs :: [Ident]
tvs _ clss :: [QualIdent]
clss) = do
ModuleIdent
m <- DVM ModuleIdent
getModuleIdent
TCEnv
tcEnv <- DVM TCEnv
getTyConsEnv
let otc :: QualIdent
otc = ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
tc
cis :: [ConstrInfo]
cis = ModuleIdent -> QualIdent -> TCEnv -> [ConstrInfo]
constructors ModuleIdent
m QualIdent
otc TCEnv
tcEnv
(QualIdent -> StateT DVState Identity (Decl PredType))
-> [QualIdent] -> StateT DVState Identity [Decl PredType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (QualIdent
-> [Ident]
-> [ConstrInfo]
-> QualIdent
-> StateT DVState Identity (Decl PredType)
deriveInstance QualIdent
otc [Ident]
tvs [ConstrInfo]
cis) [QualIdent]
clss
deriveInstances (NewtypeDecl p :: SpanInfo
p tc :: Ident
tc tvs :: [Ident]
tvs _ clss :: [QualIdent]
clss) =
Decl PredType -> StateT DVState Identity [Decl PredType]
deriveInstances (Decl PredType -> StateT DVState Identity [Decl PredType])
-> Decl PredType -> StateT DVState Identity [Decl PredType]
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> Ident -> [Ident] -> [ConstrDecl] -> [QualIdent] -> Decl PredType
forall a.
SpanInfo
-> Ident -> [Ident] -> [ConstrDecl] -> [QualIdent] -> Decl a
DataDecl SpanInfo
p Ident
tc [Ident]
tvs [] [QualIdent]
clss
deriveInstances _ = [Decl PredType] -> StateT DVState Identity [Decl PredType]
forall (m :: * -> *) a. Monad m => a -> m a
return []
deriveInstance :: QualIdent -> [Ident] -> [ConstrInfo] -> QualIdent
-> DVM (Decl PredType)
deriveInstance :: QualIdent
-> [Ident]
-> [ConstrInfo]
-> QualIdent
-> StateT DVState Identity (Decl PredType)
deriveInstance tc :: QualIdent
tc tvs :: [Ident]
tvs cis :: [ConstrInfo]
cis cls :: QualIdent
cls = do
InstEnv
inEnv <- DVM InstEnv
getInstEnv
let ps :: PredSet
ps = (ModuleIdent, PredSet, [(Ident, Int)]) -> PredSet
forall a b c. (a, b, c) -> b
snd3 ((ModuleIdent, PredSet, [(Ident, Int)]) -> PredSet)
-> (ModuleIdent, PredSet, [(Ident, Int)]) -> PredSet
forall a b. (a -> b) -> a -> b
$ Maybe (ModuleIdent, PredSet, [(Ident, Int)])
-> (ModuleIdent, PredSet, [(Ident, Int)])
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (ModuleIdent, PredSet, [(Ident, Int)])
-> (ModuleIdent, PredSet, [(Ident, Int)]))
-> Maybe (ModuleIdent, PredSet, [(Ident, Int)])
-> (ModuleIdent, PredSet, [(Ident, Int)])
forall a b. (a -> b) -> a -> b
$ InstIdent
-> InstEnv -> Maybe (ModuleIdent, PredSet, [(Ident, Int)])
lookupInstInfo (QualIdent
cls, QualIdent
tc) InstEnv
inEnv
ty :: Type
ty = Type -> [Type] -> Type
applyType (QualIdent -> Type
TypeConstructor QualIdent
tc) ([Type] -> Type) -> [Type] -> Type
forall a b. (a -> b) -> a -> b
$
Int -> [Type] -> [Type]
forall a. Int -> [a] -> [a]
take ([Ident] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
tvs) ([Type] -> [Type]) -> [Type] -> [Type]
forall a b. (a -> b) -> a -> b
$ (Int -> Type) -> [Int] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Type
TypeVariable [0 ..]
QualTypeExpr _ cx :: Context
cx inst :: TypeExpr
inst = [Ident] -> PredType -> QualTypeExpr
fromPredType [Ident]
tvs (PredType -> QualTypeExpr) -> PredType -> QualTypeExpr
forall a b. (a -> b) -> a -> b
$ PredSet -> Type -> PredType
PredType PredSet
ps Type
ty
[Decl PredType]
ds <- QualIdent
-> Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveMethods QualIdent
cls Type
ty [ConstrInfo]
cis PredSet
ps
Decl PredType -> StateT DVState Identity (Decl PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl PredType -> StateT DVState Identity (Decl PredType))
-> Decl PredType -> StateT DVState Identity (Decl PredType)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> Context
-> QualIdent
-> TypeExpr
-> [Decl PredType]
-> Decl PredType
forall a.
SpanInfo -> Context -> QualIdent -> TypeExpr -> [Decl a] -> Decl a
InstanceDecl SpanInfo
NoSpanInfo Context
cx QualIdent
cls TypeExpr
inst [Decl PredType]
ds
deriveMethods :: QualIdent -> Type -> [ConstrInfo] -> PredSet
-> DVM [Decl PredType]
deriveMethods :: QualIdent
-> Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveMethods cls :: QualIdent
cls
| QualIdent
cls QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
qEqId = Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveEqMethods
| QualIdent
cls QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
qOrdId = Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveOrdMethods
| QualIdent
cls QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
qEnumId = Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveEnumMethods
| QualIdent
cls QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
qBoundedId = Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveBoundedMethods
| QualIdent
cls QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
qReadId = Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveReadMethods
| QualIdent
cls QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
qShowId = Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveShowMethods
| Bool
otherwise = String
-> Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
forall a. String -> a
internalError (String
-> Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType])
-> String
-> Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
forall a b. (a -> b) -> a -> b
$ "Derive.deriveMethods: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualIdent -> String
forall a. Show a => a -> String
show QualIdent
cls
type BinOpExpr = Int
-> [Expression PredType]
-> Int
-> [Expression PredType]
-> Expression PredType
deriveBinOp :: QualIdent -> Ident -> BinOpExpr -> Type -> [ConstrInfo]
-> PredSet -> DVM (Decl PredType)
deriveBinOp :: QualIdent
-> Ident
-> BinOpExpr
-> Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveBinOp cls :: QualIdent
cls op :: Ident
op expr :: BinOpExpr
expr ty :: Type
ty cis :: [ConstrInfo]
cis ps :: PredSet
ps = do
PredType
pty <- PredSet -> QualIdent -> Type -> Ident -> DVM PredType
getInstMethodType PredSet
ps QualIdent
cls Type
ty Ident
op
[Equation PredType]
eqs <- ([ConstrInfo] -> StateT DVState Identity (Equation PredType))
-> [[ConstrInfo]] -> StateT DVState Identity [Equation PredType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ident
-> BinOpExpr
-> Type
-> [ConstrInfo]
-> StateT DVState Identity (Equation PredType)
deriveBinOpEquation Ident
op BinOpExpr
expr Type
ty) ([[ConstrInfo]] -> StateT DVState Identity [Equation PredType])
-> [[ConstrInfo]] -> StateT DVState Identity [Equation PredType]
forall a b. (a -> b) -> a -> b
$ [[ConstrInfo]] -> [[ConstrInfo]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [[ConstrInfo]
cis, [ConstrInfo]
cis]
Decl PredType -> StateT DVState Identity (Decl PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl PredType -> StateT DVState Identity (Decl PredType))
-> Decl PredType -> StateT DVState Identity (Decl PredType)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> PredType -> Ident -> [Equation PredType] -> Decl PredType
forall a. SpanInfo -> a -> Ident -> [Equation a] -> Decl a
FunctionDecl SpanInfo
NoSpanInfo PredType
pty Ident
op [Equation PredType]
eqs
deriveBinOpEquation :: Ident -> BinOpExpr -> Type -> [ConstrInfo]
-> DVM (Equation PredType)
deriveBinOpEquation :: Ident
-> BinOpExpr
-> Type
-> [ConstrInfo]
-> StateT DVState Identity (Equation PredType)
deriveBinOpEquation op :: Ident
op expr :: BinOpExpr
expr ty :: Type
ty [(i1 :: Int
i1, c1 :: QualIdent
c1, _, tys1 :: [Type]
tys1), (i2 :: Int
i2, c2 :: QualIdent
c2, _, tys2 :: [Type]
tys2)] = do
[(PredType, Ident)]
vs1 <- (Type -> StateT DVState Identity (PredType, Ident))
-> [Type] -> StateT DVState Identity [(PredType, Ident)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Type -> StateT DVState Identity (PredType, Ident)
freshArgument (Type -> StateT DVState Identity (PredType, Ident))
-> (Type -> Type)
-> Type
-> StateT DVState Identity (PredType, Ident)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
instType) [Type]
tys1
[(PredType, Ident)]
vs2 <- (Type -> StateT DVState Identity (PredType, Ident))
-> [Type] -> StateT DVState Identity [(PredType, Ident)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Type -> StateT DVState Identity (PredType, Ident)
freshArgument (Type -> StateT DVState Identity (PredType, Ident))
-> (Type -> Type)
-> Type
-> StateT DVState Identity (PredType, Ident)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
instType) [Type]
tys2
let pat1 :: Pattern PredType
pat1 = PredType -> QualIdent -> [(PredType, Ident)] -> Pattern PredType
forall a. a -> QualIdent -> [(a, Ident)] -> Pattern a
constrPattern PredType
pty QualIdent
c1 [(PredType, Ident)]
vs1
pat2 :: Pattern PredType
pat2 = PredType -> QualIdent -> [(PredType, Ident)] -> Pattern PredType
forall a. a -> QualIdent -> [(a, Ident)] -> Pattern a
constrPattern PredType
pty QualIdent
c2 [(PredType, Ident)]
vs2
es1 :: [Expression PredType]
es1 = ((PredType, Ident) -> Expression PredType)
-> [(PredType, Ident)] -> [Expression PredType]
forall a b. (a -> b) -> [a] -> [b]
map ((PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar) [(PredType, Ident)]
vs1
es2 :: [Expression PredType]
es2 = ((PredType, Ident) -> Expression PredType)
-> [(PredType, Ident)] -> [Expression PredType]
forall a b. (a -> b) -> [a] -> [b]
map ((PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar) [(PredType, Ident)]
vs2
Equation PredType -> StateT DVState Identity (Equation PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Equation PredType -> StateT DVState Identity (Equation PredType))
-> Equation PredType -> StateT DVState Identity (Equation PredType)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> Ident
-> [Pattern PredType]
-> Expression PredType
-> Equation PredType
forall a.
SpanInfo -> Ident -> [Pattern a] -> Expression a -> Equation a
mkEquation SpanInfo
NoSpanInfo Ident
op [Pattern PredType
pat1, Pattern PredType
pat2] (Expression PredType -> Equation PredType)
-> Expression PredType -> Equation PredType
forall a b. (a -> b) -> a -> b
$ BinOpExpr
expr Int
i1 [Expression PredType]
es1 Int
i2 [Expression PredType]
es2
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ Type -> Type
instType Type
ty
deriveBinOpEquation _ _ _ _ = String -> StateT DVState Identity (Equation PredType)
forall a. String -> a
internalError "Derive.deriveBinOpEquation"
deriveEqMethods :: Type -> [ConstrInfo] -> PredSet -> DVM [Decl PredType]
deriveEqMethods :: Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveEqMethods ty :: Type
ty cis :: [ConstrInfo]
cis ps :: PredSet
ps = [StateT DVState Identity (Decl PredType)]
-> StateT DVState Identity [Decl PredType]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[QualIdent
-> Ident
-> BinOpExpr
-> Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveBinOp QualIdent
qEqId Ident
eqOpId BinOpExpr
eqOpExpr Type
ty [ConstrInfo]
cis PredSet
ps]
eqOpExpr :: BinOpExpr
eqOpExpr :: BinOpExpr
eqOpExpr i1 :: Int
i1 es1 :: [Expression PredType]
es1 i2 :: Int
i2 es2 :: [Expression PredType]
es2
| Int
i1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i2 = if [Expression PredType] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expression PredType]
es1 then Expression PredType
prelTrue
else (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Expression PredType -> Expression PredType -> Expression PredType
prelAnd ([Expression PredType] -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall a b. (a -> b) -> a -> b
$ (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType]
-> [Expression PredType]
-> [Expression PredType]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Expression PredType -> Expression PredType -> Expression PredType
prelEq [Expression PredType]
es1 [Expression PredType]
es2
| Bool
otherwise = Expression PredType
prelFalse
deriveOrdMethods :: Type -> [ConstrInfo] -> PredSet -> DVM [Decl PredType]
deriveOrdMethods :: Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveOrdMethods ty :: Type
ty cis :: [ConstrInfo]
cis ps :: PredSet
ps = [StateT DVState Identity (Decl PredType)]
-> StateT DVState Identity [Decl PredType]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[QualIdent
-> Ident
-> BinOpExpr
-> Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveBinOp QualIdent
qOrdId Ident
leqOpId BinOpExpr
leqOpExpr Type
ty [ConstrInfo]
cis PredSet
ps]
leqOpExpr :: BinOpExpr
leqOpExpr :: BinOpExpr
leqOpExpr i1 :: Int
i1 es1 :: [Expression PredType]
es1 i2 :: Int
i2 es2 :: [Expression PredType]
es2
| Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i2 = Expression PredType
prelTrue
| Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i2 = Expression PredType
prelFalse
| Bool
otherwise = if [Expression PredType] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expression PredType]
es1 then Expression PredType
prelTrue
else (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Expression PredType -> Expression PredType -> Expression PredType
prelOr ([Expression PredType] -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall a b. (a -> b) -> a -> b
$ (Int -> Expression PredType) -> [Int] -> [Expression PredType]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Expression PredType
innerAnd [0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
where n :: Int
n = [Expression PredType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression PredType]
es1
innerAnd :: Int -> Expression PredType
innerAnd i :: Int
i = (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Expression PredType -> Expression PredType -> Expression PredType
prelAnd ([Expression PredType] -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall a b. (a -> b) -> a -> b
$ (Int -> Expression PredType) -> [Int] -> [Expression PredType]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Expression PredType
innerOp Int
i) [0 .. Int
i]
innerOp :: Int -> Int -> Expression PredType
innerOp i :: Int
i j :: Int
j | Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 = Expression PredType -> Expression PredType -> Expression PredType
prelLeq ([Expression PredType]
es1 [Expression PredType] -> Int -> Expression PredType
forall a. [a] -> Int -> a
!! Int
j) ([Expression PredType]
es2 [Expression PredType] -> Int -> Expression PredType
forall a. [a] -> Int -> a
!! Int
j)
| Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i = Expression PredType -> Expression PredType -> Expression PredType
prelLt ([Expression PredType]
es1 [Expression PredType] -> Int -> Expression PredType
forall a. [a] -> Int -> a
!! Int
j) ([Expression PredType]
es2 [Expression PredType] -> Int -> Expression PredType
forall a. [a] -> Int -> a
!! Int
j)
| Bool
otherwise = Expression PredType -> Expression PredType -> Expression PredType
prelEq ([Expression PredType]
es1 [Expression PredType] -> Int -> Expression PredType
forall a. [a] -> Int -> a
!! Int
j) ([Expression PredType]
es2 [Expression PredType] -> Int -> Expression PredType
forall a. [a] -> Int -> a
!! Int
j)
deriveEnumMethods :: Type -> [ConstrInfo] -> PredSet -> DVM [Decl PredType]
deriveEnumMethods :: Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveEnumMethods ty :: Type
ty cis :: [ConstrInfo]
cis ps :: PredSet
ps = [StateT DVState Identity (Decl PredType)]
-> StateT DVState Identity [Decl PredType]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ Ident
-> Type
-> [ConstrInfo]
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveSuccOrPred Ident
succId Type
ty [ConstrInfo]
cis ([ConstrInfo] -> [ConstrInfo]
forall a. [a] -> [a]
tail [ConstrInfo]
cis) PredSet
ps
, Ident
-> Type
-> [ConstrInfo]
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveSuccOrPred Ident
predId Type
ty ([ConstrInfo] -> [ConstrInfo]
forall a. [a] -> [a]
tail [ConstrInfo]
cis) [ConstrInfo]
cis PredSet
ps
, Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveToEnum Type
ty [ConstrInfo]
cis PredSet
ps
, Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveFromEnum Type
ty [ConstrInfo]
cis PredSet
ps
, Type
-> ConstrInfo -> PredSet -> StateT DVState Identity (Decl PredType)
deriveEnumFrom Type
ty ([ConstrInfo] -> ConstrInfo
forall a. [a] -> a
last [ConstrInfo]
cis) PredSet
ps
, Type
-> ConstrInfo
-> ConstrInfo
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveEnumFromThen Type
ty ([ConstrInfo] -> ConstrInfo
forall a. [a] -> a
head [ConstrInfo]
cis) ([ConstrInfo] -> ConstrInfo
forall a. [a] -> a
last [ConstrInfo]
cis) PredSet
ps
]
deriveSuccOrPred :: Ident -> Type -> [ConstrInfo] -> [ConstrInfo] -> PredSet
-> DVM (Decl PredType)
deriveSuccOrPred :: Ident
-> Type
-> [ConstrInfo]
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveSuccOrPred f :: Ident
f ty :: Type
ty cis1 :: [ConstrInfo]
cis1 cis2 :: [ConstrInfo]
cis2 ps :: PredSet
ps = do
PredType
pty <- PredSet -> QualIdent -> Type -> Ident -> DVM PredType
getInstMethodType PredSet
ps QualIdent
qEnumId Type
ty Ident
f
SpanInfo
-> PredType -> Ident -> [Equation PredType] -> Decl PredType
forall a. SpanInfo -> a -> Ident -> [Equation a] -> Decl a
FunctionDecl SpanInfo
NoSpanInfo PredType
pty Ident
f ([Equation PredType] -> Decl PredType)
-> StateT DVState Identity [Equation PredType]
-> StateT DVState Identity (Decl PredType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if [Equation PredType] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Equation PredType]
eqs
then do
(PredType, Ident)
v <- Type -> StateT DVState Identity (PredType, Ident)
freshArgument (Type -> StateT DVState Identity (PredType, Ident))
-> Type -> StateT DVState Identity (PredType, Ident)
forall a b. (a -> b) -> a -> b
$ Type -> Type
instType Type
ty
[Equation PredType] -> StateT DVState Identity [Equation PredType]
forall (m :: * -> *) a. Monad m => a -> m a
return [Ident -> Type -> (PredType, Ident) -> Equation PredType
failedEquation Ident
f Type
ty (PredType, Ident)
v]
else [Equation PredType] -> StateT DVState Identity [Equation PredType]
forall (m :: * -> *) a. Monad m => a -> m a
return [Equation PredType]
eqs
where eqs :: [Equation PredType]
eqs = (ConstrInfo -> ConstrInfo -> Equation PredType)
-> [ConstrInfo] -> [ConstrInfo] -> [Equation PredType]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Ident -> Type -> ConstrInfo -> ConstrInfo -> Equation PredType
succOrPredEquation Ident
f Type
ty) [ConstrInfo]
cis1 [ConstrInfo]
cis2
succOrPredEquation :: Ident -> Type -> ConstrInfo -> ConstrInfo
-> Equation PredType
succOrPredEquation :: Ident -> Type -> ConstrInfo -> ConstrInfo -> Equation PredType
succOrPredEquation f :: Ident
f ty :: Type
ty (_, c1 :: QualIdent
c1, _, _) (_, c2 :: QualIdent
c2, _, _) =
SpanInfo
-> Ident
-> [Pattern PredType]
-> Expression PredType
-> Equation PredType
forall a.
SpanInfo -> Ident -> [Pattern a] -> Expression a -> Equation a
mkEquation SpanInfo
NoSpanInfo Ident
f [SpanInfo
-> PredType -> QualIdent -> [Pattern PredType] -> Pattern PredType
forall a. SpanInfo -> a -> QualIdent -> [Pattern a] -> Pattern a
ConstructorPattern SpanInfo
NoSpanInfo PredType
pty QualIdent
c1 []] (Expression PredType -> Equation PredType)
-> Expression PredType -> Equation PredType
forall a b. (a -> b) -> a -> b
$
SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Constructor SpanInfo
NoSpanInfo PredType
pty QualIdent
c2
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ Type -> Type
instType Type
ty
failedEquation :: Ident -> Type -> (PredType, Ident) -> Equation PredType
failedEquation :: Ident -> Type -> (PredType, Ident) -> Equation PredType
failedEquation f :: Ident
f ty :: Type
ty v :: (PredType, Ident)
v =
SpanInfo
-> Ident
-> [Pattern PredType]
-> Expression PredType
-> Equation PredType
forall a.
SpanInfo -> Ident -> [Pattern a] -> Expression a -> Equation a
mkEquation SpanInfo
NoSpanInfo Ident
f [(PredType -> Ident -> Pattern PredType)
-> (PredType, Ident) -> Pattern PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SpanInfo -> PredType -> Ident -> Pattern PredType
forall a. SpanInfo -> a -> Ident -> Pattern a
VariablePattern SpanInfo
NoSpanInfo) (PredType, Ident)
v] (Expression PredType -> Equation PredType)
-> Expression PredType -> Equation PredType
forall a b. (a -> b) -> a -> b
$
Type -> Expression PredType
preludeFailed (Type -> Expression PredType) -> Type -> Expression PredType
forall a b. (a -> b) -> a -> b
$ Type -> Type
instType Type
ty
deriveToEnum :: Type -> [ConstrInfo] -> PredSet -> DVM (Decl PredType)
deriveToEnum :: Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveToEnum ty :: Type
ty cis :: [ConstrInfo]
cis ps :: PredSet
ps = do
PredType
pty <- PredSet -> QualIdent -> Type -> Ident -> DVM PredType
getInstMethodType PredSet
ps QualIdent
qEnumId Type
ty Ident
toEnumId
Decl PredType -> StateT DVState Identity (Decl PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl PredType -> StateT DVState Identity (Decl PredType))
-> Decl PredType -> StateT DVState Identity (Decl PredType)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> PredType -> Ident -> [Equation PredType] -> Decl PredType
forall a. SpanInfo -> a -> Ident -> [Equation a] -> Decl a
FunctionDecl SpanInfo
NoSpanInfo PredType
pty Ident
toEnumId [Equation PredType]
eqs
where eqs :: [Equation PredType]
eqs = (Integer -> ConstrInfo -> Equation PredType)
-> [Integer] -> [ConstrInfo] -> [Equation PredType]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Type -> Integer -> ConstrInfo -> Equation PredType
toEnumEquation Type
ty) [0 ..] [ConstrInfo]
cis
toEnumEquation :: Type -> Integer -> ConstrInfo -> Equation PredType
toEnumEquation :: Type -> Integer -> ConstrInfo -> Equation PredType
toEnumEquation ty :: Type
ty i :: Integer
i (_, c :: QualIdent
c, _, _) =
SpanInfo
-> Ident
-> [Pattern PredType]
-> Expression PredType
-> Equation PredType
forall a.
SpanInfo -> Ident -> [Pattern a] -> Expression a -> Equation a
mkEquation SpanInfo
NoSpanInfo Ident
toEnumId
[SpanInfo -> PredType -> Literal -> Pattern PredType
forall a. SpanInfo -> a -> Literal -> Pattern a
LiteralPattern SpanInfo
NoSpanInfo (Type -> PredType
predType Type
intType) (Integer -> Literal
Int Integer
i)] (Expression PredType -> Equation PredType)
-> Expression PredType -> Equation PredType
forall a b. (a -> b) -> a -> b
$
SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Constructor SpanInfo
NoSpanInfo (Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ Type -> Type
instType Type
ty) QualIdent
c
deriveFromEnum :: Type -> [ConstrInfo] -> PredSet -> DVM (Decl PredType)
ty :: Type
ty cis :: [ConstrInfo]
cis ps :: PredSet
ps = do
PredType
pty <- PredSet -> QualIdent -> Type -> Ident -> DVM PredType
getInstMethodType PredSet
ps QualIdent
qEnumId Type
ty Ident
fromEnumId
Decl PredType -> StateT DVState Identity (Decl PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl PredType -> StateT DVState Identity (Decl PredType))
-> Decl PredType -> StateT DVState Identity (Decl PredType)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> PredType -> Ident -> [Equation PredType] -> Decl PredType
forall a. SpanInfo -> a -> Ident -> [Equation a] -> Decl a
FunctionDecl SpanInfo
NoSpanInfo PredType
pty Ident
fromEnumId [Equation PredType]
eqs
where eqs :: [Equation PredType]
eqs = (ConstrInfo -> Integer -> Equation PredType)
-> [ConstrInfo] -> [Integer] -> [Equation PredType]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Type -> ConstrInfo -> Integer -> Equation PredType
fromEnumEquation Type
ty) [ConstrInfo]
cis [0 ..]
fromEnumEquation :: Type -> ConstrInfo -> Integer -> Equation PredType
ty :: Type
ty (_, c :: QualIdent
c, _, _) i :: Integer
i =
SpanInfo
-> Ident
-> [Pattern PredType]
-> Expression PredType
-> Equation PredType
forall a.
SpanInfo -> Ident -> [Pattern a] -> Expression a -> Equation a
mkEquation SpanInfo
NoSpanInfo Ident
fromEnumId [SpanInfo
-> PredType -> QualIdent -> [Pattern PredType] -> Pattern PredType
forall a. SpanInfo -> a -> QualIdent -> [Pattern a] -> Pattern a
ConstructorPattern SpanInfo
NoSpanInfo PredType
pty QualIdent
c []] (Expression PredType -> Equation PredType)
-> Expression PredType -> Equation PredType
forall a b. (a -> b) -> a -> b
$
SpanInfo -> PredType -> Literal -> Expression PredType
forall a. SpanInfo -> a -> Literal -> Expression a
Literal SpanInfo
NoSpanInfo (Type -> PredType
predType Type
intType) (Literal -> Expression PredType) -> Literal -> Expression PredType
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
Int Integer
i
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ Type -> Type
instType Type
ty
deriveEnumFrom :: Type -> ConstrInfo -> PredSet -> DVM (Decl PredType)
deriveEnumFrom :: Type
-> ConstrInfo -> PredSet -> StateT DVState Identity (Decl PredType)
deriveEnumFrom ty :: Type
ty (_, c :: QualIdent
c, _, _) ps :: PredSet
ps = do
PredType
pty <- PredSet -> QualIdent -> Type -> Ident -> DVM PredType
getInstMethodType PredSet
ps QualIdent
qEnumId Type
ty Ident
enumFromId
(PredType, Ident)
v <- Type -> StateT DVState Identity (PredType, Ident)
freshArgument (Type -> StateT DVState Identity (PredType, Ident))
-> Type -> StateT DVState Identity (PredType, Ident)
forall a b. (a -> b) -> a -> b
$ Type -> Type
instType Type
ty
Decl PredType -> StateT DVState Identity (Decl PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl PredType -> StateT DVState Identity (Decl PredType))
-> Decl PredType -> StateT DVState Identity (Decl PredType)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> PredType
-> Ident
-> [Pattern PredType]
-> Expression PredType
-> Decl PredType
forall a.
SpanInfo -> a -> Ident -> [Pattern a] -> Expression a -> Decl a
funDecl SpanInfo
NoSpanInfo PredType
pty Ident
enumFromId
[(PredType -> Ident -> Pattern PredType)
-> (PredType, Ident) -> Pattern PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SpanInfo -> PredType -> Ident -> Pattern PredType
forall a. SpanInfo -> a -> Ident -> Pattern a
VariablePattern SpanInfo
NoSpanInfo) (PredType, Ident)
v] (Expression PredType -> Decl PredType)
-> Expression PredType -> Decl PredType
forall a b. (a -> b) -> a -> b
$
(PredType, Ident) -> QualIdent -> Expression PredType
enumFromExpr (PredType, Ident)
v QualIdent
c
enumFromExpr :: (PredType, Ident) -> QualIdent -> Expression PredType
enumFromExpr :: (PredType, Ident) -> QualIdent -> Expression PredType
enumFromExpr v :: (PredType, Ident)
v c :: QualIdent
c = Expression PredType -> Expression PredType -> Expression PredType
prelEnumFromTo ((PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar (PredType, Ident)
v) (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$
SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Constructor SpanInfo
NoSpanInfo ((PredType, Ident) -> PredType
forall a b. (a, b) -> a
fst (PredType, Ident)
v) QualIdent
c
deriveEnumFromThen :: Type -> ConstrInfo -> ConstrInfo -> PredSet
-> DVM (Decl PredType)
deriveEnumFromThen :: Type
-> ConstrInfo
-> ConstrInfo
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveEnumFromThen ty :: Type
ty (_, c1 :: QualIdent
c1, _, _) (_, c2 :: QualIdent
c2, _, _) ps :: PredSet
ps = do
PredType
pty <- PredSet -> QualIdent -> Type -> Ident -> DVM PredType
getInstMethodType PredSet
ps QualIdent
qEnumId Type
ty Ident
enumFromId
[(PredType, Ident)]
vs <- (Type -> StateT DVState Identity (PredType, Ident))
-> [Type] -> StateT DVState Identity [(PredType, Ident)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Type -> StateT DVState Identity (PredType, Ident)
freshArgument (Type -> StateT DVState Identity (PredType, Ident))
-> (Type -> Type)
-> Type
-> StateT DVState Identity (PredType, Ident)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
instType) ([Type] -> StateT DVState Identity [(PredType, Ident)])
-> [Type] -> StateT DVState Identity [(PredType, Ident)]
forall a b. (a -> b) -> a -> b
$ Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate 2 Type
ty
let [v1 :: (PredType, Ident)
v1, v2 :: (PredType, Ident)
v2] = [(PredType, Ident)]
vs
Decl PredType -> StateT DVState Identity (Decl PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl PredType -> StateT DVState Identity (Decl PredType))
-> Decl PredType -> StateT DVState Identity (Decl PredType)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> PredType
-> Ident
-> [Pattern PredType]
-> Expression PredType
-> Decl PredType
forall a.
SpanInfo -> a -> Ident -> [Pattern a] -> Expression a -> Decl a
funDecl SpanInfo
NoSpanInfo PredType
pty Ident
enumFromThenId
(((PredType, Ident) -> Pattern PredType)
-> [(PredType, Ident)] -> [Pattern PredType]
forall a b. (a -> b) -> [a] -> [b]
map ((PredType -> Ident -> Pattern PredType)
-> (PredType, Ident) -> Pattern PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SpanInfo -> PredType -> Ident -> Pattern PredType
forall a. SpanInfo -> a -> Ident -> Pattern a
VariablePattern SpanInfo
NoSpanInfo)) [(PredType, Ident)]
vs) (Expression PredType -> Decl PredType)
-> Expression PredType -> Decl PredType
forall a b. (a -> b) -> a -> b
$
(PredType, Ident)
-> (PredType, Ident)
-> QualIdent
-> QualIdent
-> Expression PredType
enumFromThenExpr (PredType, Ident)
v1 (PredType, Ident)
v2 QualIdent
c1 QualIdent
c2
enumFromThenExpr :: (PredType, Ident) -> (PredType, Ident) -> QualIdent
-> QualIdent -> Expression PredType
enumFromThenExpr :: (PredType, Ident)
-> (PredType, Ident)
-> QualIdent
-> QualIdent
-> Expression PredType
enumFromThenExpr v1 :: (PredType, Ident)
v1 v2 :: (PredType, Ident)
v2 c1 :: QualIdent
c1 c2 :: QualIdent
c2 =
Expression PredType
-> Expression PredType
-> Expression PredType
-> Expression PredType
prelEnumFromThenTo ((PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar (PredType, Ident)
v1) ((PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar (PredType, Ident)
v2) (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$ Expression PredType
boundedExpr
where boundedExpr :: Expression PredType
boundedExpr = SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a.
SpanInfo
-> Expression a -> Expression a -> Expression a -> Expression a
IfThenElse SpanInfo
NoSpanInfo
(Expression PredType -> Expression PredType -> Expression PredType
prelLeq
(Expression PredType -> Expression PredType
prelFromEnum (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$ (PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar (PredType, Ident)
v1)
(Expression PredType -> Expression PredType
prelFromEnum (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$ (PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar (PredType, Ident)
v2))
(SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Constructor SpanInfo
NoSpanInfo ((PredType, Ident) -> PredType
forall a b. (a, b) -> a
fst (PredType, Ident)
v1) QualIdent
c2)
(SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Constructor SpanInfo
NoSpanInfo ((PredType, Ident) -> PredType
forall a b. (a, b) -> a
fst (PredType, Ident)
v1) QualIdent
c1)
deriveBoundedMethods :: Type -> [ConstrInfo] -> PredSet -> DVM [Decl PredType]
deriveBoundedMethods :: Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveBoundedMethods ty :: Type
ty cis :: [ConstrInfo]
cis ps :: PredSet
ps = [StateT DVState Identity (Decl PredType)]
-> StateT DVState Identity [Decl PredType]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ QualIdent
-> Type
-> ConstrInfo
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveMaxOrMinBound QualIdent
qMinBoundId Type
ty ([ConstrInfo] -> ConstrInfo
forall a. [a] -> a
head [ConstrInfo]
cis) PredSet
ps
, QualIdent
-> Type
-> ConstrInfo
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveMaxOrMinBound QualIdent
qMaxBoundId Type
ty ([ConstrInfo] -> ConstrInfo
forall a. [a] -> a
last [ConstrInfo]
cis) PredSet
ps
]
deriveMaxOrMinBound :: QualIdent -> Type -> ConstrInfo -> PredSet
-> DVM (Decl PredType)
deriveMaxOrMinBound :: QualIdent
-> Type
-> ConstrInfo
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveMaxOrMinBound f :: QualIdent
f ty :: Type
ty (_, c :: QualIdent
c, _, tys :: [Type]
tys) ps :: PredSet
ps = do
PredType
pty <- PredSet -> QualIdent -> Type -> Ident -> DVM PredType
getInstMethodType PredSet
ps QualIdent
qBoundedId Type
ty (Ident -> DVM PredType) -> Ident -> DVM PredType
forall a b. (a -> b) -> a -> b
$ QualIdent -> Ident
unqualify QualIdent
f
Decl PredType -> StateT DVState Identity (Decl PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl PredType -> StateT DVState Identity (Decl PredType))
-> Decl PredType -> StateT DVState Identity (Decl PredType)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> PredType
-> Ident
-> [Pattern PredType]
-> Expression PredType
-> Decl PredType
forall a.
SpanInfo -> a -> Ident -> [Pattern a] -> Expression a -> Decl a
funDecl SpanInfo
NoSpanInfo PredType
pty (QualIdent -> Ident
unqualify QualIdent
f) [] (Expression PredType -> Decl PredType)
-> Expression PredType -> Decl PredType
forall a b. (a -> b) -> a -> b
$ QualIdent -> QualIdent -> Type -> [Type] -> Expression PredType
maxOrMinBoundExpr QualIdent
f QualIdent
c Type
ty [Type]
tys
maxOrMinBoundExpr :: QualIdent -> QualIdent -> Type -> [Type]
-> Expression PredType
maxOrMinBoundExpr :: QualIdent -> QualIdent -> Type -> [Type] -> Expression PredType
maxOrMinBoundExpr f :: QualIdent
f c :: QualIdent
c ty :: Type
ty tys :: [Type]
tys =
Expression PredType -> [Expression PredType] -> Expression PredType
forall a. Expression a -> [Expression a] -> Expression a
apply (SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Constructor SpanInfo
NoSpanInfo PredType
pty QualIdent
c) ([Expression PredType] -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall a b. (a -> b) -> a -> b
$
(Type -> Expression PredType) -> [Type] -> [Expression PredType]
forall a b. (a -> b) -> [a] -> [b]
map ((PredType -> QualIdent -> Expression PredType)
-> QualIdent -> PredType -> Expression PredType
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo) QualIdent
f (PredType -> Expression PredType)
-> (Type -> PredType) -> Type -> Expression PredType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> PredType
predType) [Type]
instTys
where instTy :: Type
instTy:instTys :: [Type]
instTys = (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
instType ([Type] -> [Type]) -> [Type] -> [Type]
forall a b. (a -> b) -> a -> b
$ Type
ty Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [Type]
tys
pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> Type -> [Type] -> Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Type -> Type -> Type
TypeArrow Type
instTy [Type]
instTys
deriveReadMethods :: Type -> [ConstrInfo] -> PredSet -> DVM [Decl PredType]
deriveReadMethods :: Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveReadMethods ty :: Type
ty cis :: [ConstrInfo]
cis ps :: PredSet
ps = [StateT DVState Identity (Decl PredType)]
-> StateT DVState Identity [Decl PredType]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveReadsPrec Type
ty [ConstrInfo]
cis PredSet
ps]
deriveReadsPrec :: Type -> [ConstrInfo] -> PredSet -> DVM (Decl PredType)
deriveReadsPrec :: Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveReadsPrec ty :: Type
ty cis :: [ConstrInfo]
cis ps :: PredSet
ps = do
PredType
pty <- PredSet -> QualIdent -> Type -> Ident -> DVM PredType
getInstMethodType PredSet
ps QualIdent
qReadId Type
ty (Ident -> DVM PredType) -> Ident -> DVM PredType
forall a b. (a -> b) -> a -> b
$ Ident
readsPrecId
(PredType, Ident)
d <- Type -> StateT DVState Identity (PredType, Ident)
freshArgument Type
intType
(PredType, Ident)
r <- Type -> StateT DVState Identity (PredType, Ident)
freshArgument Type
stringType
let pats :: [Pattern PredType]
pats = ((PredType, Ident) -> Pattern PredType)
-> [(PredType, Ident)] -> [Pattern PredType]
forall a b. (a -> b) -> [a] -> [b]
map ((PredType -> Ident -> Pattern PredType)
-> (PredType, Ident) -> Pattern PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SpanInfo -> PredType -> Ident -> Pattern PredType
forall a. SpanInfo -> a -> Ident -> Pattern a
VariablePattern SpanInfo
NoSpanInfo)) [(PredType, Ident)
d, (PredType, Ident)
r]
SpanInfo
-> PredType
-> Ident
-> [Pattern PredType]
-> Expression PredType
-> Decl PredType
forall a.
SpanInfo -> a -> Ident -> [Pattern a] -> Expression a -> Decl a
funDecl SpanInfo
NoSpanInfo PredType
pty Ident
readsPrecId [Pattern PredType]
pats (Expression PredType -> Decl PredType)
-> StateT DVState Identity (Expression PredType)
-> StateT DVState Identity (Decl PredType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Type
-> [ConstrInfo]
-> Expression PredType
-> Expression PredType
-> StateT DVState Identity (Expression PredType)
deriveReadsPrecExpr Type
ty [ConstrInfo]
cis ((PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar (PredType, Ident)
d) ((PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar (PredType, Ident)
r)
deriveReadsPrecExpr :: Type -> [ConstrInfo] -> Expression PredType
-> Expression PredType -> DVM (Expression PredType)
deriveReadsPrecExpr :: Type
-> [ConstrInfo]
-> Expression PredType
-> Expression PredType
-> StateT DVState Identity (Expression PredType)
deriveReadsPrecExpr ty :: Type
ty cis :: [ConstrInfo]
cis d :: Expression PredType
d r :: Expression PredType
r = do
[Expression PredType]
es <- (ConstrInfo -> StateT DVState Identity (Expression PredType))
-> [ConstrInfo] -> StateT DVState Identity [Expression PredType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Type
-> Expression PredType
-> ConstrInfo
-> StateT DVState Identity (Expression PredType)
deriveReadsPrecReadParenExpr Type
ty Expression PredType
d) [ConstrInfo]
cis
Expression PredType
-> StateT DVState Identity (Expression PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression PredType
-> StateT DVState Identity (Expression PredType))
-> Expression PredType
-> StateT DVState Identity (Expression PredType)
forall a b. (a -> b) -> a -> b
$ (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Expression PredType -> Expression PredType -> Expression PredType
prelAppend ([Expression PredType] -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall a b. (a -> b) -> a -> b
$ (Expression PredType -> Expression PredType)
-> [Expression PredType] -> [Expression PredType]
forall a b. (a -> b) -> [a] -> [b]
map ((Expression PredType -> Expression PredType -> Expression PredType)
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo) Expression PredType
r) ([Expression PredType] -> [Expression PredType])
-> [Expression PredType] -> [Expression PredType]
forall a b. (a -> b) -> a -> b
$ [Expression PredType]
es
deriveReadsPrecReadParenExpr :: Type -> Expression PredType -> ConstrInfo
-> DVM (Expression PredType)
deriveReadsPrecReadParenExpr :: Type
-> Expression PredType
-> ConstrInfo
-> StateT DVState Identity (Expression PredType)
deriveReadsPrecReadParenExpr ty :: Type
ty d :: Expression PredType
d ci :: ConstrInfo
ci@(_, c :: QualIdent
c, _, _) = do
OpPrecEnv
pEnv <- DVM OpPrecEnv
getPrecEnv
let p :: Integer
p = QualIdent -> OpPrecEnv -> Integer
precedence QualIdent
c OpPrecEnv
pEnv
Expression PredType
e <- Type
-> ConstrInfo
-> Integer
-> StateT DVState Identity (Expression PredType)
deriveReadsPrecLambdaExpr Type
ty ConstrInfo
ci Integer
p
Expression PredType
-> StateT DVState Identity (Expression PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression PredType
-> StateT DVState Identity (Expression PredType))
-> Expression PredType
-> StateT DVState Identity (Expression PredType)
forall a b. (a -> b) -> a -> b
$ Expression PredType -> Expression PredType -> Expression PredType
prelReadParen (ConstrInfo -> Expression PredType -> Integer -> Expression PredType
readsPrecReadParenCondExpr ConstrInfo
ci Expression PredType
d Integer
p) Expression PredType
e
readsPrecReadParenCondExpr :: ConstrInfo -> Expression PredType -> Precedence
-> Expression PredType
readsPrecReadParenCondExpr :: ConstrInfo -> Expression PredType -> Integer -> Expression PredType
readsPrecReadParenCondExpr (_, c :: QualIdent
c, _, tys :: [Type]
tys) d :: Expression PredType
d p :: Integer
p
| [Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
tys = Expression PredType
prelFalse
| QualIdent -> Bool
isQInfixOp QualIdent
c Bool -> Bool -> Bool
&& [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 =
Expression PredType -> Expression PredType -> Expression PredType
prelLt (SpanInfo -> PredType -> Literal -> Expression PredType
forall a. SpanInfo -> a -> Literal -> Expression a
Literal SpanInfo
NoSpanInfo PredType
predIntType (Literal -> Expression PredType) -> Literal -> Expression PredType
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
Int Integer
p) Expression PredType
d
| Bool
otherwise =
Expression PredType -> Expression PredType -> Expression PredType
prelLt (SpanInfo -> PredType -> Literal -> Expression PredType
forall a. SpanInfo -> a -> Literal -> Expression a
Literal SpanInfo
NoSpanInfo PredType
predIntType (Literal -> Expression PredType) -> Literal -> Expression PredType
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
Int 10) Expression PredType
d
deriveReadsPrecLambdaExpr :: Type -> ConstrInfo -> Precedence
-> DVM (Expression PredType)
deriveReadsPrecLambdaExpr :: Type
-> ConstrInfo
-> Integer
-> StateT DVState Identity (Expression PredType)
deriveReadsPrecLambdaExpr ty :: Type
ty (_, c :: QualIdent
c, ls :: Maybe [Ident]
ls, tys :: [Type]
tys) p :: Integer
p = do
(PredType, Ident)
r <- Type -> StateT DVState Identity (PredType, Ident)
freshArgument Type
stringType
(stmts :: [Statement PredType]
stmts, vs :: [(PredType, Ident)]
vs, s :: (PredType, Ident)
s) <- Ident
-> Integer
-> (PredType, Ident)
-> Maybe [Ident]
-> [Type]
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecStmts (QualIdent -> Ident
unqualify QualIdent
c) (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1) (PredType, Ident)
r Maybe [Ident]
ls [Type]
tys
let pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> Type -> [Type] -> Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Type -> Type -> Type
TypeArrow (Type -> Type
instType Type
ty) ([Type] -> Type) -> [Type] -> Type
forall a b. (a -> b) -> a -> b
$ (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
instType [Type]
tys
e :: Expression PredType
e = SpanInfo -> [Expression PredType] -> Expression PredType
forall a. SpanInfo -> [Expression a] -> Expression a
Tuple SpanInfo
NoSpanInfo
[ Expression PredType -> [Expression PredType] -> Expression PredType
forall a. Expression a -> [Expression a] -> Expression a
apply (SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Constructor SpanInfo
NoSpanInfo PredType
pty QualIdent
c) ([Expression PredType] -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall a b. (a -> b) -> a -> b
$ ((PredType, Ident) -> Expression PredType)
-> [(PredType, Ident)] -> [Expression PredType]
forall a b. (a -> b) -> [a] -> [b]
map ((PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar) [(PredType, Ident)]
vs
, (PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar (PredType, Ident)
s
]
Expression PredType
-> StateT DVState Identity (Expression PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression PredType
-> StateT DVState Identity (Expression PredType))
-> Expression PredType
-> StateT DVState Identity (Expression PredType)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> [Pattern PredType] -> Expression PredType -> Expression PredType
forall a. SpanInfo -> [Pattern a] -> Expression a -> Expression a
Lambda SpanInfo
NoSpanInfo [(PredType -> Ident -> Pattern PredType)
-> (PredType, Ident) -> Pattern PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SpanInfo -> PredType -> Ident -> Pattern PredType
forall a. SpanInfo -> a -> Ident -> Pattern a
VariablePattern SpanInfo
NoSpanInfo) (PredType, Ident)
r]
(Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> Expression PredType
-> [Statement PredType]
-> Expression PredType
forall a. SpanInfo -> Expression a -> [Statement a] -> Expression a
ListCompr SpanInfo
NoSpanInfo Expression PredType
e [Statement PredType]
stmts
deriveReadsPrecStmts
:: Ident -> Precedence -> (PredType, Ident) -> Maybe [Ident] -> [Type]
-> DVM ([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecStmts :: Ident
-> Integer
-> (PredType, Ident)
-> Maybe [Ident]
-> [Type]
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecStmts c :: Ident
c p :: Integer
p r :: (PredType, Ident)
r ls :: Maybe [Ident]
ls tys :: [Type]
tys
| [Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
tys = Ident
-> (PredType, Ident)
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecNullaryConstrStmts Ident
c (PredType, Ident)
r
| Maybe [Ident] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [Ident]
ls =
Ident
-> (PredType, Ident)
-> [Ident]
-> [Type]
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecRecordConstrStmts Ident
c (PredType, Ident)
r (Maybe [Ident] -> [Ident]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [Ident]
ls) [Type]
tys
| Ident -> Bool
isInfixOp Ident
c Bool -> Bool -> Bool
&& [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 = Ident
-> Integer
-> (PredType, Ident)
-> [Type]
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecInfixConstrStmts Ident
c Integer
p (PredType, Ident)
r [Type]
tys
| Bool
otherwise = Ident
-> (PredType, Ident)
-> [Type]
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecConstrStmts Ident
c (PredType, Ident)
r [Type]
tys
deriveReadsPrecNullaryConstrStmts
:: Ident -> (PredType, Ident)
-> DVM ([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecNullaryConstrStmts :: Ident
-> (PredType, Ident)
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecNullaryConstrStmts c :: Ident
c r :: (PredType, Ident)
r = do
(s :: (PredType, Ident)
s, stmt :: Statement PredType
stmt) <- String
-> (PredType, Ident) -> DVM ((PredType, Ident), Statement PredType)
deriveReadsPrecLexStmt (Ident -> String
idName Ident
c) (PredType, Ident)
r
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement PredType
stmt], [], (PredType, Ident)
s)
deriveReadsPrecRecordConstrStmts
:: Ident -> (PredType, Ident) -> [Ident] -> [Type]
-> DVM ([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecRecordConstrStmts :: Ident
-> (PredType, Ident)
-> [Ident]
-> [Type]
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecRecordConstrStmts c :: Ident
c r :: (PredType, Ident)
r ls :: [Ident]
ls tys :: [Type]
tys = do
(s :: (PredType, Ident)
s, stmt1 :: Statement PredType
stmt1) <- String
-> (PredType, Ident) -> DVM ((PredType, Ident), Statement PredType)
deriveReadsPrecLexStmt (Ident -> String
idName Ident
c) (PredType, Ident)
r
(t :: (PredType, Ident)
t, ress :: [([Statement PredType], (PredType, Ident))]
ress) <-
((PredType, Ident)
-> (String, Ident, Type)
-> StateT
DVState
Identity
((PredType, Ident), ([Statement PredType], (PredType, Ident))))
-> (PredType, Ident)
-> [(String, Ident, Type)]
-> StateT
DVState
Identity
((PredType, Ident), [([Statement PredType], (PredType, Ident))])
forall (m :: * -> *) (p :: * -> *) acc x y.
(Monad m, MonadPlus p) =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, p y)
mapAccumM (PredType, Ident)
-> (String, Ident, Type)
-> StateT
DVState
Identity
((PredType, Ident), ([Statement PredType], (PredType, Ident)))
deriveReadsPrecFieldStmts (PredType, Ident)
s ([(String, Ident, Type)]
-> StateT
DVState
Identity
((PredType, Ident), [([Statement PredType], (PredType, Ident))]))
-> [(String, Ident, Type)]
-> StateT
DVState
Identity
((PredType, Ident), [([Statement PredType], (PredType, Ident))])
forall a b. (a -> b) -> a -> b
$ [String] -> [Ident] -> [Type] -> [(String, Ident, Type)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 ("{" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
forall a. a -> [a]
repeat ",") [Ident]
ls [Type]
tys
let (stmtss :: [[Statement PredType]]
stmtss, vs :: [(PredType, Ident)]
vs) = [([Statement PredType], (PredType, Ident))]
-> ([[Statement PredType]], [(PredType, Ident)])
forall a b. [(a, b)] -> ([a], [b])
unzip [([Statement PredType], (PredType, Ident))]
ress
(u :: (PredType, Ident)
u, stmt2 :: Statement PredType
stmt2) <- String
-> (PredType, Ident) -> DVM ((PredType, Ident), Statement PredType)
deriveReadsPrecLexStmt "}" (PredType, Ident)
t
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
forall (m :: * -> *) a. Monad m => a -> m a
return (Statement PredType
stmt1 Statement PredType -> [Statement PredType] -> [Statement PredType]
forall a. a -> [a] -> [a]
: [[Statement PredType]] -> [Statement PredType]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Statement PredType]]
stmtss [Statement PredType]
-> [Statement PredType] -> [Statement PredType]
forall a. [a] -> [a] -> [a]
++ [Statement PredType
stmt2], [(PredType, Ident)]
vs, (PredType, Ident)
u)
deriveReadsPrecFieldStmts
:: (PredType, Ident) -> (String, Ident, Type)
-> DVM ((PredType, Ident), ([Statement PredType], (PredType, Ident)))
deriveReadsPrecFieldStmts :: (PredType, Ident)
-> (String, Ident, Type)
-> StateT
DVState
Identity
((PredType, Ident), ([Statement PredType], (PredType, Ident)))
deriveReadsPrecFieldStmts r :: (PredType, Ident)
r (pre :: String
pre, l :: Ident
l, ty :: Type
ty) = do
(s :: (PredType, Ident)
s, stmt1 :: Statement PredType
stmt1) <- String
-> (PredType, Ident) -> DVM ((PredType, Ident), Statement PredType)
deriveReadsPrecLexStmt String
pre (PredType, Ident)
r
(t :: (PredType, Ident)
t, stmt2 :: Statement PredType
stmt2) <- String
-> (PredType, Ident) -> DVM ((PredType, Ident), Statement PredType)
deriveReadsPrecLexStmt (Ident -> String
idName Ident
l) (PredType, Ident)
s
(u :: (PredType, Ident)
u, stmt3 :: Statement PredType
stmt3) <- String
-> (PredType, Ident) -> DVM ((PredType, Ident), Statement PredType)
deriveReadsPrecLexStmt "=" (PredType, Ident)
t
(w :: (PredType, Ident)
w, (stmt4 :: Statement PredType
stmt4, v :: (PredType, Ident)
v)) <- Integer
-> (PredType, Ident)
-> Type
-> DVM ((PredType, Ident), (Statement PredType, (PredType, Ident)))
deriveReadsPrecReadsPrecStmt 0 (PredType, Ident)
u Type
ty
((PredType, Ident), ([Statement PredType], (PredType, Ident)))
-> StateT
DVState
Identity
((PredType, Ident), ([Statement PredType], (PredType, Ident)))
forall (m :: * -> *) a. Monad m => a -> m a
return ((PredType, Ident)
w, ([Statement PredType
stmt1, Statement PredType
stmt2, Statement PredType
stmt3, Statement PredType
stmt4], (PredType, Ident)
v))
deriveReadsPrecInfixConstrStmts
:: Ident -> Precedence -> (PredType, Ident) -> [Type]
-> DVM ([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecInfixConstrStmts :: Ident
-> Integer
-> (PredType, Ident)
-> [Type]
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecInfixConstrStmts c :: Ident
c p :: Integer
p r :: (PredType, Ident)
r tys :: [Type]
tys = do
(s :: (PredType, Ident)
s, (stmt1 :: Statement PredType
stmt1, v1 :: (PredType, Ident)
v1)) <- Integer
-> (PredType, Ident)
-> Type
-> DVM ((PredType, Ident), (Statement PredType, (PredType, Ident)))
deriveReadsPrecReadsPrecStmt (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1) (PredType, Ident)
r (Type
-> DVM
((PredType, Ident), (Statement PredType, (PredType, Ident))))
-> Type
-> DVM ((PredType, Ident), (Statement PredType, (PredType, Ident)))
forall a b. (a -> b) -> a -> b
$ [Type] -> Type
forall a. [a] -> a
head [Type]
tys
(t :: (PredType, Ident)
t, stmt2 :: Statement PredType
stmt2) <- String
-> (PredType, Ident) -> DVM ((PredType, Ident), Statement PredType)
deriveReadsPrecLexStmt (Ident -> String
idName Ident
c) (PredType, Ident)
s
(u :: (PredType, Ident)
u, (stmt3 :: Statement PredType
stmt3, v2 :: (PredType, Ident)
v2)) <- Integer
-> (PredType, Ident)
-> Type
-> DVM ((PredType, Ident), (Statement PredType, (PredType, Ident)))
deriveReadsPrecReadsPrecStmt (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1) (PredType, Ident)
t (Type
-> DVM
((PredType, Ident), (Statement PredType, (PredType, Ident))))
-> Type
-> DVM ((PredType, Ident), (Statement PredType, (PredType, Ident)))
forall a b. (a -> b) -> a -> b
$ [Type] -> Type
forall a. [a] -> a
head ([Type] -> Type) -> [Type] -> Type
forall a b. (a -> b) -> a -> b
$ [Type] -> [Type]
forall a. [a] -> [a]
tail [Type]
tys
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement PredType
stmt1, Statement PredType
stmt2, Statement PredType
stmt3], [(PredType, Ident)
v1, (PredType, Ident)
v2], (PredType, Ident)
u)
deriveReadsPrecConstrStmts
:: Ident -> (PredType, Ident) -> [Type]
-> DVM ([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecConstrStmts :: Ident
-> (PredType, Ident)
-> [Type]
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
deriveReadsPrecConstrStmts c :: Ident
c r :: (PredType, Ident)
r tys :: [Type]
tys = do
(s :: (PredType, Ident)
s, stmt :: Statement PredType
stmt) <- String
-> (PredType, Ident) -> DVM ((PredType, Ident), Statement PredType)
deriveReadsPrecLexStmt (Ident -> String
idName Ident
c) (PredType, Ident)
r
(t :: (PredType, Ident)
t, ress :: [(Statement PredType, (PredType, Ident))]
ress) <- ((PredType, Ident)
-> Type
-> DVM
((PredType, Ident), (Statement PredType, (PredType, Ident))))
-> (PredType, Ident)
-> [Type]
-> StateT
DVState
Identity
((PredType, Ident), [(Statement PredType, (PredType, Ident))])
forall (m :: * -> *) (p :: * -> *) acc x y.
(Monad m, MonadPlus p) =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, p y)
mapAccumM (Integer
-> (PredType, Ident)
-> Type
-> DVM ((PredType, Ident), (Statement PredType, (PredType, Ident)))
deriveReadsPrecReadsPrecStmt 11) (PredType, Ident)
s [Type]
tys
let (stmts :: [Statement PredType]
stmts, vs :: [(PredType, Ident)]
vs) = [(Statement PredType, (PredType, Ident))]
-> ([Statement PredType], [(PredType, Ident)])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Statement PredType, (PredType, Ident))]
ress
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
-> DVM
([Statement PredType], [(PredType, Ident)], (PredType, Ident))
forall (m :: * -> *) a. Monad m => a -> m a
return (Statement PredType
stmt Statement PredType -> [Statement PredType] -> [Statement PredType]
forall a. a -> [a] -> [a]
: [Statement PredType]
stmts, [(PredType, Ident)]
vs, (PredType, Ident)
t)
deriveReadsPrecLexStmt :: String -> (PredType, Ident)
-> DVM ((PredType, Ident), Statement PredType)
deriveReadsPrecLexStmt :: String
-> (PredType, Ident) -> DVM ((PredType, Ident), Statement PredType)
deriveReadsPrecLexStmt str :: String
str r :: (PredType, Ident)
r = do
(PredType, Ident)
s <- Type -> StateT DVState Identity (PredType, Ident)
freshArgument (Type -> StateT DVState Identity (PredType, Ident))
-> Type -> StateT DVState Identity (PredType, Ident)
forall a b. (a -> b) -> a -> b
$ Type
stringType
let pat :: Pattern PredType
pat = SpanInfo -> [Pattern PredType] -> Pattern PredType
forall a. SpanInfo -> [Pattern a] -> Pattern a
TuplePattern SpanInfo
NoSpanInfo
[ SpanInfo -> PredType -> Literal -> Pattern PredType
forall a. SpanInfo -> a -> Literal -> Pattern a
LiteralPattern SpanInfo
NoSpanInfo PredType
predStringType (Literal -> Pattern PredType) -> Literal -> Pattern PredType
forall a b. (a -> b) -> a -> b
$ String -> Literal
String String
str
, (PredType -> Ident -> Pattern PredType)
-> (PredType, Ident) -> Pattern PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SpanInfo -> PredType -> Ident -> Pattern PredType
forall a. SpanInfo -> a -> Ident -> Pattern a
VariablePattern SpanInfo
NoSpanInfo) (PredType, Ident)
s
]
stmt :: Statement PredType
stmt = SpanInfo
-> Pattern PredType -> Expression PredType -> Statement PredType
forall a. SpanInfo -> Pattern a -> Expression a -> Statement a
StmtBind SpanInfo
NoSpanInfo Pattern PredType
pat (Expression PredType -> Statement PredType)
-> Expression PredType -> Statement PredType
forall a b. (a -> b) -> a -> b
$ Expression PredType -> Expression PredType
preludeLex (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$ (PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar (PredType, Ident)
r
((PredType, Ident), Statement PredType)
-> DVM ((PredType, Ident), Statement PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return ((PredType, Ident)
s, Statement PredType
stmt)
deriveReadsPrecReadsPrecStmt :: Precedence -> (PredType, Ident) -> Type
-> DVM ((PredType, Ident), (Statement PredType, (PredType, Ident)))
deriveReadsPrecReadsPrecStmt :: Integer
-> (PredType, Ident)
-> Type
-> DVM ((PredType, Ident), (Statement PredType, (PredType, Ident)))
deriveReadsPrecReadsPrecStmt p :: Integer
p r :: (PredType, Ident)
r ty :: Type
ty = do
(PredType, Ident)
v <- Type -> StateT DVState Identity (PredType, Ident)
freshArgument (Type -> StateT DVState Identity (PredType, Ident))
-> Type -> StateT DVState Identity (PredType, Ident)
forall a b. (a -> b) -> a -> b
$ Type -> Type
instType Type
ty
(PredType, Ident)
s <- Type -> StateT DVState Identity (PredType, Ident)
freshArgument (Type -> StateT DVState Identity (PredType, Ident))
-> Type -> StateT DVState Identity (PredType, Ident)
forall a b. (a -> b) -> a -> b
$ Type
stringType
let pat :: Pattern PredType
pat = SpanInfo -> [Pattern PredType] -> Pattern PredType
forall a. SpanInfo -> [Pattern a] -> Pattern a
TuplePattern SpanInfo
NoSpanInfo ([Pattern PredType] -> Pattern PredType)
-> [Pattern PredType] -> Pattern PredType
forall a b. (a -> b) -> a -> b
$
((PredType, Ident) -> Pattern PredType)
-> [(PredType, Ident)] -> [Pattern PredType]
forall a b. (a -> b) -> [a] -> [b]
map ((PredType -> Ident -> Pattern PredType)
-> (PredType, Ident) -> Pattern PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SpanInfo -> PredType -> Ident -> Pattern PredType
forall a. SpanInfo -> a -> Ident -> Pattern a
VariablePattern SpanInfo
NoSpanInfo)) [(PredType, Ident)
v, (PredType, Ident)
s]
stmt :: Statement PredType
stmt = SpanInfo
-> Pattern PredType -> Expression PredType -> Statement PredType
forall a. SpanInfo -> Pattern a -> Expression a -> Statement a
StmtBind SpanInfo
NoSpanInfo Pattern PredType
pat (Expression PredType -> Statement PredType)
-> Expression PredType -> Statement PredType
forall a b. (a -> b) -> a -> b
$ Type -> Integer -> Expression PredType -> Expression PredType
preludeReadsPrec (Type -> Type
instType Type
ty) Integer
p (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$
(PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar (PredType, Ident)
r
((PredType, Ident), (Statement PredType, (PredType, Ident)))
-> DVM ((PredType, Ident), (Statement PredType, (PredType, Ident)))
forall (m :: * -> *) a. Monad m => a -> m a
return ((PredType, Ident)
s, (Statement PredType
stmt, (PredType, Ident)
v))
deriveShowMethods :: Type -> [ConstrInfo] -> PredSet -> DVM [Decl PredType]
deriveShowMethods :: Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity [Decl PredType]
deriveShowMethods ty :: Type
ty cis :: [ConstrInfo]
cis ps :: PredSet
ps = [StateT DVState Identity (Decl PredType)]
-> StateT DVState Identity [Decl PredType]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveShowsPrec Type
ty [ConstrInfo]
cis PredSet
ps]
deriveShowsPrec :: Type -> [ConstrInfo] -> PredSet -> DVM (Decl PredType)
deriveShowsPrec :: Type
-> [ConstrInfo]
-> PredSet
-> StateT DVState Identity (Decl PredType)
deriveShowsPrec ty :: Type
ty cis :: [ConstrInfo]
cis ps :: PredSet
ps = do
PredType
pty <- PredSet -> QualIdent -> Type -> Ident -> DVM PredType
getInstMethodType PredSet
ps QualIdent
qShowId Type
ty (Ident -> DVM PredType) -> Ident -> DVM PredType
forall a b. (a -> b) -> a -> b
$ Ident
showsPrecId
[Equation PredType]
eqs <- (ConstrInfo -> StateT DVState Identity (Equation PredType))
-> [ConstrInfo] -> StateT DVState Identity [Equation PredType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Type -> ConstrInfo -> StateT DVState Identity (Equation PredType)
deriveShowsPrecEquation Type
ty) [ConstrInfo]
cis
Decl PredType -> StateT DVState Identity (Decl PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl PredType -> StateT DVState Identity (Decl PredType))
-> Decl PredType -> StateT DVState Identity (Decl PredType)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> PredType -> Ident -> [Equation PredType] -> Decl PredType
forall a. SpanInfo -> a -> Ident -> [Equation a] -> Decl a
FunctionDecl SpanInfo
NoSpanInfo PredType
pty Ident
showsPrecId [Equation PredType]
eqs
deriveShowsPrecEquation :: Type -> ConstrInfo -> DVM (Equation PredType)
deriveShowsPrecEquation :: Type -> ConstrInfo -> StateT DVState Identity (Equation PredType)
deriveShowsPrecEquation ty :: Type
ty (_, c :: QualIdent
c, ls :: Maybe [Ident]
ls, tys :: [Type]
tys) = do
(PredType, Ident)
d <- Type -> StateT DVState Identity (PredType, Ident)
freshArgument Type
intType
[(PredType, Ident)]
vs <- (Type -> StateT DVState Identity (PredType, Ident))
-> [Type] -> StateT DVState Identity [(PredType, Ident)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Type -> StateT DVState Identity (PredType, Ident)
freshArgument (Type -> StateT DVState Identity (PredType, Ident))
-> (Type -> Type)
-> Type
-> StateT DVState Identity (PredType, Ident)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
instType) [Type]
tys
let pats :: [Pattern PredType]
pats = [(PredType -> Ident -> Pattern PredType)
-> (PredType, Ident) -> Pattern PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SpanInfo -> PredType -> Ident -> Pattern PredType
forall a. SpanInfo -> a -> Ident -> Pattern a
VariablePattern SpanInfo
NoSpanInfo) (PredType, Ident)
d, PredType -> QualIdent -> [(PredType, Ident)] -> Pattern PredType
forall a. a -> QualIdent -> [(a, Ident)] -> Pattern a
constrPattern PredType
pty QualIdent
c [(PredType, Ident)]
vs]
OpPrecEnv
pEnv <- DVM OpPrecEnv
getPrecEnv
Equation PredType -> StateT DVState Identity (Equation PredType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Equation PredType -> StateT DVState Identity (Equation PredType))
-> Equation PredType -> StateT DVState Identity (Equation PredType)
forall a b. (a -> b) -> a -> b
$ SpanInfo
-> Ident
-> [Pattern PredType]
-> Expression PredType
-> Equation PredType
forall a.
SpanInfo -> Ident -> [Pattern a] -> Expression a -> Equation a
mkEquation SpanInfo
NoSpanInfo Ident
showsPrecId [Pattern PredType]
pats (Expression PredType -> Equation PredType)
-> Expression PredType -> Equation PredType
forall a b. (a -> b) -> a -> b
$ Ident
-> Integer
-> Maybe [Ident]
-> Expression PredType
-> [Expression PredType]
-> Expression PredType
showsPrecExpr (QualIdent -> Ident
unqualify QualIdent
c)
(QualIdent -> OpPrecEnv -> Integer
precedence QualIdent
c OpPrecEnv
pEnv) Maybe [Ident]
ls ((PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar (PredType, Ident)
d) ([Expression PredType] -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall a b. (a -> b) -> a -> b
$ ((PredType, Ident) -> Expression PredType)
-> [(PredType, Ident)] -> [Expression PredType]
forall a b. (a -> b) -> [a] -> [b]
map ((PredType -> Ident -> Expression PredType)
-> (PredType, Ident) -> Expression PredType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PredType -> Ident -> Expression PredType
forall a. a -> Ident -> Expression a
mkVar) [(PredType, Ident)]
vs
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ Type -> Type
instType Type
ty
showsPrecExpr :: Ident -> Precedence -> Maybe [Ident] -> Expression PredType
-> [Expression PredType] -> Expression PredType
showsPrecExpr :: Ident
-> Integer
-> Maybe [Ident]
-> Expression PredType
-> [Expression PredType]
-> Expression PredType
showsPrecExpr c :: Ident
c p :: Integer
p ls :: Maybe [Ident]
ls d :: Expression PredType
d vs :: [Expression PredType]
vs
| [Expression PredType] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expression PredType]
vs = Ident -> Expression PredType
showsPrecNullaryConstrExpr Ident
c
| Maybe [Ident] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [Ident]
ls = Expression PredType
-> Integer -> Expression PredType -> Expression PredType
showsPrecShowParenExpr Expression PredType
d 10 (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$
Ident -> [Ident] -> [Expression PredType] -> Expression PredType
showsPrecRecordConstrExpr Ident
c (Maybe [Ident] -> [Ident]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [Ident]
ls) [Expression PredType]
vs
| Ident -> Bool
isInfixOp Ident
c Bool -> Bool -> Bool
&& [Expression PredType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression PredType]
vs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 = Expression PredType
-> Integer -> Expression PredType -> Expression PredType
showsPrecShowParenExpr Expression PredType
d Integer
p (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$
Ident -> Integer -> [Expression PredType] -> Expression PredType
showsPrecInfixConstrExpr Ident
c Integer
p [Expression PredType]
vs
| Bool
otherwise = Expression PredType
-> Integer -> Expression PredType -> Expression PredType
showsPrecShowParenExpr Expression PredType
d 10 (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$
Ident -> [Expression PredType] -> Expression PredType
showsPrecConstrExpr Ident
c [Expression PredType]
vs
showsPrecNullaryConstrExpr :: Ident -> Expression PredType
showsPrecNullaryConstrExpr :: Ident -> Expression PredType
showsPrecNullaryConstrExpr c :: Ident
c = String -> Expression PredType
preludeShowString (String -> Expression PredType) -> String -> Expression PredType
forall a b. (a -> b) -> a -> b
$ Ident -> String -> String
showsConstr Ident
c ""
showsPrecShowParenExpr :: Expression PredType -> Precedence
-> Expression PredType -> Expression PredType
showsPrecShowParenExpr :: Expression PredType
-> Integer -> Expression PredType -> Expression PredType
showsPrecShowParenExpr d :: Expression PredType
d p :: Integer
p =
Expression PredType -> Expression PredType -> Expression PredType
prelShowParen (Expression PredType -> Expression PredType -> Expression PredType)
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a b. (a -> b) -> a -> b
$ Expression PredType -> Expression PredType -> Expression PredType
prelLt (SpanInfo -> PredType -> Literal -> Expression PredType
forall a. SpanInfo -> a -> Literal -> Expression a
Literal SpanInfo
NoSpanInfo PredType
predIntType (Literal -> Expression PredType) -> Literal -> Expression PredType
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
Int Integer
p) Expression PredType
d
showsPrecRecordConstrExpr :: Ident -> [Ident] -> [Expression PredType]
-> Expression PredType
showsPrecRecordConstrExpr :: Ident -> [Ident] -> [Expression PredType] -> Expression PredType
showsPrecRecordConstrExpr c :: Ident
c ls :: [Ident]
ls vs :: [Expression PredType]
vs = (Expression PredType -> Expression PredType -> Expression PredType)
-> Expression PredType
-> [Expression PredType]
-> Expression PredType
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Expression PredType -> Expression PredType -> Expression PredType
prelDot (String -> Expression PredType
preludeShowString "}") ([Expression PredType] -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall a b. (a -> b) -> a -> b
$
(:) (String -> Expression PredType
preludeShowString (String -> Expression PredType) -> String -> Expression PredType
forall a b. (a -> b) -> a -> b
$ Ident -> String -> String
showsConstr Ident
c " {") ([Expression PredType] -> [Expression PredType])
-> [Expression PredType] -> [Expression PredType]
forall a b. (a -> b) -> a -> b
$
[Expression PredType]
-> [[Expression PredType]] -> [Expression PredType]
forall a. [a] -> [[a]] -> [a]
intercalate [String -> Expression PredType
preludeShowString ", "] ([[Expression PredType]] -> [Expression PredType])
-> [[Expression PredType]] -> [Expression PredType]
forall a b. (a -> b) -> a -> b
$ (Ident -> Expression PredType -> [Expression PredType])
-> [Ident] -> [Expression PredType] -> [[Expression PredType]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Ident -> Expression PredType -> [Expression PredType]
showsPrecFieldExpr [Ident]
ls [Expression PredType]
vs
showsPrecFieldExpr :: Ident -> Expression PredType -> [Expression PredType]
showsPrecFieldExpr :: Ident -> Expression PredType -> [Expression PredType]
showsPrecFieldExpr l :: Ident
l v :: Expression PredType
v =
[String -> Expression PredType
preludeShowString (String -> Expression PredType) -> String -> Expression PredType
forall a b. (a -> b) -> a -> b
$ Ident -> String -> String
showsConstr Ident
l " = ", Integer -> Expression PredType -> Expression PredType
preludeShowsPrec 0 Expression PredType
v]
showsPrecInfixConstrExpr :: Ident -> Precedence -> [Expression PredType]
-> Expression PredType
showsPrecInfixConstrExpr :: Ident -> Integer -> [Expression PredType] -> Expression PredType
showsPrecInfixConstrExpr c :: Ident
c p :: Integer
p vs :: [Expression PredType]
vs = (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Expression PredType -> Expression PredType -> Expression PredType
prelDot
[ Integer -> Expression PredType -> Expression PredType
preludeShowsPrec (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1) (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$ [Expression PredType] -> Expression PredType
forall a. [a] -> a
head [Expression PredType]
vs
, String -> Expression PredType
preludeShowString (String -> Expression PredType) -> String -> Expression PredType
forall a b. (a -> b) -> a -> b
$ ' ' Char -> String -> String
forall a. a -> [a] -> [a]
: Ident -> String
idName Ident
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "
, Integer -> Expression PredType -> Expression PredType
preludeShowsPrec (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1) (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$ [Expression PredType] -> Expression PredType
forall a. [a] -> a
head ([Expression PredType] -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall a b. (a -> b) -> a -> b
$ [Expression PredType] -> [Expression PredType]
forall a. [a] -> [a]
tail [Expression PredType]
vs
]
showsPrecConstrExpr :: Ident -> [Expression PredType] -> Expression PredType
showsPrecConstrExpr :: Ident -> [Expression PredType] -> Expression PredType
showsPrecConstrExpr c :: Ident
c vs :: [Expression PredType]
vs = (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Expression PredType -> Expression PredType -> Expression PredType
prelDot ([Expression PredType] -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall a b. (a -> b) -> a -> b
$
String -> Expression PredType
preludeShowString (Ident -> String -> String
showsConstr Ident
c " ") Expression PredType
-> [Expression PredType] -> [Expression PredType]
forall a. a -> [a] -> [a]
:
Expression PredType
-> [Expression PredType] -> [Expression PredType]
forall a. a -> [a] -> [a]
intersperse (String -> Expression PredType
preludeShowString " ") ((Expression PredType -> Expression PredType)
-> [Expression PredType] -> [Expression PredType]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Expression PredType -> Expression PredType
preludeShowsPrec 11) [Expression PredType]
vs)
freshArgument :: Type -> DVM (PredType, Ident)
freshArgument :: Type -> StateT DVState Identity (PredType, Ident)
freshArgument = String -> Type -> StateT DVState Identity (PredType, Ident)
freshVar "_#arg"
freshVar :: String -> Type -> DVM (PredType, Ident)
freshVar :: String -> Type -> StateT DVState Identity (PredType, Ident)
freshVar name :: String
name ty :: Type
ty =
((,) (Type -> PredType
predType Type
ty)) (Ident -> (PredType, Ident))
-> (Integer -> Ident) -> Integer -> (PredType, Ident)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Ident
mkIdent (String -> Ident) -> (Integer -> String) -> Integer -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Integer -> String) -> Integer -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> (PredType, Ident))
-> DVM Integer -> StateT DVState Identity (PredType, Ident)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DVM Integer
getNextId
constructors :: ModuleIdent -> QualIdent -> TCEnv -> [ConstrInfo]
constructors :: ModuleIdent -> QualIdent -> TCEnv -> [ConstrInfo]
constructors m :: ModuleIdent
m tc :: QualIdent
tc tcEnv :: TCEnv
tcEnv = (Int -> DataConstr -> ConstrInfo)
-> [Int] -> [DataConstr] -> [ConstrInfo]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ModuleIdent -> Int -> DataConstr -> ConstrInfo
mkConstrInfo ModuleIdent
m) [1 ..] ([DataConstr] -> [ConstrInfo]) -> [DataConstr] -> [ConstrInfo]
forall a b. (a -> b) -> a -> b
$
case QualIdent -> TCEnv -> [TypeInfo]
qualLookupTypeInfo QualIdent
tc TCEnv
tcEnv of
[DataType _ _ cs :: [DataConstr]
cs] -> [DataConstr]
cs
[RenamingType _ _ nc :: DataConstr
nc] -> [DataConstr
nc]
_ -> String -> [DataConstr]
forall a. String -> a
internalError (String -> [DataConstr]) -> String -> [DataConstr]
forall a b. (a -> b) -> a -> b
$ "Derive.constructors: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualIdent -> String
forall a. Show a => a -> String
show QualIdent
tc
mkConstrInfo :: ModuleIdent -> Int -> DataConstr -> ConstrInfo
mkConstrInfo :: ModuleIdent -> Int -> DataConstr -> ConstrInfo
mkConstrInfo m :: ModuleIdent
m i :: Int
i (DataConstr c :: Ident
c tys :: [Type]
tys) =
(Int
i, ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
c, Maybe [Ident]
forall a. Maybe a
Nothing, [Type]
tys)
mkConstrInfo m :: ModuleIdent
m i :: Int
i (RecordConstr c :: Ident
c ls :: [Ident]
ls tys :: [Type]
tys) =
(Int
i, ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
c, [Ident] -> Maybe [Ident]
forall a. a -> Maybe a
Just [Ident]
ls, [Type]
tys)
showsConstr :: Ident -> ShowS
showsConstr :: Ident -> String -> String
showsConstr c :: Ident
c = Bool -> (String -> String) -> String -> String
showParen (Ident -> Bool
isInfixOp Ident
c) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
showString (String -> String -> String) -> String -> String -> String
forall a b. (a -> b) -> a -> b
$ Ident -> String
idName Ident
c
precedence :: QualIdent -> OpPrecEnv -> Precedence
precedence :: QualIdent -> OpPrecEnv -> Integer
precedence op :: QualIdent
op pEnv :: OpPrecEnv
pEnv = case QualIdent -> OpPrecEnv -> [PrecInfo]
qualLookupP QualIdent
op OpPrecEnv
pEnv of
[] -> Integer
defaultPrecedence
PrecInfo _ (OpPrec _ p :: Integer
p) : _ -> Integer
p
instType :: Type -> Type
instType :: Type -> Type
instType (TypeConstructor tc :: QualIdent
tc) = QualIdent -> Type
TypeConstructor QualIdent
tc
instType (TypeVariable tv :: Int
tv) = Int -> Type
TypeVariable (-1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tv)
instType (TypeApply ty1 :: Type
ty1 ty2 :: Type
ty2) = Type -> Type -> Type
TypeApply (Type -> Type
instType Type
ty1) (Type -> Type
instType Type
ty2)
instType (TypeArrow ty1 :: Type
ty1 ty2 :: Type
ty2) = Type -> Type -> Type
TypeArrow (Type -> Type
instType Type
ty1) (Type -> Type
instType Type
ty2)
instType ty :: Type
ty = Type
ty
getInstMethodType :: PredSet -> QualIdent -> Type -> Ident -> DVM PredType
getInstMethodType :: PredSet -> QualIdent -> Type -> Ident -> DVM PredType
getInstMethodType ps :: PredSet
ps cls :: QualIdent
cls ty :: Type
ty f :: Ident
f = do
ValueEnv
vEnv <- DVM ValueEnv
getValueEnv
PredType -> DVM PredType
forall (m :: * -> *) a. Monad m => a -> m a
return (PredType -> DVM PredType) -> PredType -> DVM PredType
forall a b. (a -> b) -> a -> b
$ ValueEnv -> PredSet -> QualIdent -> Type -> Ident -> PredType
instMethodType ValueEnv
vEnv PredSet
ps QualIdent
cls Type
ty Ident
f
instMethodType :: ValueEnv -> PredSet -> QualIdent -> Type -> Ident -> PredType
instMethodType :: ValueEnv -> PredSet -> QualIdent -> Type -> Ident -> PredType
instMethodType vEnv :: ValueEnv
vEnv ps :: PredSet
ps cls :: QualIdent
cls ty :: Type
ty f :: Ident
f = PredSet -> Type -> PredType
PredType (PredSet
ps PredSet -> PredSet -> PredSet
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` PredSet
ps'') Type
ty''
where PredType ps' :: PredSet
ps' ty' :: Type
ty' = case QualIdent -> ValueEnv -> [ValueInfo]
qualLookupValue (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
cls Ident
f) ValueEnv
vEnv of
[Value _ _ _ (ForAll _ pty :: PredType
pty)] -> PredType
pty
_ -> String -> PredType
forall a. String -> a
internalError (String -> PredType) -> String -> PredType
forall a b. (a -> b) -> a -> b
$ "Derive.instMethodType"
PredType ps'' :: PredSet
ps'' ty'' :: Type
ty'' = Type -> PredType -> PredType
forall a. ExpandAliasType a => Type -> a -> a
instanceType Type
ty (PredType -> PredType) -> PredType -> PredType
forall a b. (a -> b) -> a -> b
$ PredSet -> Type -> PredType
PredType (PredSet -> PredSet
forall a. Set a -> Set a
Set.deleteMin PredSet
ps') Type
ty'
prelTrue :: Expression PredType
prelTrue :: Expression PredType
prelTrue = SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Constructor SpanInfo
NoSpanInfo PredType
predBoolType QualIdent
qTrueId
prelFalse :: Expression PredType
prelFalse :: Expression PredType
prelFalse = SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Constructor SpanInfo
NoSpanInfo PredType
predBoolType QualIdent
qFalseId
prelAppend :: Expression PredType -> Expression PredType -> Expression PredType
prelAppend :: Expression PredType -> Expression PredType -> Expression PredType
prelAppend e1 :: Expression PredType
e1 e2 :: Expression PredType
e2 = (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo)
[SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qAppendOpId, Expression PredType
e1, Expression PredType
e2]
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow ([Type] -> Type) -> [Type] -> Type
forall a b. (a -> b) -> a -> b
$ Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate 3 (Type -> [Type]) -> Type -> [Type]
forall a b. (a -> b) -> a -> b
$ Expression PredType -> Type
forall a. Typeable a => a -> Type
typeOf Expression PredType
e1
prelDot :: Expression PredType -> Expression PredType -> Expression PredType
prelDot :: Expression PredType -> Expression PredType -> Expression PredType
prelDot e1 :: Expression PredType
e1 e2 :: Expression PredType
e2 = (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo)
[SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qDotOpId, Expression PredType
e1, Expression PredType
e2]
where ty1 :: Type
ty1@(TypeArrow _ ty12 :: Type
ty12) = Expression PredType -> Type
forall a. Typeable a => a -> Type
typeOf Expression PredType
e1
ty2 :: Type
ty2@(TypeArrow ty21 :: Type
ty21 _ ) = Expression PredType -> Type
forall a. Typeable a => a -> Type
typeOf Expression PredType
e2
pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow [Type
ty1, Type
ty2, Type
ty21, Type
ty12]
prelAnd :: Expression PredType -> Expression PredType -> Expression PredType
prelAnd :: Expression PredType -> Expression PredType -> Expression PredType
prelAnd e1 :: Expression PredType
e1 e2 :: Expression PredType
e2 = (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo)
[SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qAndOpId, Expression PredType
e1, Expression PredType
e2]
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow ([Type] -> Type) -> [Type] -> Type
forall a b. (a -> b) -> a -> b
$ Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate 3 Type
boolType
prelEq :: Expression PredType -> Expression PredType -> Expression PredType
prelEq :: Expression PredType -> Expression PredType -> Expression PredType
prelEq e1 :: Expression PredType
e1 e2 :: Expression PredType
e2 = (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo)
[SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qEqOpId, Expression PredType
e1, Expression PredType
e2]
where ty :: Type
ty = Expression PredType -> Type
forall a. Typeable a => a -> Type
typeOf Expression PredType
e1
pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow [Type
ty, Type
ty, Type
boolType]
prelLeq :: Expression PredType -> Expression PredType -> Expression PredType
prelLeq :: Expression PredType -> Expression PredType -> Expression PredType
prelLeq e1 :: Expression PredType
e1 e2 :: Expression PredType
e2 = (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo)
[SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qLeqOpId, Expression PredType
e1, Expression PredType
e2]
where ty :: Type
ty = Expression PredType -> Type
forall a. Typeable a => a -> Type
typeOf Expression PredType
e1
pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow [Type
ty, Type
ty, Type
boolType]
prelLt :: Expression PredType -> Expression PredType -> Expression PredType
prelLt :: Expression PredType -> Expression PredType -> Expression PredType
prelLt e1 :: Expression PredType
e1 e2 :: Expression PredType
e2 = (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo)
[SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qLtOpId, Expression PredType
e1, Expression PredType
e2]
where ty :: Type
ty = Expression PredType -> Type
forall a. Typeable a => a -> Type
typeOf Expression PredType
e1
pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow [Type
ty, Type
ty, Type
boolType]
prelOr :: Expression PredType -> Expression PredType -> Expression PredType
prelOr :: Expression PredType -> Expression PredType -> Expression PredType
prelOr e1 :: Expression PredType
e1 e2 :: Expression PredType
e2 = (Expression PredType -> Expression PredType -> Expression PredType)
-> [Expression PredType] -> Expression PredType
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo)
[SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qOrOpId, Expression PredType
e1, Expression PredType
e2]
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow ([Type] -> Type) -> [Type] -> Type
forall a b. (a -> b) -> a -> b
$ Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate 3 Type
boolType
prelFromEnum :: Expression PredType -> Expression PredType
e :: Expression PredType
e = SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo (SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qFromEnumId) Expression PredType
e
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
TypeArrow (Expression PredType -> Type
forall a. Typeable a => a -> Type
typeOf Expression PredType
e) Type
intType
prelEnumFromTo :: Expression PredType -> Expression PredType
-> Expression PredType
prelEnumFromTo :: Expression PredType -> Expression PredType -> Expression PredType
prelEnumFromTo e1 :: Expression PredType
e1 e2 :: Expression PredType
e2 = Expression PredType -> [Expression PredType] -> Expression PredType
forall a. Expression a -> [Expression a] -> Expression a
apply (SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qEnumFromToId) [Expression PredType
e1, Expression PredType
e2]
where ty :: Type
ty = Expression PredType -> Type
forall a. Typeable a => a -> Type
typeOf Expression PredType
e1
pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow [Type
ty, Type
ty, Type -> Type
listType Type
ty]
prelEnumFromThenTo :: Expression PredType -> Expression PredType
-> Expression PredType -> Expression PredType
prelEnumFromThenTo :: Expression PredType
-> Expression PredType
-> Expression PredType
-> Expression PredType
prelEnumFromThenTo e1 :: Expression PredType
e1 e2 :: Expression PredType
e2 e3 :: Expression PredType
e3 =
Expression PredType -> [Expression PredType] -> Expression PredType
forall a. Expression a -> [Expression a] -> Expression a
apply (SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qEnumFromThenToId) [Expression PredType
e1, Expression PredType
e2, Expression PredType
e3]
where ty :: Type
ty = Expression PredType -> Type
forall a. Typeable a => a -> Type
typeOf Expression PredType
e1
pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow [Type
ty, Type
ty, Type
ty, Type -> Type
listType Type
ty]
prelReadParen :: Expression PredType -> Expression PredType
-> Expression PredType
prelReadParen :: Expression PredType -> Expression PredType -> Expression PredType
prelReadParen e1 :: Expression PredType
e1 e2 :: Expression PredType
e2 = Expression PredType -> [Expression PredType] -> Expression PredType
forall a. Expression a -> [Expression a] -> Expression a
apply (SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qReadParenId) [Expression PredType
e1, Expression PredType
e2]
where ty :: Type
ty = Expression PredType -> Type
forall a. Typeable a => a -> Type
typeOf Expression PredType
e2
pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow [Type
boolType, Type
ty, Type
ty]
prelShowParen :: Expression PredType -> Expression PredType
-> Expression PredType
prelShowParen :: Expression PredType -> Expression PredType -> Expression PredType
prelShowParen e1 :: Expression PredType
e1 e2 :: Expression PredType
e2 = Expression PredType -> [Expression PredType] -> Expression PredType
forall a. Expression a -> [Expression a] -> Expression a
apply (SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qShowParenId) [Expression PredType
e1, Expression PredType
e2]
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow [ Type
boolType
, Type -> Type -> Type
TypeArrow Type
stringType Type
stringType
, Type
stringType, Type
stringType
]
preludeLex :: Expression PredType -> Expression PredType
preludeLex :: Expression PredType -> Expression PredType
preludeLex e :: Expression PredType
e = SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo (SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qLexId) Expression PredType
e
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
TypeArrow Type
stringType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
Type -> Type
listType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Type] -> Type
tupleType [Type
stringType, Type
stringType]
preludeReadsPrec :: Type -> Integer -> Expression PredType
-> Expression PredType
preludeReadsPrec :: Type -> Integer -> Expression PredType -> Expression PredType
preludeReadsPrec ty :: Type
ty p :: Integer
p e :: Expression PredType
e = (Expression PredType -> Expression PredType -> Expression PredType)
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo) Expression PredType
e (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$
SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo (SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qReadsPrecId) (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$
SpanInfo -> PredType -> Literal -> Expression PredType
forall a. SpanInfo -> a -> Literal -> Expression a
Literal SpanInfo
NoSpanInfo PredType
predIntType (Literal -> Expression PredType) -> Literal -> Expression PredType
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
Int Integer
p
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow [ Type
intType, Type
stringType
, Type -> Type
listType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Type] -> Type
tupleType [ Type
ty
, Type
stringType
]
]
preludeShowsPrec :: Integer -> Expression PredType -> Expression PredType
preludeShowsPrec :: Integer -> Expression PredType -> Expression PredType
preludeShowsPrec p :: Integer
p e :: Expression PredType
e = (Expression PredType -> Expression PredType -> Expression PredType)
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo) Expression PredType
e (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$
SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo (SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qShowsPrecId) (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$
SpanInfo -> PredType -> Literal -> Expression PredType
forall a. SpanInfo -> a -> Literal -> Expression a
Literal SpanInfo
NoSpanInfo PredType
predIntType (Literal -> Expression PredType) -> Literal -> Expression PredType
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
Int Integer
p
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow [ Type
intType, Expression PredType -> Type
forall a. Typeable a => a -> Type
typeOf Expression PredType
e
, Type
stringType, Type
stringType
]
preludeShowString :: String -> Expression PredType
preludeShowString :: String -> Expression PredType
preludeShowString s :: String
s = SpanInfo
-> Expression PredType
-> Expression PredType
-> Expression PredType
forall a. SpanInfo -> Expression a -> Expression a -> Expression a
Apply SpanInfo
NoSpanInfo (SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo PredType
pty QualIdent
qShowStringId) (Expression PredType -> Expression PredType)
-> Expression PredType -> Expression PredType
forall a b. (a -> b) -> a -> b
$
SpanInfo -> PredType -> Literal -> Expression PredType
forall a. SpanInfo -> a -> Literal -> Expression a
Literal SpanInfo
NoSpanInfo PredType
predStringType (Literal -> Expression PredType) -> Literal -> Expression PredType
forall a b. (a -> b) -> a -> b
$ String -> Literal
String String
s
where pty :: PredType
pty = Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
TypeArrow ([Type] -> Type) -> [Type] -> Type
forall a b. (a -> b) -> a -> b
$ Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate 3 Type
stringType
preludeFailed :: Type -> Expression PredType
preludeFailed :: Type -> Expression PredType
preludeFailed ty :: Type
ty = SpanInfo -> PredType -> QualIdent -> Expression PredType
forall a. SpanInfo -> a -> QualIdent -> Expression a
Variable SpanInfo
NoSpanInfo (Type -> PredType
predType Type
ty) QualIdent
qFailedId