{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Futhark.CodeGen.Backends.PyOpenCL.Boilerplate
( openClInit
, openClPrelude
) where
import Data.FileEmbed
import qualified Data.Map as M
import qualified Data.Text as T
import NeatInterpolation (text)
import Futhark.CodeGen.ImpCode.OpenCL
(PrimType(..), SizeClass(..),
FailureMsg(..), ErrorMsg(..), ErrorMsgPart(..), errorMsgArgTypes)
import Futhark.CodeGen.OpenCL.Heuristics
import Futhark.CodeGen.Backends.GenericPython.AST
import Futhark.Util.Pretty (prettyText)
errorMsgNumArgs :: ErrorMsg a -> Int
errorMsgNumArgs :: ErrorMsg a -> Int
errorMsgNumArgs = [PrimType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PrimType] -> Int)
-> (ErrorMsg a -> [PrimType]) -> ErrorMsg a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMsg a -> [PrimType]
forall a. ErrorMsg a -> [PrimType]
errorMsgArgTypes
openClPrelude :: String
openClPrelude :: String
openClPrelude = $(embedStringFile "rts/python/opencl.py")
openClInit :: [PrimType] -> String -> M.Map Name SizeClass -> [FailureMsg] -> String
openClInit :: [PrimType]
-> String -> Map Name SizeClass -> [FailureMsg] -> String
openClInit [PrimType]
types String
assign Map Name SizeClass
sizes [FailureMsg]
failures = Text -> String
T.unpack [text|
size_heuristics=$size_heuristics
self.global_failure_args_max = $max_num_args
self.failure_msgs=$failure_msgs
program = initialise_opencl_object(self,
program_src=fut_opencl_src,
command_queue=command_queue,
interactive=interactive,
platform_pref=platform_pref,
device_pref=device_pref,
default_group_size=default_group_size,
default_num_groups=default_num_groups,
default_tile_size=default_tile_size,
default_threshold=default_threshold,
size_heuristics=size_heuristics,
required_types=$types',
user_sizes=sizes,
all_sizes=$sizes')
$assign'
|]
where assign' :: Text
assign' = String -> Text
T.pack String
assign
size_heuristics :: Text
size_heuristics = PyExp -> Text
forall a. Pretty a => a -> Text
prettyText (PyExp -> Text) -> PyExp -> Text
forall a b. (a -> b) -> a -> b
$ [SizeHeuristic] -> PyExp
sizeHeuristicsToPython [SizeHeuristic]
sizeHeuristicsTable
types' :: Text
types' = [String] -> Text
forall a. Pretty a => a -> Text
prettyText ([String] -> Text) -> [String] -> Text
forall a b. (a -> b) -> a -> b
$ (PrimType -> String) -> [PrimType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
forall a. Show a => a -> String
show (String -> String) -> (PrimType -> String) -> PrimType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimType -> String
forall a. Pretty a => a -> String
pretty) [PrimType]
types
sizes' :: Text
sizes' = PyExp -> Text
forall a. Pretty a => a -> Text
prettyText (PyExp -> Text) -> PyExp -> Text
forall a b. (a -> b) -> a -> b
$ Map Name SizeClass -> PyExp
sizeClassesToPython Map Name SizeClass
sizes
max_num_args :: Text
max_num_args = Int -> Text
forall a. Pretty a => a -> Text
prettyText (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (FailureMsg -> Int) -> [FailureMsg] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (ErrorMsg Exp -> Int
forall a. ErrorMsg a -> Int
errorMsgNumArgs (ErrorMsg Exp -> Int)
-> (FailureMsg -> ErrorMsg Exp) -> FailureMsg -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailureMsg -> ErrorMsg Exp
failureError) [FailureMsg]
failures
failure_msgs :: Text
failure_msgs = PyExp -> Text
forall a. Pretty a => a -> Text
prettyText (PyExp -> Text) -> PyExp -> Text
forall a b. (a -> b) -> a -> b
$ [PyExp] -> PyExp
List ([PyExp] -> PyExp) -> [PyExp] -> PyExp
forall a b. (a -> b) -> a -> b
$ (FailureMsg -> PyExp) -> [FailureMsg] -> [PyExp]
forall a b. (a -> b) -> [a] -> [b]
map FailureMsg -> PyExp
formatFailure [FailureMsg]
failures
formatFailure :: FailureMsg -> PyExp
formatFailure :: FailureMsg -> PyExp
formatFailure (FailureMsg (ErrorMsg [ErrorMsgPart Exp]
parts) String
backtrace) =
String -> PyExp
String (String -> PyExp) -> String -> PyExp
forall a b. (a -> b) -> a -> b
$ (ErrorMsgPart Exp -> String) -> [ErrorMsgPart Exp] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ErrorMsgPart Exp -> String
forall a. ErrorMsgPart a -> String
onPart [ErrorMsgPart Exp]
parts String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
formatEscape String
backtrace
where formatEscape :: String -> String
formatEscape = let escapeChar :: Char -> String
escapeChar Char
'{' = String
"{{"
escapeChar Char
'}' = String
"}}"
escapeChar Char
c = [Char
c]
in (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeChar
onPart :: ErrorMsgPart a -> String
onPart (ErrorString String
s) = String -> String
formatEscape String
s
onPart ErrorInt32{} = String
"{}"
sizeClassesToPython :: M.Map Name SizeClass -> PyExp
sizeClassesToPython :: Map Name SizeClass -> PyExp
sizeClassesToPython = [(PyExp, PyExp)] -> PyExp
Dict ([(PyExp, PyExp)] -> PyExp)
-> (Map Name SizeClass -> [(PyExp, PyExp)])
-> Map Name SizeClass
-> PyExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, SizeClass) -> (PyExp, PyExp))
-> [(Name, SizeClass)] -> [(PyExp, PyExp)]
forall a b. (a -> b) -> [a] -> [b]
map (Name, SizeClass) -> (PyExp, PyExp)
forall a. Pretty a => (a, SizeClass) -> (PyExp, PyExp)
f ([(Name, SizeClass)] -> [(PyExp, PyExp)])
-> (Map Name SizeClass -> [(Name, SizeClass)])
-> Map Name SizeClass
-> [(PyExp, PyExp)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name SizeClass -> [(Name, SizeClass)]
forall k a. Map k a -> [(k, a)]
M.toList
where f :: (a, SizeClass) -> (PyExp, PyExp)
f (a
size_name, SizeClass
size_class) =
(String -> PyExp
String (String -> PyExp) -> String -> PyExp
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Pretty a => a -> String
pretty a
size_name,
[(PyExp, PyExp)] -> PyExp
Dict [(String -> PyExp
String String
"class", String -> PyExp
String (String -> PyExp) -> String -> PyExp
forall a b. (a -> b) -> a -> b
$ SizeClass -> String
forall a. Pretty a => a -> String
pretty SizeClass
size_class),
(String -> PyExp
String String
"value", SizeClass -> PyExp
defValue SizeClass
size_class)])
defValue :: SizeClass -> PyExp
defValue (SizeBespoke Name
_ Int32
x) = Integer -> PyExp
Integer (Integer -> PyExp) -> Integer -> PyExp
forall a b. (a -> b) -> a -> b
$ Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger Int32
x
defValue SizeClass
_ = PyExp
None
sizeHeuristicsToPython :: [SizeHeuristic] -> PyExp
sizeHeuristicsToPython :: [SizeHeuristic] -> PyExp
sizeHeuristicsToPython = [PyExp] -> PyExp
List ([PyExp] -> PyExp)
-> ([SizeHeuristic] -> [PyExp]) -> [SizeHeuristic] -> PyExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeHeuristic -> PyExp) -> [SizeHeuristic] -> [PyExp]
forall a b. (a -> b) -> [a] -> [b]
map SizeHeuristic -> PyExp
f
where f :: SizeHeuristic -> PyExp
f (SizeHeuristic String
platform_name DeviceType
device_type WhichSize
which HeuristicValue
what) =
[PyExp] -> PyExp
Tuple [String -> PyExp
String String
platform_name,
DeviceType -> PyExp
clDeviceType DeviceType
device_type,
PyExp
which',
PyExp
what']
where clDeviceType :: DeviceType -> PyExp
clDeviceType DeviceType
DeviceGPU = String -> PyExp
Var String
"cl.device_type.GPU"
clDeviceType DeviceType
DeviceCPU = String -> PyExp
Var String
"cl.device_type.CPU"
which' :: PyExp
which' = case WhichSize
which of WhichSize
LockstepWidth -> String -> PyExp
String String
"lockstep_width"
WhichSize
NumGroups -> String -> PyExp
String String
"num_groups"
WhichSize
GroupSize -> String -> PyExp
String String
"group_size"
WhichSize
TileSize -> String -> PyExp
String String
"tile_size"
WhichSize
Threshold -> String -> PyExp
String String
"threshold"
what' :: PyExp
what' = case HeuristicValue
what of
HeuristicConst Int
x -> Integer -> PyExp
Integer (Integer -> PyExp) -> Integer -> PyExp
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
x
HeuristicDeviceInfo String
s -> String -> PyExp
String String
s