module DDF.UnLiftEnv where
import DDF.DLang
import qualified DDF.Map as Map
newtype UnLiftEnv r h x = UnLiftEnv {runUnLiftEnv :: r () (h -> x)}
unLiftEnv = UnLiftEnv . const1
instance (Prod r, Unit r) => DBI (UnLiftEnv r) where
z = UnLiftEnv zro
s (UnLiftEnv x) = UnLiftEnv $ x `com2` fst
abs (UnLiftEnv x) = UnLiftEnv $ curry1 $ x `com2` swap
app (UnLiftEnv f) (UnLiftEnv x) = UnLiftEnv $ scomb2 f x
liftEnv (UnLiftEnv x) = UnLiftEnv $ x `com2` (const1 unit)
instance (Dual r, Unit r) => Dual (UnLiftEnv r) where
dual = unLiftEnv dual
runDual = unLiftEnv runDual
instance (Prod r, Unit r, Float r) => Float (UnLiftEnv r) where
float = unLiftEnv . float
floatPlus = unLiftEnv floatPlus
floatMinus = unLiftEnv floatMinus
floatMult = unLiftEnv floatMult
floatDivide = unLiftEnv floatDivide
floatExp = unLiftEnv floatExp
instance (Prod r, Unit r, Double r) => Double (UnLiftEnv r) where
double = unLiftEnv . double
doublePlus = unLiftEnv doublePlus
doubleMinus = unLiftEnv doubleMinus
doubleMult = unLiftEnv doubleMult
doubleDivide = unLiftEnv doubleDivide
doubleExp = unLiftEnv doubleExp
instance (Prod r, Unit r, Char r) => Char (UnLiftEnv r) where
char = unLiftEnv . char
instance (Prod r, Unit r, Bool r) => Bool (UnLiftEnv r) where
bool = unLiftEnv . bool
ite = unLiftEnv ite
instance (Prod r, Unit r) => Prod (UnLiftEnv r) where
mkProd = unLiftEnv mkProd
zro = unLiftEnv zro
fst = unLiftEnv fst
instance (Prod r, Unit r) => Unit (UnLiftEnv r) where
unit = unLiftEnv unit
instance (Prod r, Unit r, Option r) => Option (UnLiftEnv r) where
nothing = unLiftEnv nothing
just = unLiftEnv just
optionMatch = unLiftEnv optionMatch
instance (Unit r, Map.Map r) => Map.Map (UnLiftEnv r) where
empty = unLiftEnv Map.empty
singleton = unLiftEnv Map.singleton
lookup = unLiftEnv Map.lookup
alter = unLiftEnv Map.alter
mapMap = unLiftEnv Map.mapMap
instance (Unit r, Bimap r) => Bimap (UnLiftEnv r) where
instance Lang r => Lang (UnLiftEnv r) where
fix = unLiftEnv fix
left = unLiftEnv left
right = unLiftEnv right
sumMatch = unLiftEnv sumMatch
exfalso = unLiftEnv exfalso
ioRet = unLiftEnv ioRet
ioBind = unLiftEnv ioBind
ioMap = unLiftEnv ioMap
nil = unLiftEnv nil
cons = unLiftEnv cons
listMatch = unLiftEnv listMatch
writer = unLiftEnv writer
runWriter = unLiftEnv runWriter
state = unLiftEnv state
runState = unLiftEnv runState
float2Double = unLiftEnv float2Double
double2Float = unLiftEnv double2Float
putStrLn = unLiftEnv putStrLn
instance DLang r => DLang (UnLiftEnv r) where