{-# LANGUAGE QuasiQuotes #-}

module Futhark.CodeGen.Backends.GenericWASM
  ( GC.CParts (..),
    GC.asLibrary,
    GC.asExecutable,
    GC.asServer,
    EntryPointType,
    JSEntryPoint (..),
    JSRecordField (..),
    JSOpaqueType (..),
    emccExportNames,
    javascriptWrapper,
    extToString,
    opaqueToJS,
    runServer,
    libraryExports,
  )
where

import Data.List (intercalate)
import Data.Map qualified as M
import Data.Text qualified as T
import Futhark.CodeGen.Backends.GenericC qualified as GC
import Futhark.CodeGen.Backends.SimpleRep (isValidCName, opaqueName)
import Futhark.CodeGen.ImpCode.Sequential qualified as Imp
import Futhark.CodeGen.RTS.JavaScript
import Futhark.Manifest
import Futhark.Util (nubOrd, showText, zEncodeText)
import Language.Futhark.Core (nameToText)
import Language.Futhark.Primitive
import NeatInterpolation (text)

extToString :: Imp.ExternalValue -> String
extToString :: ExternalValue -> String
extToString (Imp.TransparentValue (Imp.ArrayValue VName
vn Space
_ PrimType
pt Signedness
s [DimSize]
dimSize)) =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([DimSize] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DimSize]
dimSize) String
"[]") String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExternalValue -> String
extToString (ValueDesc -> ExternalValue
Imp.TransparentValue (PrimType -> Signedness -> VName -> ValueDesc
Imp.ScalarValue PrimType
pt Signedness
s VName
vn))
extToString (Imp.TransparentValue (Imp.ScalarValue (FloatType FloatType
Float16) Signedness
_ VName
_)) = String
"f16"
extToString (Imp.TransparentValue (Imp.ScalarValue (FloatType FloatType
Float32) Signedness
_ VName
_)) = String
"f32"
extToString (Imp.TransparentValue (Imp.ScalarValue (FloatType FloatType
Float64) Signedness
_ VName
_)) = String
"f64"
extToString (Imp.TransparentValue (Imp.ScalarValue (IntType IntType
Int8) Signedness
Imp.Signed VName
_)) = String
"i8"
extToString (Imp.TransparentValue (Imp.ScalarValue (IntType IntType
Int16) Signedness
Imp.Signed VName
_)) = String
"i16"
extToString (Imp.TransparentValue (Imp.ScalarValue (IntType IntType
Int32) Signedness
Imp.Signed VName
_)) = String
"i32"
extToString (Imp.TransparentValue (Imp.ScalarValue (IntType IntType
Int64) Signedness
Imp.Signed VName
_)) = String
"i64"
extToString (Imp.TransparentValue (Imp.ScalarValue (IntType IntType
Int8) Signedness
Imp.Unsigned VName
_)) = String
"u8"
extToString (Imp.TransparentValue (Imp.ScalarValue (IntType IntType
Int16) Signedness
Imp.Unsigned VName
_)) = String
"u16"
extToString (Imp.TransparentValue (Imp.ScalarValue (IntType IntType
Int32) Signedness
Imp.Unsigned VName
_)) = String
"u32"
extToString (Imp.TransparentValue (Imp.ScalarValue (IntType IntType
Int64) Signedness
Imp.Unsigned VName
_)) = String
"u64"
extToString (Imp.TransparentValue (Imp.ScalarValue PrimType
Bool Signedness
_ VName
_)) = String
"bool"
extToString (Imp.TransparentValue (Imp.ScalarValue PrimType
Unit Signedness
_ VName
_)) = String -> String
forall a. HasCallStack => String -> a
error String
"extToString: Unit"
extToString (Imp.OpaqueValue Name
oname [ValueDesc]
_) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Name -> Text
opaqueName Name
oname

type EntryPointType = String

data JSEntryPoint = JSEntryPoint
  { JSEntryPoint -> String
name :: String,
    JSEntryPoint -> [String]
parameters :: [EntryPointType],
    JSEntryPoint -> String
ret :: EntryPointType
  }

-- | A field in a JavaScript record opaque type.
data JSRecordField = JSRecordField
  { -- | Original field name (used in the server protocol).
    JSRecordField -> String
jsrfName :: String,
    -- | JavaScript type string (e.g. @"i32"@, @"[]f64"@, @"opaque_foo"@).
    JSRecordField -> String
jsrfType :: EntryPointType,
    -- | JavaScript method name on @FutharkContext@ (e.g. @"project_opaque_foo_x"@).
    JSRecordField -> String
jsrfProjectFn :: String
  }

-- | How an opaque type is represented for the JavaScript server.
data JSOpaqueType
  = -- | A record type with named, projectable fields.
    JSOpaqueRecord [JSRecordField]
  | -- | Any other opaque type (no project support).
    JSOpaqueOther

