{-# LANGUAGE OverloadedStrings #-}

-- | C code generator.  This module can convert a correct ImpCode
-- program to an equivalent C program.  This C program is expected to
-- be converted to WebAssembly, so we also produce the intended
-- JavaScript wrapper.
module Futhark.CodeGen.Backends.MulticoreWASM
  ( compileProg,
    runServer,
    libraryExports,
    GC.CParts (..),
    GC.asLibrary,
    GC.asExecutable,
    GC.asServer,
  )
where

import Data.Maybe
import qualified Data.Text as T
import qualified Futhark.CodeGen.Backends.GenericC as GC
import Futhark.CodeGen.Backends.GenericWASM
import qualified Futhark.CodeGen.Backends.MulticoreC as MC
import qualified Futhark.CodeGen.ImpCode.Multicore as Imp
import qualified Futhark.CodeGen.ImpGen.Multicore as ImpGen
import Futhark.IR.MCMem
import Futhark.MonadFreshNames

compileProg ::
  MonadFreshNames m =>
  T.Text ->
  Prog MCMem ->
  m (ImpGen.Warnings, (GC.CParts, T.Text, [String]))
compileProg :: Text -> Prog MCMem -> m (Warnings, (CParts, Text, [String]))
compileProg Text
version Prog MCMem
prog = do
  (Warnings
ws, Definitions Multicore
prog') <- Prog MCMem -> m (Warnings, Definitions Multicore)
forall (m :: * -> *).
MonadFreshNames m =>
Prog MCMem -> m (Warnings, Definitions Multicore)
ImpGen.compileProg Prog MCMem
prog

  CParts
prog'' <-
    Text
-> Text
-> Operations Multicore ()
-> CompilerM Multicore () ()
-> Text
-> [Space]
-> [Option]
-> Definitions Multicore
-> m CParts
forall (m :: * -> *) op.
MonadFreshNames m =>
Text
-> Text
-> Operations op ()
-> CompilerM op () ()
-> Text
-> [Space]
-> [Option]
-> Definitions op
-> m CParts
GC.compileProg
      Text
"wasm_multicore"
      Text
version
      Operations Multicore ()
MC.operations
      CompilerM Multicore () ()
forall op. CompilerM op () ()
MC.generateContext
      Text
""
      [Space
DefaultSpace]
      [Option]
MC.cliOptions
      Definitions Multicore
prog'

  (Warnings, (CParts, Text, [String]))
-> m (Warnings, (CParts, Text, [String]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( Warnings
ws,
      ( CParts
prog'',
        [JSEntryPoint] -> Text
javascriptWrapper (Definitions Multicore -> [JSEntryPoint]
fRepMyRep Definitions Multicore
prog'),
        String
"_futhark_context_config_set_num_threads" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [JSEntryPoint] -> [String]
emccExportNames (Definitions Multicore -> [JSEntryPoint]
fRepMyRep Definitions Multicore
prog')
      )
    )

fRepMyRep :: Imp.Definitions Imp.Multicore -> [JSEntryPoint]
fRepMyRep :: Definitions Multicore -> [JSEntryPoint]
fRepMyRep Definitions Multicore
prog =
  let Imp.Functions [(Name, Function Multicore)]
fs = Definitions Multicore -> Functions Multicore
forall a. Definitions a -> Functions a
Imp.defFuns Definitions Multicore
prog
      function :: FunctionT a -> Maybe JSEntryPoint
function (Imp.Function Maybe Name
entry [Param]
_ [Param]
_ Code a
_ [ExternalValue]
res [(Name, ExternalValue)]
args) = do
        Name
n <- Maybe Name
entry
        JSEntryPoint -> Maybe JSEntryPoint
forall a. a -> Maybe a
Just (JSEntryPoint -> Maybe JSEntryPoint)
-> JSEntryPoint -> Maybe JSEntryPoint
forall a b. (a -> b) -> a -> b
$
          JSEntryPoint :: String -> [String] -> [String] -> JSEntryPoint
JSEntryPoint
            { name :: String
name = Name -> String
nameToString Name
n,
              parameters :: [String]
parameters = ((Name, ExternalValue) -> String)
-> [(Name, ExternalValue)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ExternalValue -> String
extToString (ExternalValue -> String)
-> ((Name, ExternalValue) -> ExternalValue)
-> (Name, ExternalValue)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, ExternalValue) -> ExternalValue
forall a b. (a, b) -> b
snd) [(Name, ExternalValue)]
args,
              ret :: [String]
ret = (ExternalValue -> String) -> [ExternalValue] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ExternalValue -> String
extToString [ExternalValue]
res
            }
   in ((Name, Function Multicore) -> Maybe JSEntryPoint)
-> [(Name, Function Multicore)] -> [JSEntryPoint]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Function Multicore -> Maybe JSEntryPoint
forall a. FunctionT a -> Maybe JSEntryPoint
function (Function Multicore -> Maybe JSEntryPoint)
-> ((Name, Function Multicore) -> Function Multicore)
-> (Name, Function Multicore)
-> Maybe JSEntryPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Function Multicore) -> Function Multicore
forall a b. (a, b) -> b
snd) [(Name, Function Multicore)]
fs