{-# LANGUAGE QuasiQuotes #-}
module Futhark.CodeGen.Backends.SequentialC
( compileProg,
GC.CParts (..),
GC.asLibrary,
GC.asExecutable,
)
where
import Control.Monad
import qualified Futhark.CodeGen.Backends.GenericC as GC
import qualified Futhark.CodeGen.ImpCode.Sequential as Imp
import qualified Futhark.CodeGen.ImpGen.Sequential as ImpGen
import Futhark.IR.SeqMem
import Futhark.MonadFreshNames
import qualified Language.C.Quote.OpenCL as C
compileProg :: MonadFreshNames m => Prog SeqMem -> m (ImpGen.Warnings, GC.CParts)
compileProg :: Prog SeqMem -> m (Warnings, CParts)
compileProg =
(Definitions Sequential -> m CParts)
-> (Warnings, Definitions Sequential) -> m (Warnings, CParts)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
(String
-> Operations Sequential ()
-> CompilerM Sequential () ()
-> String
-> [Space]
-> [Option]
-> Definitions Sequential
-> m CParts
forall (m :: * -> *) op.
MonadFreshNames m =>
String
-> Operations op ()
-> CompilerM op () ()
-> String
-> [Space]
-> [Option]
-> Definitions op
-> m CParts
GC.compileProg String
"c" Operations Sequential ()
operations CompilerM Sequential () ()
forall op s. CompilerM op s ()
generateContext String
"" [Space
DefaultSpace] [])
((Warnings, Definitions Sequential) -> m (Warnings, CParts))
-> (Prog SeqMem -> m (Warnings, Definitions Sequential))
-> Prog SeqMem
-> m (Warnings, CParts)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Prog SeqMem -> m (Warnings, Definitions Sequential)
forall (m :: * -> *).
MonadFreshNames m =>
Prog SeqMem -> m (Warnings, Definitions Sequential)
ImpGen.compileProg
where
operations :: GC.Operations Imp.Sequential ()
operations :: Operations Sequential ()
operations =
Operations Sequential ()
forall op s. Operations op s
GC.defaultOperations
{ opsCompiler :: OpCompiler Sequential ()
GC.opsCompiler = CompilerM Sequential () () -> OpCompiler Sequential ()
forall a b. a -> b -> a
const (CompilerM Sequential () () -> OpCompiler Sequential ())
-> CompilerM Sequential () () -> OpCompiler Sequential ()
forall a b. (a -> b) -> a -> b
$ () -> CompilerM Sequential () ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
opsCopy :: Copy Sequential ()
GC.opsCopy = Copy Sequential ()
copySequentialMemory
}
generateContext :: CompilerM op s ()
generateContext = do
String
cfg <- String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s String
forall op s.
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s String
GC.publicDef String
"context_config" HeaderSection
GC.InitDecl ((String -> (Definition, Definition)) -> CompilerM op s String)
-> (String -> (Definition, Definition)) -> CompilerM op s String
forall a b. (a -> b) -> a -> b
$ \String
s ->
( [C.cedecl|struct $id:s;|],
[C.cedecl|struct $id:s { int debugging; };|]
)
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
forall op s.
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
GC.publicDef_ String
"context_config_new" HeaderSection
GC.InitDecl ((String -> (Definition, Definition)) -> CompilerM op s ())
-> (String -> (Definition, Definition)) -> CompilerM op s ()
forall a b. (a -> b) -> a -> b
$ \String
s ->
( [C.cedecl|struct $id:cfg* $id:s(void);|],
[C.cedecl|struct $id:cfg* $id:s(void) {
struct $id:cfg *cfg = (struct $id:cfg*) malloc(sizeof(struct $id:cfg));
if (cfg == NULL) {
return NULL;
}
cfg->debugging = 0;
return cfg;
}|]
)
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
forall op s.
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
GC.publicDef_ String
"context_config_free" HeaderSection
GC.InitDecl ((String -> (Definition, Definition)) -> CompilerM op s ())
-> (String -> (Definition, Definition)) -> CompilerM op s ()
forall a b. (a -> b) -> a -> b
$ \String
s ->
( [C.cedecl|void $id:s(struct $id:cfg* cfg);|],
[C.cedecl|void $id:s(struct $id:cfg* cfg) {
free(cfg);
}|]
)
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
forall op s.
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
GC.publicDef_ String
"context_config_set_debugging" HeaderSection
GC.InitDecl ((String -> (Definition, Definition)) -> CompilerM op s ())
-> (String -> (Definition, Definition)) -> CompilerM op s ()
forall a b. (a -> b) -> a -> b
$ \String
s ->
( [C.cedecl|void $id:s(struct $id:cfg* cfg, int flag);|],
[C.cedecl|void $id:s(struct $id:cfg* cfg, int detail) {
cfg->debugging = detail;
}|]
)
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
forall op s.
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
GC.publicDef_ String
"context_config_set_logging" HeaderSection
GC.InitDecl ((String -> (Definition, Definition)) -> CompilerM op s ())
-> (String -> (Definition, Definition)) -> CompilerM op s ()
forall a b. (a -> b) -> a -> b
$ \String
s ->
( [C.cedecl|void $id:s(struct $id:cfg* cfg, int flag);|],
[C.cedecl|void $id:s(struct $id:cfg* cfg, int detail) {
/* Does nothing for this backend. */
(void)cfg; (void)detail;
}|]
)
([FieldGroup]
fields, [Stm]
init_fields) <- CompilerM op s ([FieldGroup], [Stm])
forall op s. CompilerM op s ([FieldGroup], [Stm])
GC.contextContents
String
ctx <- String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s String
forall op s.
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s String
GC.publicDef String
"context" HeaderSection
GC.InitDecl ((String -> (Definition, Definition)) -> CompilerM op s String)
-> (String -> (Definition, Definition)) -> CompilerM op s String
forall a b. (a -> b) -> a -> b
$ \String
s ->
( [C.cedecl|struct $id:s;|],
[C.cedecl|struct $id:s {
int detail_memory;
int debugging;
int profiling;
typename lock_t lock;
char *error;
int profiling_paused;
$sdecls:fields
};|]
)
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
forall op s.
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
GC.publicDef_ String
"context_new" HeaderSection
GC.InitDecl ((String -> (Definition, Definition)) -> CompilerM op s ())
-> (String -> (Definition, Definition)) -> CompilerM op s ()
forall a b. (a -> b) -> a -> b
$ \String
s ->
( [C.cedecl|struct $id:ctx* $id:s(struct $id:cfg* cfg);|],
[C.cedecl|struct $id:ctx* $id:s(struct $id:cfg* cfg) {
struct $id:ctx* ctx = (struct $id:ctx*) malloc(sizeof(struct $id:ctx));
if (ctx == NULL) {
return NULL;
}
ctx->detail_memory = cfg->debugging;
ctx->debugging = cfg->debugging;
ctx->profiling = cfg->debugging;
ctx->error = NULL;
create_lock(&ctx->lock);
$stms:init_fields
init_constants(ctx);
return ctx;
}|]
)
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
forall op s.
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
GC.publicDef_ String
"context_free" HeaderSection
GC.InitDecl ((String -> (Definition, Definition)) -> CompilerM op s ())
-> (String -> (Definition, Definition)) -> CompilerM op s ()
forall a b. (a -> b) -> a -> b
$ \String
s ->
( [C.cedecl|void $id:s(struct $id:ctx* ctx);|],
[C.cedecl|void $id:s(struct $id:ctx* ctx) {
free_constants(ctx);
free_lock(&ctx->lock);
free(ctx);
}|]
)
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
forall op s.
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
GC.publicDef_ String
"context_sync" HeaderSection
GC.MiscDecl ((String -> (Definition, Definition)) -> CompilerM op s ())
-> (String -> (Definition, Definition)) -> CompilerM op s ()
forall a b. (a -> b) -> a -> b
$ \String
s ->
( [C.cedecl|int $id:s(struct $id:ctx* ctx);|],
[C.cedecl|int $id:s(struct $id:ctx* ctx) {
(void)ctx;
return 0;
}|]
)
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
forall op s.
String
-> HeaderSection
-> (String -> (Definition, Definition))
-> CompilerM op s ()
GC.publicDef_ String
"context_clear_caches" HeaderSection
GC.MiscDecl ((String -> (Definition, Definition)) -> CompilerM op s ())
-> (String -> (Definition, Definition)) -> CompilerM op s ()
forall a b. (a -> b) -> a -> b
$ \String
s ->
( [C.cedecl|int $id:s(struct $id:ctx* ctx);|],
[C.cedecl|int $id:s(struct $id:ctx* ctx) {
(void)ctx;
return 0;
}|]
)
copySequentialMemory :: GC.Copy Imp.Sequential ()
copySequentialMemory :: Copy Sequential ()
copySequentialMemory Exp
destmem Exp
destidx Space
DefaultSpace Exp
srcmem Exp
srcidx Space
DefaultSpace Exp
nbytes =
Exp -> Exp -> Exp -> Exp -> Exp -> CompilerM Sequential () ()
forall op s. Exp -> Exp -> Exp -> Exp -> Exp -> CompilerM op s ()
GC.copyMemoryDefaultSpace Exp
destmem Exp
destidx Exp
srcmem Exp
srcidx Exp
nbytes
copySequentialMemory Exp
_ Exp
_ Space
destspace Exp
_ Exp
_ Space
srcspace Exp
_ =
String -> CompilerM Sequential () ()
forall a. HasCallStack => String -> a
error (String -> CompilerM Sequential () ())
-> String -> CompilerM Sequential () ()
forall a b. (a -> b) -> a -> b
$ String
"Cannot copy to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Space -> String
forall a. Show a => a -> String
show Space
destspace String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Space -> String
forall a. Show a => a -> String
show Space
srcspace