module Futhark.CodeGen.Backends.SequentialWASM
( compileProg,
runServer,
libraryExports,
GC.CParts (..),
GC.asLibrary,
GC.asExecutable,
GC.asServer,
)
where
import Data.Maybe
import Data.Text qualified as T
import Futhark.CodeGen.Backends.GenericC qualified as GC
import Futhark.CodeGen.Backends.GenericWASM
import Futhark.CodeGen.Backends.SequentialC.Boilerplate
import Futhark.CodeGen.ImpCode.Sequential qualified as Imp
import Futhark.CodeGen.ImpGen.Sequential qualified as ImpGen
import Futhark.IR.SeqMem
import Futhark.MonadFreshNames
compileProg :: (MonadFreshNames m) => T.Text -> Prog SeqMem -> m (ImpGen.Warnings, (GC.CParts, T.Text, [String]))
compileProg :: forall (m :: * -> *).
MonadFreshNames m =>
Text -> Prog SeqMem -> m (Warnings, (CParts, Text, [String]))
compileProg Text
version Prog SeqMem
prog = do
(Warnings
ws, Program
prog') <- Prog SeqMem -> m (Warnings, Program)
forall (m :: * -> *).
MonadFreshNames m =>
Prog SeqMem -> m (Warnings, Program)
ImpGen.compileProg Prog SeqMem
prog
CParts
prog'' <-
Text
-> Text
-> ParamMap
-> Operations Sequential ()
-> CompilerM Sequential () ()
-> Text
-> (Space, [Space])
-> [Option]
-> Program
-> m CParts
forall (m :: * -> *) op.
MonadFreshNames m =>
Text
-> Text
-> ParamMap
-> Operations op ()
-> CompilerM op () ()
-> Text
-> (Space, [Space])
-> [Option]
-> Definitions op
-> m CParts
GC.compileProg
Text
"wasm"
Text
version
ParamMap
forall a. Monoid a => a
mempty
Operations Sequential ()
operations
CompilerM Sequential () ()
forall op s. CompilerM op s ()
generateBoilerplate
Text
""
(Space
DefaultSpace, [Space
DefaultSpace])
[]
Program
prog'
(Warnings, (CParts, Text, [String]))
-> m (Warnings, (CParts, Text, [String]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Warnings
ws, (CParts
prog'', [JSEntryPoint] -> Text
javascriptWrapper (Program -> [JSEntryPoint]
fRepMyRep Program
prog'), [JSEntryPoint] -> [String]
emccExportNames (Program -> [JSEntryPoint]
fRepMyRep Program
prog')))
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 a. a -> CompilerM Sequential () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
}
fRepMyRep :: Imp.Program -> [JSEntryPoint]
fRepMyRep :: Program -> [JSEntryPoint]
fRepMyRep Program
prog =
let Imp.Functions [(Name, Function Sequential)]
fs = Program -> Functions Sequential
forall a. Definitions a -> Functions a
Imp.defFuns Program
prog
function :: FunctionT a -> Maybe JSEntryPoint
function (Imp.Function Maybe EntryPoint
entry [Param]
_ [Param]
_ Code a
_) = do
Imp.EntryPoint Name
n [(Uniqueness, ExternalValue)]
res [((Name, Uniqueness), ExternalValue)]
args <- Maybe EntryPoint
entry
JSEntryPoint -> Maybe JSEntryPoint
forall a. a -> Maybe a
Just (JSEntryPoint -> Maybe JSEntryPoint)
-> JSEntryPoint -> Maybe JSEntryPoint
forall a b. (a -> b) -> a -> b
$
JSEntryPoint
{ name :: String
name = Name -> String
nameToString Name
n,
parameters :: [String]
parameters = (((Name, Uniqueness), ExternalValue) -> String)
-> [((Name, Uniqueness), ExternalValue)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ExternalValue -> String
extToString (ExternalValue -> String)
-> (((Name, Uniqueness), ExternalValue) -> ExternalValue)
-> ((Name, Uniqueness), ExternalValue)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Uniqueness), ExternalValue) -> ExternalValue
forall a b. (a, b) -> b
snd) [((Name, Uniqueness), ExternalValue)]
args,
ret :: [String]
ret = ((Uniqueness, ExternalValue) -> String)
-> [(Uniqueness, ExternalValue)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ExternalValue -> String
extToString (ExternalValue -> String)
-> ((Uniqueness, ExternalValue) -> ExternalValue)
-> (Uniqueness, ExternalValue)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uniqueness, ExternalValue) -> ExternalValue
forall a b. (a, b) -> b
snd) [(Uniqueness, ExternalValue)]
res
}
in ((Name, Function Sequential) -> Maybe JSEntryPoint)
-> [(Name, Function Sequential)] -> [JSEntryPoint]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Function Sequential -> Maybe JSEntryPoint
forall {a}. FunctionT a -> Maybe JSEntryPoint
function (Function Sequential -> Maybe JSEntryPoint)
-> ((Name, Function Sequential) -> Function Sequential)
-> (Name, Function Sequential)
-> Maybe JSEntryPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Function Sequential) -> Function Sequential
forall a b. (a, b) -> b
snd) [(Name, Function Sequential)]
fs