    {-# LANGUAGE QuasiQuotes #-}

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

    import Data.List (intercalate)
    import Data.Text qualified as T
    import Futhark.CodeGen.Backends.GenericC qualified as GC
    import Futhark.CodeGen.Backends.SimpleRep (opaqueName)
    import Futhark.CodeGen.ImpCode.Sequential qualified as Imp
    import Futhark.CodeGen.RTS.JavaScript
    import Futhark.Util (nubOrd, showText)
    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]
      }

    emccExportNames :: [JSEntryPoint] -> [String]
    emccExportNames :: [JSEntryPoint] -> [String]
    emccExportNames [JSEntryPoint]
    jses =
      (JSEntryPoint -> String) -> [JSEntryPoint] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\JSEntryPoint
    jse -> String
    "'_futhark_entry_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    T.unpack (Text -> Text
    GC.escapeName (String -> Text
    T.pack (JSEntryPoint -> String
    name JSEntryPoint
    jse))) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'") [JSEntryPoint]
    jses
        [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    arg -> String
    "'" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String -> String
    gfn String
    "new" String
    arg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'") [String]
    arrays
        [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    arg -> String
    "'" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String -> String
    gfn String
    "free" String
    arg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'") [String]
    arrays
        [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    arg -> String
    "'" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String -> String
    gfn String
    "shape" String
    arg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'") [String]
    arrays
        [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    arg -> String
    "'" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String -> String
    gfn String
    "values_raw" String
    arg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'") [String]
    arrays
        [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    arg -> String
    "'" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String -> String
    gfn String
    "values" String
    arg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'") [String]
    arrays
        [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    arg -> String
    "'" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_futhark_free_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    arg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'") [String]
    opaques
        [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"
           ]
      where
        arrays :: [String]
    arrays = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    isArray [String]
    typs
        opaques :: [String]
    opaques = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    isOpaque [String]
    typs
        typs :: [String]
    typs = [String] -> [String]
    forall a. Ord a => [a] -> [a]
    nubOrd ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (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
        gfn :: String -> String -> String
    gfn String
    typ String
    str = String
    "_futhark_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    typ String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    baseType String
    str 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
    str) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "d"

    javascriptWrapper :: [JSEntryPoint] -> T.Text
    javascriptWrapper :: [JSEntryPoint] -> Text
    javascriptWrapper [JSEntryPoint]
    entryPoints =
      [Text] -> Text
    T.unlines
        [ Text
    serverJs,
          Text
    valuesJs,
          Text
    wrapperclassesJs,
          [JSEntryPoint] -> Text
    classFutharkContext [JSEntryPoint]
    entryPoints
        ]

    classFutharkContext :: [JSEntryPoint] -> T.Text
    classFutharkContext :: [JSEntryPoint] -> Text
    classFutharkContext [JSEntryPoint]
    entryPoints =
      [Text] -> Text
    T.unlines
        [ Text
    "class FutharkContext {",
          [JSEntryPoint] -> Text
    constructor [JSEntryPoint]
    entryPoints,
          Text
    getFreeFun,
          Text
    getEntryPointsFun,
          Text
    getErrorFun,
          [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
    $ (JSEntryPoint -> Text) -> [JSEntryPoint] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map JSEntryPoint -> Text
    jsWrapEntryPoint [JSEntryPoint]
    entryPoints,
          Text
    "}",
          [text|
          async function newFutharkContext() {
            var wasm = await loadWASM();
            return new FutharkContext(wasm);
          }
          |]
        ]
      where
        arrays :: [String]
    arrays = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    isArray [String]
    typs
        typs :: [String]
    typs = [String] -> [String]
    forall a. Ord a => [a] -> [a]
    nubOrd ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (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

    constructor :: [JSEntryPoint] -> T.Text
    constructor :: [JSEntryPoint] -> Text
    constructor [JSEntryPoint]
    jses =
      [text|
      constructor(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}
        };
      }
      |]
      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

    getFreeFun :: T.Text
    getFreeFun :: Text
    getFreeFun =
      [text|
      free() {
        this.wasm._futhark_context_free(this.ctx);
        this.wasm._futhark_context_config_free(this.cfg);
      }
      |]

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

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

    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

    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]

        alr :: [Int]
    alr = [Int
    0 .. [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (JSEntryPoint -> [String]
    ret JSEntryPoint
    jse) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
        outparams :: Text
    outparams = 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
    ", " [Integer -> String
    forall a. Show a => a -> String
    show (Integer -> String) -> Integer -> String
    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 [String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i | Int
    i <- [Int]
    alr]
        results :: Text
    results = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines [Int -> String -> String
    makeResult Int
    i (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ JSEntryPoint -> [String]
    ret JSEntryPoint
    jse [String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i | Int
    i <- [Int]
    alr]
        res_array :: String
    res_array = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " [String
    "result" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i | Int
    i <- [Int]
    alr]
        res :: Text
    res = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ if [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (JSEntryPoint -> [String]
    ret JSEntryPoint
    jse) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 then String
    "result0" else String
    "[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    res_array String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "]"

    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 :: T.Text
    runServer :: Text
    runServer =
      [text|
       Module.onRuntimeInitialized = () => {
         var context = new FutharkContext(Module);
         var server = new Server(context);
         server.run();
       }|]

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