{-# LANGUAGE TypeFamilies #-}
module LLVM.Extra.Control (
arrayLoop,
arrayLoop2,
arrayLoopWithExit,
arrayLoop2WithExit,
fixedLengthLoop,
whileLoop,
whileLoopShared,
loopWithExit,
ifThenElse,
ifThen,
Select(select),
selectTraversable,
ifThenSelect,
ret,
retVoid,
) where
import qualified LLVM.Extra.ArithmeticPrivate as A
import qualified LLVM.Extra.TuplePrivate as Tuple
import LLVM.Extra.ArithmeticPrivate (cmp, sub, dec, advanceArrayElementPtr)
import qualified LLVM.Core as LLVM
import LLVM.Core
(getCurrentBasicBlock, newBasicBlock, defineBasicBlock,
br, condBr,
Value, value, valueOf,
phi, addPhiInputs,
CmpPredicate(CmpGT), CmpRet,
IsInteger, IsType, IsConst, IsPrimitive,
CodeGenFunction,
CodeGenModule, newModule, defineModule, writeBitcodeToFile, )
import qualified Control.Applicative as App
import qualified Data.Traversable as Trav
import Control.Monad (liftM3, liftM2, )
import Data.Tuple.HT (mapSnd, )
arrayLoop ::
(Tuple.Phi a, IsType b,
Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> Value (LLVM.Ptr b) -> a ->
(Value (LLVM.Ptr b) -> a -> CodeGenFunction r a) ->
CodeGenFunction r a
arrayLoop :: forall a b i r.
(Phi a, IsType b, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i) =>
Value i
-> Value (Ptr b)
-> a
-> (Value (Ptr b) -> a -> CodeGenFunction r a)
-> CodeGenFunction r a
arrayLoop Value i
len Value (Ptr b)
ptr a
start Value (Ptr b) -> a -> CodeGenFunction r a
loopBody =
((Value (Ptr b), a) -> a)
-> CodeGenFunction r (Value (Ptr b), a) -> CodeGenFunction r a
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value (Ptr b), a) -> a
forall a b. (a, b) -> b
snd (CodeGenFunction r (Value (Ptr b), a) -> CodeGenFunction r a)
-> CodeGenFunction r (Value (Ptr b), a) -> CodeGenFunction r a
forall a b. (a -> b) -> a -> b
$
Value i
-> (Value (Ptr b), a)
-> ((Value (Ptr b), a) -> CodeGenFunction r (Value (Ptr b), a))
-> CodeGenFunction r (Value (Ptr b), a)
forall s i r.
(Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> s -> (s -> CodeGenFunction r s) -> CodeGenFunction r s
fixedLengthLoop Value i
len (Value (Ptr b)
ptr, a
start) (((Value (Ptr b), a) -> CodeGenFunction r (Value (Ptr b), a))
-> CodeGenFunction r (Value (Ptr b), a))
-> ((Value (Ptr b), a) -> CodeGenFunction r (Value (Ptr b), a))
-> CodeGenFunction r (Value (Ptr b), a)
forall a b. (a -> b) -> a -> b
$ \(Value (Ptr b)
p,a
s) ->
(Value (Ptr b) -> a -> (Value (Ptr b), a))
-> CodeGenFunction r (Value (Ptr b))
-> CodeGenFunction r a
-> CodeGenFunction r (Value (Ptr b), a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)
(Value (Ptr b) -> CodeGenFunction r (Value (Ptr b))
forall a r.
IsType a =>
Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
advanceArrayElementPtr Value (Ptr b)
p)
(Value (Ptr b) -> a -> CodeGenFunction r a
loopBody Value (Ptr b)
p a
s)
arrayLoop2 ::
(Tuple.Phi s, IsType a, IsType b,
Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s ->
(Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s -> CodeGenFunction r s) ->
CodeGenFunction r s
arrayLoop2 :: forall s a b i r.
(Phi s, IsType a, IsType b, Num i, IsConst i, IsInteger i,
CmpRet i, IsPrimitive i) =>
Value i
-> Value (Ptr a)
-> Value (Ptr b)
-> s
-> (Value (Ptr a) -> Value (Ptr b) -> s -> CodeGenFunction r s)
-> CodeGenFunction r s
arrayLoop2 Value i
len Value (Ptr a)
ptrA Value (Ptr b)
ptrB s
start Value (Ptr a) -> Value (Ptr b) -> s -> CodeGenFunction r s
loopBody =
((Value (Ptr b), s) -> s)
-> CodeGenFunction r (Value (Ptr b), s) -> CodeGenFunction r s
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value (Ptr b), s) -> s
forall a b. (a, b) -> b
snd (CodeGenFunction r (Value (Ptr b), s) -> CodeGenFunction r s)
-> CodeGenFunction r (Value (Ptr b), s) -> CodeGenFunction r s
forall a b. (a -> b) -> a -> b
$
Value i
-> Value (Ptr a)
-> (Value (Ptr b), s)
-> (Value (Ptr a)
-> (Value (Ptr b), s) -> CodeGenFunction r (Value (Ptr b), s))
-> CodeGenFunction r (Value (Ptr b), s)
forall a b i r.
(Phi a, IsType b, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i) =>
Value i
-> Value (Ptr b)
-> a
-> (Value (Ptr b) -> a -> CodeGenFunction r a)
-> CodeGenFunction r a
arrayLoop Value i
len Value (Ptr a)
ptrA (Value (Ptr b)
ptrB,s
start)
(\Value (Ptr a)
pa (Value (Ptr b)
pb,s
s) ->
(Value (Ptr b) -> s -> (Value (Ptr b), s))
-> CodeGenFunction r (Value (Ptr b))
-> CodeGenFunction r s
-> CodeGenFunction r (Value (Ptr b), s)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)
(Value (Ptr b) -> CodeGenFunction r (Value (Ptr b))
forall a r.
IsType a =>
Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
advanceArrayElementPtr Value (Ptr b)
pb)
(Value (Ptr a) -> Value (Ptr b) -> s -> CodeGenFunction r s
loopBody Value (Ptr a)
pa Value (Ptr b)
pb s
s))
arrayLoopWithExit ::
(Tuple.Phi s, IsType a,
Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> Value (LLVM.Ptr a) -> s ->
(Value (LLVM.Ptr a) -> s -> CodeGenFunction r (Value Bool, s)) ->
CodeGenFunction r (Value i, s)
arrayLoopWithExit :: forall s a i r.
(Phi s, IsType a, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i) =>
Value i
-> Value (Ptr a)
-> s
-> (Value (Ptr a) -> s -> CodeGenFunction r (Value Bool, s))
-> CodeGenFunction r (Value i, s)
arrayLoopWithExit Value i
len Value (Ptr a)
ptr s
start Value (Ptr a) -> s -> CodeGenFunction r (Value Bool, s)
loopBody = do
((Value Bool
_, s
vars), (Value i
i,Value (Ptr a)
_)) <-
((Value Bool, s), (Value i, Value (Ptr a)))
-> (((Value Bool, s), (Value i, Value (Ptr a)))
-> (CodeGenFunction r (Value Bool),
CodeGenFunction r ((Value Bool, s), (Value i, Value (Ptr a)))))
-> CodeGenFunction r ((Value Bool, s), (Value i, Value (Ptr a)))
forall a r.
Phi a =>
a
-> (a -> (CodeGenFunction r (Value Bool), CodeGenFunction r a))
-> CodeGenFunction r a
whileLoopShared ((Bool -> Value Bool
forall a. IsConst a => a -> Value a
valueOf Bool
True, s
start), (Value i
len, Value (Ptr a)
ptr)) ((((Value Bool, s), (Value i, Value (Ptr a)))
-> (CodeGenFunction r (Value Bool),
CodeGenFunction r ((Value Bool, s), (Value i, Value (Ptr a)))))
-> CodeGenFunction r ((Value Bool, s), (Value i, Value (Ptr a))))
-> (((Value Bool, s), (Value i, Value (Ptr a)))
-> (CodeGenFunction r (Value Bool),
CodeGenFunction r ((Value Bool, s), (Value i, Value (Ptr a)))))
-> CodeGenFunction r ((Value Bool, s), (Value i, Value (Ptr a)))
forall a b. (a -> b) -> a -> b
$ \((Value Bool
b,s
v0), (Value i
i,Value (Ptr a)
p)) ->
(Value Bool -> Value Bool -> CodeGenFunction r (Value Bool)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
A.and Value Bool
b (Value Bool -> CodeGenFunction r (Value Bool))
-> CodeGenFunction r (Value Bool) -> CodeGenFunction r (Value Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmpPredicate
-> Value i -> Value i -> CodeGenFunction r (Value Bool)
forall a b r.
(CmpRet a, CmpResult a ~ b) =>
CmpPredicate -> Value a -> Value a -> CodeGenFunction r (Value b)
cmp CmpPredicate
CmpGT Value i
i (ConstValue i -> Value i
forall a. ConstValue a -> Value a
value ConstValue i
forall a. IsType a => ConstValue a
LLVM.zero),
do (Value Bool, s)
bv1 <- Value (Ptr a) -> s -> CodeGenFunction r (Value Bool, s)
loopBody Value (Ptr a)
p s
v0
(Value i, Value (Ptr a))
ip1 <-
Value Bool
-> (Value i, Value (Ptr a))
-> CodeGenFunction r (Value i, Value (Ptr a))
-> CodeGenFunction r (Value i, Value (Ptr a))
forall a r.
Phi a =>
Value Bool -> a -> CodeGenFunction r a -> CodeGenFunction r a
ifThen ((Value Bool, s) -> Value Bool
forall a b. (a, b) -> a
fst (Value Bool, s)
bv1) (Value i
i,Value (Ptr a)
p) (CodeGenFunction r (Value i, Value (Ptr a))
-> CodeGenFunction r (Value i, Value (Ptr a)))
-> CodeGenFunction r (Value i, Value (Ptr a))
-> CodeGenFunction r (Value i, Value (Ptr a))
forall a b. (a -> b) -> a -> b
$
(Value i -> Value (Ptr a) -> (Value i, Value (Ptr a)))
-> CodeGenFunction r (Value i)
-> CodeGenFunction r (Value (Ptr a))
-> CodeGenFunction r (Value i, Value (Ptr a))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)
(Value i -> CodeGenFunction r (Value i)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
dec Value i
i)
(Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
forall a r.
IsType a =>
Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
advanceArrayElementPtr Value (Ptr a)
p)
((Value Bool, s), (Value i, Value (Ptr a)))
-> CodeGenFunction r ((Value Bool, s), (Value i, Value (Ptr a)))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Value Bool, s)
bv1,(Value i, Value (Ptr a))
ip1))
Value i
pos <- Value i -> Value i -> CodeGenFunction r (Value i)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
sub Value i
len Value i
i
(Value i, s) -> CodeGenFunction r (Value i, s)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value i
pos, s
vars)
_arrayLoopWithExitDecLoop ::
(Tuple.Phi a, IsType b,
Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> Value (LLVM.Ptr b) -> a ->
(Value (LLVM.Ptr b) -> a -> CodeGenFunction r (Value Bool, a)) ->
CodeGenFunction r (Value i, a)
_arrayLoopWithExitDecLoop :: forall s a i r.
(Phi s, IsType a, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i) =>
Value i
-> Value (Ptr a)
-> s
-> (Value (Ptr a) -> s -> CodeGenFunction r (Value Bool, s))
-> CodeGenFunction r (Value i, s)
_arrayLoopWithExitDecLoop Value i
len Value (Ptr b)
ptr a
start Value (Ptr b) -> a -> CodeGenFunction r (Value Bool, a)
loopBody = do
BasicBlock
top <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
getCurrentBasicBlock
BasicBlock
checkEnd <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
BasicBlock
loop <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
BasicBlock
next <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
BasicBlock
exit <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
Value Bool
t0 <- CmpPredicate
-> Value i -> Value i -> CodeGenFunction r (Value Bool)
forall a b r.
(CmpRet a, CmpResult a ~ b) =>
CmpPredicate -> Value a -> Value a -> CodeGenFunction r (Value b)
cmp CmpPredicate
CmpGT Value i
len (ConstValue i -> Value i
forall a. ConstValue a -> Value a
value ConstValue i
forall a. IsType a => ConstValue a
LLVM.zero)
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
br BasicBlock
checkEnd
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
checkEnd
Value i
i <- [(Value i, BasicBlock)] -> CodeGenFunction r (Value i)
forall a r.
IsFirstClass a =>
[(Value a, BasicBlock)] -> CodeGenFunction r (Value a)
phi [(Value i
len, BasicBlock
top)]
Value (Ptr b)
p <- [(Value (Ptr b), BasicBlock)] -> CodeGenFunction r (Value (Ptr b))
forall a r.
IsFirstClass a =>
[(Value a, BasicBlock)] -> CodeGenFunction r (Value a)
phi [(Value (Ptr b)
ptr, BasicBlock
top)]
a
vars <- BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> a -> CodeGenFunction r a
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
Tuple.phi BasicBlock
top a
start
Value Bool
t <- [(Value Bool, BasicBlock)] -> CodeGenFunction r (Value Bool)
forall a r.
IsFirstClass a =>
[(Value a, BasicBlock)] -> CodeGenFunction r (Value a)
phi [(Value Bool
t0, BasicBlock
top)]
Value Bool -> BasicBlock -> BasicBlock -> CodeGenFunction r ()
forall r.
Value Bool -> BasicBlock -> BasicBlock -> CodeGenFunction r ()
condBr Value Bool
t BasicBlock
loop BasicBlock
exit
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
loop
(Value Bool
cont, a
vars') <- Value (Ptr b) -> a -> CodeGenFunction r (Value Bool, a)
loopBody Value (Ptr b)
p a
vars
BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> a -> a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
next a
vars a
vars'
Value Bool -> BasicBlock -> BasicBlock -> CodeGenFunction r ()
forall r.
Value Bool -> BasicBlock -> BasicBlock -> CodeGenFunction r ()
condBr Value Bool
cont BasicBlock
next BasicBlock
exit
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
next
Value (Ptr b)
p' <- Value (Ptr b) -> CodeGenFunction r (Value (Ptr b))
forall a r.
IsType a =>
Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
advanceArrayElementPtr Value (Ptr b)
p
Value i
i' <- Value i -> CodeGenFunction r (Value i)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
dec Value i
i
Value Bool
t' <- CmpPredicate
-> Value i -> Value i -> CodeGenFunction r (Value Bool)
forall a b r.
(CmpRet a, CmpResult a ~ b) =>
CmpPredicate -> Value a -> Value a -> CodeGenFunction r (Value b)
cmp CmpPredicate
CmpGT Value i
i' (ConstValue i -> Value i
forall a. ConstValue a -> Value a
value ConstValue i
forall a. IsType a => ConstValue a
LLVM.zero)
Value i -> [(Value i, BasicBlock)] -> CodeGenFunction r ()
forall a r.
IsFirstClass a =>
Value a -> [(Value a, BasicBlock)] -> CodeGenFunction r ()
addPhiInputs Value i
i [(Value i
i', BasicBlock
next)]
Value (Ptr b)
-> [(Value (Ptr b), BasicBlock)] -> CodeGenFunction r ()
forall a r.
IsFirstClass a =>
Value a -> [(Value a, BasicBlock)] -> CodeGenFunction r ()
addPhiInputs Value (Ptr b)
p [(Value (Ptr b)
p', BasicBlock
next)]
Value Bool -> [(Value Bool, BasicBlock)] -> CodeGenFunction r ()
forall a r.
IsFirstClass a =>
Value a -> [(Value a, BasicBlock)] -> CodeGenFunction r ()
addPhiInputs Value Bool
t [(Value Bool
t', BasicBlock
next)]
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
br BasicBlock
checkEnd
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
exit
Value i
pos <- Value i -> Value i -> CodeGenFunction r (Value i)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
sub Value i
len Value i
i
(Value i, a) -> CodeGenFunction r (Value i, a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value i
pos, a
vars)
arrayLoop2WithExit ::
(Tuple.Phi s, IsType a, IsType b,
Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s ->
(Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s -> CodeGenFunction r (Value Bool, s)) ->
CodeGenFunction r (Value i, s)
arrayLoop2WithExit :: forall s a b i r.
(Phi s, IsType a, IsType b, Num i, IsConst i, IsInteger i,
CmpRet i, IsPrimitive i) =>
Value i
-> Value (Ptr a)
-> Value (Ptr b)
-> s
-> (Value (Ptr a)
-> Value (Ptr b) -> s -> CodeGenFunction r (Value Bool, s))
-> CodeGenFunction r (Value i, s)
arrayLoop2WithExit Value i
len Value (Ptr a)
ptrA Value (Ptr b)
ptrB s
start Value (Ptr a)
-> Value (Ptr b) -> s -> CodeGenFunction r (Value Bool, s)
loopBody =
((Value i, (Value (Ptr b), s)) -> (Value i, s))
-> CodeGenFunction r (Value i, (Value (Ptr b), s))
-> CodeGenFunction r (Value i, s)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Value (Ptr b), s) -> s)
-> (Value i, (Value (Ptr b), s)) -> (Value i, s)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (Value (Ptr b), s) -> s
forall a b. (a, b) -> b
snd) (CodeGenFunction r (Value i, (Value (Ptr b), s))
-> CodeGenFunction r (Value i, s))
-> CodeGenFunction r (Value i, (Value (Ptr b), s))
-> CodeGenFunction r (Value i, s)
forall a b. (a -> b) -> a -> b
$
Value i
-> Value (Ptr a)
-> (Value (Ptr b), s)
-> (Value (Ptr a)
-> (Value (Ptr b), s)
-> CodeGenFunction r (Value Bool, (Value (Ptr b), s)))
-> CodeGenFunction r (Value i, (Value (Ptr b), s))
forall s a i r.
(Phi s, IsType a, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i) =>
Value i
-> Value (Ptr a)
-> s
-> (Value (Ptr a) -> s -> CodeGenFunction r (Value Bool, s))
-> CodeGenFunction r (Value i, s)
arrayLoopWithExit Value i
len Value (Ptr a)
ptrA (Value (Ptr b)
ptrB,s
start)
(\Value (Ptr a)
ptrAi (Value (Ptr b)
ptrB0,s
s0) -> do
(Value Bool
cont, s
s1) <- Value (Ptr a)
-> Value (Ptr b) -> s -> CodeGenFunction r (Value Bool, s)
loopBody Value (Ptr a)
ptrAi Value (Ptr b)
ptrB0 s
s0
Value (Ptr b)
ptrB1 <- Value (Ptr b) -> CodeGenFunction r (Value (Ptr b))
forall a r.
IsType a =>
Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
advanceArrayElementPtr Value (Ptr b)
ptrB0
(Value Bool, (Value (Ptr b), s))
-> CodeGenFunction r (Value Bool, (Value (Ptr b), s))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value Bool
cont, (Value (Ptr b)
ptrB1,s
s1)))
fixedLengthLoop ::
(Tuple.Phi s,
Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> s ->
(s -> CodeGenFunction r s) ->
CodeGenFunction r s
fixedLengthLoop :: forall s i r.
(Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> s -> (s -> CodeGenFunction r s) -> CodeGenFunction r s
fixedLengthLoop Value i
len s
start s -> CodeGenFunction r s
loopBody =
((Value i, s) -> s)
-> CodeGenFunction r (Value i, s) -> CodeGenFunction r s
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value i, s) -> s
forall a b. (a, b) -> b
snd (CodeGenFunction r (Value i, s) -> CodeGenFunction r s)
-> CodeGenFunction r (Value i, s) -> CodeGenFunction r s
forall a b. (a -> b) -> a -> b
$
(Value i, s)
-> ((Value i, s)
-> (CodeGenFunction r (Value Bool),
CodeGenFunction r (Value i, s)))
-> CodeGenFunction r (Value i, s)
forall a r.
Phi a =>
a
-> (a -> (CodeGenFunction r (Value Bool), CodeGenFunction r a))
-> CodeGenFunction r a
whileLoopShared (Value i
len,s
start) (((Value i, s)
-> (CodeGenFunction r (Value Bool),
CodeGenFunction r (Value i, s)))
-> CodeGenFunction r (Value i, s))
-> ((Value i, s)
-> (CodeGenFunction r (Value Bool),
CodeGenFunction r (Value i, s)))
-> CodeGenFunction r (Value i, s)
forall a b. (a -> b) -> a -> b
$ \(Value i
i,s
s) ->
(CmpPredicate
-> Value i -> Value i -> CodeGenFunction r (Value Bool)
forall a b r.
(CmpRet a, CmpResult a ~ b) =>
CmpPredicate -> Value a -> Value a -> CodeGenFunction r (Value b)
cmp CmpPredicate
LLVM.CmpGT Value i
i (ConstValue i -> Value i
forall a. ConstValue a -> Value a
value ConstValue i
forall a. IsType a => ConstValue a
LLVM.zero),
(Value i -> s -> (Value i, s))
-> CodeGenFunction r (Value i)
-> CodeGenFunction r s
-> CodeGenFunction r (Value i, s)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (Value i -> CodeGenFunction r (Value i)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
dec Value i
i) (s -> CodeGenFunction r s
loopBody s
s))
whileLoop, _whileLoop ::
Tuple.Phi a =>
a ->
(a -> CodeGenFunction r (Value Bool)) ->
(a -> CodeGenFunction r a) ->
CodeGenFunction r a
whileLoop :: forall a r.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool))
-> (a -> CodeGenFunction r a)
-> CodeGenFunction r a
whileLoop a
start a -> CodeGenFunction r (Value Bool)
check a -> CodeGenFunction r a
body =
a
-> (a -> CodeGenFunction r (Value Bool, a))
-> (a -> CodeGenFunction r a)
-> CodeGenFunction r a
forall a r b.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool, b))
-> (b -> CodeGenFunction r a)
-> CodeGenFunction r b
loopWithExit a
start
(\a
a -> (Value Bool -> (Value Bool, a))
-> CodeGenFunction r (Value Bool)
-> CodeGenFunction r (Value Bool, a)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value Bool -> a -> (Value Bool, a))
-> a -> Value Bool -> (Value Bool, a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) a
a) (CodeGenFunction r (Value Bool)
-> CodeGenFunction r (Value Bool, a))
-> CodeGenFunction r (Value Bool)
-> CodeGenFunction r (Value Bool, a)
forall a b. (a -> b) -> a -> b
$ a -> CodeGenFunction r (Value Bool)
check a
a)
a -> CodeGenFunction r a
body
_whileLoop :: forall a r.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool))
-> (a -> CodeGenFunction r a)
-> CodeGenFunction r a
_whileLoop a
start a -> CodeGenFunction r (Value Bool)
check a -> CodeGenFunction r a
body = do
BasicBlock
top <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
getCurrentBasicBlock
BasicBlock
loop <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
BasicBlock
cont <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
BasicBlock
exit <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
br BasicBlock
loop
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
loop
a
state <- BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> a -> CodeGenFunction r a
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
Tuple.phi BasicBlock
top a
start
Value Bool
b <- a -> CodeGenFunction r (Value Bool)
check a
state
Value Bool -> BasicBlock -> BasicBlock -> CodeGenFunction r ()
forall r.
Value Bool -> BasicBlock -> BasicBlock -> CodeGenFunction r ()
condBr Value Bool
b BasicBlock
cont BasicBlock
exit
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
cont
a
res <- a -> CodeGenFunction r a
body a
state
BasicBlock
cont' <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
getCurrentBasicBlock
BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> a -> a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
cont' a
state a
res
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
br BasicBlock
loop
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
exit
a -> CodeGenFunction r a
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return a
state
loopWithExit ::
Tuple.Phi a =>
a ->
(a -> CodeGenFunction r (Value Bool, b)) ->
(b -> CodeGenFunction r a) ->
CodeGenFunction r b
loopWithExit :: forall a r b.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool, b))
-> (b -> CodeGenFunction r a)
-> CodeGenFunction r b
loopWithExit a
start a -> CodeGenFunction r (Value Bool, b)
check b -> CodeGenFunction r a
body = do
BasicBlock
top <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
getCurrentBasicBlock
BasicBlock
loop <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
BasicBlock
cont <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
BasicBlock
exit <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
br BasicBlock
loop
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
loop
a
state <- BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> a -> CodeGenFunction r a
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
Tuple.phi BasicBlock
top a
start
(Value Bool
contB,b
b) <- a -> CodeGenFunction r (Value Bool, b)
check a
state
Value Bool -> BasicBlock -> BasicBlock -> CodeGenFunction r ()
forall r.
Value Bool -> BasicBlock -> BasicBlock -> CodeGenFunction r ()
condBr Value Bool
contB BasicBlock
cont BasicBlock
exit
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
cont
a
a <- b -> CodeGenFunction r a
body b
b
BasicBlock
cont' <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
getCurrentBasicBlock
BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> a -> a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
cont' a
state a
a
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
br BasicBlock
loop
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
exit
b -> CodeGenFunction r b
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
whileLoopShared ::
Tuple.Phi a =>
a ->
(a ->
(CodeGenFunction r (Value Bool),
CodeGenFunction r a)) ->
CodeGenFunction r a
whileLoopShared :: forall a r.
Phi a =>
a
-> (a -> (CodeGenFunction r (Value Bool), CodeGenFunction r a))
-> CodeGenFunction r a
whileLoopShared a
start a -> (CodeGenFunction r (Value Bool), CodeGenFunction r a)
checkBody =
a
-> (a -> CodeGenFunction r (Value Bool))
-> (a -> CodeGenFunction r a)
-> CodeGenFunction r a
forall a r.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool))
-> (a -> CodeGenFunction r a)
-> CodeGenFunction r a
whileLoop a
start
((CodeGenFunction r (Value Bool), CodeGenFunction r a)
-> CodeGenFunction r (Value Bool)
forall a b. (a, b) -> a
fst ((CodeGenFunction r (Value Bool), CodeGenFunction r a)
-> CodeGenFunction r (Value Bool))
-> (a -> (CodeGenFunction r (Value Bool), CodeGenFunction r a))
-> a
-> CodeGenFunction r (Value Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (CodeGenFunction r (Value Bool), CodeGenFunction r a)
checkBody)
((CodeGenFunction r (Value Bool), CodeGenFunction r a)
-> CodeGenFunction r a
forall a b. (a, b) -> b
snd ((CodeGenFunction r (Value Bool), CodeGenFunction r a)
-> CodeGenFunction r a)
-> (a -> (CodeGenFunction r (Value Bool), CodeGenFunction r a))
-> a
-> CodeGenFunction r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (CodeGenFunction r (Value Bool), CodeGenFunction r a)
checkBody)
ifThenElse ::
Tuple.Phi a =>
Value Bool ->
CodeGenFunction r a ->
CodeGenFunction r a ->
CodeGenFunction r a
ifThenElse :: forall a r.
Phi a =>
Value Bool
-> CodeGenFunction r a
-> CodeGenFunction r a
-> CodeGenFunction r a
ifThenElse Value Bool
cond CodeGenFunction r a
thenCode CodeGenFunction r a
elseCode = do
BasicBlock
thenBlock <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
BasicBlock
elseBlock <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
BasicBlock
mergeBlock <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
Value Bool -> BasicBlock -> BasicBlock -> CodeGenFunction r ()
forall r.
Value Bool -> BasicBlock -> BasicBlock -> CodeGenFunction r ()
condBr Value Bool
cond BasicBlock
thenBlock BasicBlock
elseBlock
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
thenBlock
a
a0 <- CodeGenFunction r a
thenCode
BasicBlock
thenBlock' <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
getCurrentBasicBlock
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
br BasicBlock
mergeBlock
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
elseBlock
a
a1 <- CodeGenFunction r a
elseCode
BasicBlock
elseBlock' <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
getCurrentBasicBlock
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
br BasicBlock
mergeBlock
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
mergeBlock
a
a2 <- BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> a -> CodeGenFunction r a
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
Tuple.phi BasicBlock
thenBlock' a
a0
BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> a -> a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
elseBlock' a
a2 a
a1
a -> CodeGenFunction r a
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a2
ifThen ::
Tuple.Phi a =>
Value Bool ->
a ->
CodeGenFunction r a ->
CodeGenFunction r a
ifThen :: forall a r.
Phi a =>
Value Bool -> a -> CodeGenFunction r a -> CodeGenFunction r a
ifThen Value Bool
cond a
deflt CodeGenFunction r a
thenCode = do
BasicBlock
defltBlock <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
getCurrentBasicBlock
BasicBlock
thenBlock <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
BasicBlock
mergeBlock <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
newBasicBlock
Value Bool -> BasicBlock -> BasicBlock -> CodeGenFunction r ()
forall r.
Value Bool -> BasicBlock -> BasicBlock -> CodeGenFunction r ()
condBr Value Bool
cond BasicBlock
thenBlock BasicBlock
mergeBlock
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
thenBlock
a
a0 <- CodeGenFunction r a
thenCode
BasicBlock
thenBlock' <- CodeGenFunction r BasicBlock
forall r. CodeGenFunction r BasicBlock
getCurrentBasicBlock
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
br BasicBlock
mergeBlock
BasicBlock -> CodeGenFunction r ()
forall r. BasicBlock -> CodeGenFunction r ()
defineBasicBlock BasicBlock
mergeBlock
a
a1 <- BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> a -> CodeGenFunction r a
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
Tuple.phi BasicBlock
defltBlock a
deflt
BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> a -> a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
thenBlock' a
a1 a
a0
a -> CodeGenFunction r a
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a1
class Tuple.Phi a => Select a where
select :: Value Bool -> a -> a -> CodeGenFunction r a
instance (CmpRet a, IsPrimitive a) => Select (Value a) where
select :: forall r.
Value Bool -> Value a -> Value a -> CodeGenFunction r (Value a)
select = Value Bool -> Value a -> Value a -> CodeGenFunction r (Value a)
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select
instance Select () where
select :: forall r. Value Bool -> () -> () -> CodeGenFunction r ()
select Value Bool
_ () () = () -> CodeGenFunction r ()
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance (Select a, Select b) => Select (a,b) where
select :: forall r.
Value Bool -> (a, b) -> (a, b) -> CodeGenFunction r (a, b)
select Value Bool
cond (a
a0,b
b0) (a
a1,b
b1) =
(a -> b -> (a, b))
-> CodeGenFunction r a
-> CodeGenFunction r b
-> CodeGenFunction r (a, b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)
(Value Bool -> a -> a -> CodeGenFunction r a
forall r. Value Bool -> a -> a -> CodeGenFunction r a
forall a r. Select a => Value Bool -> a -> a -> CodeGenFunction r a
select Value Bool
cond a
a0 a
a1)
(Value Bool -> b -> b -> CodeGenFunction r b
forall r. Value Bool -> b -> b -> CodeGenFunction r b
forall a r. Select a => Value Bool -> a -> a -> CodeGenFunction r a
select Value Bool
cond b
b0 b
b1)
instance (Select a, Select b, Select c) => Select (a,b,c) where
select :: forall r.
Value Bool -> (a, b, c) -> (a, b, c) -> CodeGenFunction r (a, b, c)
select Value Bool
cond (a
a0,b
b0,c
c0) (a
a1,b
b1,c
c1) =
(a -> b -> c -> (a, b, c))
-> CodeGenFunction r a
-> CodeGenFunction r b
-> CodeGenFunction r c
-> CodeGenFunction r (a, b, c)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,)
(Value Bool -> a -> a -> CodeGenFunction r a
forall r. Value Bool -> a -> a -> CodeGenFunction r a
forall a r. Select a => Value Bool -> a -> a -> CodeGenFunction r a
select Value Bool
cond a
a0 a
a1)
(Value Bool -> b -> b -> CodeGenFunction r b
forall r. Value Bool -> b -> b -> CodeGenFunction r b
forall a r. Select a => Value Bool -> a -> a -> CodeGenFunction r a
select Value Bool
cond b
b0 b
b1)
(Value Bool -> c -> c -> CodeGenFunction r c
forall r. Value Bool -> c -> c -> CodeGenFunction r c
forall a r. Select a => Value Bool -> a -> a -> CodeGenFunction r a
select Value Bool
cond c
c0 c
c1)
selectTraversable ::
(Select a, Trav.Traversable f, App.Applicative f) =>
Value Bool -> f a -> f a -> CodeGenFunction r (f a)
selectTraversable :: forall a (f :: * -> *) r.
(Select a, Traversable f, Applicative f) =>
Value Bool -> f a -> f a -> CodeGenFunction r (f a)
selectTraversable Value Bool
b f a
x f a
y =
f (CodeGenFunction r a) -> CodeGenFunction r (f a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => f (m a) -> m (f a)
Trav.sequence ((a -> a -> CodeGenFunction r a)
-> f a -> f a -> f (CodeGenFunction r a)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
App.liftA2 (Value Bool -> a -> a -> CodeGenFunction r a
forall r. Value Bool -> a -> a -> CodeGenFunction r a
forall a r. Select a => Value Bool -> a -> a -> CodeGenFunction r a
select Value Bool
b) f a
x f a
y)
ifThenSelect ::
Select a =>
Value Bool ->
a ->
CodeGenFunction r a ->
CodeGenFunction r a
ifThenSelect :: forall a r.
Select a =>
Value Bool -> a -> CodeGenFunction r a -> CodeGenFunction r a
ifThenSelect Value Bool
cond a
deflt CodeGenFunction r a
thenCode = do
a
thenResult <- CodeGenFunction r a
thenCode
Value Bool -> a -> a -> CodeGenFunction r a
forall r. Value Bool -> a -> a -> CodeGenFunction r a
forall a r. Select a => Value Bool -> a -> a -> CodeGenFunction r a
select Value Bool
cond a
thenResult a
deflt
ret :: Value a -> CodeGenFunction a ()
ret :: forall a. Value a -> CodeGenFunction a ()
ret = Value a -> CodeGenFunction a ()
Value a -> CodeGenFunction (Result (Value a)) ()
forall a. Ret a => a -> CodeGenFunction (Result a) ()
LLVM.ret
retVoid :: CodeGenFunction () ()
retVoid :: CodeGenFunction () ()
retVoid = () -> CodeGenFunction (Result ()) ()
forall a. Ret a => a -> CodeGenFunction (Result a) ()
LLVM.ret ()
_emitCode :: FilePath -> CodeGenModule a -> IO ()
_emitCode :: forall a. FilePath -> CodeGenModule a -> IO ()
_emitCode FilePath
fileName CodeGenModule a
cgm = do
Module
m <- IO Module
newModule
a
_ <- Module -> CodeGenModule a -> IO a
forall a. Module -> CodeGenModule a -> IO a
defineModule Module
m CodeGenModule a
cgm
FilePath -> Module -> IO ()
writeBitcodeToFile FilePath
fileName Module
m