-- | Convert the opaque-type table from an ImpCode program into the
-- JavaScript-oriented representation used by the code generator.
opaqueToJS :: Imp.OpaqueTypes -> [(String, JSOpaqueType)]
opaqueToJS :: OpaqueTypes -> [(String, JSOpaqueType)]
opaqueToJS (Imp.OpaqueTypes [(Name, (OpaqueType, Maybe Text))]
types) = ((Name, (OpaqueType, Maybe Text)) -> (String, JSOpaqueType))
-> [(Name, (OpaqueType, Maybe Text))] -> [(String, JSOpaqueType)]
forall a b. (a -> b) -> [a] -> [b]
map (Name, (OpaqueType, Maybe Text)) -> (String, JSOpaqueType)
forall {b}. (Name, (OpaqueType, b)) -> (String, JSOpaqueType)
convertOne [(Name, (OpaqueType, Maybe Text))]
types
  where
    convertOne :: (Name, (OpaqueType, b)) -> (String, JSOpaqueType)
convertOne (Name
desc, (Imp.OpaqueRecord [(Name, EntryPointType)]
fields, b
_)) =
      (Text -> String
T.unpack (Name -> Text
opaqueName Name
desc), [JSRecordField] -> JSOpaqueType
JSOpaqueRecord (((Name, EntryPointType) -> JSRecordField)
-> [(Name, EntryPointType)] -> [JSRecordField]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> (Name, EntryPointType) -> JSRecordField
convertField Name
desc) [(Name, EntryPointType)]
fields))
    convertOne (Name
desc, (OpaqueType, b)
_) =
      (Text -> String
T.unpack (Name -> Text
opaqueName Name
desc), JSOpaqueType
JSOpaqueOther)

    convertField :: Name -> (Name, EntryPointType) -> JSRecordField
convertField Name
desc (Name
fname, EntryPointType
etype) =
      JSRecordField
        { jsrfName :: String
jsrfName = Text -> String
T.unpack (Name -> Text
nameToText Name
fname),
          jsrfType :: String
jsrfType = EntryPointType -> String
entryTypeToJSString EntryPointType
etype,
          jsrfProjectFn :: String
jsrfProjectFn =
            String
"project_"
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (Name -> Text
opaqueName Name
desc)
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
f'
        }
      where
        f' :: Text
f'
          | Text -> Bool
isValidCName (Name -> Text
opaqueName Name
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
nameToText Name
fname) =
              Name -> Text
nameToText Name
fname
          | Bool
otherwise = Text -> Text
zEncodeText (Name -> Text
nameToText Name
fname)

-- | Convert an 'Imp.EntryPointType' to its JavaScript string representation.
entryTypeToJSString :: Imp.EntryPointType -> String
entryTypeToJSString :: EntryPointType -> String
entryTypeToJSString (Imp.TypeOpaque Name
desc) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Name -> Text
opaqueName Name
desc
entryTypeToJSString (Imp.TypeTransparent (Imp.ValueType Signedness
sign (Imp.Rank Int
rank) PrimType
pt)) =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
rank String
"[]") String -> String -> String
forall a. [a] -> [a] -> [a]
++ Signedness -> PrimType -> String
forall {a}. IsString a => Signedness -> PrimType -> a
primToJSString Signedness
sign PrimType
pt
  where
    primToJSString :: Signedness -> PrimType -> a
primToJSString Signedness
_ (FloatType FloatType
Float16) = a
"f16"
    primToJSString Signedness
_ (FloatType FloatType
Float32) = a
"f32"
    primToJSString Signedness
_ (FloatType FloatType
Float64) = a
"f64"
    primToJSString Signedness
Imp.Signed (IntType IntType
Int8) = a
"i8"
    primToJSString Signedness
Imp.Signed (IntType IntType
Int16) = a
"i16"
    primToJSString Signedness
Imp.Signed (IntType IntType
Int32) = a
"i32"
    primToJSString Signedness
Imp.Signed (IntType IntType
Int64) = a
"i64"
    primToJSString Signedness
Imp.Unsigned (IntType IntType
Int8) = a
"u8"
    primToJSString Signedness
Imp.Unsigned (IntType IntType
Int16) = a
"u16"
    primToJSString Signedness
Imp.Unsigned (IntType IntType
Int32) = a
"u32"
    primToJSString Signedness
Imp.Unsigned (IntType IntType
Int64) = a
"u64"
    primToJSString Signedness
_ PrimType
Bool = a
"bool"
    primToJSString Signedness
_ PrimType
Unit = String -> a
forall a. HasCallStack => String -> a
error String
"entryTypeToJSString: Unit"

