futhask-1.0.0: src/Context.hs

{-# LANGUAGE OverloadedStrings #-}

module Context where
import qualified Futhark.Manifest as FM
import Backends
import CodeGen

rawContextDec manifest = tuningCalls </> configCalls manifest </> contextCalls
    where
        tuningCalls = ""
            </> cFFICall "get_tuning_param_count" "futhark_get_tuning_param_count" [] int
            </> cFFICall "get_tuning_param_name" "futhark_get_tuning_param_name" [int] string
            </> cFFICall "get_tuning_param_class" "futhark_get_tuning_param_class" [int] string
        configCalls backend = "data Config"
            </> cFFICall "config_new" "futhark_context_config_new" [] config
            </> cFFICall "config_free" "futhark_context_config_free" [config] empty
            </> cFFICall "config_set_debugging" "futhark_context_config_set_debugging" [config, int] empty
            </> cFFICall "config_set_profiling" "futhark_context_config_set_profiling" [config, int] empty
            </> cFFICall "config_set_logging" "futhark_context_config_set_logging" [config, int] empty
            </> cFFICall "config_set_tuning_param" "futhark_context_config_set_tuning_param" [config, string, size] int
            </> cFFICall "config_set_cache_file" "futhark_context_config_set_cache_file" [config, string] empty
            </> case FM.manifestBackend manifest of
                "c"         -> c_config
                "multicore" -> multicore_config
                "opencl"    -> gpu_config <> opencl_config
                "cuda"      -> gpu_config <> cuda_config
                "hip"       -> gpu_config 
        c_config = ""
        multicore_config = cFFICall "config_set_num_threads" "futhark_context_config_set_num_threads" [config, int] empty
        gpu_config 
            =   cFFICall "config_set_device" "futhark_context_config_set_device" [config, string] empty 
            </> cFFICall "config_set_unified_memory" "futhark_context_config_set_unified_memory" [config, int] empty
            </> cFFICall "config_set_default_thread_block_size" "futhark_context_config_set_default_thread_block_size" [config, int] empty
            </> cFFICall "config_set_default_group_size" "futhark_context_config_set_default_group_size" [config, int] empty
            </> cFFICall "config_set_default_grid_size" "futhark_context_config_set_default_grid_size" [config, int] empty

            </> cFFICall "config_set_default_group_num" "futhark_context_config_set_default_group_num" [config, int] empty

            </> cFFICall "config_set_default_tile_size" "futhark_context_config_set_default_tile_size" [config, int] empty

            </> cFFICall "config_get_program" "futhark_context_config_get_program" [config] string
            </> cFFICall "config_set_program" "futhark_context_config_set_program" [config, string] empty
        opencl_config 
            =   cFFICall "config_set_platform" "futhark_context_config_set_platform" [config, string] empty
            </> cFFICall "config_add_build_option" "futhark_context_config_add_build_option" [config, string] empty
        cuda_config
            =   cFFICall "config_add_nvrtc_option" "futhark_context_config_add_nvrtc_option" [config, string] empty
            </> cFFICall "config_dump_ptx_to" "futhark_context_dump_ptx_to" [config, string] empty
            </> cFFICall "config_load_ptx_from" "futhark_context_load_ptx_from" [config, string] empty
        contextCalls = "data Context"
            </> cFFICall "context_new" "futhark_context_new" [config] context
            </> cFFICall "context_free" "futhark_context_free" [context] empty
            </> cFFICall "context_sync" "futhark_context_sync" [context] int
            </> cFFICall "context_get_error" "futhark_context_get_error" [context] text
            </> cFFICall "context_set_logging_file" "futhark_context_set_logging_file" [context, file] empty
            </> cFFICall "context_pause_profiling" "futhark_context_pause_profiling" [context] empty
            </> cFFICall "context_unpause_profiling" "futhark_context_unpause_profiling" [context] empty
            </> cFFICall "context_report" "futhark_context_report" [context] text
            </> cFFICall "context_clear_caches" "futhark_context_clear_caches" [context] int
        config = pointer "Config"
        context = pointer "Context"
        file = pointer "CFile"
        text = pointer "CChar"
        string = "CString"
        int = "Int"
        size = "CSize"
        empty = "()"

wrappedContextDec manifest 
    = newtypeFormat "Context" "(Futhask.ReferenceCounter, ForeignPtr (Raw.Context))"
    </> "instance Futhask.Context" <~> ctx <~> "where"
    </~> "type RawContext" <~> ctx <=> rctx
    </~> "type RawConfig"  <~> ctx <=> rcfg
    </~> "wrapRawContext" <=> ctx
    </~> "unwrapRawContext (" <> ctx <>" a) = a"
    </~> "newContext" <=> raw "context_new"
    </~> "freeContext" <=> raw "context_free"
    </~> "syncContext" <=> raw "context_sync"
    </~> "clearCaches" <=> raw "context_clear_caches"
    </~> "getError" <=> raw "context_get_error"
    </~> "getReport" <=> raw "context_report"
    </~> "pauseProfiling" <=> raw "context_pause_profiling"
    </~> "unpauseProfiling" <=> raw "context_unpause_profiling"
    </~> "newConfig" <=> raw "config_new"
    </~> "freeConfig" <=> raw "config_free"
    </~> "setTuningParam" <=> raw "config_set_tuning_param"
    </~> "setCacheFile" <=> raw "config_set_cache_file"
    </~> "setDebug" <=> raw "config_set_debugging"
    </~> "setLog" <=> raw "config_set_logging"
    </~> "setProfile" <=> raw "config_set_profiling"
    </~> "setDevice" <=> (if gpu then raw "config_set_device" else nothing)
    </~> "setDefaultThreadBlockSize" <=> (if gpu then raw "config_set_default_thread_block_size" else nothing)
    </~> "setDefaultGridSize" <=> (if gpu then raw "config_set_default_grid_size" else nothing)
    </~> "setDefaultTileSize" <=> (if gpu then raw "config_set_default_tile_size" else nothing)
    </~> "setPlatform" <=> (if opencl then raw "config_set_platform" else nothing)
    </~> "setBuildOption" <=> (if opencl then raw "config_set_build_option" else nothing)
    </~> "setNvrtcOption" <=> (if cuda then raw "config_set_nvrtc_option" else nothing)
    </~> "setNumThreads" <=> (if multicore then raw "config_set_num_threads" else nothing)
    </> "-- | Make new context with a list of options"
    </> "mkContext :: [Futhask.ContextOption] -> IO (Context, [String])"
    </> "mkContext = Futhask.mkContext"
    where
        nothing = "(\\_ _ -> pure ())" 
        raw a = "Raw." <> a
        ctx = "Context"
        cfg = "Config"
        rctx = raw ctx
        rcfg = raw cfg 
        gpu = case FM.manifestBackend manifest of
            "opencl" -> True
            "cuda"   -> True
            "hip"    -> True
            _        -> False
        opencl = case FM.manifestBackend manifest of
            "opencl" -> True
            _        -> False
        cuda = case FM.manifestBackend manifest of
            "cuda" -> True
            _      -> False
        multicore = case FM.manifestBackend manifest of
            "multicore" -> True
            _           -> False