/usr/share/doc/libghc-llvm-doc/examples/Arith.hs is in libghc-llvm-doc 3.0.0.0-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 | {-# OPTIONS_GHC -fno-warn-type-defaults #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Arith where
import Data.Int
import Data.TypeLevel(D4)
import LLVM.Core
import LLVM.ExecutionEngine
import LLVM.Util.Arithmetic
import LLVM.Util.Foreign as F
import LLVM.Util.File(writeCodeGenModule)
import Foreign.Storable
{-
import Foreign.Ptr
import Foreign.Marshal.Utils
import Foreign.Marshal.Alloc as F
-}
mSomeFn :: forall a b . (IsConst a, Floating a, IsFloating a, CallIntrinsic a,
FunctionRet a, Cmp a b
) => CodeGenModule (Function (a -> IO a))
mSomeFn = do
foo <- createFunction InternalLinkage $ arithFunction $ \ x y -> exp (sin x) + y
let foo' = toArithFunction foo
createFunction ExternalLinkage $ arithFunction $ \ x -> do
y <- set $ x^3
sqrt (x^2 - 5 * x + 6) + foo' x x + y + log y
mFib :: CodeGenModule (Function (Int32 -> IO Int32))
mFib = recursiveFunction $ \ rfib n -> n %< 2 ? (1, rfib (n-1) + rfib (n-2))
type V = Vector D4 Float
mVFun :: CodeGenModule (Function (Ptr V -> Ptr V -> IO ()))
mVFun = do
fn :: Function (V -> IO V)
<- createFunction ExternalLinkage $ arithFunction $ \ x ->
log x * exp x * x - 16
vectorToPtr fn
main :: IO ()
main = do
-- Initialize jitter
initializeNativeTarget
let mSomeFn' = mSomeFn
ioSomeFn <- simpleFunction mSomeFn'
let someFn :: Double -> Double
someFn = unsafePurify ioSomeFn
writeCodeGenModule "Arith.bc" mSomeFn'
print (someFn 10)
print (someFn 2)
writeCodeGenModule "ArithFib.bc" mFib
fib <- simpleFunction mFib
fib 22 >>= print
{-
writeCodeGenModule "VArith.bc" mVFun
ioVFun <- simpleFunction mVFun
let v = toVector (1,2,3,4)
r <- vectorPtrWrap ioVFun v
print r
-}
vectorToPtr :: Function (V -> IO V) -> CodeGenModule (Function (Ptr V -> Ptr V -> IO ()))
vectorToPtr f =
createFunction ExternalLinkage $ \ px py -> do
x <- load px
y <- call f x
store y py
ret ()
vectorPtrWrap :: (Ptr V -> Ptr V -> IO ()) -> V -> IO V
vectorPtrWrap f v =
with v $ \ aPtr ->
F.alloca $ \ bPtr -> do
f aPtr bPtr
peek bPtr
|