-- | The names of the C functions that must be exported from the WebAssembly
-- module. This is every function named in the manifest, as the server calls
-- these directly, as well as the context management functions.
emccExportNames :: Manifest -> [String]
emccExportNames :: Manifest -> [String]
emccExportNames Manifest
manifest =
  (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
f -> String
"'_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") ([Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubOrd ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Manifest -> [Text]
manifestFunctions Manifest
manifest)
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"_futhark_context_config_new",
         String
"_futhark_context_config_free",
         String
"_futhark_context_new",
         String
"_futhark_context_free",
         String
"_futhark_context_get_error",
         String
"_futhark_context_sync",
         String
"_futhark_context_clear_caches",
         String
"_futhark_context_report",
         String
"_futhark_context_pause_profiling",
         String
"_futhark_context_unpause_profiling"
       ]

manifestFunctions :: Manifest -> [CFuncName]
manifestFunctions :: Manifest -> [Text]
manifestFunctions Manifest
manifest =
  (EntryPoint -> Text) -> [EntryPoint] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map EntryPoint -> Text
entryPointCFun (Map Text EntryPoint -> [EntryPoint]
forall k a. Map k a -> [a]
M.elems (Map Text EntryPoint -> [EntryPoint])
-> Map Text EntryPoint -> [EntryPoint]
forall a b. (a -> b) -> a -> b
$ Manifest -> Map Text EntryPoint
manifestEntryPoints Manifest
manifest)
    [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Type -> [Text]) -> [Type] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> [Text]
typeFunctions (Map Text Type -> [Type]
forall k a. Map k a -> [a]
M.elems (Map Text Type -> [Type]) -> Map Text Type -> [Type]
forall a b. (a -> b) -> a -> b
$ Manifest -> Map Text Type
manifestTypes Manifest
manifest)
  where
    typeFunctions :: Type -> [Text]
typeFunctions (TypeArray Text
_ Text
_ Int
_ ArrayOps
ops) =
      [ ArrayOps -> Text
arrayFree ArrayOps
ops,
        ArrayOps -> Text
arrayShape ArrayOps
ops,
        ArrayOps -> Text
arrayValues ArrayOps
ops,
        ArrayOps -> Text
arrayNew ArrayOps
ops,
        ArrayOps -> Text
arrayNewRaw ArrayOps
ops,
        ArrayOps -> Text
arrayValuesRaw ArrayOps
ops,
        ArrayOps -> Text
arrayIndex ArrayOps
ops,
        ArrayOps -> Text
arraySet ArrayOps
ops
      ]
    typeFunctions (TypeOpaque Text
_ OpaqueOps
ops Maybe OpaqueExtraOps
extra_ops Maybe Text
_) =
      [OpaqueOps -> Text
opaqueFree OpaqueOps
ops, OpaqueOps -> Text
opaqueStore OpaqueOps
ops, OpaqueOps -> Text
opaqueRestore OpaqueOps
ops]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
-> (OpaqueExtraOps -> [Text]) -> Maybe OpaqueExtraOps -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] OpaqueExtraOps -> [Text]
extraFunctions Maybe OpaqueExtraOps
extra_ops

    extraFunctions :: OpaqueExtraOps -> [Text]
extraFunctions (OpaqueRecord RecordOps
ops) =
      RecordOps -> Text
recordNew RecordOps
ops Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (RecordField -> Text) -> [RecordField] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map RecordField -> Text
recordFieldProject (RecordOps -> [RecordField]
recordFields RecordOps
ops)
    extraFunctions (OpaqueSum SumOps
ops) =
      SumOps -> Text
sumVariant SumOps
ops Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (SumVariant -> [Text]) -> [SumVariant] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SumVariant -> [Text]
variantFunctions (SumOps -> [SumVariant]
sumVariants SumOps
ops)
    extraFunctions (OpaqueArray OpaqueArrayOps
ops) =
      [ OpaqueArrayOps -> Text
opaqueArrayIndex OpaqueArrayOps
ops,
        OpaqueArrayOps -> Text
opaqueArrayShape OpaqueArrayOps
ops,
        OpaqueArrayOps -> Text
opaqueArrayNew OpaqueArrayOps
ops,
        OpaqueArrayOps -> Text
opaqueArraySet OpaqueArrayOps
ops
      ]
    extraFunctions (OpaqueRecordArray RecordArrayOps
ops) =
      [ RecordArrayOps -> Text
recordArrayZip RecordArrayOps
ops,
        RecordArrayOps -> Text
recordArrayIndex RecordArrayOps
ops,
        RecordArrayOps -> Text
recordArrayShape RecordArrayOps
ops,
        RecordArrayOps -> Text
recordArrayNew RecordArrayOps
ops,
        RecordArrayOps -> Text
recordArraySet RecordArrayOps
ops
      ]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (RecordField -> Text) -> [RecordField] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map RecordField -> Text
recordFieldProject (RecordArrayOps -> [RecordField]
recordArrayFields RecordArrayOps
ops)

    variantFunctions :: SumVariant -> [Text]
