{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} module Futhark.CodeGen.Backends.GenericWASM ( GC.CParts (..), GC.asLibrary, GC.asExecutable, GC.asServer, JSEntryPoint (..), emccExportNames, javascriptWrapper, extToString, runServer, libraryExports, ) where import Data.List (intercalate, nub) import qualified Data.Text as T import qualified Futhark.CodeGen.Backends.GenericC as GC import Futhark.CodeGen.Backends.SimpleRep (opaqueName) import qualified Futhark.CodeGen.ImpCode.Sequential as Imp import Futhark.CodeGen.RTS.JavaScript import Futhark.IR.Primitive import NeatInterpolation (text) extToString :: Imp.ExternalValue -> String extToString :: ExternalValue -> String extToString (Imp.TransparentValue Uniqueness u (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 (t :: * -> *) a. Foldable t => t a -> Int length [DimSize] dimSize) String "[]") String -> String -> String forall a. [a] -> [a] -> [a] ++ ExternalValue -> String extToString (Uniqueness -> ValueDesc -> ExternalValue Imp.TransparentValue Uniqueness u (PrimType -> Signedness -> VName -> ValueDesc Imp.ScalarValue PrimType pt Signedness s VName vn)) extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue (FloatType FloatType Float16) Signedness _ VName _)) = String "f16" extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue (FloatType FloatType Float32) Signedness _ VName _)) = String "f32" extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue (FloatType FloatType Float64) Signedness _ VName _)) = String "f64" extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue (IntType IntType Int8) Signedness Imp.TypeDirect VName _)) = String "i8" extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue (IntType IntType Int16) Signedness Imp.TypeDirect VName _)) = String "i16" extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue (IntType IntType Int32) Signedness Imp.TypeDirect VName _)) = String "i32" extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue (IntType IntType Int64) Signedness Imp.TypeDirect VName _)) = String "i64" extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue (IntType IntType Int8) Signedness Imp.TypeUnsigned VName _)) = String "u8" extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue (IntType IntType Int16) Signedness Imp.TypeUnsigned VName _)) = String "u16" extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue (IntType IntType Int32) Signedness Imp.TypeUnsigned VName _)) = String "u32" extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue (IntType IntType Int64) Signedness Imp.TypeUnsigned VName _)) = String "u64" extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue PrimType Bool Signedness _ VName _)) = String "bool" extToString (Imp.TransparentValue Uniqueness _ (Imp.ScalarValue PrimType Unit Signedness _ VName _)) = String -> String forall a. HasCallStack => String -> a error String "extToString: Unit" extToString (Imp.OpaqueValue Uniqueness _ String oname [ValueDesc] vds) = String -> [ValueDesc] -> String opaqueName String oname [ValueDesc] vds 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] ++ 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. Eq a => [a] -> [a] nub ([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. Eq a => [a] -> [a] nub ([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}' : [${params}, ${rets}] |] where 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 T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ [String] -> String forall a. Show a => a -> String show ([String] -> String) -> [String] -> String forall a b. (a -> b) -> a -> b $ JSEntryPoint -> [String] parameters JSEntryPoint jse rets :: Text rets = 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] -> String) -> [String] -> String 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 = 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 (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. [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. [a] -> Int -> a !! Int i | Int i <- [Int] alp] alr :: [Int] alr = [Int 0 .. [String] -> 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. [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. [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 (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 = String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ Integer -> String forall a. Show a => a -> String show (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] runServer :: T.Text runServer :: Text runServer = [text| Module.onRuntimeInitialized = () => { var context = new FutharkContext(Module); var server = new Server(context); server.run(); }|] libraryExports :: T.Text libraryExports :: Text libraryExports = Text "export {newFutharkContext, FutharkContext, FutharkArray, FutharkOpaque};"