module Language.Hakaru.CodeGen.Libs
(
expE, expm1E, logE, log1pE, sqrtE,
infinityE,negInfinityE,
printfE, sscanfE, fopenE, fcloseE, fileT, feofE, fgetsE, rewindE,
randE, srandE, mallocE, freeE,
gcHeader, gcInit, gcMalloc,
openMpHeader, ompGetNumThreads, ompGetThreadNum, OMP(..), Directive(..),
ompToPP
) where
import Language.Hakaru.CodeGen.AST
import Language.Hakaru.CodeGen.Pretty
import Text.PrettyPrint (render)
expE,expm1E,logE,log1pE,sqrtE :: CExpr -> CExpr
expE :: CExpr -> CExpr
expE = String -> CExpr -> CExpr
mkUnaryE String
"exp"
expm1E :: CExpr -> CExpr
expm1E = String -> CExpr -> CExpr
mkUnaryE String
"expm1"
logE :: CExpr -> CExpr
logE = String -> CExpr -> CExpr
mkUnaryE String
"log"
log1pE :: CExpr -> CExpr
log1pE = String -> CExpr -> CExpr
mkUnaryE String
"log1p"
sqrtE :: CExpr -> CExpr
sqrtE = String -> CExpr -> CExpr
mkUnaryE String
"sqrt"
infinityE,negInfinityE :: CExpr
infinityE :: CExpr
infinityE = (Integer -> CExpr
intE Integer
1) CExpr -> CExpr -> CExpr
./. (Integer -> CExpr
intE Integer
0)
negInfinityE :: CExpr
negInfinityE = CExpr -> CExpr
logE (Integer -> CExpr
intE Integer
0)
randE :: CExpr
randE :: CExpr
randE = String -> [CExpr] -> CExpr
mkCallE String
"rand" []
srandE :: CExpr -> CExpr
srandE :: CExpr -> CExpr
srandE CExpr
e = String -> [CExpr] -> CExpr
mkCallE String
"srand" [CExpr
e]
mallocE :: CExpr -> CExpr
mallocE :: CExpr -> CExpr
mallocE = String -> CExpr -> CExpr
mkUnaryE String
"malloc"
freeE :: CExpr -> CExpr
freeE :: CExpr -> CExpr
freeE = String -> CExpr -> CExpr
mkUnaryE String
"free"
printfE,sscanfE :: [CExpr] -> CExpr
printfE :: [CExpr] -> CExpr
printfE = String -> [CExpr] -> CExpr
mkCallE String
"printf"
sscanfE :: [CExpr] -> CExpr
sscanfE = String -> [CExpr] -> CExpr
mkCallE String
"sscanf"
fopenE :: CExpr -> CExpr -> CExpr
fopenE :: CExpr -> CExpr -> CExpr
fopenE CExpr
e0 CExpr
e1 = String -> [CExpr] -> CExpr
mkCallE String
"fopen" [CExpr
e0,CExpr
e1]
fcloseE,feofE,rewindE :: CExpr -> CExpr
fcloseE :: CExpr -> CExpr
fcloseE CExpr
e = String -> [CExpr] -> CExpr
mkCallE String
"fclose" [CExpr
e]
feofE :: CExpr -> CExpr
feofE CExpr
e = String -> [CExpr] -> CExpr
mkCallE String
"feof" [CExpr
e]
rewindE :: CExpr -> CExpr
rewindE CExpr
e = String -> [CExpr] -> CExpr
mkCallE String
"rewind" [CExpr
e]
fgetsE :: CExpr -> CExpr -> CExpr -> CExpr
fgetsE :: CExpr -> CExpr -> CExpr -> CExpr
fgetsE CExpr
e0 CExpr
e1 CExpr
e2 = String -> [CExpr] -> CExpr
mkCallE String
"fgets" [CExpr
e0,CExpr
e1,CExpr
e2]
fileT :: CTypeSpec
fileT :: CTypeSpec
fileT = Ident -> CTypeSpec
CTypeDefType (String -> Ident
Ident String
"FILE")
gcHeader :: Preprocessor
= String -> Preprocessor
PPInclude String
"gc.h"
gcInit :: CExpr
gcInit :: CExpr
gcInit = String -> [CExpr] -> CExpr
mkCallE String
"GC_INIT" []
gcMalloc :: CExpr -> CExpr
gcMalloc :: CExpr -> CExpr
gcMalloc CExpr
e = String -> [CExpr] -> CExpr
mkCallE String
"GC_MALLOC" [CExpr
e]
openMpHeader :: Preprocessor
= String -> Preprocessor
PPInclude String
"omp.h"
ompGetNumThreads :: CExpr
ompGetNumThreads :: CExpr
ompGetNumThreads = String -> [CExpr] -> CExpr
mkCallE String
"omp_get_num_threads" []
ompGetThreadNum :: CExpr
ompGetThreadNum :: CExpr
ompGetThreadNum = String -> [CExpr] -> CExpr
mkCallE String
"omp_get_thread_num" []
data OMP = OMP Directive
data Directive
= Parallel [Directive]
| For
| Critical
| Reduction (Either CBinaryOp Ident) [CExpr]
| DeclareRed Ident CTypeSpec CExpr CExpr
ompToPP :: OMP -> Preprocessor
ompToPP :: OMP -> Preprocessor
ompToPP (OMP Directive
d) = [String] -> Preprocessor
PPPragma ([String] -> Preprocessor) -> [String] -> Preprocessor
forall a b. (a -> b) -> a -> b
$ String
"omp"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(Directive -> [String]
showDirective Directive
d)
where showDirective :: Directive -> [String]
showDirective :: Directive -> [String]
showDirective (Parallel [Directive]
ds) = String
"parallel"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:((Directive -> [String]) -> [Directive] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Directive -> [String]
showDirective [Directive]
ds)
showDirective Directive
For = [String
"for"]
showDirective Directive
Critical = [String
"critical"]
showDirective (Reduction Either CBinaryOp Ident
eop [CExpr]
vs) =
let op :: String
op = case Either CBinaryOp Ident
eop of
Left CBinaryOp
binop -> Doc -> String
render (Doc -> String) -> (CBinaryOp -> Doc) -> CBinaryOp -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBinaryOp -> Doc
forall a. Pretty a => a -> Doc
pretty (CBinaryOp -> String) -> CBinaryOp -> String
forall a b. (a -> b) -> a -> b
$ CBinaryOp
binop
Right (Ident String
s) -> String
s
in [String
"reduction(",String
op,String
":",[String] -> String
unwords ([String] -> String) -> ([CExpr] -> [String]) -> [CExpr] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CExpr -> String) -> [CExpr] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc -> String
render(Doc -> String) -> (CExpr -> Doc) -> CExpr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CExpr -> Doc
forall a. Pretty a => a -> Doc
pretty) ([CExpr] -> String) -> [CExpr] -> String
forall a b. (a -> b) -> a -> b
$ [CExpr]
vs,String
")"]
showDirective (DeclareRed (Ident String
name) CTypeSpec
typ CExpr
mul CExpr
unit) =
let typ' :: String
typ' = Doc -> String
render (Doc -> String) -> (CTypeSpec -> Doc) -> CTypeSpec -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTypeSpec -> Doc
forall a. Pretty a => a -> Doc
pretty (CTypeSpec -> String) -> CTypeSpec -> String
forall a b. (a -> b) -> a -> b
$ CTypeSpec
typ
mul' :: String
mul' = Doc -> String
render (Doc -> String) -> (CExpr -> Doc) -> CExpr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CExpr -> Doc
forall a. Pretty a => a -> Doc
pretty (CExpr -> String) -> CExpr -> String
forall a b. (a -> b) -> a -> b
$ CExpr
mul
unit' :: String
unit' = Doc -> String
render (Doc -> String) -> (CExpr -> Doc) -> CExpr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CExpr -> Doc
forall a. Pretty a => a -> Doc
pretty (CExpr -> String) -> CExpr -> String
forall a b. (a -> b) -> a -> b
$ CExpr
unit
in [String
"declare",String
"reduction(",String
name,String
":",String
typ',String
":",String
mul',String
") initializer ("
,String
unit',String
")"]