variantFunctions SumVariant
v = [SumVariant -> Text
sumVariantConstruct SumVariant
v, SumVariant -> Text
sumVariantDestruct SumVariant
v]

javascriptWrapper :: [JSEntryPoint] -> [(String, JSOpaqueType)] -> T.Text
javascriptWrapper :: [JSEntryPoint] -> [(String, JSOpaqueType)] -> Text
javascriptWrapper [JSEntryPoint]
entryPoints [(String, JSOpaqueType)]
opaqueTypes =
  [Text] -> Text
T.unlines
    [ Text
serverJs,
      Text
valuesJs,
      Text
wrapperclassesJs,
      [JSEntryPoint] -> [(String, JSOpaqueType)] -> Text
classFutharkContext [JSEntryPoint]
entryPoints [(String, JSOpaqueType)]
opaqueTypes
    ]

-- Make FutharkModule the generated primary class, but keeps FutharkContext around for backwards compatibility.
classFutharkContext :: [JSEntryPoint] -> [(String, JSOpaqueType)] -> T.Text
classFutharkContext :: [JSEntryPoint] -> [(String, JSOpaqueType)] -> Text
classFutharkContext [JSEntryPoint]
entryPoints [(String, JSOpaqueType)]
opaqueTypes =
  [Text] -> Text
T.unlines
    [ Text
"class FutharkModule {",
      Text
moduleConstructor,
      [JSEntryPoint] -> [(String, JSOpaqueType)] -> Text
moduleInitFromWasm [JSEntryPoint]
entryPoints [(String, JSOpaqueType)]
opaqueTypes,
      Text
moduleInit,
      Text
getFreeFun,
      Text
getEntryPointsFun,
      Text
getTypesFun,
      Text
getErrorFun,
      Text
getUtilityFuns,
      [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
toFutharkArray [String]
arrays,
      [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((String, JSOpaqueType) -> [Text])
-> [(String, JSOpaqueType)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (JSOpaqueType -> [Text]
generateProjectMethods (JSOpaqueType -> [Text])
-> ((String, JSOpaqueType) -> JSOpaqueType)
-> (String, JSOpaqueType)
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, JSOpaqueType) -> JSOpaqueType
forall a b. (a, b) -> b
snd) [(String, JSOpaqueType)]
opaqueTypes,
      [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (JSEntryPoint -> Text) -> [JSEntryPoint] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map JSEntryPoint -> Text
jsWrapEntryPoint [JSEntryPoint]
entryPoints,
      Text
"}",
      Text
classFutharkContextCompat,
      [text|
      async function newFutharkContext(num_threads) {
        var wasm = await loadWASM();
        return new FutharkContext(wasm, num_threads);
      }
      |]
    ]
  where
    -- Collect array types from entry points AND from record fields so the
    -- array constructors are always available when returning projected values.
    arrays :: [String]
arrays = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isArray ([String]
entryPointTypes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
recordFieldTypes)
    entryPointTypes :: [String]
entryPointTypes = (JSEntryPoint -> [String]) -> [JSEntryPoint] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\JSEntryPoint
jse -> JSEntryPoint -> [String]
parameters JSEntryPoint
jse [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [JSEntryPoint -> String
ret JSEntryPoint
jse]) [JSEntryPoint]
entryPoints
    recordFieldTypes :: [String]
recordFieldTypes = [JSRecordField -> String
jsrfType JSRecordField
rf | (String
_, JSOpaqueRecord [JSRecordField]
fields) <- [(String, JSOpaqueType)]
opaqueTypes, JSRecordField
rf <- [JSRecordField]
fields]

moduleConstructor :: T.Text
moduleConstructor :: Text
moduleConstructor =
  [text|
  constructor() {
    this.wasm = undefined;
    this.cfg = undefined;
    this.ctx = undefined;
    this.entry_points = {};
    this.types = {};
    this.entry = {};
  }
  |]

moduleInitFromWasm :: [JSEntryPoint] -> [(String, JSOpaqueType)] -> T.Text
moduleInitFromWasm :: [JSEntryPoint] -> [(String, JSOpaqueType)] -> Text
moduleInitFromWasm [JSEntryPoint]
jses [(String, JSOpaqueType)]
opaqueTypes =
  [text|
  _init_from_wasm(wasm, num_threads) {
    this.wasm = wasm;
    this.cfg = this.wasm._futhark_context_config_new();
    if (num_threads) this.wasm._futhark_context_config_set_num_threads(this.cfg, num_threads);
    this.ctx = this.wasm._futhark_context_new(this.cfg);

    this.entry_points = {
      ${entries}
    };
    this.types = {
      ${type_entries}
    };
    this.entry = {};
    ${entry_aliases}
    ${array_aliases}
    ${array_type_aliases}
  }
  |]
  where
    entries :: Text
entries = Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (JSEntryPoint -> Text) -> [JSEntryPoint] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map JSEntryPoint -> Text
dicEntry [JSEntryPoint]
jses
    type_entries :: Text
type_entries = Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((String, JSOpaqueType) -> Text)
-> [(String, JSOpaqueType)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String, JSOpaqueType) -> Text
dicTypeEntry [(String, JSOpaqueType)]
opaqueTypes
    entry_aliases :: Text
entry_aliases = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (JSEntryPoint -> Text) -> [JSEntryPoint] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map JSEntryPoint -> Text
entryAlias [JSEntryPoint]
jses
    array_aliases :: Text
array_aliases = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
arrayAlias [String]
arrays
    array_type_aliases :: Text
array_type_aliases = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
arrayTypeAlias [String]
arrays

    arrays :: [String]
arrays = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isArray ([String]
entryPointTypes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
recordFieldTypes)
    entryPointTypes :: [String]
entryPointTypes = (JSEntryPoint -> [String]) -> [JSEntryPoint] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\JSEntryPoint
jse -> JSEntryPoint -> [String]
parameters JSEntryPoint
jse [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [JSEntryPoint -> String
ret JSEntryPoint
jse]) [JSEntryPoint]
jses
    recordFieldTypes :: [String]
recordFieldTypes = [JSRecordField -> String
jsrfType JSRecordField
rf | (String
_, JSOpaqueRecord [JSRecordField]
fields) <- [(String, JSOpaqueType)]
opaqueTypes, JSRecordField
rf <- [JSRecordField]
fields]

moduleInit :: T.Text
moduleInit :: Text
moduleInit =
  [text|
  async init(wasm, num_threads) {
    if (wasm === undefined) {
      throw new Error("FutharkModule.init() requires the generated backend runtime module");
    }

    this._init_from_wasm(wasm, num_threads);
  }
  |]

classFutharkContextCompat :: T.Text
classFutharkContextCompat :: Text
classFutharkContextCompat =
  [text|
  class FutharkContext extends FutharkModule {
    constructor(wasm, num_threads) {
      super();

      if (wasm !== undefined) {
        this._init_from_wasm(wasm, num_threads);
      }
    }
  }
  |]

getFreeFun :: T.Text
getFreeFun :: Text
getFreeFun =
  [text|
  free() {
    if (this.ctx !== undefined) {
      this.wasm._futhark_context_free(this.ctx);
      this.ctx = undefined;
    }

    if (this.cfg !== undefined) {
      this.wasm._futhark_context_config_free(this.cfg);
      this.cfg = undefined;
    }
  }
  |]

getEntryPointsFun :: T.Text
getEntryPointsFun :: Text
getEntryPointsFun =
  [text|
  get_entry_points() {
    return this.entry_points;
  }
  |]

getTypesFun :: T.Text
getTypesFun :: Text
getTypesFun =
  [text|
  get_types() {
    return this.types;
  }
  |]

getErrorFun :: T.Text
getErrorFun :: Text
getErrorFun =
  [text|
  get_error() {
    var ptr = this.wasm._futhark_context_get_error(this.ctx);
    var len = this.wasm.HEAP8.subarray(ptr).indexOf(0);
    var str = String.fromCharCode(...this.wasm.HEAP8.subarray(ptr, ptr + len));
    this.wasm._free(ptr);
    return str;
  }
  |]

getUtilityFuns :: T.Text
getUtilityFuns :: Text
getUtilityFuns =
  [text|
  async context_sync() {
    return this.wasm._futhark_context_sync(this.ctx);
  }

  async clear_caches() {
    return this.wasm._futhark_context_clear_caches(this.ctx);
  }

  async report() {
    var ptr = this.wasm._futhark_context_report(this.ctx);
    var len = this.wasm.HEAP8.subarray(ptr).indexOf(0);
    var bytes = this.wasm.HEAPU8.subarray(ptr, ptr + len);
    var str = new TextDecoder().decode(bytes);
    this.wasm._free(ptr);
    return str;
  }

  async pause_profiling() {
    return this.wasm._futhark_context_pause_profiling(this.ctx);
  }

  async unpause_profiling() {
    return this.wasm._futhark_context_unpause_profiling(this.ctx);
  }
  |]

entryAlias :: JSEntryPoint -> T.Text
entryAlias :: JSEntryPoint -> Text
entryAlias JSEntryPoint
jse =
  [text|this.entry["${ename}"] = this.${fname}.bind(this);|]
  where
    fname :: Text
fname = Text -> Text
GC.escapeName (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ JSEntryPoint -> String
name JSEntryPoint
jse
    ename :: Text
ename = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ JSEntryPoint -> String
name JSEntryPoint
jse

arrayAlias :: String -> T.Text
arrayAlias :: String -> Text
arrayAlias String
typ =
  [text|
  this.${signature} = {
    from_data: (data, ${dims}) => this.new_${signature}(data, ${dims}),
    from_jsarray: (data) => this.new_${signature}_from_jsarray(data)
  };
  |]
  where
    d :: Int
d = String -> Int
dim String
typ
    ftype :: String
ftype = String -> String
baseType String
typ
    signature :: Text
signature = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
ftype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"d"
    dims :: Text
dims = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
"d" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i | Int
i <- [Int
0 .. Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

arrayTypeAlias :: String -> T.Text
arrayTypeAlias :: String -> Text
arrayTypeAlias String
typ =
  [text|this.types["${typ_text}"] = this.${signature};|]
  where
    d :: Int
d = String -> Int
dim String
typ
    ftype :: String
ftype = String -> String
baseType String
typ
    signature :: Text
signature = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
ftype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"d"
    typ_text :: Text
typ_text = String -> Text
T.pack String
typ

dicEntry :: JSEntryPoint -> T.Text
dicEntry :: JSEntryPoint -> Text
dicEntry JSEntryPoint
jse =
  [text|
       "${ename}" : ["${fname}", ${params}, ${rets}]
  |]
  where
    fname :: Text
fname = Text -> Text
GC.escapeName (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ JSEntryPoint -> String
name JSEntryPoint
jse
    ename :: Text
ename = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ JSEntryPoint -> String
name JSEntryPoint
jse
    params :: Text
params = [String] -> Text
forall a. Show a => a -> Text
showText ([String] -> Text) -> [String] -> Text
forall a b. (a -> b) -> a -> b
$ JSEntryPoint -> [String]
parameters JSEntryPoint
jse
    rets :: Text
rets = String -> Text
forall a. Show a => a -> Text
showText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ JSEntryPoint -> String
ret JSEntryPoint
jse

-- | Generate the @types@ dictionary entry for a single opaque type.
dicTypeEntry :: (String, JSOpaqueType) -> T.Text
dicTypeEntry :: (String, JSOpaqueType) -> Text
dicTypeEntry (String
tname, JSOpaqueRecord [JSRecordField]
fields) =
  String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
    String -> String
forall a. Show a => a -> String
show String
tname
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": [\"record\", ["
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((JSRecordField -> String) -> [JSRecordField] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map JSRecordField -> String
fieldEntry [JSRecordField]
fields)
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]]"
  where
    fieldEntry :: JSRecordField -> String
fieldEntry JSRecordField
rf =
      String
"["
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (JSRecordField -> String
jsrfName JSRecordField
rf)
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (JSRecordField -> String
jsrfType JSRecordField
rf)
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", \""
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ JSRecordField -> String
jsrfProjectFn JSRecordField
rf
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"]"
dicTypeEntry (String
tname, JSOpaqueType
JSOpaqueOther) =
  String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
tname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": [\"opaque\"]"

-- | Generate @project_*@ wrapper methods for a record opaque type.
generateProjectMethods :: JSOpaqueType -> [T.Text]
generateProjectMethods :: JSOpaqueType -> [Text]
generateProjectMethods (JSOpaqueRecord [JSRecordField]
fields) = (JSRecordField -> Text) -> [JSRecordField] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map JSRecordField -> Text
generateProjectMethod [JSRecordField]
fields
generateProjectMethods JSOpaqueType
JSOpaqueOther = []

generateProjectMethod :: JSRecordField -> T.Text
generateProjectMethod :: JSRecordField -> Text
generateProjectMethod JSRecordField
rf =
  String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
    [String] -> String
unlines
      [ String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ JSRecordField -> String
jsrfProjectFn JSRecordField
rf String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(obj) {",
        String
"    var out = this.wasm._malloc(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (String -> Integer
typeSize String
ftype) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");",
        String
"    this.wasm._futhark_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ JSRecordField -> String
jsrfProjectFn JSRecordField
rf String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(this.ctx, out, obj.ptr);",
        String
"    var result = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
readResult String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";",
        String
"    this.wasm._free(out);",
        String
"    return result;",
        String
"  }"
      ]
  where
    ftype :: String
ftype = JSRecordField -> String
jsrfType JSRecordField
rf
    readout :: String
readout = String -> String
typeHeap String
ftype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[out >> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (String -> Integer
typeShift String
ftype) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
    readResult :: String
readResult
      | String -> Bool
isArray String
ftype =
          String
"this.new_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
baseType String
ftype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (String -> Int
dim String
ftype) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"d_from_ptr(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
readout String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
      | String -> Bool
isOpaque String
ftype =
          String
"new FutharkOpaque(this, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
readout String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", this.wasm._futhark_free_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ftype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
      | String
ftype String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bool" = String
readout String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"!==0"
      | Bool
otherwise = String
readout

jsWrapEntryPoint :: JSEntryPoint -> T.Text
jsWrapEntryPoint :: JSEntryPoint -> Text
jsWrapEntryPoint JSEntryPoint
jse =
  [text|
  ${func_name}(${inparams}) {
    var out = [${outparams}].map(n => this.wasm._malloc(n));
    var to_free = [];
    var do_free = () => { out.forEach(this.wasm._free); to_free.forEach(f => f.free()); };
    ${paramsToPtr}
    if (this.wasm._futhark_entry_${func_name}(this.ctx, ...out, ${ins}) > 0) {
      do_free();
      throw this.get_error();
    }
    ${results}
    do_free();
    return ${res};
  }
  |]
  where
    func_name :: Text
func_name = Text -> Text
GC.escapeName (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ JSEntryPoint -> String
name JSEntryPoint
jse

    alp :: [Int]
alp = [Int
0 .. [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (JSEntryPoint -> [String]
parameters JSEntryPoint
jse) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    inparams :: Text
inparams = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
"in" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i | Int
i <- [Int]
alp]
    ins :: Text
ins = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String -> String -> String
maybeDerefence (String
"in" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ JSEntryPoint -> [String]
parameters JSEntryPoint
jse [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
i | Int
i <- [Int]
alp]
    paramsToPtr :: Text
paramsToPtr = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=) [String -> String -> String
arrayPointer (String
"in" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ JSEntryPoint -> [String]
parameters JSEntryPoint
jse [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
i | Int
i <- [Int]
alp]

    outparams :: Text
outparams = Integer -> Text
forall a. Show a => a -> Text
showText (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ String -> Integer
typeSize (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ JSEntryPoint -> String
ret JSEntryPoint
jse
    results :: Text
results = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
makeResult Int
0 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ JSEntryPoint -> String
ret JSEntryPoint
jse
    res :: Text
res = Text
"result0"

maybeDerefence :: String -> String -> String
maybeDerefence :: String -> String -> String
maybeDerefence String
arg String
typ =
  if String -> Bool
isScalar String
typ then String
arg else String
arg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".ptr"

arrayPointer :: String -> String -> String
arrayPointer :: String -> String -> String
arrayPointer String
arg String
typ =
  if String -> Bool
isArray String
typ
    then String
"  if (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" instanceof Array) { " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
reassign String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"; to_free.push(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"); }"
    else String
""
  where
    reassign :: String
reassign = String
arg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = this.new_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
signature String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_from_jsarray(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    signature :: String
signature = String -> String
baseType String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (String -> Int
dim String
typ) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"d"

makeResult :: Int -> String -> String
makeResult :: Int -> String -> String
makeResult Int
i String
typ =
  String
"  var result"
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ if String -> Bool
isArray String
typ
      then String
"this.new_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
signature String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_from_ptr(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
readout String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
      else
        if String -> Bool
isOpaque String
typ
          then String
"new FutharkOpaque(this, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
readout String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", this.wasm._futhark_free_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
          else String
readout String -> String -> String
forall a. [a] -> [a] -> [a]
++ if String
typ String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bool" then String
"!==0;" else String
";"
  where
    res :: String
res = String
"out[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
    readout :: String
readout = String -> String
typeHeap String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
res String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" >> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (String -> Integer
typeShift String
typ) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
    signature :: String
signature = String -> String
baseType String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (String -> Int
dim String
typ) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"d"

baseType :: String -> String
baseType :: String -> String
baseType (Char
'[' : Char
']' : String
end) = String -> String
baseType String
end
baseType String
typ = String
typ

dim :: String -> Int
dim :: String -> Int
dim (Char
'[' : Char
']' : String
end) = String -> Int
dim String
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
dim String
_ = Int
0

isArray :: String -> Bool
isArray :: String -> Bool
isArray String
typ = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
typ String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"[]"

isOpaque :: String -> Bool
isOpaque :: String -> Bool
isOpaque String
typ = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
6 String
typ String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"opaque"

isScalar :: String -> Bool
isScalar :: String -> Bool
isScalar String
typ = Bool -> Bool
not (String -> Bool
isArray String
typ Bool -> Bool -> Bool
|| String -> Bool
isOpaque String
typ)

typeSize :: String -> Integer
typeSize :: String -> Integer
typeSize String
typ =
  case String
typ of
    String
"i8" -> Integer
1
    String
"i16" -> Integer
2
    String
"i32" -> Integer
4
    String
"i64" -> Integer
8
    String
"u8" -> Integer
1
    String
"u16" -> Integer
2
    String
"u32" -> Integer
4
    String
"u64" -> Integer
8
    String
"f16" -> Integer
2
    String
"f32" -> Integer
4
    String
"f64" -> Integer
8
    String
"bool" -> Integer
1
    String
_ -> Integer
4

typeShift :: String -> Integer
typeShift :: String -> Integer
typeShift String
typ =
  case String
typ of
    String
"i8" -> Integer
0
    String
"i16" -> Integer
1
    String
"i32" -> Integer
2
    String
"i64" -> Integer
3
    String
"u8" -> Integer
0
    String
"u16" -> Integer
1
    String
"u32" -> Integer
2
    String
"u64" -> Integer
3
    String
"f16" -> Integer
1
    String
"f32" -> Integer
2
    String
"f64" -> Integer
3
    String
"bool" -> Integer
0
    String
_ -> Integer
2

typeHeap :: String -> String
typeHeap :: String -> String
typeHeap String
typ =
  case String
typ of
    String
"i8" -> String
"this.wasm.HEAP8"
    String
"i16" -> String
"this.wasm.HEAP16"
    String
"i32" -> String
"this.wasm.HEAP32"
    String
"i64" -> String
"this.wasm.HEAP64"
    String
"u8" -> String
"this.wasm.HEAPU8"
    String
"u16" -> String
"this.wasm.HEAPU16"
    String
"u32" -> String
"this.wasm.HEAPU32"
    String
"u64" -> String
"(new BigUint64Array(this.wasm.HEAP64.buffer))"
    String
"f16" -> String
"this.wasm.HEAPU16"
    String
"f32" -> String
"this.wasm.HEAPF32"
    String
"f64" -> String
"this.wasm.HEAPF64"
    String
"bool" -> String
"this.wasm.HEAP8"
    String
_ -> String
"this.wasm.HEAP32"

toFutharkArray :: String -> T.Text
toFutharkArray :: String -> Text
toFutharkArray String
typ =
  [text|
  ${new}_from_jsarray(${arraynd_p}) {
    return this.${new}(${arraynd_flat_p}, ${arraynd_dims_p});
  }
  ${new}(array, ${dims}) {
    console.assert(array.length === ${dims_multiplied}, 'len=%s,dims=%s', array.length, [${dims}].toString());
      var copy = this.wasm._malloc(array.length << ${shift});
      ${heapType}.set(array, copy >> ${shift});
      var ptr = ${fnew}(this.ctx, copy, ${bigint_dims});
      this.wasm._free(copy);
      return this.${new}_from_ptr(ptr);
    }

    ${new}_from_ptr(ptr) {
      return new FutharkArray(this, ptr, ${args});
    }
    |]
  where
    d :: Int
d = String -> Int
dim String
typ
    ftype :: String
ftype = String -> String
baseType String
typ
    heap :: String
heap = String -> String
typeHeap String
ftype
    signature :: String
signature = String
ftype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"d"
    new :: Text
new = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"new_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
signature
    fnew :: Text
fnew = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"this.wasm._futhark_new_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
signature
    fshape :: String
fshape = String
"this.wasm._futhark_shape_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
signature
    fvalues :: String
fvalues = String
"this.wasm._futhark_values_raw_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
signature
    ffree :: String
ffree = String
"this.wasm._futhark_free_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
signature
    arraynd :: String
arraynd = String
"array" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"d"
    shift :: Text
shift = Integer -> Text
forall a. Show a => a -> Text
showText (String -> Integer
typeShift String
ftype)
    heapType :: Text
heapType = String -> Text
T.pack String
heap
    arraynd_flat :: String
arraynd_flat = if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then String
arraynd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".flat()" else String
arraynd
    arraynd_dims :: String
arraynd_dims = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
arraynd String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
mult Int
i String
"[0]" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".length" | Int
i <- [Int
0 .. Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
    dims :: Text
dims = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
"d" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i | Int
i <- [Int
0 .. Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
    dims_multiplied :: Text
dims_multiplied = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"*" [String
"Number(d" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")" | Int
i <- [Int
0 .. Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
    bigint_dims :: Text
bigint_dims = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
"BigInt(d" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")" | Int
i <- [Int
0 .. Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
    mult :: Int -> [a] -> [a]
mult Int
i [a]
s = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [[a]]
forall a. Int -> a -> [a]
replicate Int
i [a]
s
    (Text
arraynd_p, Text
arraynd_flat_p, Text
arraynd_dims_p) = (String -> Text
T.pack String
arraynd, String -> Text
T.pack String
arraynd_flat, String -> Text
T.pack String
arraynd_dims)
    args :: Text
args = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ftype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'", Int -> String
forall a. Show a => a -> String
show Int
d, String
heap, String
fshape, String
fvalues, String
ffree]

-- | Javascript code that can be appended to the generated module to
-- run a Futhark server instance on startup.
runServer :: Manifest -> T.Text
runServer :: Manifest -> Text
runServer Manifest
manifest =
  [text|
   Module.onRuntimeInitialized = () => {
     var context = new FutharkContext(Module);
     var server = new Server(context, ${manifest_json});
     server.run();
   }|]
  where
    manifest_json :: Text
manifest_json = Manifest -> Text
manifestToJSON Manifest
manifest

-- | The names exported by the generated module.
libraryExports :: T.Text
libraryExports :: Text
libraryExports = Text
"export {newFutharkContext, FutharkContext, FutharkModule, FutharkArray, FutharkOpaque};"