futhark 0.15.8 → 0.16.1

raw patch · 183 files changed

+3642/−11572 lines, 183 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• docs/c-api.rst +33/−34
• docs/conf.py +1/−3
• docs/hacking.rst +22/−0
• docs/index.rst +0/−2
• docs/language-reference.rst +72/−25
• docs/man/futhark-autotune.rst +1/−1
• docs/man/futhark-bench.rst +2/−2
• docs/man/futhark-c.rst +1/−1
• docs/man/futhark-csharp.rst +0/−68
• docs/man/futhark-csopencl.rst +0/−72
• docs/man/futhark-cuda.rst +1/−1
• docs/man/futhark-opencl.rst +1/−1
• docs/man/futhark-repl.rst +1/−1
• docs/man/futhark-run.rst +1/−1
• docs/man/futhark-test.rst +2/−2
• docs/requirements.txt +1/−0
• futhark.cabal +2/−20
• rts/c/cuda.h +79/−3
• rts/c/free_list.h +27/−16
• rts/c/lock.h +11/−11
• rts/c/opencl.h +37/−8
• rts/c/timing.h +1/−1
• rts/c/util.h +6/−6
• rts/c/values.h +10/−10
• rts/csharp/exceptions.cs +0/−6
• rts/csharp/memory.cs +0/−457
• rts/csharp/memory_opencl.cs +0/−231
• rts/csharp/opencl.cs +0/−964
• rts/csharp/panic.cs +0/−24
• rts/csharp/reader.cs +0/−885
• rts/csharp/scalar.cs +0/−484
• rts/python/opencl.py +11/−5
• rts/python/scalar.py +62/−8
• src/Futhark/Actions.hs +2/−13
• src/Futhark/Analysis/AlgSimplify.hs +0/−1435
• src/Futhark/Analysis/Alias.hs +6/−6
• src/Futhark/Analysis/CallGraph.hs +10/−2
• src/Futhark/Analysis/Metrics.hs +0/−1
• src/Futhark/Analysis/PrimExp.hs +10/−4
• src/Futhark/Analysis/PrimExp/Convert.hs +10/−0
• src/Futhark/Analysis/PrimExp/Generalize.hs +32/−33
• src/Futhark/Analysis/Range.hs +0/−216
• src/Futhark/Analysis/ScalExp.hs +0/−313
• src/Futhark/Analysis/SymbolTable.hs +105/−412
• src/Futhark/Analysis/UsageTable.hs +35/−15
• src/Futhark/Bench.hs +38/−0
• src/Futhark/Binder.hs +41/−34
• src/Futhark/Binder/Class.hs +11/−0
• src/Futhark/CLI/Autotune.hs +10/−3
• src/Futhark/CLI/Bench.hs +62/−16
• src/Futhark/CLI/C.hs +2/−2
• src/Futhark/CLI/CSOpenCL.hs +0/−45
• src/Futhark/CLI/CSharp.hs +0/−49
• src/Futhark/CLI/CUDA.hs +3/−3
• src/Futhark/CLI/Dev.hs +0/−4
• src/Futhark/CLI/OpenCL.hs +2/−2
• src/Futhark/CLI/Pkg.hs +2/−2
• src/Futhark/CLI/PyOpenCL.hs +2/−2
• src/Futhark/CLI/Python.hs +2/−2
• src/Futhark/CLI/REPL.hs +47/−17
• src/Futhark/CLI/Run.hs +3/−3
• src/Futhark/CLI/Test.hs +14/−12
• src/Futhark/CodeGen/Backends/CCUDA.hs +56/−29
• src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs +74/−15
• src/Futhark/CodeGen/Backends/COpenCL.hs +12/−12
• src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs +53/−38
• src/Futhark/CodeGen/Backends/CSOpenCL.hs +0/−443
• src/Futhark/CodeGen/Backends/CSOpenCL/Boilerplate.hs +0/−376
• src/Futhark/CodeGen/Backends/GenericC.hs +78/−57
• src/Futhark/CodeGen/Backends/GenericCSharp.hs +0/−1403
• src/Futhark/CodeGen/Backends/GenericCSharp/AST.hs +0/−413
• src/Futhark/CodeGen/Backends/GenericCSharp/Definitions.hs +0/−33
• src/Futhark/CodeGen/Backends/GenericCSharp/Options.hs +0/−46
• src/Futhark/CodeGen/Backends/GenericPython.hs +43/−35
• src/Futhark/CodeGen/Backends/GenericPython/AST.hs +2/−1
• src/Futhark/CodeGen/Backends/PyOpenCL.hs +12/−7
• src/Futhark/CodeGen/Backends/PyOpenCL/Boilerplate.hs +7/−3
• src/Futhark/CodeGen/Backends/SequentialC.hs +3/−2
• src/Futhark/CodeGen/Backends/SequentialCSharp.hs +0/−40
• src/Futhark/CodeGen/Backends/SequentialPython.hs +7/−7
• src/Futhark/CodeGen/Backends/SimpleRep.hs +17/−3
• src/Futhark/CodeGen/ImpCode.hs +17/−5
• src/Futhark/CodeGen/ImpCode/Kernels.hs +2/−2
• src/Futhark/CodeGen/ImpCode/OpenCL.hs +6/−6
• src/Futhark/CodeGen/ImpGen.hs +90/−30
• src/Futhark/CodeGen/ImpGen/CUDA.hs +7/−4
• src/Futhark/CodeGen/ImpGen/Kernels.hs +59/−6
• src/Futhark/CodeGen/ImpGen/Kernels/Base.hs +94/−35
• src/Futhark/CodeGen/ImpGen/Kernels/SegHist.hs +23/−23
• src/Futhark/CodeGen/ImpGen/Kernels/SegMap.hs +6/−2
• src/Futhark/CodeGen/ImpGen/Kernels/SegRed.hs +11/−7
• src/Futhark/CodeGen/ImpGen/Kernels/SegScan.hs +19/−5
• src/Futhark/CodeGen/ImpGen/Kernels/ToOpenCL.hs +193/−82
• src/Futhark/CodeGen/ImpGen/Kernels/Transpose.hs +8/−8
• src/Futhark/CodeGen/ImpGen/OpenCL.hs +6/−3
• src/Futhark/CodeGen/ImpGen/Sequential.hs +2/−1
• src/Futhark/CodeGen/OpenCL/Heuristics.hs +31/−18
• src/Futhark/Compiler.hs +18/−6
• src/Futhark/Compiler/CLI.hs +9/−4
• src/Futhark/Compiler/Program.hs +1/−2
• src/Futhark/Construct.hs +1/−9
• src/Futhark/Doc/Generator.hs +1/−1
• src/Futhark/IR/Aliases.hs +30/−30
• src/Futhark/IR/Kernels/Kernel.hs +1/−28
• src/Futhark/IR/Kernels/Simplify.hs +13/−5
• src/Futhark/IR/KernelsMem.hs +19/−5
• src/Futhark/IR/Mem.hs +59/−53
• src/Futhark/IR/Mem/IxFun.hs +55/−76
• src/Futhark/IR/Mem/Simplify.hs +14/−23
• src/Futhark/IR/Pretty.hs +11/−9
• src/Futhark/IR/Primitive.hs +95/−36
• src/Futhark/IR/Prop.hs +28/−2
• src/Futhark/IR/Prop/Aliases.hs +0/−1
• src/Futhark/IR/Prop/Names.hs +18/−6
• src/Futhark/IR/Prop/Ranges.hs +0/−282
• src/Futhark/IR/Prop/Reshape.hs +0/−20
• src/Futhark/IR/Prop/TypeOf.hs +0/−2
• src/Futhark/IR/Ranges.hs +0/−187
• src/Futhark/IR/SOACS/SOAC.hs +0/−37
• src/Futhark/IR/SOACS/Simplify.hs +89/−69
• src/Futhark/IR/SegOp.hs +8/−35
• src/Futhark/IR/SeqMem.hs +3/−3
• src/Futhark/IR/Syntax.hs +10/−17
• src/Futhark/IR/Syntax/Core.hs +17/−1
• src/Futhark/IR/Traversals.hs +0/−5
• src/Futhark/Internalise.hs +107/−103
• src/Futhark/Internalise/AccurateSizes.hs +33/−47
• src/Futhark/Internalise/Bindings.hs +1/−1
• src/Futhark/Internalise/Defunctionalise.hs +13/−11
• src/Futhark/Internalise/Defunctorise.hs +2/−2
• src/Futhark/Internalise/Lambdas.hs +3/−3
• src/Futhark/Internalise/Monad.hs +16/−3
• src/Futhark/Internalise/Monomorphise.hs +17/−14
• src/Futhark/Optimise/Fusion.hs +3/−3
• src/Futhark/Optimise/InPlaceLowering.hs +2/−2
• src/Futhark/Optimise/InliningDeadFun.hs +13/−10
• src/Futhark/Optimise/Simplify.hs +5/−5
• src/Futhark/Optimise/Simplify/Engine.hs +91/−87
• src/Futhark/Optimise/Simplify/Lore.hs +23/−41
• src/Futhark/Optimise/Simplify/Rule.hs +10/−24
• src/Futhark/Optimise/Simplify/Rules.hs +49/−21
• src/Futhark/Optimise/Sink.hs +3/−7
• src/Futhark/Optimise/TileLoops.hs +39/−35
• src/Futhark/Optimise/Unstream.hs +56/−25
• src/Futhark/Pass/ExpandAllocations.hs +69/−52
• src/Futhark/Pass/ExplicitAllocations.hs +128/−77
• src/Futhark/Pass/ExplicitAllocations/Kernels.hs +18/−15
• src/Futhark/Pass/ExtractKernels.hs +96/−72
• src/Futhark/Pass/ExtractKernels/DistributeNests.hs +152/−110
• src/Futhark/Pass/ExtractKernels/Interchange.hs +4/−39
• src/Futhark/Pass/ExtractKernels/Intragroup.hs +7/−0
• src/Futhark/Pass/ExtractKernels/StreamKernel.hs +2/−2
• src/Futhark/Pass/KernelBabysitting.hs +2/−1
• src/Futhark/Pass/ResolveAssertions.hs +0/−63
• src/Futhark/Passes.hs +0/−2
• src/Futhark/Test.hs +2/−2
• src/Futhark/Tools.hs +8/−12
• src/Futhark/Transform/FirstOrderTransform.hs +52/−16
• src/Futhark/Transform/Rename.hs +2/−2
• src/Futhark/TypeCheck.hs +41/−26
• src/Futhark/Util.hs +19/−3
• src/Futhark/Util/IntegralExp.hs +6/−6
• src/Futhark/Util/Table.hs +2/−1
• src/Language/Futhark/Interpreter.hs +59/−28
• src/Language/Futhark/Parser/Lexer.x +28/−43
• src/Language/Futhark/Parser/Parser.y +29/−11
• src/Language/Futhark/Pretty.hs +5/−4
• src/Language/Futhark/Prop.hs +38/−24
• src/Language/Futhark/Syntax.hs +4/−8
• src/Language/Futhark/Traversals.hs +0/−3
• src/Language/Futhark/TypeChecker.hs +6/−6
• src/Language/Futhark/TypeChecker/Modules.hs +13/−9
• src/Language/Futhark/TypeChecker/Monad.hs +34/−13
• src/Language/Futhark/TypeChecker/Terms.hs +20/−18
• src/Language/Futhark/TypeChecker/Unify.hs +14/−6
• src/Language/Futhark/Warnings.hs +20/−8
• src/futhark.hs +2/−6
• unittests/Futhark/Analysis/ScalExpTests.hs +0/−104
• unittests/Futhark/IR/Mem/IxFun/Alg.hs +1/−20
• unittests/Futhark/IR/Mem/IxFunTests.hs +1/−51
• unittests/Futhark/IR/Mem/IxFunWrapper.hs +0/−7
• unittests/Futhark/Optimise/AlgSimplifyTests.hs +0/−101
• unittests/futhark_tests.hs +0/−4

@@ -8,15 +8,22 @@ ``futlib.h``.  The API provided in the ``.h`` file is documented in the following. -Usaging the API revolves around creating a *configuration object*,-which can then be used to obtain a *context object*, which must be-passed whenever entry points are called.+Using the API requires creating a *configuration object*, which is+then used to obtain a *context object*, which is then used to perform+most other operations, such as calling Futhark functions.  Most functions that can fail return an integer: 0 on success and a non-zero value on error.  Others return a ``NULL`` pointer.  Use :c:func:`futhark_context_get_error` to get a (possibly) more precise error message. +.. c:macro:: FUTHARK_BACKEND_foo++   A preprocessor macro identifying that the backend *foo* was used to+   generate the code; e.g. ``c``, ``opencl``, or ``cuda``.  This can+   be used for conditional compilation of code that only works with+   specific backends.+ Configuration ------------- @@ -26,7 +33,7 @@ freed before any context objects for which it is used.  The same configuration may be used for multiple concurrent contexts. -.. c:type:: struct futhark_context_config+.. c:struct:: futhark_context_config     An opaque struct representing a Futhark configuration. @@ -62,7 +69,7 @@ Context ------- -.. c:type:: struct futhark_context+.. c:struct:: futhark_context     An opaque struct representing a Futhark context. @@ -82,8 +89,9 @@  .. c:function:: int futhark_context_sync(struct futhark_context *ctx) -   Block until all outstanding operations have finished executing.-   Many API functions are asynchronous on their own.+   Block until all outstanding operations, including copies, have+   finished executing.  Many API functions are asynchronous on their+   own.  .. c:function:: void futhark_context_pause_profiling(struct futhark_context *ctx) @@ -143,7 +151,7 @@ unchanged, you should still free both the input and the output - this will not result in a double free. -.. c:type:: struct futhark_i32_1d+.. c:struct:: futhark_i32_1d     An opaque struct representing a Futhark value of type ``[]i32``. @@ -171,8 +179,9 @@  .. c:function:: int futhark_values_i32_1d(struct futhark_context *ctx, struct futhark_i32_1d *arr, int32_t *data) -   Copy data from the value into ``data``, which must be of sufficient-   size.  Multi-dimensional arrays are written in row-major form.+   Asynchronously copy data from the value into ``data``, which must+   be of sufficient size.  Multi-dimensional arrays are written in+   row-major form.  .. c:function:: const int64_t *futhark_shape_i32_1d(struct futhark_context *ctx, struct futhark_i32_1d *arr) @@ -183,10 +192,10 @@ Entry points ------------ -Entry points are mapped 1:1 to C functions.  Return value are handled-with "out"-parameters.+Entry points are mapped 1:1 to C functions.  Return values are handled+with *out*-parameters. -For example, the following entry point::+For example, this Futhark entry point::    entry sum = i32.sum @@ -216,7 +225,7 @@ Exotic ~~~~~~ -The following functions are not going to interesting to most users.+The following functions are not interesting to most users.  .. c:function:: void futhark_context_config_set_default_group_size(struct futhark_context_config *cfg, int size) @@ -231,6 +240,16 @@    Set the default tile size used when executing kernels that have    been block tiled. +.. c:function:: void futhark_context_config_dump_program_to(struct futhark_context_config *cfg, const char *path)++   During :c:func:`futhark_context_new`, dump the OpenCL or CUDA+   program source to the given file.++.. c:function:: void futhark_context_config_load_program_from(struct futhark_context_config *cfg, const char *path)++   During :c:func:`futhark_context_new`, read OpenCL or CUDA program+   source from the given file instead of using the embedded program.+ OpenCL ------ @@ -270,16 +289,6 @@    Add a build option to the OpenCL kernel compiler.  See the OpenCL    specification for `clBuildProgram` for available options. -.. c:function:: void futhark_context_config_dump_program_to(struct futhark_context_config *cfg, const char *path)--   During :c:func:`futhark_context_new`, dump the OpenCL program-   source to the given file.--.. c:function:: void futhark_context_config_load_program_from(struct futhark_context_config *cfg, const char *path)--   During :c:func:`futhark_context_new`, read OpenCL program source-   from the given file instead of using the embedded program.- .. c:function:: void futhark_context_config_dump_binary_to(struct futhark_context_config *cfg, const char *path)     During :c:func:`futhark_context_new`, dump the compiled OpenCL@@ -306,16 +315,6 @@     Add a build option to the NVRTC compiler.  See the CUDA    documentation for ``nvrtcCompileProgram`` for available options.--.. c:function:: void futhark_context_config_dump_program_to(struct futhark_context_config *cfg, const char *path)--   During :c:func:`futhark_context_new`, dump the CUDA program-   source to the given file.--.. c:function:: void futhark_context_config_load_program_from(struct futhark_context_config *cfg, const char *path)--   During :c:func:`futhark_context_new`, read CUDA program source-   from the given file instead of using the embedded program.  .. c:function:: void futhark_context_config_dump_ptx_to(struct futhark_context_config *cfg, const char *path) 

@@ -108,7 +108,7 @@      tokens = {         'root': [-            (r'(if|then|else|let|loop|in|val|for|do|with|local|open|include|import|type|entry|module|while|unsafe|module)\b', token.Keyword),+            (r'(if|then|else|let|loop|in|val|for|do|with|local|open|include|import|type|entry|module|while|module)\b', token.Keyword),             (r"[a-zA-Z_][a-zA-Z0-9_']*", token.Name),             (r"-- .*", token.Comment),             (r'.', token.Text)@@ -266,8 +266,6 @@     ('man/futhark-cuda', 'futhark-cuda', 'compile Futhark to CUDA', [], 1),     ('man/futhark-python', 'futhark-python', 'compile Futhark to sequential Python', [], 1),     ('man/futhark-pyopencl', 'futhark-pyopencl', 'compile Futhark to Python and OpenCL', [], 1),-    ('man/futhark-csharp', 'futhark-csharp', 'compile Futhark to sequential C#', [], 1),-    ('man/futhark-csopencl', 'futhark-csopencl', 'compile Futhark to C# and OpenCL', [], 1),     ('man/futhark-run', 'futhark-run', 'interpret Futhark program', [], 1),     ('man/futhark-repl', 'futhark-repl', 'interactive Futhark read-eval-print-loop', [], 1),     ('man/futhark-test', 'futhark-test', 'test Futhark programs', [], 1),

@@ -93,3 +93,25 @@ allows you to tailor your own compilation pipeline using command line options.  It is also useful for seeing what the AST looks like after specific passes.++When you are about to have a bad day+------------------------------------++When using the ``cuda`` backend, you can use the ``--dump-ptx``+runtime option to dump PTX, a kind of high-level assembly for NVIDIA+GPUs, corresponding to the GPU kernels.  This can be used to+investigate why the generated code isn't running as fast as you expect+(not fun), or even whether NVIDIAs compiler is miscompiling something+(extremely not fun).  With the OpenCL backend,+``--dump-opencl-binary`` does the same thing.++On AMD platforms, ``--dump-opencl-binary`` tends to produce an actual+binary of some kind, and it is pretty tricky to obtain a debugger for+it (they are available and open source, but the documentation and+installation instructions are terrible).  Instead, AMDs OpenCL kernel+compiler accepts a ``-save-temps=foo`` build option, which will make+it write certain intermediate files, prefixed with ``foo``.  In+particular, it will write an ``.s`` file that contains what appears to+be HSA assembly (at least when using ROCm).  If you find yourself+having to do do this, then you are definitely going to have a bad day,+and probably evening and night as well.

@@ -45,8 +45,6 @@    man/futhark-autotune.rst    man/futhark-bench.rst    man/futhark-c.rst-   man/futhark-csharp.rst-   man/futhark-csopencl.rst    man/futhark-cuda.rst    man/futhark-dataset.rst    man/futhark-doc.rst

@@ -115,7 +115,7 @@ System`_).  .. productionlist::-   tuple_type: "(" ")" | "(" `type` ("[" "," `type` "]")* ")"+   tuple_type: "(" ")" | "(" `type` ("," `type`)+ ")"  A tuple value or type is written as a sequence of comma-separated values or types enclosed in parentheses.  For example, ``(0, 1)`` is a@@ -212,6 +212,7 @@       : | "open" `mod_exp`       : | "import" `stringlit`       : | "local" `dec`+      : | "#[" attr "]" dec  The ``open`` declaration brings names defined in another module into scope (see also `Module System`_).  For the meaning of ``import``, see@@ -1172,8 +1173,9 @@ of an array *before* the ``f x`` application is encountered.  The notion of "before" is subtle, as there is no evaluation ordering of a Futhark expression, *except* that a ``let``-binding is always-evaluated before its body, and the argument to a function is always-evaluated before the function.+evaluated before its body, the argument to a function is always+evaluated before the function itself, and the left operand to an+operator is evaluated before the right.  The causality restriction only occurs when a function has size parameters whose first use is *not* as a concrete array size.  For@@ -1538,6 +1540,7 @@        : | "type" ["^"] `id` `type_param`*        : | "module" `id` ":" `mod_type_exp`        : | "include" `mod_type_exp`+       : | "#[" attr "]" spec    spec_type: `type` | `type` "->" `spec_type`  Module types classify modules, with the only (unimportant) difference@@ -1582,66 +1585,110 @@  .. productionlist::    attr:   `id`+       : | `id` "(" [`attr` ("," `attr`)*] ")" -An expression can be prefixed with an attribute, written as-``#[attr]``.  This may affect how it is treated by the compiler or-other tools.  In no case will attributes affect or change the-*semantics* of a program, but it may affect how well it compiles (or-in some cases, whether it compiles at all).  Unknown attributes are-silently ignored.  Most have no effect in the interpreter.+An expression, declaration, or module type spec can be prefixed with+an attribute, written as ``#[attr]``.  This may affect how it is+treated by the compiler or other tools.  In no case will attributes+affect or change the *semantics* of a program, but it may affect how+well it compiles and runs (or in some cases, whether it compiles or+runs at all).  Unknown attributes are silently ignored.  Most have no+effect in the interpreter.  An attribute can be either an *atom*,+written as just an identifier, or *compound*, consisting of an+identifier and a comma-separated sequence of attributes.  The latter+is used for grouping and encoding of more complex information. -Many attributes affect second-order array combinators (*SOACS*).-These must be applied to a fully saturated function application or-they will have no effect.  If two SOACs with contradictory attributes-are combined through fusion, it is unspecified which attributes take-precedence.+Expression attributes+~~~~~~~~~~~~~~~~~~~~~ +Many expression attributes affect second-order array combinators+(*SOACS*).  These must be applied to a fully saturated function+application or they will have no effect.  If two SOACs with+contradictory attributes are combined through fusion, it is+unspecified which attributes take precedence.+ The following expression attributes are supported. -``incremental_flattening_no_outer``-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+``incremental_flattening(no_outer)``+....................................  When using incremental flattening, do not generate the "only outer parallelism" version for the attributed SOACs. -``incremental_flattening_no_intra``-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+``incremental_flattening(no_intra)``+....................................  When using incremental flattening, do not generate the "intra-group parallelism" version for the attributed SOACs. -``incremental_flattening_only_inner``-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+``incremental_flattening(only_intra)``+...................................... +When using incremental flattening, *only* generate the "intra-group+parallelism" version of the attributed SOACs.  **Beware**: the+resulting program will fail to run if the inner parallelism does not+fit on the device.++``incremental_flattening(only_inner)``+......................................+ When using incremental flattening, do not generate multiple versions for this SOAC, but do exploit inner parallelism (which may give rise to multiple versions at deeper levels).  ``noinline``-~~~~~~~~~~~~+............  Do not inline the attributed function application.  If used within a parallel construct (e.g. ``map``), this will likely prevent the GPU backends from generating working code.  ``sequential``-~~~~~~~~~~~~~~+..............  *Fully* sequentialise the attributed SOAC.  ``sequential_outer``-~~~~~~~~~~~~~~~~~~~~+....................  Turn the outer parallelism in the attributed SOAC sequential, but preserve any inner parallelism.  ``sequential_inner``-~~~~~~~~~~~~~~~~~~~~+....................  Exploit only outer parallelism in the attributed SOAC.  ``unsafe``-~~~~~~~~~~+..........  Do not perform any dynamic safety checks (such as bound checks) during execution of the attributed expression.++``warn(safety_checks)``+.......................++Make the compiler issue a warning if the attributed expression (or its+subexpressions) requires safety checks (such as bounds checking) at+run-time.  This is used for performance-critical code where you want+to be told when the compiler is unable to statically verify the safety+of all operations.++Declaration attributes+~~~~~~~~~~~~~~~~~~~~~~++The following declaration attributes are supported.++``noinline``+............++Do not inline any calls to this function.  If the function is then+used within a parallel construct (e.g. ``map``), this will likely+prevent the GPU backends from generating working code.++Spec attributes+~~~~~~~~~~~~~~~++No spec attributes are currently supported by the compiler itself,+although they are syntactically permitted and may be used by other+tools.

@@ -9,7 +9,7 @@ SYNOPSIS ======== -futhark autotune [options...] program+futhark autotune [options...] <program.fut>  DESCRIPTION ===========

@@ -86,8 +86,8 @@   directly, but instead the indicated *program* is run with its first   argument being the path to the compiled Futhark program.  This is   useful for compilation targets that cannot be executed directly (as-  with :ref:`futhark-csharp(1)`), or when you wish to run the program-  on a remote machine.+  with :ref:`futhark-pyopencl(1)` on some platforms), or when you wish+  to run the program on a remote machine.  --runs=count 

@@ -9,7 +9,7 @@ SYNOPSIS ======== -futhark c [options...] infile+futhark c [options...] <program.fut>  DESCRIPTION ===========

@@ -1,68 +0,0 @@-.. role:: ref(emphasis)--.. _futhark-csharp(1):--==============-futhark-csharp-==============--SYNOPSIS-========--futhark csharp [options...] infile--DESCRIPTION-===========--``futhark csharp`` translates a Futhark program to sequential C# code,-and either compiles that C# code with the Roslyn C# Compiler ``csc``-to an executable binary program, or produces a ``.dll`` file that can-be linked with other code..  The standard Futhark optimisation-pipeline is used, and ``csc`` is invoked with ``-lib:$MONO_PATH``,-``-r:Mono.Options.dll``, and ``/unsafe``.--The resulting program will read the arguments to the entry point-(``main`` by default) from standard input and print its return value-on standard output.  The arguments are read and printed in Futhark-syntax.--OPTIONS-=======---h-  Print help text to standard output and exit.----library-  Generate a library instead of an executable.  Appends ``.dll``-  to the name indicated by the ``-o`` option to determine output-  file names.---o outfile-  Where to write the result.  If the source program is named-  'foo.fut', this defaults to 'foo'.----safe-  Ignore ``unsafe`` in program and perform safety checks unconditionally.---v verbose-  Enable debugging output.  If compilation fails due to a compiler-  error, the result of the last successful compiler step will be-  printed to standard error.---W-  Do not print any warnings.---V-  Print version information on standard output and exit.--REQUIREMENTS-============-``futhark csharp`` uses the Mono implementation of the .NET framework.-To compile and execute the compiled binaries/libraries, you must have the ``MONO_PATH`` environment variable defined. ``MONO_PATH`` must be set to a directory containing the ``Mono.Options`` dll.--Mono.Options is available on https://www.nuget.org/packages/Mono.Options/5.3.0.1--SEE ALSO-========--:ref:`futhark-csopencl(1)`

@@ -1,72 +0,0 @@-.. role:: ref(emphasis)--.. _futhark-csopencl(1):--================-futhark-csopencl-================--SYNOPSIS-========--futhark csopencl [options...] infile--DESCRIPTION-===========---``futhark csopencl`` translates a Futhark program to C# code invoking-OpenCL kernels, and either compiles that C# code with the Roslyn C# Compiler ``csc``-to an executable binary program, or produces a ``.dll`` file that can be linked with-other code..  The standard Futhark optimisation pipeline is used, and-``csc`` is invoked with ``-lib:$MONO_PATH``, ``-r:Cloo.clSharp.dll``,-``-r:Mono.Options.dll``, and ``/unsafe``.--The resulting program will otherwise behave exactly as-one compiled with ``futhark csharp``.--OPTIONS-=======---h-  Print help text to standard output and exit.----library-  Generate a library instead of an executable.  Appends ``.dll``-  to the name indicated by the ``-o`` option to determine output-  file names.---o outfile-  Where to write the result.  If the source program is named-  ``foo.fut``, this defaults to ``foo``.----safe-  Ignore ``unsafe`` in program and perform safety checks unconditionally.---v verbose-  Enable debugging output.  If compilation fails due to a compiler-  error, the result of the last successful compiler step will be-  printed to standard error.---V-  Print version information on standard output and exit.---W-  Do not print any warnings.----Werror-  Treat warnings as errors.--REQUIREMENTS-============-``futhark csopencl`` uses the Mono implementation of the .NET framework.-To compile and execute the compiled binaries/libraries, you must have the ``MONO_PATH`` environment variable defined. ``MONO_PATH`` must be set to a directory containing the ``Mono.Options`` and ``Cloo.clSharp`` dll's.--Mono.Options is available on https://www.nuget.org/packages/Mono.Options/5.3.0.1--Cloo.clSharp is available on https://www.nuget.org/packages/Cloo.clSharp/--SEE ALSO-========--:ref:`futhark-test(1)`, :ref:`futhark-csharp(1)`

@@ -9,7 +9,7 @@ SYNOPSIS ======== -futhark cuda [options...] infile+futhark cuda [options...] <program.fut>  DESCRIPTION ===========

@@ -9,7 +9,7 @@ SYNOPSIS ======== -futhark opencl [options...] infile+futhark opencl [options...] <program.fut>  DESCRIPTION ===========

@@ -9,7 +9,7 @@ SYNOPSIS ======== -futhark repl+futhark repl [program.fut]  DESCRIPTION ===========

@@ -9,7 +9,7 @@ SYNOPSIS ======== -futhark run [program]+futhark run <program.fut>  DESCRIPTION ===========

@@ -172,8 +172,8 @@   directly, but instead the indicated *program* is run with its first   argument being the path to the compiled Futhark program.  This is   useful for compilation targets that cannot be executed directly (as-  with :ref:`futhark-csharp(1)`), or when you wish to run the program-  on a remote machine.+  with :ref:`futhark-pyopencl(1)` on some platforms), or when you wish+  to run the program on a remote machine.  --tuning=EXTENSION 

@@ -1,1 +1,2 @@ pyyaml>=4.2b1+sphinx==3.0.3

@@ -1,7 +1,7 @@ cabal-version: 2.4  name:           futhark-version:        0.15.8+version:        0.16.1 synopsis:       An optimising compiler for a functional, array-oriented language.  description:    Futhark is a small programming language designed to be compiled to@@ -24,7 +24,7 @@                 * "Futhark.Construct" explains how to write code that                   manipulates and creates AST fragments.                 .-                <<assets/ohyes.png You too can go fast once you rewrite your program in Futhark.>>+                <<docs/assets/ohyes.png You too can go fast once you rewrite your program in Futhark.>>  category:       Language homepage:       https://futhark-lang.org@@ -35,7 +35,6 @@ build-type:     Simple extra-source-files:     rts/c/*.h-    rts/csharp/*.cs     rts/futhark-doc/*.css     rts/python/*.py     prelude/*.fut@@ -54,7 +53,6 @@ library   exposed-modules:       Futhark.Actions-      Futhark.Analysis.AlgSimplify       Futhark.Analysis.Alias       Futhark.Analysis.CallGraph       Futhark.Analysis.DataDependencies@@ -65,9 +63,7 @@       Futhark.Analysis.PrimExp.Convert       Futhark.Analysis.PrimExp.Generalize       Futhark.Analysis.PrimExp.Simplify-      Futhark.Analysis.Range       Futhark.Analysis.Rephrase-      Futhark.Analysis.ScalExp       Futhark.Analysis.SymbolTable       Futhark.Analysis.UsageTable       Futhark.Bench@@ -76,8 +72,6 @@       Futhark.CLI.Autotune       Futhark.CLI.Bench       Futhark.CLI.C-      Futhark.CLI.CSOpenCL-      Futhark.CLI.CSharp       Futhark.CLI.CUDA       Futhark.CLI.Check       Futhark.CLI.Datacmp@@ -97,14 +91,8 @@       Futhark.CodeGen.Backends.CCUDA.Boilerplate       Futhark.CodeGen.Backends.COpenCL       Futhark.CodeGen.Backends.COpenCL.Boilerplate-      Futhark.CodeGen.Backends.CSOpenCL-      Futhark.CodeGen.Backends.CSOpenCL.Boilerplate       Futhark.CodeGen.Backends.GenericC       Futhark.CodeGen.Backends.GenericC.Options-      Futhark.CodeGen.Backends.GenericCSharp-      Futhark.CodeGen.Backends.GenericCSharp.AST-      Futhark.CodeGen.Backends.GenericCSharp.Definitions-      Futhark.CodeGen.Backends.GenericCSharp.Options       Futhark.CodeGen.Backends.GenericPython       Futhark.CodeGen.Backends.GenericPython.AST       Futhark.CodeGen.Backends.GenericPython.Definitions@@ -112,7 +100,6 @@       Futhark.CodeGen.Backends.PyOpenCL       Futhark.CodeGen.Backends.PyOpenCL.Boilerplate       Futhark.CodeGen.Backends.SequentialC-      Futhark.CodeGen.Backends.SequentialCSharp       Futhark.CodeGen.Backends.SequentialPython       Futhark.CodeGen.Backends.SimpleRep       Futhark.CodeGen.ImpCode@@ -158,13 +145,11 @@       Futhark.IR.Prop.Constants       Futhark.IR.Prop.Names       Futhark.IR.Prop.Patterns-      Futhark.IR.Prop.Ranges       Futhark.IR.Prop.Rearrange       Futhark.IR.Prop.Reshape       Futhark.IR.Prop.Scope       Futhark.IR.Prop.TypeOf       Futhark.IR.Prop.Types-      Futhark.IR.Ranges       Futhark.IR.RetType       Futhark.IR.SOACS       Futhark.IR.SOACS.SOAC@@ -220,7 +205,6 @@       Futhark.Pass.ExtractKernels.ToKernels       Futhark.Pass.FirstOrderTransform       Futhark.Pass.KernelBabysitting-      Futhark.Pass.ResolveAssertions       Futhark.Pass.Simplify       Futhark.Passes       Futhark.Pipeline@@ -333,9 +317,7 @@   type: exitcode-stdio-1.0   main-is: futhark_tests.hs   other-modules:-      Futhark.Analysis.ScalExpTests       Futhark.BenchTests-      Futhark.Optimise.AlgSimplifyTests       Futhark.Pkg.SolveTests       Futhark.IR.Prop.RearrangeTests       Futhark.IR.Prop.ReshapeTests

@@ -67,7 +67,7 @@   cfg->load_ptx_from = NULL;    cfg->default_block_size = 256;-  cfg->default_grid_size = 256;+  cfg->default_grid_size = 0; // Set properly later.   cfg->default_tile_size = 32;   cfg->default_threshold = 32*1024; @@ -82,6 +82,13 @@   cfg->size_classes = size_classes; } +// A record of something that happened.+struct profiling_record {+  cudaEvent_t *events; // Points to two events.+  int *runs;+  int64_t *runtime;+};+ struct cuda_context {   CUdevice dev;   CUcontext cu_ctx;@@ -99,6 +106,10 @@   size_t max_bespoke;    size_t lockstep_width;++  struct profiling_record *profiling_records;+  int profiling_records_capacity;+  int profiling_records_used; };  #define CU_DEV_ATTR(x) (CU_DEVICE_ATTRIBUTE_##x)@@ -352,6 +363,13 @@     ctx->cfg.default_tile_size = ctx->max_tile_size;   } +  if (!ctx->cfg.default_grid_size_changed) {+    ctx->cfg.default_grid_size =+      (device_query(ctx->dev, MULTIPROCESSOR_COUNT) *+       device_query(ctx->dev, MAX_THREADS_PER_MULTIPROCESSOR))+      / ctx->cfg.default_block_size;+  }+   for (int i = 0; i < ctx->cfg.num_sizes; i++) {     const char *size_class, *size_name;     size_t *size_value, max_value, default_value;@@ -366,6 +384,12 @@     } else if (strstr(size_class, "num_groups") == size_class) {       max_value = ctx->max_grid_size;       default_value = ctx->cfg.default_grid_size;+      // XXX: as a quick and dirty hack, use twice as many threads for+      // histograms by default.  We really should just be smarter+      // about sizes somehow.+      if (strstr(size_name, ".seghist_") != NULL) {+        default_value *= 2;+      }     } else if (strstr(size_class, "tile_size") == size_class) {       max_value = ctx->max_tile_size;       default_value = ctx->cfg.default_tile_size;@@ -449,10 +473,62 @@   cuda_module_setup(ctx, src_fragments, extra_opts); } +// Count up the runtime all the profiling_records that occured during execution.+// Also clears the buffer of profiling_records.+static cudaError_t cuda_tally_profiling_records(struct cuda_context *ctx) {+  cudaError_t err;+  for (int i = 0; i < ctx->profiling_records_used; i++) {+    struct profiling_record record = ctx->profiling_records[i];++    float ms;+    if ((err = cudaEventElapsedTime(&ms, record.events[0], record.events[1])) != CUDA_SUCCESS) {+      return err;+    }++    // CUDA provides milisecond resolution, but we want microseconds.+    *record.runs += 1;+    *record.runtime += ms*1000;++    if ((err = cudaEventDestroy(record.events[0])) != CUDA_SUCCESS) {+      return err;+    }+    if ((err = cudaEventDestroy(record.events[1])) != CUDA_SUCCESS) {+      return err;+    }++    free(record.events);+  }++  ctx->profiling_records_used = 0;++  return CUDA_SUCCESS;+}++// Returns pointer to two events.+static cudaEvent_t* cuda_get_events(struct cuda_context *ctx, int *runs, int64_t *runtime) {+    if (ctx->profiling_records_used == ctx->profiling_records_capacity) {+      ctx->profiling_records_capacity *= 2;+      ctx->profiling_records =+        realloc(ctx->profiling_records,+                ctx->profiling_records_capacity *+                sizeof(struct profiling_record));+    }+    cudaEvent_t *events = calloc(2, sizeof(cudaEvent_t));+    cudaEventCreate(&events[0]);+    cudaEventCreate(&events[1]);+    ctx->profiling_records[ctx->profiling_records_used].events = events;+    ctx->profiling_records[ctx->profiling_records_used].runs = runs;+    ctx->profiling_records[ctx->profiling_records_used].runtime = runtime;+    ctx->profiling_records_used++;+    return events;+}+ static CUresult cuda_free_all(struct cuda_context *ctx);  static void cuda_cleanup(struct cuda_context *ctx) {   CUDA_SUCCEED(cuda_free_all(ctx));+  (void)cuda_tally_profiling_records(ctx);+  free(ctx->profiling_records);   CUDA_SUCCEED(cuModuleUnload(ctx->module));   CUDA_SUCCEED(cuCtxDestroy(ctx->cu_ctx)); }@@ -464,7 +540,7 @@   }    size_t size;-  if (free_list_find(&ctx->free_list, tag, &size, mem_out) == 0) {+  if (free_list_find(&ctx->free_list, min_size, &size, mem_out) == 0) {     if (size >= min_size) {       return CUDA_SUCCESS;     } else {@@ -498,7 +574,7 @@   CUdeviceptr existing_mem;    // If there is already a block with this tag, then remove it.-  if (free_list_find(&ctx->free_list, tag, &size, &existing_mem) == 0) {+  if (free_list_find(&ctx->free_list, -1, &size, &existing_mem) == 0) {     CUresult res = cuMemFree(existing_mem);     if (res != CUDA_SUCCESS) {       return res;

@@ -1,8 +1,8 @@ // Start of free_list.h. -/* An entry in the free list.  May be invalid, to avoid having to-   deallocate entries as soon as they are removed.  There is also a-   tag, to help with memory reuse. */+// An entry in the free list.  May be invalid, to avoid having to+// deallocate entries as soon as they are removed.  There is also a+// tag, to help with memory reuse. struct free_list_entry {   size_t size;   fl_mem_t mem;@@ -25,7 +25,7 @@   } } -/* Remove invalid entries from the free list. */+// Remove invalid entries from the free list. static void free_list_pack(struct free_list *l) {   int p = 0;   for (int i = 0; i < l->capacity; i++) {@@ -82,25 +82,36 @@   l->used++; } -/* Find and remove a memory block of at least the desired size and-   tag.  Returns 0 on success.  */-static int free_list_find(struct free_list *l, const char *tag, size_t *size_out, fl_mem_t *mem_out) {+// Find and remove a memory block of the indicated tag, or if that+// does not exist, another memory block with exactly the desired size.+// Returns 0 on success.+static int free_list_find(struct free_list *l, size_t size,+                          size_t *size_out, fl_mem_t *mem_out) {+  int size_match = -1;   int i;   for (i = 0; i < l->capacity; i++) {-    if (l->entries[i].valid && l->entries[i].tag == tag) {-      l->entries[i].valid = 0;-      *size_out = l->entries[i].size;-      *mem_out = l->entries[i].mem;-      l->used--;-      return 0;+    if (l->entries[i].valid &&+        size <= l->entries[i].size &&+        (size_match < 0 || l->entries[i].size < l->entries[size_match].size)) {+      // If this entry is valid, has sufficient size, and is smaller than the+      // best entry found so far, use this entry.+      size_match = i;     }   } -  return 1;+  if (size_match >= 0) {+    l->entries[size_match].valid = 0;+    *size_out = l->entries[size_match].size;+    *mem_out = l->entries[size_match].mem;+    l->used--;+    return 0;+  } else {+    return 1;+  } } -/* Remove the first block in the free list.  Returns 0 if a block was-   removed, and nonzero if the free list was already empty. */+// Remove the first block in the free list.  Returns 0 if a block was+// removed, and nonzero if the free list was already empty. static int free_list_first(struct free_list *l, fl_mem_t *mem_out) {   for (int i = 0; i < l->capacity; i++) {     if (l->entries[i].valid) {

@@ -1,20 +1,20 @@ // Start of lock.h. -/* A very simple cross-platform implementation of locks.  Uses-   pthreads on Unix and some Windows thing there.  Futhark's-   host-level code is not multithreaded, but user code may be, so we-   need some mechanism for ensuring atomic access to API functions.-   This is that mechanism.  It is not exposed to user code at all, so-   we do not have to worry about name collisions. */+// A very simple cross-platform implementation of locks.  Uses+// pthreads on Unix and some Windows thing there.  Futhark's+// host-level code is not multithreaded, but user code may be, so we+// need some mechanism for ensuring atomic access to API functions.+// This is that mechanism.  It is not exposed to user code at all, so+// we do not have to worry about name collisions.  #ifdef _WIN32  typedef HANDLE lock_t;  static lock_t create_lock(lock_t *lock) {-  *lock = CreateMutex(NULL,  /* Default security attributes. */-                      FALSE, /* Initially unlocked. */-                      NULL); /* Unnamed. */+  *lock = CreateMutex(NULL,  // Default security attributes.+                      FALSE, // Initially unlocked.+                      NULL); // Unnamed. }  static void lock_lock(lock_t *lock) {@@ -30,7 +30,7 @@ }  #else-/* Assuming POSIX */+// Assuming POSIX  #include <pthread.h> @@ -52,7 +52,7 @@ }  static void free_lock(lock_t *lock) {-  /* Nothing to do for pthreads. */+  // Nothing to do for pthreads.   (void)lock; } 

@@ -123,10 +123,10 @@   char *device_name; }; -/* This function must be defined by the user.  It is invoked by-   setup_opencl() after the platform and device has been found, but-   before the program is loaded.  Its intended use is to tune-   constants based on the selected platform and device. */+// This function must be defined by the user.  It is invoked by+// setup_opencl() after the platform and device has been found, but+// before the program is loaded.  Its intended use is to tune+// constants based on the selected platform and device. static void post_opencl_setup(struct opencl_context*, struct opencl_device_option*);  static char *strclone(const char *str) {@@ -465,8 +465,8 @@   return build_status; } -/* Fields in a bitmask indicating which types we must be sure are-   available. */+// Fields in a bitmask indicating which types we must be sure are+// available. enum opencl_required_type { OPENCL_F64 = 1 };  // We take as input several strings representing the program, because@@ -526,6 +526,16 @@   OPENCL_SUCCEED_FATAL(clGetDeviceInfo(device_option.device, CL_DEVICE_LOCAL_MEM_SIZE,                                        sizeof(size_t), &max_local_memory, NULL)); +  // Futhark reserves 4 bytes for bookkeeping information.+  max_local_memory -= 4;++  // NVIDIA reserves some more bytes for who-knows-what.  The number+  // of bytes here has been experimentally determined, but the+  // overhead seems to vary a bit depending on what the kernel does.+  if (strstr(device_option.platform_name, "NVIDIA CUDA") != NULL) {+    max_local_memory -= 12;+  }+   // Make sure this function is defined.   post_opencl_setup(ctx, &device_option); @@ -563,6 +573,12 @@     } else if (strstr(size_class, "num_groups") == size_class) {       max_value = max_group_size; // Futhark assumes this constraint.       default_value = ctx->cfg.default_num_groups;+      // XXX: as a quick and dirty hack, use twice as many threads for+      // histograms by default.  We really should just be smarter+      // about sizes somehow.+      if (strstr(size_name, ".seghist_") != NULL) {+        default_value *= 2;+      }     } else if (strstr(size_class, "tile_size") == size_class) {       max_value = sqrt(max_group_size);       default_value = ctx->cfg.default_tile_size;@@ -682,6 +698,7 @@   }    if (ctx->cfg.debugging) {+    fprintf(stderr, "OpenCL compiler options: %s\n", compile_opts);     fprintf(stderr, "Building OpenCL program...\n");   }   OPENCL_SUCCEED_FATAL(build_opencl_program(prog, device_option.device, compile_opts));@@ -833,7 +850,7 @@    size_t size; -  if (free_list_find(&ctx->free_list, tag, &size, mem_out) == 0) {+  if (free_list_find(&ctx->free_list, min_size, &size, mem_out) == 0) {     // Successfully found a free block.  Is it big enough?     //     // FIXME: we might also want to check whether the block is *too@@ -848,8 +865,16 @@     // expose OpenCL pointer values directly to the application, but     // instead rely on a level of indirection.     if (size >= min_size) {+      if (ctx->cfg.debugging) {+        fprintf(stderr, "No need to allocate: Found a block in the free list.\n");+      }+       return CL_SUCCESS;     } else {+      if (ctx->cfg.debugging) {+        fprintf(stderr, "Found a free block, but it was too small.\n");+      }+       // Not just right - free it.       int error = clReleaseMemObject(*mem_out);       if (error != CL_SUCCESS) {@@ -866,6 +891,10 @@   // have to check after every deallocation.  This might be pretty   // expensive.  Let's hope that this case is hit rarely. +  if (ctx->cfg.debugging) {+    fprintf(stderr, "Actually allocating the desired block.\n");+  }+   int error = opencl_alloc_actual(ctx, min_size, mem_out);    while (error == CL_MEM_OBJECT_ALLOCATION_FAILURE) {@@ -892,7 +921,7 @@   cl_mem existing_mem;    // If there is already a block with this tag, then remove it.-  if (free_list_find(&ctx->free_list, tag, &size, &existing_mem) == 0) {+  if (free_list_find(&ctx->free_list, -1, &size, &existing_mem) == 0) {     int error = clReleaseMemObject(existing_mem);     if (error != CL_SUCCESS) {       return error;

@@ -15,7 +15,7 @@ }  #else-/* Assuming POSIX */+// Assuming POSIX  #include <time.h> #include <sys/time.h>

@@ -20,20 +20,20 @@   va_start(vl, s);   size_t needed = 1 + (size_t)vsnprintf(NULL, 0, s, vl);   char *buffer = (char*) malloc(needed);-  va_start(vl, s); /* Must re-init. */+  va_start(vl, s); // Must re-init.   vsnprintf(buffer, needed, s, vl);   return buffer; }  // Read a file into a NUL-terminated string; returns NULL on error.-static char* slurp_file(const char *filename, size_t *size) {-  char *s;+static void* slurp_file(const char *filename, size_t *size) {+  unsigned char *s;   FILE *f = fopen(filename, "rb"); // To avoid Windows messing with linebreaks.   if (f == NULL) return NULL;   fseek(f, 0, SEEK_END);   size_t src_size = ftell(f);   fseek(f, 0, SEEK_SET);-  s = (char*) malloc(src_size + 1);+  s = (unsigned char*) malloc(src_size + 1);   if (fread(s, 1, src_size, f) != src_size) {     free(s);     s = NULL;@@ -51,7 +51,7 @@  // Dump 'n' bytes from 'buf' into the file at the designated location. // Returns 0 on success.-static int dump_file(const char *file, const char *buf, size_t n) {+static int dump_file(const char *file, const void *buf, size_t n) {   FILE *f = fopen(file, "w");    if (f == NULL) {@@ -92,7 +92,7 @@     b->str = realloc(b->str, b->capacity);   } -  va_start(vl, s); /* Must re-init. */+  va_start(vl, s); // Must re-init.   vsnprintf(b->str+b->used, b->capacity-b->used, s, vl);   b->used += needed; }

@@ -277,11 +277,11 @@   }  static int read_str_i8(char *buf, void* dest) {-  /* Some platforms (WINDOWS) does not support scanf %hhd or its-     cousin, %SCNi8.  Read into int first to avoid corrupting-     memory.--     https://gcc.gnu.org/bugzilla/show_bug.cgi?id=63417  */+  // Some platforms (WINDOWS) does not support scanf %hhd or its+  // cousin, %SCNi8.  Read into int first to avoid corrupting+  // memory.+  //+  // https://gcc.gnu.org/bugzilla/show_bug.cgi?id=63417   remove_underscores(buf);   int j, x;   if (sscanf(buf, "%i%n", &x, &j) == 1) {@@ -293,11 +293,11 @@ }  static int read_str_u8(char *buf, void* dest) {-  /* Some platforms (WINDOWS) does not support scanf %hhd or its-     cousin, %SCNu8.  Read into int first to avoid corrupting-     memory.--     https://gcc.gnu.org/bugzilla/show_bug.cgi?id=63417  */+  // Some platforms (WINDOWS) does not support scanf %hhd or its+  // cousin, %SCNu8.  Read into int first to avoid corrupting+  // memory.+  //+  // https://gcc.gnu.org/bugzilla/show_bug.cgi?id=63417   remove_underscores(buf);   int j, x;   if (sscanf(buf, "%i%n", &x, &j) == 1) {

@@ -1,6 +0,0 @@-private class ValueError : Exception-{-    public ValueError(){}-    public ValueError(string message):base(message){}-    public ValueError(string message, Exception inner):base(message, inner){}-}

@@ -1,457 +0,0 @@-public struct FlatArray<T>-{-    public long[] shape;-    public T[] array;--    public FlatArray(T[] data_array, long[] shape_array)-    {-        shape = shape_array;-        array = data_array;-    }--    public FlatArray(T[] data_array)-    {-        shape = new long[] {data_array.Length};-        array = data_array;-    }--    private long getIdx(int[] idxs)-    {-        long idx = 0;-        for (int i = 0; i<idxs.Length; i++)-        {-            idx += shape[i] * idxs[i];-        }-        return idx;--    }-    public T this[params int[] indexes]-    {-        get-        {-            Debug.Assert(indexes.Length == shape.Length);-            return array[getIdx(indexes)];-        }--        set-        {-            Debug.Assert(indexes.Length == shape.Length);-            array[getIdx(indexes)] = value;-        }-    }--    public IEnumerator GetEnumerator()-    {-        foreach (T val in array)-        {-            yield return val;-        }-    }--    public (T[], long[]) AsTuple()-    {-        return (this.array, this.shape);-    }-}--public class Opaque{-    object desc;-    object data;-    public Opaque(string str, object payload)-    {-        this.desc = str;-        this.data = payload;-    }--    public override string ToString()-    {-        return string.Format("<opaque Futhark value of type {}>", desc);-    }-}--private byte[] allocateMem(sbyte size)-{-    return new byte[size];-}--private byte[] allocateMem(short size)-{-    return new byte[size];-}--private byte[] allocateMem(int size)-{-    return new byte[size];-}--private byte[] allocateMem(long size)-{-    return new byte[size];-}--private byte[] allocateMem(byte size)-{-    return new byte[size];-}--private byte[] allocateMem(ushort size)-{-    return new byte[size];-}--private byte[] allocateMem(uint size)-{-    return new byte[size];-}--private byte[] allocateMem(ulong size)-{-    return new byte[size];-}--private Tuple<byte[], long[]> createTuple_byte(byte[] bytes, long[] shape)-{-    var byteArray = new byte[bytes.Length / sizeof(byte)];-    Buffer.BlockCopy(bytes, 0, byteArray, 0, bytes.Length);-    return Tuple.Create(byteArray, shape);-}--private Tuple<ushort[], long[]> createTuple_ushort(byte[] bytes, long[] shape)-{-    var ushortArray = new ushort[bytes.Length / sizeof(ushort)];-    Buffer.BlockCopy(bytes, 0, ushortArray, 0, bytes.Length);-    return Tuple.Create(ushortArray, shape);-}--private Tuple<uint[], long[]> createTuple_uint(byte[] bytes, long[] shape)-{-    var uintArray = new uint[bytes.Length / sizeof(uint)];-    Buffer.BlockCopy(bytes, 0, uintArray, 0, bytes.Length);-    return Tuple.Create(uintArray, shape);-}--private Tuple<ulong[], long[]> createTuple_ulong(byte[] bytes, long[] shape)-{-    var ulongArray = new ulong[bytes.Length / sizeof(ulong)];-    Buffer.BlockCopy(bytes, 0, ulongArray, 0, bytes.Length);-    return Tuple.Create(ulongArray, shape);-}---private Tuple<sbyte[], long[]> createTuple_sbyte(byte[] bytes, long[] shape)-{-    var sbyteArray = new sbyte[1];-    if (bytes.Length > 0)-    {-        sbyteArray = new sbyte[bytes.Length / sizeof(sbyte)];-    }-    Buffer.BlockCopy(bytes, 0, sbyteArray, 0, bytes.Length);-    return Tuple.Create(sbyteArray, shape);-}---private Tuple<short[], long[]> createTuple_short(byte[] bytes, long[] shape)-{-    var shortArray = new short[1];-    if (bytes.Length > 0)-    {-        shortArray = new short[bytes.Length / sizeof(short)];-    }-    Buffer.BlockCopy(bytes, 0, shortArray, 0, bytes.Length);-    return Tuple.Create(shortArray, shape);-}--private Tuple<int[], long[]> createTuple_int(byte[] bytes, long[] shape)-{-    var intArray = new int[1];-    if (bytes.Length > 0)-    {-        intArray = new int[bytes.Length / sizeof(int)];-    }-    Buffer.BlockCopy(bytes, 0, intArray, 0, bytes.Length);-    return Tuple.Create(intArray, shape);-}--private Tuple<long[], long[]> createTuple_long(byte[] bytes, long[] shape)-{-    var longArray = new long[1];-    if (bytes.Length > 0)-    {-        longArray = new long[bytes.Length / sizeof(long)];-    }-    Buffer.BlockCopy(bytes, 0, longArray, 0, bytes.Length);-    return Tuple.Create(longArray, shape);-}--private Tuple<float[], long[]> createTuple_float(byte[] bytes, long[] shape)-{-    var floatArray = new float[1];-    if (bytes.Length > 0)-    {-        floatArray = new float[bytes.Length / sizeof(float)];-    }-    Buffer.BlockCopy(bytes, 0, floatArray, 0, bytes.Length);-    return Tuple.Create(floatArray, shape);-}---private Tuple<double[], long[]> createTuple_double(byte[] bytes, long[] shape)-{-    var doubleArray = new double[1];-    if (bytes.Length > 0)-    {-        doubleArray = new double[bytes.Length / sizeof(double)];-    }-    Buffer.BlockCopy(bytes, 0, doubleArray, 0, bytes.Length);-    return Tuple.Create(doubleArray, shape);-}--private Tuple<bool[], long[]> createTuple_bool(byte[] bytes, long[] shape)-{-    var boolArray = new bool[1];-    if (bytes.Length > 0)-    {-        boolArray = new bool[bytes.Length / sizeof(bool)];-    }-    Buffer.BlockCopy(bytes, 0, boolArray, 0, bytes.Length);-    return Tuple.Create(boolArray, shape);-}--private byte[] unwrapArray(Array src, int obj_size)-{-    var bytes = new byte[src.Length * obj_size];-    Buffer.BlockCopy(src, 0, bytes, 0, bytes.Length);-    return bytes;-}--private byte indexArray_byte(byte[] src, int offset)-{-    unsafe-    {-        fixed (void* dest_ptr = &src[offset])-        {-            return *(byte*) dest_ptr;-        }-    }-}--private ushort indexArray_ushort(byte[] src, int offset)-{-    unsafe-    {-        fixed (void* dest_ptr = &src[offset])-        {-            return *(ushort*) dest_ptr;-        }-    }-}--private uint indexArray_uint(byte[] src, int offset)-{-    unsafe-    {-        fixed (void* dest_ptr = &src[offset])-        {-            return *(uint*) dest_ptr;-        }-    }-}--private ulong indexArray_ulong(byte[] src, int offset)-{-    unsafe-    {-        fixed (void* dest_ptr = &src[offset])-        {-            return *(ulong*) dest_ptr;-        }-    }-}--private sbyte indexArray_sbyte(byte[] src, int offset)-{-    unsafe-    {-        fixed (void* dest_ptr = &src[offset])-        {-            return *(sbyte*) dest_ptr;-        }-    }-}--private short indexArray_short(byte[] src, int offset)-{-    unsafe-    {-        fixed (void* dest_ptr = &src[offset])-        {-            return *(short*) dest_ptr;-        }-    }-}--private int indexArray_int(byte[] src, int offset)-{-    unsafe-    {-        fixed (void* dest_ptr = &src[offset])-        {-            return *(int*) dest_ptr;-        }-    }-}--private long indexArray_long(byte[] src, int offset)-{-    unsafe-    {-        fixed (void* dest_ptr = &src[offset])-        {-            return *(long*) dest_ptr;-        }-    }-}--private float indexArray_float(byte[] src, int offset)-{-    unsafe-    {-        fixed (void* dest_ptr = &src[offset])-        {-            return *(float*) dest_ptr;-        }-    }-}--private double indexArray_double(byte[] src, int offset)-{-    unsafe-    {-        fixed (void* dest_ptr = &src[offset])-        {-            return *(double*) dest_ptr;-        }-    }-}--private bool indexArray_bool(byte[] src, int offset)-{-    unsafe-    {-        fixed (void* dest_ptr = &src[offset])-        {-            return *(bool*) dest_ptr;-        }-    }-}--private void writeScalarArray(byte[] dest, int offset, sbyte value)-{-    unsafe-    {-        fixed (byte* dest_ptr = &dest[offset])-        {-            *(sbyte*) dest_ptr = value;-        }-    }-}-private void writeScalarArray(byte[] dest, int offset, byte value)-{-    unsafe-    {-        fixed (byte* dest_ptr = &dest[offset])-        {-            *(byte*) dest_ptr = value;-        }-    }-}-private void writeScalarArray(byte[] dest, int offset, short value)-{-    unsafe-    {-        fixed (byte* dest_ptr = &dest[offset])-        {-            *(short*) dest_ptr = value;-        }-    }-}-private void writeScalarArray(byte[] dest, int offset, ushort value)-{-    unsafe-    {-        fixed (byte* dest_ptr = &dest[offset])-        {-            *(ushort*) dest_ptr = value;-        }-    }-}-private void writeScalarArray(byte[] dest, int offset, int value)-{-    unsafe-    {-        fixed (byte* dest_ptr = &dest[offset])-        {-            *(int*) dest_ptr = value;-        }-    }-}-private void writeScalarArray(byte[] dest, int offset, uint value)-{-    unsafe-    {-        fixed (byte* dest_ptr = &dest[offset])-        {-            *(uint*) dest_ptr = value;-        }-    }-}-private void writeScalarArray(byte[] dest, int offset, long value)-{-    unsafe-    {-        fixed (byte* dest_ptr = &dest[offset])-        {-            *(long*) dest_ptr = value;-        }-    }-}-private void writeScalarArray(byte[] dest, int offset, ulong value)-{-    unsafe-    {-        fixed (byte* dest_ptr = &dest[offset])-        {-            *(ulong*) dest_ptr = value;-        }-    }-}-private void writeScalarArray(byte[] dest, int offset, float value)-{-    unsafe-    {-        fixed (byte* dest_ptr = &dest[offset])-        {-            *(float*) dest_ptr = value;-        }-    }-}-private void writeScalarArray(byte[] dest, int offset, double value)-{-    unsafe-    {-        fixed (byte* dest_ptr = &dest[offset])-        {-            *(double*) dest_ptr = value;-        }-    }-}-private void writeScalarArray(byte[] dest, int offset, bool value)-{-    unsafe-    {-        fixed (byte* dest_ptr = &dest[offset])-        {-            *(bool*) dest_ptr = value;-        }-    }-}

@@ -1,231 +0,0 @@-private Tuple<byte[], long[]> createTuple_byte(CLMemoryHandle mem, CLCommandQueueHandle queue,-                                       int nbytes, long[] shape)-{-    var byteArray = new byte[1];-    if (nbytes > 0)-    {-        byteArray = new byte[nbytes / sizeof(byte)];-    }-    unsafe-    {-        fixed(void* ptr = &byteArray[0])-        {-            CL10.EnqueueReadBuffer(queue, mem, true,-                                   new IntPtr(0), new IntPtr(nbytes), new IntPtr(ptr),-                                   0, null, null-                                   );-        }-    }-    return Tuple.Create(byteArray, shape);-}--private Tuple<ushort[], long[]> createTuple_ushort(CLMemoryHandle mem, CLCommandQueueHandle queue,-                                           int nbytes, long[] shape)-{-    var byteArray = new ushort[1];-    if (nbytes > 0)-    {-        byteArray = new ushort[nbytes / sizeof(ushort)];-    }-    unsafe-    {-        fixed(void* ptr = &byteArray[0])-        {-            CL10.EnqueueReadBuffer(queue, mem, true,-                                   new IntPtr(0), new IntPtr(nbytes), new IntPtr(ptr),-                                   0, null, null-                                   );-        }-    }-    return Tuple.Create(byteArray, shape);-}--private Tuple<uint[], long[]> createTuple_uint(CLMemoryHandle mem, CLCommandQueueHandle queue,-                                   int nbytes, long[] shape)-{-    var byteArray = new uint[1];-    if (nbytes > 0)-    {-        byteArray = new uint[nbytes / sizeof(uint)];-    }-    unsafe-    {-        fixed(void* ptr = &byteArray[0])-        {-            CL10.EnqueueReadBuffer(queue, mem, true,-                                   new IntPtr(0), new IntPtr(nbytes), new IntPtr(ptr),-                                   0, null, null-                                   );-        }-    }-    return Tuple.Create(byteArray, shape);-}--private Tuple<ulong[], long[]> createTuple_ulong(CLMemoryHandle mem, CLCommandQueueHandle queue,-                                 int nbytes, long[] shape)-{-    var byteArray = new ulong[1];-    if (nbytes > 0)-    {-        byteArray = new ulong[nbytes / sizeof(ulong)];-    }-    unsafe-    {-        fixed(void* ptr = &byteArray[0])-        {-            CL10.EnqueueReadBuffer(queue, mem, true,-                                   new IntPtr(0), new IntPtr(nbytes), new IntPtr(ptr),-                                   0, null, null-                                   );-        }-    }-    return Tuple.Create(byteArray, shape);-}--private Tuple<sbyte[], long[]> createTuple_sbyte(CLMemoryHandle mem, CLCommandQueueHandle queue,-                                  int nbytes, long[] shape)-{-    var byteArray = new sbyte[1];-    if (nbytes > 0)-    {-        byteArray = new sbyte[nbytes / sizeof(sbyte)];-    }-    unsafe-    {-        fixed(void* ptr = &byteArray[0])-        {-            CL10.EnqueueReadBuffer(queue, mem, true,-                                   new IntPtr(0), new IntPtr(nbytes), new IntPtr(ptr),-                                   0, null, null-                                   );-        }-    }-    return Tuple.Create(byteArray, shape);-}--private Tuple<short[], long[]> createTuple_short(CLMemoryHandle mem, CLCommandQueueHandle queue,-                                  int nbytes, long[] shape)-{-    var byteArray = new short[1];-    if (nbytes > 0)-    {-        byteArray = new short[nbytes / sizeof(short)];-    }-    unsafe-    {-        fixed(void* ptr = &byteArray[0])-        {-            CL10.EnqueueReadBuffer(queue, mem, true,-                                   new IntPtr(0), new IntPtr(nbytes), new IntPtr(ptr),-                                   0, null, null-                                   );-        }-    }-    return Tuple.Create(byteArray, shape);-}--private Tuple<int[], long[]> createTuple_int(CLMemoryHandle mem, CLCommandQueueHandle queue,-                                  int nbytes, long[] shape)-{-    var byteArray = new int[1];-    if (nbytes > 0)-    {-        byteArray = new int[nbytes / sizeof(int)];-    }-    unsafe-    {-        fixed(void* ptr = &byteArray[0])-        {-            CL10.EnqueueReadBuffer(queue, mem, true,-                                   new IntPtr(0), new IntPtr(nbytes), new IntPtr(ptr),-                                   0, null, null-                                   );-        }-    }-    return Tuple.Create(byteArray, shape);-}--private Tuple<long[], long[]> createTuple_long(CLMemoryHandle mem, CLCommandQueueHandle queue,-                                int nbytes, long[] shape)-{-    var byteArray = new long[1];-    if (nbytes > 0)-    {-        byteArray = new long[nbytes / sizeof(long)];-    }-    unsafe-    {-        fixed(void* ptr = &byteArray[0])-        {-            CL10.EnqueueReadBuffer(queue, mem, true,-                                   new IntPtr(0), new IntPtr(nbytes), new IntPtr(ptr),-                                   0, null, null-                                   );-        }-    }-    return Tuple.Create(byteArray, shape);-}--private Tuple<float[], long[]> createTuple_float(CLMemoryHandle mem, CLCommandQueueHandle queue,-                                 int nbytes, long[] shape)-{-    var byteArray = new float[1];-    if (nbytes > 0)-    {-        byteArray = new float[nbytes / sizeof(float)];-    }-    unsafe-    {-        fixed(void* ptr = &byteArray[0])-        {-            CL10.EnqueueReadBuffer(queue, mem, true,-                                   new IntPtr(0), new IntPtr(nbytes), new IntPtr(ptr),-                                   0, null, null-                                   );-        }-    }-    return Tuple.Create(byteArray, shape);-}--private Tuple<double[], long[]> createTuple_double(CLMemoryHandle mem, CLCommandQueueHandle queue,-                                 int nbytes, long[] shape)-{-    var byteArray = new double[1];-    if (nbytes > 0)-    {-        byteArray = new double[nbytes / sizeof(double)];-    }-    unsafe-    {-        fixed(void* ptr = &byteArray[0])-        {-            CL10.EnqueueReadBuffer(queue, mem, true,-                                   new IntPtr(0), new IntPtr(nbytes), new IntPtr(ptr),-                                   0, null, null-                                   );-        }-    }-    return Tuple.Create(byteArray, shape);-}--private Tuple<bool[], long[]> createTuple_bool(CLMemoryHandle mem, CLCommandQueueHandle queue,-                                 int nbytes, long[] shape)-{-    var byteArray = new bool[1];-    if (nbytes > 0)-    {-        byteArray = new bool[nbytes / sizeof(bool)];-    }-    unsafe-    {-        fixed(void* ptr = &byteArray[0])-        {-            CL10.EnqueueReadBuffer(queue, mem, true,-                                   new IntPtr(0), new IntPtr(nbytes), new IntPtr(ptr),-                                   0, null, null-                                   );-        }-    }-    return Tuple.Create(byteArray, shape);-}-

@@ -1,964 +0,0 @@-// Stub code for OpenCL setup.--private void OPENCL_SUCCEED(int return_code,-                        [CallerFilePath] string filePath = "",-                        [CallerLineNumber] int lineNumber = 0)-{-    OpenCLSucceed(return_code, "", filePath, lineNumber);-}--private void OPENCL_SUCCEED(ComputeErrorCode return_code,-                    [CallerFilePath] string filePath = "",-                    [CallerLineNumber] int lineNumber = 0)-{-    OpenCLSucceed((int) return_code, "", filePath, lineNumber);-}--private void OPENCL_SUCCEED(object return_code,-                    [CallerFilePath] string filePath = "",-                    [CallerLineNumber] int lineNumber = 0)-{-    OpenCLSucceed((int) return_code, "", filePath, lineNumber);-}--public struct OpenCLConfig-{-    public bool Debugging;-    public int PreferredDeviceNum;-    public string PreferredPlatform;-    public string PreferredDevice;--    public string DumpProgramTo;-    public string LoadProgramFrom;--    public int DefaultGroupSize;-    public int DefaultNumGroups;-    public int DefaultTileSize;-    public int DefaultThreshold;--    public int NumSizes;-    public string[] SizeNames;-    public string[] SizeVars;-    public int[] SizeValues;-    public string[] SizeClasses;-}--private void MemblockUnrefDevice(ref FutharkContext- context, ref OpenCLMemblock block, string desc)-{-    if (!block.IsNull)-    {-        block.DecreaseRefs();-        if (context.DetailMemory)-        {-            Console.Error.WriteLine(String.Format(-                "Unreferencing block {0} (allocated as {1}) in {2}: {3} references remaining.",-                desc, block.Tag, "space 'device'", block.References));-        }--        if (block.References == 0)-        {-            context.CurrentMemUsageDevice -= block.Size;-            OPENCL_SUCCEED(OpenCLFree(ref context, block.Mem, block.Tag));-            block.IsNull = true;-        }--        if (context.DetailMemory)-        {-            Console.Error.WriteLine(String.Format(-                "{0} bytes freed (now allocated: {1} bytes)",-                block.Size, context.CurrentMemUsageDevice));-        }-    }-}--private void MemblockSetDevice(ref FutharkContext context,-    ref OpenCLMemblock lhs, ref OpenCLMemblock rhs, string lhs_desc)-{-    MemblockUnrefDevice(ref context, ref lhs, lhs_desc);-    rhs.IncreaseRefs();-    lhs = rhs;-}--private OpenCLMemblock MemblockAllocDevice(ref FutharkContext context, OpenCLMemblock block, long size, string desc)-{-    if (size < 0)-    {-        panic(1, String.Format("Negative allocation of {0} bytes attempted for {1} in {2}",-            size, desc));-    }--    MemblockUnrefDevice(ref context, ref block, desc);-    OPENCL_SUCCEED(OpenCLAlloc(ref context, size, desc, ref block.Mem));--    block.References = 1;-    block.IsNull = false;-    block.Size = size;-    block.Tag = desc;-    context.CurrentMemUsageDevice += size;--    if (context.DetailMemory)-    {-        Console.Error.Write(String.Format("Allocated {0} bytes for {1} in {2} (now allocated: {3} bytes)",-            size, desc, "space 'device'", Ctx.CurrentMemUsageDevice));-    }--    if (context.CurrentMemUsageDevice > context.PeakMemUsageDevice)-    {-        context.PeakMemUsageDevice = context.CurrentMemUsageDevice;-        if (context.DetailMemory)-        {-            Console.Error.Write(" (new peak).\n");-        }-    }-    else if (context.DetailMemory)-    {-        Console.Error.Write(".\n");-    }--    return block;-}---private bool FreeListFind(ref OpenCLFreeList free_list, string tag, ref long size_out, ref CLMemoryHandle mem_out)-{-    for (int i = 0; i < free_list.Capacity; i++)-    {-        if (free_list.Entries[i].Valid && free_list.Entries[i].Tag == tag)-        {-            free_list.Entries[i].Valid = false;-            size_out = free_list.Entries[i].Size;-            mem_out = free_list.Entries[i].Mem;-            free_list.Used--;-            return true;-        }-    }--    return false;-}--private bool FreeListFirst(ref OpenCLFreeList free_list, ref CLMemoryHandle mem_out)-{-    for (int i = 0; i < free_list.Capacity; i++)-    {-        if (free_list.Entries[i].Valid)-        {-            free_list.Entries[i].Valid = false;-            mem_out = free_list.Entries[i].Mem;-            free_list.Used--;-            return true;-        }-    }-    return false;-}--private ComputeErrorCode OpenCLAllocActual(ref FutharkContext context, long min_size, ref CLMemoryHandle mem)-{-    ComputeErrorCode error;-    mem = CL10.CreateBuffer(context.OpenCL.Context, ComputeMemoryFlags.ReadWrite-        , new IntPtr(min_size), IntPtr.Zero, out error);--    if (error != ComputeErrorCode.Success)-    {-        return error;-    }--    int x = 2;-    unsafe-    {-        error = CL10.EnqueueWriteBuffer(Ctx.OpenCL.Queue, mem, true, IntPtr.Zero, new IntPtr(sizeof(int)), new IntPtr(&x), 0, null, null);-    }--    return error;-}--private ComputeErrorCode OpenCLAlloc(ref FutharkContext context, long min_size, string tag, ref CLMemoryHandle mem_out)-{-    if (min_size < 0)-    {-        panic(1, "Tried to allocate a negative amount of bytes.");-    }--    min_size = (min_size < sizeof(int)) ? sizeof(int) : min_size;--    long size = 0;--    if (FreeListFind(ref context.FreeList, tag, ref size, ref mem_out))-    {-        if (size >= min_size && size <= min_size * 2)-        {-            return ComputeErrorCode.Success;-        }-        else-        {-            ComputeErrorCode code1 = CL10.ReleaseMemObject(mem_out);-            if (code1 != ComputeErrorCode.Success)-            {-                return code1;-            }-        }-    }--    ComputeErrorCode error = OpenCLAllocActual(ref context, min_size, ref mem_out);-    while (error == ComputeErrorCode.MemoryObjectAllocationFailure)-    {-        CLMemoryHandle mem = Ctx.EMPTY_MEM_HANDLE;-        if (FreeListFirst(ref context.FreeList, ref mem))-        {-            error = CL10.ReleaseMemObject(mem);-            if (error != ComputeErrorCode.Success)-            {-                return error;-            }-        }-        else-        {-            break;-        }--        error = OpenCLAllocActual(ref context, min_size, ref mem_out);-    }-    return error;-}---private ComputeErrorCode OpenCLFree(ref FutharkContext context, CLMemoryHandle mem, string tag)-{-    long size = 0;-    CLMemoryHandle existing_mem = Ctx.EMPTY_MEM_HANDLE;-    ComputeErrorCode error = ComputeErrorCode.Success;-    if (FreeListFind(ref context.FreeList, tag, ref size, ref existing_mem))-    {-        error = CL10.ReleaseMemObject(existing_mem);-        if (error != ComputeErrorCode.Success)-        {-            return error;-        }-    }--    if (existing_mem.Value == mem.Value)-    {-        return error;-    }--    var trash_null = new IntPtr(0);-    unsafe-    {-        error = CL10.GetMemObjectInfo(mem, ComputeMemoryInfo.Size,-            new IntPtr(sizeof(long)), new IntPtr(&size), out trash_null);-    }--    if (error == ComputeErrorCode.Success)-    {-        FreeListInsert(ref context, size, mem, tag);-    }-    return error;-}--private void FreeListInsert(ref FutharkContext context, long size, CLMemoryHandle mem, string tag)-{-    int i = FreeListFindInvalid(ref context);-    if (i == context.FreeList.Capacity)-    {-        var cap = context.FreeList.Capacity;-        int new_capacity = cap * 2;-        Array.Resize(ref context.FreeList.Entries, new_capacity);-        for (int j = 0; j < cap; j++)-        {-            var entry = new OpenCLFreeListEntry();-            entry.Valid = false;-            context.FreeList.Entries[cap + j] = entry;-        }--        context.FreeList.Capacity *= 2;-    }--    context.FreeList.Entries[i].Valid = true;-    context.FreeList.Entries[i].Size = size;-    context.FreeList.Entries[i].Tag = tag;-    context.FreeList.Entries[i].Mem = mem;-    context.FreeList.Used++;-}--private int FreeListFindInvalid(ref FutharkContext context)-{-    int i;-    for (i = 0; i < context.FreeList.Capacity; i++)-    {-        if (!context.FreeList.Entries[i].Valid)-        {-            break;-        }-    }--    return i;-}--private class OpenCLMemblock-{-    public int References;-    public CLMemoryHandle Mem;-    public long Size;-    public string Tag;-    public bool IsNull;--    public void IncreaseRefs()-    {-        this.References += 1;-    }--    public void DecreaseRefs()-    {-        this.References -= 1;-    }-}--private OpenCLMemblock EmptyMemblock(CLMemoryHandle mem)-{-    var block = new OpenCLMemblock();-    block.Mem = mem;-    block.References = 0;-    block.Tag = "";-    block.Size = 0;-    block.IsNull = true;--    return block;-}--public struct OpenCLFreeListEntry-{-    public bool Valid;-    public CLMemoryHandle Mem;-    public long Size;-    public string Tag;-}--public struct OpenCLFreeList-{-    public OpenCLFreeListEntry[] Entries;-    public int Capacity;-    public int Used;-}---private OpenCLFreeList OpenCLFreeListInit()-{-    int CAPACITY = 30; // arbitrarily chosen-    var free_list = new OpenCLFreeList();-    free_list.Entries = Enumerable.Range(0, CAPACITY)-        .Select<int, OpenCLFreeListEntry>(_ =>-                {-                    var entry = new OpenCLFreeListEntry();-                    entry.Valid = false;-                    return entry;-                }).ToArray();--    free_list.Capacity = CAPACITY;-    free_list.Used = 0;--    return free_list;-}---private void OpenCLConfigInit(out OpenCLConfig cfg,-                      int num_sizes,-                      string[] size_names,-                      string[] size_vars,-                      int[] size_values,-                      string[] size_classes)-{-    cfg.Debugging = false;-    cfg.PreferredDeviceNum = 0;-    cfg.PreferredPlatform = "";-    cfg.PreferredDevice = "";-    cfg.DumpProgramTo = null;-    cfg.LoadProgramFrom = null;--    // The following are dummy sizes that mean the concrete defaults-    // will be set during initialisation via hardware-inspection-based-    // heuristics.-    cfg.DefaultGroupSize = 0;-    cfg.DefaultNumGroups = 0;-    cfg.DefaultTileSize = 0;-    cfg.DefaultThreshold = 0;--    cfg.NumSizes = num_sizes;-    cfg.SizeNames = size_names;-    cfg.SizeVars = size_vars;-    cfg.SizeValues = size_values;-    cfg.SizeClasses = size_classes;-}--public struct OpenCLContext {-   public CLPlatformHandle Platform;-   public CLDeviceHandle Device;-   public CLContextHandle Context;-   public CLCommandQueueHandle Queue;--   public OpenCLConfig Cfg;--   public int MaxGroupSize;-   public int MaxNumGroups;-   public int MaxTileSize;-   public int MaxThreshold;-   public int MaxLocalMemory;-   public int MaxBespoke;--   public int LockstepWidth;-}--public struct OpenCLDeviceOption {-    public CLPlatformHandle Platform;-    public CLDeviceHandle Device;-    public ComputeDeviceTypes DeviceType;-    public string PlatformName;-    public string DeviceName;-};--/* This function must be defined by the user.  It is invoked by-   setup_opencl() after the platform and device has been found, but-   before the program is loaded.  Its intended use is to tune-   constants based on the selected platform and device. */--private string OpenCLErrorString(int err)-{-    switch ((ComputeErrorCode) err) {-        case ComputeErrorCode.Success:                                        return "Success!";-        case ComputeErrorCode.DeviceNotFound:                                 return "Device not found.";-        case ComputeErrorCode.DeviceNotAvailable:                             return "Device not available";-        case ComputeErrorCode.CompilerNotAvailable:                           return "Compiler not available";-        case ComputeErrorCode.MemoryObjectAllocationFailure:                  return "Memory object allocation failure";-        case ComputeErrorCode.OutOfResources:                                 return "Out of resources";-        case ComputeErrorCode.OutOfHostMemory:                                return "Out of host memory";-        case ComputeErrorCode.ProfilingInfoNotAvailable:                      return "Profiling information not available";-        case ComputeErrorCode.MemoryCopyOverlap:                              return "Memory copy overlap";-        case ComputeErrorCode.ImageFormatMismatch:                            return "Image format mismatch";-        case ComputeErrorCode.ImageFormatNotSupported:                        return "Image format not supported";-        case ComputeErrorCode.BuildProgramFailure:                            return "Program build failure";-        case ComputeErrorCode.MapFailure:                                     return "Map failure";-        case ComputeErrorCode.InvalidValue:                                   return "Invalid value";-        case ComputeErrorCode.InvalidDeviceType:                              return "Invalid device type";-        case ComputeErrorCode.InvalidPlatform:                                return "Invalid platform";-        case ComputeErrorCode.InvalidDevice:                                  return "Invalid device";-        case ComputeErrorCode.InvalidContext:                                 return "Invalid context";-        case ComputeErrorCode.InvalidCommandQueueFlags:                       return "Invalid queue properties";-        case ComputeErrorCode.InvalidCommandQueue:                            return "Invalid command queue";-        case ComputeErrorCode.InvalidHostPointer:                             return "Invalid host pointer";-        case ComputeErrorCode.InvalidMemoryObject:                            return "Invalid memory object";-        case ComputeErrorCode.InvalidImageFormatDescriptor:                   return "Invalid image format descriptor";-        case ComputeErrorCode.InvalidImageSize:                               return "Invalid image size";-        case ComputeErrorCode.InvalidSampler:                                 return "Invalid sampler";-        case ComputeErrorCode.InvalidBinary:                                  return "Invalid binary";-        case ComputeErrorCode.InvalidBuildOptions:                            return "Invalid build options";-        case ComputeErrorCode.InvalidProgram:                                 return "Invalid program";-        case ComputeErrorCode.InvalidProgramExecutable:                       return "Invalid program executable";-        case ComputeErrorCode.InvalidKernelName:                              return "Invalid kernel name";-        case ComputeErrorCode.InvalidKernelDefinition:                        return "Invalid kernel definition";-        case ComputeErrorCode.InvalidKernel:                                  return "Invalid kernel";-        case ComputeErrorCode.InvalidArgumentIndex:                           return "Invalid argument index";-        case ComputeErrorCode.InvalidArgumentValue:                           return "Invalid argument value";-        case ComputeErrorCode.InvalidArgumentSize:                            return "Invalid argument size";-        case ComputeErrorCode.InvalidKernelArguments:                         return "Invalid kernel arguments";-        case ComputeErrorCode.InvalidWorkDimension:                           return "Invalid work dimension";-        case ComputeErrorCode.InvalidWorkGroupSize:                           return "Invalid work group size";-        case ComputeErrorCode.InvalidWorkItemSize:                            return "Invalid work item size";-        case ComputeErrorCode.InvalidGlobalOffset:                            return "Invalid global offset";-        case ComputeErrorCode.InvalidEventWaitList:                           return "Invalid event wait list";-        case ComputeErrorCode.InvalidEvent:                                   return "Invalid event";-        case ComputeErrorCode.InvalidOperation:                               return "Invalid operation";-        case ComputeErrorCode.InvalidGLObject:                                return "Invalid OpenGL object";-        case ComputeErrorCode.InvalidBufferSize:                              return "Invalid buffer size";-        case ComputeErrorCode.InvalidMipLevel:                                return "Invalid mip-map level";-        default:                                             return "Unknown";-    }-}--private void OpenCLSucceed(int ret,-                   string call,-                   string file,-                   int line)-{-    if (ret != (int) ComputeErrorCode.Success)-    {-        panic(-1, "{0}:{1}: OpenCL call\n  {2}\nfailed with error code {3} ({4})\n",-              file, line, call, ret, OpenCLErrorString(ret));-    }-}--private void SetPreferredPlatform(ref OpenCLConfig cfg, string s) {-    cfg.PreferredPlatform = s;-}--private void SetPreferredDevice(ref OpenCLConfig cfg, string s)-{-    int x = 0;-    int i = 0;-    if (s[0] == '#') {-        i = 1;-        while (i < s.Length && char.IsDigit(s[i])) {-            x = x * 10 + (int) (s[i])-'0';-            i++;-        }-        // Skip trailing spaces.-        while (i < s.Length && char.IsWhiteSpace(s[i])) {-            i++;-        }-    }-    cfg.PreferredDevice = s.Substring(i);-    cfg.PreferredDeviceNum = x;-}--private string OpenCLPlatformInfo(CLPlatformHandle platform,-                         ComputePlatformInfo param) {-    IntPtr req_bytes;-    IntPtr _null = new IntPtr();-    OPENCL_SUCCEED(CL10.GetPlatformInfo(platform, param, _null, _null, out req_bytes));--    byte[] info = new byte[(int) req_bytes];-    unsafe-    {-        fixed (byte* ptr = &info[0])-        {-            OPENCL_SUCCEED(CL10.GetPlatformInfo(platform, param, req_bytes, new IntPtr(ptr), out _null));-        }-    }--    return System.Text.Encoding.Default.GetString(info);-}--private string OpenCLDeviceInfo(CLDeviceHandle device,-                        ComputeDeviceInfo param) {-    IntPtr req_bytes;-    IntPtr _null = new IntPtr();-    OPENCL_SUCCEED(CL10.GetDeviceInfo(device, param, _null, _null, out req_bytes));--    byte[] info = new byte[(int) req_bytes];-    unsafe-    {-        fixed (byte* ptr = &info[0])-        {-            OPENCL_SUCCEED(CL10.GetDeviceInfo(device, param, req_bytes, new IntPtr(ptr), out _null));-        }-    }-    return System.Text.Encoding.Default.GetString(info);--}--private void OpenCLAllDeviceOptions(out OpenCLDeviceOption[] devices_out,-                            out int num_devices_out)-{-    int num_devices = 0, num_devices_added = 0;--    CLPlatformHandle[] all_platforms;-    int[] platform_num_devices;--    int num_platforms;--    // Find the number of platforms.-    OPENCL_SUCCEED(CL10.GetPlatformIDs(0, null, out num_platforms));--    // Make room for them.-    all_platforms = new CLPlatformHandle[num_platforms];-    platform_num_devices = new int[num_platforms];--    int tmp;-    // Fetch all the platforms.-    OPENCL_SUCCEED(CL10.GetPlatformIDs(num_platforms, all_platforms, out tmp));--    // Count the number of devices for each platform, as well as the-    // total number of devices.-    for (int i = 0; i < num_platforms; i++)-    {-        if (CL10.GetDeviceIDs(all_platforms[i], ComputeDeviceTypes.All,-                              0, null, out platform_num_devices[i]) == ComputeErrorCode.Success)-        {-            num_devices += platform_num_devices[i];-        }-        else-        {-            platform_num_devices[i] = 0;-        }-    }--    // Make room for all the device options.-    OpenCLDeviceOption[] devices = new OpenCLDeviceOption[num_devices];--    // Loop through the platforms, getting information about their devices.-    for (int i = 0; i < num_platforms; i++) {-        CLPlatformHandle platform = all_platforms[i];-        int num_platform_devices = platform_num_devices[i];--        if (num_platform_devices == 0) {-            continue;-        }--        string platform_name = OpenCLPlatformInfo(platform, ComputePlatformInfo.Name);-        CLDeviceHandle[] platform_devices = new CLDeviceHandle[num_platform_devices];--        // Fetch all the devices.-        OPENCL_SUCCEED(CL10.GetDeviceIDs(platform, ComputeDeviceTypes.All,-                                         num_platform_devices, platform_devices, out tmp));--        IntPtr tmpptr;-        // Loop through the devices, adding them to the devices array.-        unsafe-        {-            for (int j = 0; j < num_platform_devices; j++) {-                string device_name = OpenCLDeviceInfo(platform_devices[j], ComputeDeviceInfo.Name);-                devices[num_devices_added].Platform = platform;-                devices[num_devices_added].Device = platform_devices[j];-                fixed (void* ptr = &devices[num_devices_added].DeviceType)-                {-                    OPENCL_SUCCEED(CL10.GetDeviceInfo(platform_devices[j],-                                                      ComputeDeviceInfo.Type,-                                                      new IntPtr(sizeof(ComputeDeviceTypes)),-                                                      new IntPtr(ptr),-                                                      out tmpptr));-                }-                // We don't want the structs to share memory, so copy the platform name.-                // Each device name is already unique.-                devices[num_devices_added].PlatformName = platform_name;-                devices[num_devices_added].DeviceName = device_name;-                num_devices_added++;-            }-        }-    }--    devices_out = devices;-    num_devices_out = num_devices;-}--private bool IsBlacklisted(string platform_name, string device_name)-{-    return (platform_name.Contains("Apple") &&-            device_name.Contains("Intel(R) Core(TM)"));-}--private OpenCLDeviceOption GetPreferredDevice(OpenCLConfig cfg) {-    OpenCLDeviceOption[] devices;-    int num_devices;--    OpenCLAllDeviceOptions(out devices, out num_devices);--    int num_device_matches = 0;--    for (int i = 0; i < num_devices; i++)-    {-        OpenCLDeviceOption device = devices[i];-        if (!IsBlacklisted(device.PlatformName, device.DeviceName) &&-            device.PlatformName.Contains(cfg.PreferredPlatform) &&-            device.DeviceName.Contains(cfg.PreferredDevice) &&-            num_device_matches++ == cfg.PreferredDeviceNum)-        {-            return device;-        }-    }--    panic(1, "Could not find acceptable OpenCL device.\n");-    // this is never reached-    throw new Exception();--}--private void DescribeDeviceOption(OpenCLDeviceOption device) {-    Console.Error.WriteLine("Using platform: {0}", device.PlatformName);-    Console.Error.WriteLine("Using device: {0}", device.DeviceName);-}--private ComputeProgramBuildStatus BuildOpenCLProgram(ref CLProgramHandle program, CLDeviceHandle device, string options) {-    ComputeErrorCode ret_val = CL10.BuildProgram(program, 1, new []{device}, options, null, IntPtr.Zero);--    // Avoid termination due to CL_BUILD_PROGRAM_FAILURE-    if (ret_val != ComputeErrorCode.Success && ret_val != ComputeErrorCode.BuildProgramFailure) {-        Debug.Assert((int) ret_val == 0);-    }--    ComputeProgramBuildStatus build_status;-    unsafe-    {-        IntPtr _null = new IntPtr();-        ret_val = CL10.GetProgramBuildInfo(program,-                                           device,-                                           ComputeProgramBuildInfo.Status,-                                           new IntPtr(sizeof(int)),-                                           new IntPtr(&build_status),-                                           out _null);-    }-    Debug.Assert(ret_val == 0);--    if (build_status != ComputeProgramBuildStatus.Success) {-        char[] build_log;-        IntPtr ret_val_size;-        unsafe-        {-        ret_val = CL10.GetProgramBuildInfo(program,-                                           device,-                                           ComputeProgramBuildInfo.BuildLog,-                                           IntPtr.Zero,-                                           IntPtr.Zero,-                                           out ret_val_size);-        }-        Debug.Assert(ret_val == 0);--        build_log = new char[((int)ret_val_size)+1];-        unsafe-        {-            IntPtr _null = new IntPtr();-            fixed (char* ptr = &build_log[0])-            {-                CL10.GetProgramBuildInfo(program,-                                         device,-                                         ComputeProgramBuildInfo.BuildLog,-                                         ret_val_size,-                                         new IntPtr(ptr),-                                         out _null);-            }-        }-        Debug.Assert(ret_val == 0);--        // The spec technically does not say whether the build log is zero-terminated, so let's be careful.-        build_log[(int)ret_val_size] = '\0';-        Console.Error.Write("Build log:\n{0}\n", new string(build_log));-    }--    return build_status;-}---// We take as input several strings representing the program, because-// C does not guarantee that the compiler supports particularly large-// literals.  Notably, Visual C has a limit of 2048 characters.  The-// array must be NULL-terminated.-private CLProgramHandle SetupOpenCL(ref FutharkContext ctx,-                            string[] srcs,-                            bool required_types) {--    ComputeErrorCode error;-    CLPlatformHandle platform;-    CLDeviceHandle device;-    int MaxGroupSize, MaxLocalMemory;--    ctx.OpenCL.LockstepWidth = 0;--    OpenCLDeviceOption device_option = GetPreferredDevice(ctx.OpenCL.Cfg);--    if (ctx.Debugging) {-        DescribeDeviceOption(device_option);-    }--    device = device = device_option.Device;-    platform = platform = device_option.Platform;--    if (required_types){-        int supported;-        unsafe-        {-            IntPtr throwaway0 = new IntPtr();-            OPENCL_SUCCEED(CL10.GetDeviceInfo(device,-                                              ComputeDeviceInfo.PreferredVectorWidthDouble,-                                              new IntPtr(sizeof(IntPtr)),-                                              new IntPtr(&supported),-                                              out throwaway0));-        }-        if (supported == 0) {-            panic(1,-                  "Program uses double-precision floats, but this is not supported on chosen device: {0}\n",-                  device_option.DeviceName);-        }-    }--    unsafe-    {-        IntPtr throwaway1 = new IntPtr();-        OPENCL_SUCCEED(CL10.GetDeviceInfo(device,-                                          ComputeDeviceInfo.MaxWorkGroupSize,-                                          new IntPtr(sizeof(IntPtr)),-                                          new IntPtr(&MaxGroupSize),-                                          out throwaway1));-    }--    int MaxTileSize = (int) Math.Sqrt(MaxGroupSize);--    unsafe-    {-        IntPtr throwaway1 = new IntPtr();-        OPENCL_SUCCEED(CL10.GetDeviceInfo(device,-                                          ComputeDeviceInfo.LocalMemorySize,-                                          new IntPtr(sizeof(IntPtr)),-                                          new IntPtr(&MaxLocalMemory),-                                          out throwaway1));-    }--    // Make sure this function is defined.-    PostOpenCLSetup(ref ctx, ref device_option);--    if (MaxGroupSize < ctx.OpenCL.Cfg.DefaultGroupSize) {-        Console.Error.WriteLine("Note: Device limits default group size to {0} (down from {1}).\n",-                                MaxGroupSize, ctx.OpenCL.Cfg.DefaultGroupSize);-        ctx.OpenCL.Cfg.DefaultGroupSize = MaxGroupSize;-    }--    if (MaxTileSize < ctx.OpenCL.Cfg.DefaultTileSize) {-        Console.Error.WriteLine("Note: Device limits default tile size to {0} (down from {1}).\n",-                                MaxTileSize, ctx.OpenCL.Cfg.DefaultTileSize);-        ctx.OpenCL.Cfg.DefaultTileSize = MaxTileSize;-    }--    ctx.OpenCL.MaxGroupSize = MaxGroupSize;-    ctx.OpenCL.MaxTileSize = MaxTileSize; // No limit.-    ctx.OpenCL.MaxThreshold = ctx.OpenCL.MaxNumGroups; // No limit.-    ctx.OpenCL.MaxLocalMemory = MaxLocalMemory;-    ctx.OpenCL.MaxBespoke = 0; // No limit.--    // Now we go through all the sizes, clamp them to the valid range,-    // or set them to the default.-    for (int i = 0; i < ctx.OpenCL.Cfg.NumSizes; i++) {-        string size_class = ctx.OpenCL.Cfg.SizeClasses[i];-        int size_value = ctx.OpenCL.Cfg.SizeValues[i];-        string size_name = ctx.OpenCL.Cfg.SizeNames[i];-        int max_value, default_value;-        max_value = default_value = 0;-        if (size_class.StartsWith("group_size")) {-            max_value = MaxGroupSize;-            default_value = ctx.OpenCL.Cfg.DefaultGroupSize;-        } else if (size_class.StartsWith("num_groups")) {-            max_value = MaxGroupSize; // Futhark assumes this constraint.-            default_value = ctx.OpenCL.Cfg.DefaultNumGroups;-        } else if (size_class.StartsWith("tile_size")){-            max_value = (int) Math.Sqrt(MaxGroupSize);-            default_value = ctx.OpenCL.Cfg.DefaultTileSize;-        } else if (size_class.StartsWith("threshold")) {-            max_value = 0; // No limit.-            default_value = ctx.OpenCL.Cfg.DefaultThreshold;-        } else {-            // Bespoke sizes have no limit or default.-            max_value = 0;-        }-        if (size_value == 0) {-            ctx.OpenCL.Cfg.SizeValues[i] = default_value;-        } else if (max_value > 0 && size_value > max_value) {-            Console.Error.WriteLine("Note: Device limits {0} to {1} (down from {2})",-                                    size_name, max_value, size_value);-            ctx.OpenCL.Cfg.SizeValues[i] = default_value;-        }-    }--    IntPtr[] properties = new []{-        new IntPtr((int) ComputeContextInfo.Platform),-        platform.Value,-        IntPtr.Zero-    };-    // Note that nVidia's OpenCL requires the platform property-    IntPtr _null;-    ctx.OpenCL.Context = CL10.CreateContext(properties, 1, new []{device}, null, ctx.NULL, out error);-    Debug.Assert(error == 0);--    ctx.OpenCL.Queue = CL10.CreateCommandQueue(ctx.OpenCL.Context, device, 0, out error);-    Debug.Assert(error == 0);--    if (ctx.Debugging) {-        Console.Error.WriteLine("Lockstep width: {0}\n", (int)ctx.OpenCL.LockstepWidth);-        Console.Error.WriteLine("Default group size: {0}\n", (int)ctx.OpenCL.Cfg.DefaultGroupSize);-        Console.Error.WriteLine("Default number of groups: {0}\n", (int)ctx.OpenCL.Cfg.DefaultNumGroups);-    }--    string fut_opencl_src;--    // Maybe we have to read OpenCL source from somewhere else (used for debugging).-    if (ctx.OpenCL.Cfg.LoadProgramFrom != null) {-        fut_opencl_src = File.ReadAllText(ctx.OpenCL.Cfg.LoadProgramFrom);-    } else {-        // Build the OpenCL program.  First we have to concatenate all the fragments.-        fut_opencl_src = string.Join("\n", srcs);-    }--    CLProgramHandle prog;-    error = 0;-    string[] src_ptr = new[]{fut_opencl_src};-    IntPtr[] src_size = new []{IntPtr.Zero};--    if (ctx.OpenCL.Cfg.DumpProgramTo != null) {-        File.WriteAllText(ctx.OpenCL.Cfg.DumpProgramTo, fut_opencl_src);-    }--    unsafe-    {-        prog = CL10.CreateProgramWithSource(ctx.OpenCL.Context, 1, src_ptr, src_size, out error);-    }-    Debug.Assert(error == 0);--    int compile_opts_size = 1024;--    string compile_opts = String.Format("-DLOCKSTEP_WIDTH={0} ",-                                        ctx.OpenCL.LockstepWidth);--    for (int i = 0; i < ctx.OpenCL.Cfg.NumSizes; i++) {-        compile_opts += String.Format("-D{0}={1} ",-                                      ctx.OpenCL.Cfg.SizeVars[i],-                                      ctx.OpenCL.Cfg.SizeValues[i]);-    }--    OPENCL_SUCCEED(BuildOpenCLProgram(ref prog, device, compile_opts));--    return prog;-}--private CLMemoryHandle EmptyMemHandle(CLContextHandle context)-{-    ComputeErrorCode tmp;-    var cl_mem = CL10.CreateBuffer(context, ComputeMemoryFlags.ReadWrite,-                                   IntPtr.Zero, IntPtr.Zero,-                                   out tmp);-    return cl_mem;--}--private void FutharkConfigPrintSizes()-{-    int n = FutharkGetNumSizes();-    for (int i = 0; i < n; i++)-    {-      Console.WriteLine("{0} ({1})", FutharkGetSizeName(i),-                        FutharkGetSizeClass(i));-    }-    Environment.Exit(0);-}--private void FutharkConfigSetSize(ref FutharkContextConfig config, string optarg)-{-    var name_and_value = optarg.Split('=');-    if (name_and_value.Length != 2)-    {-        panic(1, "Invalid argument for size option: {0}", optarg);-    }--    var name = name_and_value[0];-    var value = Convert.ToInt32(name_and_value[1]);-    if (name == "default_num_groups") {-        config.OpenCL.DefaultNumGroups = value;-    }-    else if (name == "default_group_size") {-        config.OpenCL.DefaultGroupSize = value;-    }-    else if (name == "default_tile_size") {-        config.OpenCL.DefaultTileSize = value;-    }-    else if (name == "default_threshold") {-        config.OpenCL.DefaultThreshold = value;-    }-    else if (!FutharkContextConfigSetSize(ref config, name, value))-    {-        panic(1, "Unknown size: {0}", name);-    }-}--private void FutharkConfigLoadTuning(ref FutharkContextConfig config, string fname)-{-    StreamReader file = new StreamReader(fname);-    String line;-    while((line = file.ReadLine()) != null)-    {-        FutharkConfigSetSize(ref config, line);-    }-    file.Close();-}

@@ -1,24 +0,0 @@-private void panic(int exitcode, string str, params Object[] args)-{-    var prog_name = Environment.GetCommandLineArgs()[0];-    Console.Error.WriteLine(String.Format("{0}:", prog_name));-    Console.Error.WriteLine(String.Format(str, args));-    Environment.Exit(exitcode);-}--private void FutharkAssert(bool assertion)-{-    if (!assertion)-    {-        Environment.Exit(1);-    }-}--private void FutharkAssert(bool assertion, string errorMsg)-{-    if (!assertion)-    {-        Console.Error.WriteLine(errorMsg);-        Environment.Exit(1);-    }-}

@@ -1,885 +0,0 @@-private Stream s;-private BinaryReader b;--// Note that the lookahead buffer does not interact well with-// binary reading.  We are careful to not let this become a-// problem.-private Stack<char> LookaheadBuffer = new Stack<char>();--private void ResetLookahead(){-    LookaheadBuffer.Clear();-}--private void ValueReader(Stream s)-{-    this.s = s;-}--private void ValueReader()-{-    this.s = Console.OpenStandardInput();-    this.b = new BinaryReader(s);-}--private char? GetChar()-{-    char c;-    if (LookaheadBuffer.Count == 0)-    {-        c = (char) this.b.ReadByte();-    }-    else-    {-        c = LookaheadBuffer.Pop();-    }--    return c;-}--private char[] GetChars(int n)-{-    return Enumerable.Range(0, n).Select(_ => GetChar().Value).ToArray();-}--private void UngetChar(char c)-{-    LookaheadBuffer.Push(c);-}--private char PeekChar()-{-    var c = GetChar();-    UngetChar(c.Value);-    return c.Value;-}--private void SkipSpaces()-{-    var c = GetChar();-    while (c.HasValue){-        if (char.IsWhiteSpace(c.Value))-        {-            c = GetChar();-        }-        else if (c == '-')-        {-            if (PeekChar() == '-')-            {-                while (c.Value != '\n')-                {-                    c = GetChar();-                }-            }-            else-            {-                break;-            }-        }-        else-        {-            break;-        }-    }--    if (c.HasValue)-    {-        UngetChar(c.Value);-    }-}--private bool ParseSpecificChar(char c)-{-    var got = GetChar();-    if (got.Value != c)-    {-        UngetChar(got.Value);-        throw new ValueError();-    }-    return true;-}--private bool ParseSpecificString(string str)-{-    var read = new List<char>();-    foreach (var c in str.ToCharArray())-    {-        try-        {-            ParseSpecificChar(c);-            read.Add(c);-        }-        catch(ValueError)-        {-            read.Reverse();-            foreach (var cc in read)-            {-                UngetChar(cc);-            }-            throw;-        }-    }--    return true;-}--private string Optional(Func<string> p)-{-    string res = null;-    try-    {-        res = p();-    }-    catch (Exception)-    {-    }--    return res;-}--private bool Optional(Func<char, bool> p, char c)-{-    try-    {-        return p(c);-    }-    catch (Exception)-    {-    }--    return false;-}--private bool OptionalSpecificString(string s)-{-    var c = PeekChar();-    if (c == s[0])-    {-        return ParseSpecificString(s);-    }-    return false;-}---private List<string> sepBy(Func<string> p, Func<string> sep)-{-    var elems = new List<string>();-    var x = Optional(p);-    if (!string.IsNullOrWhiteSpace(x))-    {-        elems.Add(x);-        while (!string.IsNullOrWhiteSpace(Optional(sep)))-        {-            var y = Optional(p);-            elems.Add(y);-        }-    }-    return elems;-}--private string ParseHexInt()-{-    var s = "";-    var c = GetChar();-    while (c.HasValue)-    {-        if (Uri.IsHexDigit(c.Value))-        {-            s += c.Value;-            c = GetChar();-        }-        else if (c == '_')-        {-            c = GetChar();-        }-        else-        {-            UngetChar(c.Value);-            break;-        }-    }--    return Convert.ToString(Convert.ToUInt32(s, 16));-}--private string ParseInt()-{-    var s = "";-    var c = GetChar();-    if (c.Value == '0' && "xX".Contains(PeekChar()))-    {-        GetChar();-        s += ParseHexInt();-    }-    else-    {-        while (c.HasValue)-        {-            if (char.IsDigit(c.Value))-            {-                s += c.Value;-                c = GetChar();-            }else if (c == '_')-            {-                c = GetChar();-            }-            else-            {-                UngetChar(c.Value);-                break;-            }-        }--    }--    if (s.Length == 0)-    {-        throw new Exception("ValueError");-    }--    return s;-}--private string ParseIntSigned()-{-    var c = GetChar();-    if (c.Value == '-' && char.IsDigit(PeekChar()))-    {-        return c + ParseInt();-    }-    else-    {-        if (c.Value != '+')-        {-            UngetChar(c.Value);-        }--        return ParseInt();-    }-}--private string ReadStrComma()-{-    SkipSpaces();-    ParseSpecificChar(',');-    return ",";-}--private int ReadStrInt(string s)-{-    SkipSpaces();-    var x = Convert.ToInt32(ParseIntSigned());-    OptionalSpecificString(s);-    return x;-}--private ulong ReadStrUInt64(string s)-{-    SkipSpaces();-    var x = Convert.ToUInt64(ParseInt());-    OptionalSpecificString(s);-    return x;-}--private long ReadStrInt64(string s)-{-    SkipSpaces();-    var x = Convert.ToInt64(ParseIntSigned());-    OptionalSpecificString(s);-    return x;-}--private uint ReadStrUInt(string s)-{-    SkipSpaces();-    var x = Convert.ToUInt32(ParseInt());-    OptionalSpecificString(s);-    return x;-}--private int ReadStrI8(){return ReadStrInt("i8");}-private int ReadStrI16(){return ReadStrInt("i16");}-private int ReadStrI32(){return ReadStrInt("i32");}-private long ReadStrI64(){return ReadStrInt64("i64");}-private uint ReadStrU8(){return ReadStrUInt("u8");}-private uint ReadStrU16(){return ReadStrUInt("u16");}-private uint ReadStrU32(){return ReadStrUInt("u32");}-private ulong ReadStrU64(){return ReadStrUInt64("u64");}-private sbyte ReadBinI8(){return (sbyte) b.ReadByte();}-private short ReadBinI16(){return b.ReadInt16();}-private int ReadBinI32(){return b.ReadInt32();}-private long ReadBinI64(){return b.ReadInt64();}-private byte ReadBinU8(){return (byte) b.ReadByte();}-private ushort ReadBinU16(){return b.ReadUInt16();}-private uint ReadBinU32(){return b.ReadUInt32();}-private ulong ReadBinU64(){return b.ReadUInt64();}-private float ReadBinF32(){return b.ReadSingle();}-private double ReadBinF64(){return b.ReadDouble();}-private bool ReadBinBool(){return b.ReadBoolean();}--private char ReadChar()-{-    SkipSpaces();-    ParseSpecificChar('\'');-    var c = GetChar();-    ParseSpecificChar('\'');-    return c.Value;-}--private double ReadStrHexFloat(char sign)-{-    var int_part = ParseHexInt();-    ParseSpecificChar('.');-    var frac_part = ParseHexInt();-    ParseSpecificChar('p');-    var exponent = ParseHexInt();--    var int_val = Convert.ToInt32(int_part, 16);-    var frac_val = Convert.ToSingle(Convert.ToInt32(frac_part, 16)) / Math.Pow(16, frac_part.Length);-    var exp_val = Convert.ToInt32(exponent);--    var total_val = (int_val + frac_val) * Math.Pow(2, exp_val);-    if (sign == '-')-    {-        total_val = -1 * total_val;-    }--    return Convert.ToDouble(total_val);-}--private double ReadStrDecimal()-{-    SkipSpaces();-    var c = GetChar();-    char sign;-    if (c.Value == '-')-    {-        sign = '-';-    }-    else-    {-        UngetChar(c.Value);-        sign = '+';-    }--    // Check for hexadecimal float-    c = GetChar();-    if (c.Value == '0' && "xX".Contains(PeekChar()))-    {-        GetChar();-        return ReadStrHexFloat(sign);-    }-    else-    {-        UngetChar(c.Value);-    }--    var bef = Optional(this.ParseInt);-    var aft = "";-    if (string.IsNullOrEmpty(bef))-    {-        bef = "0";-        ParseSpecificChar('.');-        aft = ParseInt();-    }else if (Optional(ParseSpecificChar, '.'))-    {-        aft = ParseInt();-    }-    else-    {-        aft = "0";-    }--    var expt = "";-    if (Optional(ParseSpecificChar, 'E') ||-        Optional(ParseSpecificChar, 'e'))-    {-        expt = ParseIntSigned();-    }-    else-    {-        expt = "0";-    }--    return Convert.ToDouble(sign + bef + "." + aft + "E" + expt);-}--private float ReadStrF32()-{-    try-    {-        ParseSpecificString("f32.nan");-        return Single.NaN;-    }-    catch (ValueError)-    {-        try-        {-            ParseSpecificString("-f32.inf");-            return Single.NegativeInfinity;-        }-        catch (ValueError)-        {-            try-            {-                ParseSpecificString("f32.inf");-                return Single.PositiveInfinity;-            }-            catch (ValueError)-            {-                var x = ReadStrDecimal();-                OptionalSpecificString("f32");-                return Convert.ToSingle(x);-            }-        }-    }-}--private double ReadStrF64()-{-    try-    {-        ParseSpecificString("f64.nan");-        return Double.NaN;-    }-    catch (ValueError)-    {-        try-        {-            ParseSpecificString("-f64.inf");-            return Double.NegativeInfinity;-        }-        catch (ValueError)-        {-            try-            {-                ParseSpecificString("f64.inf");-                return Double.PositiveInfinity;-            }-            catch (ValueError)-            {-                var x = ReadStrDecimal();-                OptionalSpecificString("f64");-                return x;-            }-        }-    }-}-private bool ReadStrBool()-{-    SkipSpaces();-    if (PeekChar() == 't')-    {-        ParseSpecificString("true");-        return true;-    }--    if (PeekChar() == 'f')-    {-        ParseSpecificString("false");-        return false;-    }--    throw new ValueError();-}--private (T[], int[]) ReadStrArrayElems<T>(int rank, Func<T> ReadStrScalar)-{-    bool first = true;-    bool[] knows_dimsize = new bool[rank];-    int cur_dim = rank-1;-    int[] elems_read_in_dim = new int[rank];-    int[] shape = new int[rank];--    int capacity = 100;-    T[] data = new T[capacity];-    int write_ptr = 0;--    while (true) {-        SkipSpaces();--        char c = (char) GetChar();-        if (c == ']') {-            if (knows_dimsize[cur_dim]) {-                if (shape[cur_dim] != elems_read_in_dim[cur_dim]) {-                    throw new Exception("Irregular array");-                }-            } else {-                knows_dimsize[cur_dim] = true;-                shape[cur_dim] = elems_read_in_dim[cur_dim];-            }-            if (cur_dim == 0) {-                break;-            } else {-                cur_dim--;-                elems_read_in_dim[cur_dim]++;-            }-        } else if (c == ',') {-            SkipSpaces();-            c = (char) GetChar();-            if (c == '[') {-                if (cur_dim == rank - 1) {-                    throw new Exception("Array has too many dimensions");-                }-                first = true;-                cur_dim++;-                elems_read_in_dim[cur_dim] = 0;-            } else if (cur_dim == rank - 1) {-                UngetChar(c);--                data[write_ptr++] = ReadStrScalar();-                if (write_ptr == capacity) {-                    capacity *= 2;-                    Array.Resize(ref data, capacity);-                }-                elems_read_in_dim[cur_dim]++;-            } else {-                throw new Exception("Unexpected comma when reading array");-            }-        } else if (first) {-            if (c == '[') {-                if (cur_dim == rank - 1) {-                    throw new Exception("Array has too many dimensions");-                }-                cur_dim++;-                elems_read_in_dim[cur_dim] = 0;-            } else {-                UngetChar(c);-                data[write_ptr++] = ReadStrScalar();-                if (write_ptr == capacity) {-                    capacity *= 2;-                    Array.Resize(ref data, capacity);-                }-                elems_read_in_dim[cur_dim]++;-                first = false;-            }-        } else {-            throw new Exception("Unexpected character in array");-        }-    }-    Array.Resize(ref data, write_ptr);-    return (data, shape);-}--private (T[], int[]) ReadStrArrayEmpty<T>(int rank, string typeName, Func<T> ReadStrScalar)-{-    ParseSpecificString("empty");-    ParseSpecificChar('(');-    int[] shape = new int[rank];-    for (int i = 0; i < rank; i++) {-        ParseSpecificString("[");-        shape[i] = Convert.ToInt32(ParseIntSigned());-        ParseSpecificString("]");-    }-    ParseSpecificString(typeName);-    ParseSpecificChar(')');--    // Check whether the array really is empty.-    for (int i = 0; i < rank; i++) {-        if (shape[i] == 0) {-            return (new T[1], shape);-        }-    }--    // Not an empty array!-    throw new Exception("empty() used with nonempty shape");-}--private (T[], int[]) ReadStrArray<T>(int rank, string typeName, Func<T> ReadStrScalar)-{-    long read_dims = 0;--    while (true) {-        SkipSpaces();-        var c = GetChar();-        if (c=='[') {-            read_dims++;-        } else {-            if (c != null) {-                UngetChar((char)c);-            }-            break;-        }-    }--    if (read_dims == 0) {-        return ReadStrArrayEmpty(rank, typeName, ReadStrScalar);-    }--    if (read_dims != rank) {-        throw new Exception("Wrong number of dimensions");-    }--    return ReadStrArrayElems(rank, ReadStrScalar);-}--private Dictionary<string, string> primtypes = new Dictionary<string, string>-{-    {"  i8",   "i8"},-    {" i16",  "i16"},-    {" i32",  "i32"},-    {" i64",  "i64"},-    {"  u8",   "u8"},-    {" u16",  "u16"},-    {" u32",  "u32"},-    {" u64",  "u64"},-    {" f32",  "f32"},-    {" f64",  "f64"},-    {"bool", "bool"}-};--private int BINARY_FORMAT_VERSION = 2;---private void read_le_2byte(ref short dest)-{-    dest = b.ReadInt16();-}--private void read_le_4byte(ref int dest)-{-    dest = b.ReadInt32();-}--private void read_le_8byte(ref long dest)-{-    dest = b.ReadInt64();-}--private bool ReadIsBinary()-    {-        SkipSpaces();-        var c = GetChar();-        if (c == 'b')-        {-            byte bin_version = new byte();-            try-            {-                bin_version = (byte) b.ReadByte();-            }-            catch-            {-                Console.WriteLine("binary-input: could not read version");-                Environment.Exit(1);-            }--            if (bin_version != BINARY_FORMAT_VERSION)-            {-                Console.WriteLine((-                    "binary-input: File uses version {0}, but I only understand version {1}.", bin_version,-                    BINARY_FORMAT_VERSION));-                Environment.Exit(1);-            }--            return true;-        }-        UngetChar((char) c);-        return false;-    }--private (T[], int[]) ReadArray<T>(int rank, string typeName, Func<T> ReadStrScalar)-{-    if (!ReadIsBinary())-    {-        return ReadStrArray<T>(rank, typeName, ReadStrScalar);-    }-    else-    {-        return ReadBinArray<T>(rank, typeName, ReadStrScalar);-    }-}-private T ReadScalar<T>(string typeName, Func<T> ReadStrScalar, Func<T> ReadBinScalar)-{-    if (!ReadIsBinary())-    {-        return ReadStrScalar();-    }-    else-    {-        ReadBinEnsureScalar(typeName);-        return ReadBinScalar();-    }-}--private void ReadBinEnsureScalar(string typeName)-{-    var bin_dims = b.ReadByte();-    if (bin_dims != 0)-    {-        Console.WriteLine("binary-input: Expected scalar (0 dimensions), but got array with {0} dimensions.", bin_dims);-        Environment.Exit(1);-    }--    var bin_type = ReadBinReadTypeString();-    if (bin_type != typeName)-    {-        Console.WriteLine("binary-input: Expected scalar of type {0} but got scalar of type {1}.", typeName,-                          bin_type);-        Environment.Exit(1);-    }-}--private string ReadBinReadTypeString()-{-    var str_bytes = b.ReadBytes(4);-    var str = System.Text.Encoding.UTF8.GetString(str_bytes, 0, 4);-    return primtypes[str];-}--private (T[], int[]) ReadBinArray<T>(int rank, string typeName, Func<T> ReadStrScalar)-{-    var bin_dims = new int();-    var shape = new int[rank];-    try-    {-        bin_dims = b.ReadByte();-    }-    catch-    {-        Console.WriteLine("binary-input: Couldn't get dims.");-        Environment.Exit(1);-    }--    if (bin_dims != rank)-    {-        Console.WriteLine("binary-input: Expected {0} dimensions, but got array with {1} dimensions", rank,-            bin_dims);-        Environment.Exit(1);--    }--    var bin_primtype = ReadBinReadTypeString();-    if (typeName != bin_primtype)-    {-        Console.WriteLine("binary-input: Expected {0}D-array with element type '{1}', but got {2}D-array with element type '{3}'.",-                          rank, typeName, bin_dims, bin_primtype);-        Environment.Exit(1);-    }--    int elem_count = 1;-    for (var i = 0; i < rank; i++)-    {-        long bin_shape = new long();-        try-        {-            read_le_8byte(ref bin_shape);-        }-        catch-        {-            Console.WriteLine("binary-input: Couldn't read size for dimension {0} of array.", i);-            Environment.Exit(1);-        }--        elem_count *= (int) bin_shape;-        shape[i] = (int) bin_shape;-    }--    // For whatever reason, Marshal.SizeOf<bool> is 4, so special-case that here.-    var elem_size = typeof(T) == typeof(bool) ? 1 : Marshal.SizeOf<T>();-    var num_bytes = elem_count * elem_size;-    var tmp = new byte[num_bytes];-    var data = new T[elem_count];--    var to_read = num_bytes;-    var have_read = 0;-    while (to_read > 0)-    {-        var bytes_read = b.Read(tmp, have_read, to_read);-        to_read -= bytes_read;-        have_read += bytes_read;-        if (bytes_read == 0) {-            Console.WriteLine("binary-input: EOF after {0} bytes (expected {1})", have_read, num_bytes);-            Environment.Exit(1);-        }-    }--    if (!BitConverter.IsLittleEndian && elem_size != 1)-    {-        for (int i = 0; i < elem_count; i ++)-        {-            Array.Reverse(tmp, i * elem_size, elem_size); -        }-    }-    Buffer.BlockCopy(tmp,0,data,0,num_bytes);--    /* we should have a proper error message here */-    return (data, shape);-}---private sbyte ReadI8()-{-    return (sbyte) ReadStrI8();-}-private short ReadI16()-{-    return (short) ReadStrI16();-}-private int ReadI32()-{-    return ReadStrI32();-}-private long ReadI64()-{-    return ReadStrI64();-}--private byte ReadU8()-{-    return (byte) ReadStrU8();-}-private ushort ReadU16()-{-    return (ushort) ReadStrU16();-}-private uint ReadU32()-{-    return (uint) ReadStrU32();-}-private ulong ReadU64()-{-    return (ulong) ReadStrU64();-}-private bool ReadBool()-{-    return ReadStrBool();-}-private float ReadF32()-{-    return ReadStrF32();-}-private double ReadF64()-{-    return ReadStrF64();-}--private void EndOfInput(string entry)-{-    try {-        SkipSpaces();-        var c = GetChar();-        if (c.HasValue) {-            throw new Exception(String.Format("Expected EOF on stdin after reading input for \"{0}\".", entry));-        }-    } catch (System.IO.EndOfStreamException e) {-    }-}--private void WriteValue(bool x){Console.Write(x ? "true" : "false", x);}-private void WriteValue(sbyte x){Console.Write("{0}i8", x);}-private void WriteValue(short x){Console.Write("{0}i16", x);}-private void WriteValue(int x){Console.Write("{0}i32", x);}-private void WriteValue(long x){Console.Write("{0}i64", x);}-private void WriteValue(byte x){Console.Write("{0}u8", x);}-private void WriteValue(ushort x){Console.Write("{0}u16", x);}-private void WriteValue(uint x){Console.Write("{0}u32", x);}-private void WriteValue(ulong x){Console.Write("{0}u64", x);}-private void WriteValue(float x){if (Single.IsNaN(x))-    {Console.Write("f32.nan");} else if (Single.IsNegativeInfinity(x))-    {Console.Write("-f32.inf");} else if (Single.IsPositiveInfinity(x))-    {Console.Write("f32.inf");} else-    {Console.Write("{0:0.000000}f32", x);}}-private void WriteValue(double x){if (Double.IsNaN(x))-    {Console.Write("f64.nan");} else if (Double.IsNegativeInfinity(x))-    {Console.Write("-f64.inf");} else if (Double.IsPositiveInfinity(x))-    {Console.Write("f64.inf");} else-    {Console.Write("{0:0.000000}f64", x);}}

@@ -1,484 +0,0 @@-// Scalar functions.-private static sbyte signed(byte x){ return (sbyte) x;}-private static short signed(ushort x){ return (short) x;}-private static int signed(uint x){ return (int) x;}-private static long signed(ulong x){ return (long) x;}--private static byte unsigned(sbyte x){ return (byte) x;}-private static ushort unsigned(short x){ return (ushort) x;}-private static uint unsigned(int x){ return (uint) x;}-private static ulong unsigned(long x){ return (ulong) x;}--private static sbyte add8(sbyte x, sbyte y){ return (sbyte) ((byte) x + (byte) y);}-private static short add16(short x, short y){ return (short) ((ushort) x + (ushort) y);}-private static int add32(int x, int y){ return (int) ((uint) x + (uint) y);}-private static long add64(long x, long y){ return (long) ((ulong) x + (ulong) y);}--private static sbyte add_nw8(sbyte x, sbyte y){ return (sbyte) ((byte) x + (byte) y);}-private static short add_nw16(short x, short y){ return (short) ((ushort) x + (ushort) y);}-private static int add_nw32(int x, int y){ return (int) ((uint) x + (uint) y);}-private static long add_nw64(long x, long y){ return (long) ((ulong) x + (ulong) y);}--private static sbyte sub8(sbyte x, sbyte y){ return (sbyte) ((byte) x - (byte) y);}-private static short sub16(short x, short y){ return (short) ((ushort) x - (ushort) y);}-private static int sub32(int x, int y){ return (int) ((uint) x - (uint) y);}-private static long sub64(long x, long y){ return (long) ((ulong) x - (ulong) y);}--private static sbyte sub_nw8(sbyte x, sbyte y){ return (sbyte) ((byte) x - (byte) y);}-private static short sub_nw16(short x, short y){ return (short) ((ushort) x - (ushort) y);}-private static int sub_nw32(int x, int y){ return (int) ((uint) x - (uint) y);}-private static long sub_nw64(long x, long y){ return (long) ((ulong) x - (ulong) y);}--private static sbyte mul8(sbyte x, sbyte y){ return (sbyte) ((byte) x * (byte) y);}-private static short mul16(short x, short y){ return (short) ((ushort) x * (ushort) y);}-private static int mul32(int x, int y){ return (int) ((uint) x * (uint) y);}-private static long mul64(long x, long y){ return (long) ((ulong) x * (ulong) y);}--private static sbyte mul_nw8(sbyte x, sbyte y){ return (sbyte) ((byte) x * (byte) y);}-private static short mul_nw16(short x, short y){ return (short) ((ushort) x * (ushort) y);}-private static int mul_nw32(int x, int y){ return (int) ((uint) x * (uint) y);}-private static long mul_nw64(long x, long y){ return (long) ((ulong) x * (ulong) y);}--private static sbyte or8(sbyte x, sbyte y){ return (sbyte) (x | y); }-private static short or16(short x, short y){ return (short) (x | y); }-private static int or32(int x, int y){ return x | y; }-private static long or64(long x, long y){ return x | y;}--private static sbyte xor8(sbyte x, sbyte y){ return (sbyte) (x ^ y); }-private static short xor16(short x, short y){ return (short) (x ^ y); }-private static int xor32(int x, int y){ return x ^ y; }-private static long xor64(long x, long y){ return x ^ y;}--private static sbyte and8(sbyte x, sbyte y){ return (sbyte) (x & y); }-private static short and16(short x, short y){ return (short) (x & y); }-private static int and32(int x, int y){ return x & y; }-private static long and64(long x, long y){ return x & y;}--private static sbyte shl8(sbyte x, sbyte y){ return (sbyte) (x << y); }-private static short shl16(short x, short y){ return (short) (x << y); }-private static int shl32(int x, int y){ return x << y; }-private static long shl64(long x, long y){ return x << Convert.ToInt32(y); }--private static sbyte ashr8(sbyte x, sbyte y){ return (sbyte) (x >> y); }-private static short ashr16(short x, short y){ return (short) (x >> y); }-private static int ashr32(int x, int y){ return x >> y; }-private static long ashr64(long x, long y){ return x >> Convert.ToInt32(y); }--private static sbyte sdiv8(sbyte x, sbyte y){-    var q = squot8(x,y);-    var r = srem8(x,y);-    return (sbyte) (q - (((r != (sbyte) 0) && ((r < (sbyte) 0) != (y < (sbyte) 0))) ? (sbyte) 1 : (sbyte) 0));-}-private static short sdiv16(short x, short y){-    var q = squot16(x,y);-    var r = srem16(x,y);-    return (short) (q - (((r != (short) 0) && ((r < (short) 0) != (y < (short) 0))) ? (short) 1 : (short) 0));-}-private static int sdiv32(int x, int y){-    var q = squot32(x,y);-    var r = srem32(x,y);-    return q - (((r != (int) 0) && ((r < (int) 0) != (y < (int) 0))) ? (int) 1 : (int) 0);-}-private static long sdiv64(long x, long y){-    var q = squot64(x,y);-    var r = srem64(x,y);-    return q - (((r != (long) 0) && ((r < (long) 0) != (y < (long) 0))) ? (long) 1 : (long) 0);-}--private static sbyte smod8(sbyte x, sbyte y){-    var r = srem8(x,y);-    return (sbyte) (r + ((r == (sbyte) 0 || (x > (sbyte) 0 && y > (sbyte) 0) || (x < (sbyte) 0 && y < (sbyte) 0)) ? (sbyte) 0 : y));-}-private static short smod16(short x, short y){-    var r = srem16(x,y);-    return (short) (r + ((r == (short) 0 || (x > (short) 0 && y > (short) 0) || (x < (short) 0 && y < (short) 0)) ? (short) 0 : y));-}-private static int smod32(int x, int y){-    var r = srem32(x,y);-    return (int) r + ((r == (int) 0 || (x > (int) 0 && y > (int) 0) || (x < (int) 0 && y < (int) 0)) ? (int) 0 : y);-}-private static long smod64(long x, long y){-    var r = srem64(x,y);-    return (long) r + ((r == (long) 0 || (x > (long) 0 && y > (long) 0) || (x < (long) 0 && y < (long) 0)) ? (long) 0 : y);-}--private static sbyte udiv8(sbyte x, sbyte y){ return signed((byte) (unsigned(x) / unsigned(y))); }-private static short udiv16(short x, short y){ return signed((ushort) (unsigned(x) / unsigned(y))); }-private static int udiv32(int x, int y){ return signed(unsigned(x) / unsigned(y)); }-private static long udiv64(long x, long y){ return signed(unsigned(x) / unsigned(y)); }--private static sbyte umod8(sbyte x, sbyte y){ return signed((byte) (unsigned(x) % unsigned(y))); }-private static short umod16(short x, short y){ return signed((ushort) (unsigned(x) % unsigned(y))); }-private static int umod32(int x, int y){ return signed(unsigned(x) % unsigned(y)); }-private static long umod64(long x, long y){ return signed(unsigned(x) % unsigned(y)); }--private static sbyte squot8(sbyte x, sbyte y){ return (sbyte) Math.Truncate(ToSingle(x) / ToSingle(y)); }-private static short squot16(short x, short y){ return (short) Math.Truncate(ToSingle(x) / ToSingle(y)); }-private static int squot32(int x, int y){ return (int) Math.Truncate(ToSingle(x) / ToSingle(y)); }-private static long squot64(long x, long y){ return (long) Math.Truncate(ToSingle(x) / ToSingle(y)); }--// private static Maybe change srem, it calls np.fmod originally so i dont know-private static sbyte srem8(sbyte x, sbyte y){ return (sbyte) ((sbyte) x % (sbyte) y);}-private static short srem16(short x, short y){ return (short) ((short) x % (short) y);}-private static int srem32(int x, int y){ return (int) ((int) x % (int) y);}-private static long srem64(long x, long y){ return (long) ((long) x % (long) y);}--private static sbyte smin8(sbyte x, sbyte y){ return Math.Min(x,y);}-private static short smin16(short x, short y){ return Math.Min(x,y);}-private static int smin32(int x, int y){ return Math.Min(x,y);}-private static long smin64(long x, long y){ return Math.Min(x,y);}--private static sbyte smax8(sbyte x, sbyte y){ return Math.Max(x,y);}-private static short smax16(short x, short y){ return Math.Max(x,y);}-private static int smax32(int x, int y){ return Math.Max(x,y);}-private static long smax64(long x, long y){ return Math.Max(x,y);}--private static sbyte umin8(sbyte x, sbyte y){ return signed(Math.Min(unsigned(x),unsigned(y)));}-private static short umin16(short x, short y){ return signed(Math.Min(unsigned(x),unsigned(y)));}-private static int umin32(int x, int y){ return signed(Math.Min(unsigned(x),unsigned(y)));}-private static long umin64(long x, long y){ return signed(Math.Min(unsigned(x),unsigned(y)));}--private static sbyte umax8(sbyte x, sbyte y){ return signed(Math.Max(unsigned(x),unsigned(y)));}-private static short umax16(short x, short y){ return signed(Math.Max(unsigned(x),unsigned(y)));}-private static int umax32(int x, int y){ return signed(Math.Max(unsigned(x),unsigned(y)));}-private static long umax64(long x, long y){ return signed(Math.Max(unsigned(x),unsigned(y)));}--private static float fmin32(float x, float y){ return Math.Min(x,y);}-private static double fmin64(double x, double y){ return Math.Min(x,y);}-private static float fmax32(float x, float y){ return Math.Max(x,y);}-private static double fmax64(double x, double y){ return Math.Max(x,y);}--private static sbyte pow8(sbyte x, sbyte y){sbyte res = 1;for (var i = 0; i < y; i++){res *= x;}return res;}-private static short pow16(short x, short y){short res = 1;for (var i = 0; i < y; i++){res *= x;}return res;}-private static int pow32(int x, int y){int res = 1;for (var i = 0; i < y; i++){res *= x;}return res;}-private static long pow64(long x, long y){long res = 1;for (var i = 0; i < y; i++){res *= x;}return res;}--private static float fpow32(float x, float y){ return Convert.ToSingle(Math.Pow(x,y));}-private static double fpow64(double x, double y){ return Convert.ToDouble(Math.Pow(x,y));}--private static bool sle8(sbyte x, sbyte y){ return x <= y ;}-private static bool sle16(short x, short y){ return x <= y ;}-private static bool sle32(int x, int y){ return x <= y ;}-private static bool sle64(long x, long y){ return x <= y ;}--private static bool slt8(sbyte x, sbyte y){ return x < y ;}-private static bool slt16(short x, short y){ return x < y ;}-private static bool slt32(int x, int y){ return x < y ;}-private static bool slt64(long x, long y){ return x < y ;}--private static bool ule8(sbyte x, sbyte y){ return unsigned(x) <= unsigned(y) ;}-private static bool ule16(short x, short y){ return unsigned(x) <= unsigned(y) ;}-private static bool ule32(int x, int y){ return unsigned(x) <= unsigned(y) ;}-private static bool ule64(long x, long y){ return unsigned(x) <= unsigned(y) ;}--private static bool ult8(sbyte x, sbyte y){ return unsigned(x) < unsigned(y) ;}-private static bool ult16(short x, short y){ return unsigned(x) < unsigned(y) ;}-private static bool ult32(int x, int y){ return unsigned(x) < unsigned(y) ;}-private static bool ult64(long x, long y){ return unsigned(x) < unsigned(y) ;}--private static sbyte lshr8(sbyte x, sbyte y){ return (sbyte) ((uint) x >> (int) y);}-private static short lshr16(short x, short y){ return (short) ((ushort) x >> (int) y);}-private static int lshr32(int x, int y){ return (int) ((uint) (x) >> (int) y);}-private static long lshr64(long x, long y){ return (long) ((ulong) x >> (int) y);}--private static sbyte sext_i8_i8(sbyte x){return (sbyte) (x);}-private static short sext_i8_i16(sbyte x){return (short) (x);}-private static int sext_i8_i32(sbyte x){return (int) (x);}-private static long sext_i8_i64(sbyte x){return (long) (x);}--private static sbyte sext_i16_i8(short x){return (sbyte) (x);}-private static short sext_i16_i16(short x){return (short) (x);}-private static int sext_i16_i32(short x){return (int) (x);}-private static long sext_i16_i64(short x){return (long) (x);}--private static sbyte sext_i32_i8(int x){return (sbyte) (x);}-private static short sext_i32_i16(int x){return (short) (x);}-private static int sext_i32_i32(int x){return (int) (x);}-private static long sext_i32_i64(int x){return (long) (x);}--private static sbyte sext_i64_i8(long x){return (sbyte) (x);}-private static short sext_i64_i16(long x){return (short) (x);}-private static int sext_i64_i32(long x){return (int) (x);}-private static long sext_i64_i64(long x){return (long) (x);}--private static sbyte btoi_bool_i8 (bool x){return (sbyte) (Convert.ToInt32(x));}-private static short btoi_bool_i16(bool x){return (short) (Convert.ToInt32(x));}-private static int   btoi_bool_i32(bool x){return (int)   (Convert.ToInt32(x));}-private static long  btoi_bool_i64(bool x){return (long)  (Convert.ToInt32(x));}--private static bool itob_i8_bool (sbyte x){return x != 0;}-private static bool itob_i16_bool(short x){return x != 0;}-private static bool itob_i32_bool(int x)  {return x != 0;}-private static bool itob_i64_bool(long x) {return x != 0;}--private static sbyte zext_i8_i8(sbyte x)   {return (sbyte) ((byte)(x));}-private static short zext_i8_i16(sbyte x)  {return (short)((byte)(x));}-private static int   zext_i8_i32(sbyte x)  {return (int)((byte)(x));}-private static long  zext_i8_i64(sbyte x)  {return (long)((byte)(x));}--private static sbyte zext_i16_i8(short x)  {return (sbyte) ((ushort)(x));}-private static short zext_i16_i16(short x) {return (short)((ushort)(x));}-private static int   zext_i16_i32(short x) {return (int)((ushort)(x));}-private static long  zext_i16_i64(short x) {return (long)((ushort)(x));}--private static sbyte zext_i32_i8(int x){return (sbyte) ((uint)(x));}-private static short zext_i32_i16(int x){return (short)((uint)(x));}-private static int   zext_i32_i32(int x){return (int)((uint)(x));}-private static long  zext_i32_i64(int x){return (long)((uint)(x));}--private static sbyte zext_i64_i8(long x){return (sbyte) ((ulong)(x));}-private static short zext_i64_i16(long x){return (short)((ulong)(x));}-private static int   zext_i64_i32(long x){return (int)((ulong)(x));}-private static long  zext_i64_i64(long x){return (long)((ulong)(x));}--private static sbyte ssignum(sbyte x){return (sbyte) Math.Sign(x);}-private static short ssignum(short x){return (short) Math.Sign(x);}-private static int ssignum(int x){return Math.Sign(x);}-private static long ssignum(long x){return (long) Math.Sign(x);}--private static sbyte usignum(sbyte x){return ((byte) x > 0) ? (sbyte) 1 : (sbyte) 0;}-private static short usignum(short x){return ((ushort) x > 0) ? (short) 1 : (short) 0;}-private static int usignum(int x){return ((uint) x > 0) ? (int) 1 : (int) 0;}-private static long usignum(long x){return ((ulong) x > 0) ? (long) 1 : (long) 0;}--private static float sitofp_i8_f32(sbyte x){return Convert.ToSingle(x);}-private static float sitofp_i16_f32(short x){return Convert.ToSingle(x);}-private static float sitofp_i32_f32(int x){return Convert.ToSingle(x);}-private static float sitofp_i64_f32(long x){return Convert.ToSingle(x);}--private static double sitofp_i8_f64(sbyte x){return Convert.ToDouble(x);}-private static double sitofp_i16_f64(short x){return Convert.ToDouble(x);}-private static double sitofp_i32_f64(int x){return Convert.ToDouble(x);}-private static double sitofp_i64_f64(long x){return Convert.ToDouble(x);}---private static float uitofp_i8_f32(sbyte x){return Convert.ToSingle(unsigned(x));}-private static float uitofp_i16_f32(short x){return Convert.ToSingle(unsigned(x));}-private static float uitofp_i32_f32(int x){return Convert.ToSingle(unsigned(x));}-private static float uitofp_i64_f32(long x){return Convert.ToSingle(unsigned(x));}--private static double uitofp_i8_f64(sbyte x){return Convert.ToDouble(unsigned(x));}-private static double uitofp_i16_f64(short x){return Convert.ToDouble(unsigned(x));}-private static double uitofp_i32_f64(int x){return Convert.ToDouble(unsigned(x));}-private static double uitofp_i64_f64(long x){return Convert.ToDouble(unsigned(x));}--private static byte fptoui_f32_i8(float x){return (byte) (Math.Truncate(x));}-private static byte fptoui_f64_i8(double x){return (byte) (Math.Truncate(x));}-private static sbyte fptosi_f32_i8(float x){return (sbyte) (Math.Truncate(x));}-private static sbyte fptosi_f64_i8(double x){return (sbyte) (Math.Truncate(x));}--private static ushort fptoui_f32_i16(float x){return (ushort) (Math.Truncate(x));}-private static ushort fptoui_f64_i16(double x){return (ushort) (Math.Truncate(x));}-private static short fptosi_f32_i16(float x){return (short) (Math.Truncate(x));}-private static short fptosi_f64_i16(double x){return (short) (Math.Truncate(x));}--private static uint fptoui_f32_i32(float x){return (uint) (Math.Truncate(x));}-private static uint fptoui_f64_i32(double x){return (uint) (Math.Truncate(x));}-private static int fptosi_f32_i32(float x){return (int) (Math.Truncate(x));}-private static int fptosi_f64_i32(double x){return (int) (Math.Truncate(x));}--private static ulong fptoui_f32_i64(float x){return (ulong) (Math.Truncate(x));}-private static ulong fptoui_f64_i64(double x){return (ulong) (Math.Truncate(x));}-private static long fptosi_f32_i64(float x){return (long) (Math.Truncate(x));}-private static long fptosi_f64_i64(double x){return (long) (Math.Truncate(x));}--private static double fpconv_f32_f64(float x){return Convert.ToDouble(x);}-private static float fpconv_f64_f32(double x){return Convert.ToSingle(x);}--private static double futhark_log64(double x){return Math.Log(x);}-private static double futhark_log2_64(double x){return Math.Log(x,2.0);}-private static double futhark_log10_64(double x){return Math.Log10(x);}-private static double futhark_sqrt64(double x){return Math.Sqrt(x);}-private static double futhark_exp64(double x){return Math.Exp(x);}-private static double futhark_cos64(double x){return Math.Cos(x);}-private static double futhark_sin64(double x){return Math.Sin(x);}-private static double futhark_tan64(double x){return Math.Tan(x);}-private static double futhark_acos64(double x){return Math.Acos(x);}-private static double futhark_asin64(double x){return Math.Asin(x);}-private static double futhark_atan64(double x){return Math.Atan(x);}-private static double futhark_cosh64(double x){return Math.Cosh(x);}-private static double futhark_sinh64(double x){return Math.Sinh(x);}-private static double futhark_tanh64(double x){return Math.Tanh(x);}-private static double futhark_acosh64(double x){return Math.Acosh(x);}-private static double futhark_asinh64(double x){return Math.Asinh(x);}-private static double futhark_atanh64(double x){return Math.Atanh(x);}-private static double futhark_atan2_64(double x, double y){return Math.Atan2(x, y);}-private static double futhark_gamma64(double x){throw new NotImplementedException();}-private static double futhark_lgamma64(double x){throw new NotImplementedException();}-private static bool futhark_isnan64(double x){return double.IsNaN(x);}-private static bool futhark_isinf64(double x){return double.IsInfinity(x);}-private static long futhark_to_bits64(double x){return BitConverter.ToInt64(BitConverter.GetBytes(x),0);}-private static double futhark_from_bits64(long x){return BitConverter.ToDouble(BitConverter.GetBytes(x),0);}--private static float futhark_log32(float x){return (float) Math.Log(x);}-private static float futhark_log2_32(float x){return (float) Math.Log(x,2.0);}-private static float futhark_log10_32(float x){return (float) Math.Log10(x);}-private static float futhark_sqrt32(float x){return (float) Math.Sqrt(x);}-private static float futhark_exp32(float x){return (float) Math.Exp(x);}-private static float futhark_cos32(float x){return (float) Math.Cos(x);}-private static float futhark_sin32(float x){return (float) Math.Sin(x);}-private static float futhark_tan32(float x){return (float) Math.Tan(x);}-private static float futhark_acos32(float x){return (float) Math.Acos(x);}-private static float futhark_asin32(float x){return (float) Math.Asin(x);}-private static float futhark_atan32(float x){return (float) Math.Atan(x);}-private static float futhark_cosh32(float x){return (float) Math.Cosh(x);}-private static float futhark_sinh32(float x){return (float) Math.Sinh(x);}-private static float futhark_tanh32(float x){return (float) Math.Tanh(x);}-private static float futhark_acosh32(float x){return (float) Math.Acosh(x);}-private static float futhark_asinh32(float x){return (float) Math.Asinh(x);}-private static float futhark_atanh32(float x){return (float) Math.Atanh(x);}-private static float futhark_atan2_32(float x, float y){return (float) Math.Atan2(x, y);}-private static float futhark_gamma32(float x){throw new NotImplementedException();}-private static float futhark_lgamma32(float x){throw new NotImplementedException();}-private static bool futhark_isnan32(float x){return float.IsNaN(x);}-private static bool futhark_isinf32(float x){return float.IsInfinity(x);}-private static int futhark_to_bits32(float x){return BitConverter.ToInt32(BitConverter.GetBytes(x), 0);}-private static float futhark_from_bits32(int x){return BitConverter.ToSingle(BitConverter.GetBytes(x), 0);}--private static float futhark_round32(float x){return (float) Math.Round(x);}-private static double futhark_round64(double x){return Math.Round(x);}-private static float futhark_ceil32(float x){return (float) Math.Ceiling(x);}-private static double futhark_ceil64(double x){return Math.Ceiling(x);}-private static float futhark_floor32(float x){return (float) Math.Floor(x);}-private static double futhark_floor64(double x){return Math.Floor(x);}--private static float futhark_lerp32(float v0, float v1, float t){return v0 + (v1-v0)*t;}-private static double futhark_lerp64(double v0, double v1, double t){return v0 + (v1-v0)*t;}--private static float futhark_fma32(float a, float b, float c){return a*b+c;}-private static double futhark_fma64(double a, double b, double c){return a*b+c;}--private static float futhark_mad32(float a, float b, float c){return a*b+c;}-private static double futhark_mad64(double a, double b, double c){return a*b+c;}---int futhark_popc8 (sbyte x) {-  int c = 0;-  for (; x != 0; ++c) {-      x &= (sbyte)(x - 1);-  }-  return c;- }--int futhark_popc16 (short x) {-  int c = 0;-  for (; x != 0; ++c) {-      x &= (short)(x - 1);-  }-  return c;-}--int futhark_popc32 (int x) {-  int c = 0;-  for (; x != 0; ++c) {-      x &= x - 1;-  }-  return c;-}--int futhark_popc64 (long x) {-  int c = 0;-  for (; x != 0; ++c) {-      x &= x - 1;-  }-  return c;-}--int futhark_clzz8 (sbyte x) {-    int n = 0;-    int bits = sizeof(sbyte) * 8;-    for (int i = 0; i < bits; i++) {-        if (x < 0) break;-        n++;-        x <<= 1;-    }-    return n;-}--int futhark_clzz16 (short x) {-    int n = 0;-    int bits = sizeof(short) * 8;-    for (int i = 0; i < bits; i++) {-        if (x < 0) break;-        n++;-        x <<= 1;-    }-    return n;-}--int futhark_clzz32 (int x) {-    int n = 0;-    int bits = sizeof(int) * 8;-    for (int i = 0; i < bits; i++) {-        if (x < 0) break;-        n++;-        x <<= 1;-    }-    return n;-}--int futhark_clzz64 (long x) {-    int n = 0;-    int bits = sizeof(long) * 8;-    for (int i = 0; i < bits; i++) {-        if (x < 0) break;-        n++;-        x <<= 1;-    }-    return n;-}--sbyte futhark_mul_hi8(sbyte a, sbyte b) {-    ushort aa = (ushort)(byte)a;-    ushort bb = (ushort)(byte)b;-    return (sbyte)((aa * bb) >> 8);-}--short futhark_mul_hi16(short a, short b) {-    uint aa = (uint)(ushort)a;-    uint bb = (uint)(ushort)b;-    return (short)((aa * bb) >> 16);-}--int futhark_mul_hi32(int a, int b) {-    ulong aa = (ulong)(uint)a;-    ulong bb = (ulong)(uint)b;-    return (int)((aa * bb) >> 32);-}--// By Ben Voigt at-// https://stackoverflow.com/questions/29722093/computing-the-high-bits-of-a-multiplication-in-c-sharp-long futhark_mul_hi64(long xx, long yy) {-    ulong x = (ulong)xx;-    ulong y = (ulong)yy;-    ulong accum = ((ulong)(uint)x) * ((ulong)(uint)y);-    accum >>= 32;-    ulong term1 = (x >> 32) * ((ulong)(uint)y);-    ulong term2 = (y >> 32) * ((ulong)(uint)x);-    accum += (uint)term1;-    accum += (uint)term2;-    accum >>= 32;-    accum += (term1 >> 32) + (term2 >> 32);-    accum += (x >> 32) * (y >> 32);-    return (long)accum;-}--sbyte futhark_mad_hi8(sbyte a, sbyte b, sbyte c) {-    return (sbyte)(futhark_mul_hi8(a,b) + c);-}--short futhark_mad_hi16(short a, short b, short c) {-    return (short)(futhark_mul_hi16(a,b) + c);-}--int futhark_mad_hi32(int a, int b, int c) {-    return futhark_mul_hi32(a,b) + c;-}--long futhark_mad_hi64(long a, long b, long c) {-    return futhark_mul_hi64(a,b) + c;-}--private static bool llt (bool x, bool y){return (!x && y);}-private static bool lle (bool x, bool y){return (!x || y);}-

@@ -65,14 +65,11 @@             raise Exception('Program uses double-precision floats, but this is not supported on chosen device: %s' % self.device.name)  def apply_size_heuristics(self, size_heuristics, sizes):-    for (platform_name, device_type, size, value) in size_heuristics:+    for (platform_name, device_type, size, valuef) in size_heuristics:         if sizes[size] == None \            and self.platform.name.find(platform_name) >= 0 \            and self.device.type == device_type:-               if type(value) == str:-                   sizes[size] = self.device.get_info(getattr(cl.device_info,value))-               else:-                   sizes[size] = value+               sizes[size] = valuef(self.device)     return sizes  def initialise_opencl_object(self,@@ -109,7 +106,16 @@     self.max_tile_size = max_tile_size     self.max_threshold = 0     self.max_num_groups = 0+     self.max_local_memory = int(self.device.local_mem_size)++    # Futhark reserves 4 bytes of local memory for its own purposes.+    self.max_local_memory -= 4++    # See comment in rts/c/opencl.h.+    if self.platform.name.find('NVIDIA CUDA') >= 0:+        self.max_local_memory -= 12+     self.free_list = {}      self.global_failure = self.pool.allocate(np.int32().itemsize)

@@ -4,6 +4,16 @@ import math import struct +def intlit(t, x):+  if t == np.int8:+    return np.int8(x)+  elif t == np.int16:+    return np.int16(x)+  elif t == np.int32:+    return np.int32(x)+  else:+    return np.int64(x)+ def signed(x):   if type(x) == np.uint8:     return np.int8(x)@@ -30,23 +40,56 @@ def ashrN(x,y):   return x >> y +# Python is so slow that we just make all the unsafe operations safe,+# always.+ def sdivN(x,y):-  return x // y+  if y == 0:+    return intlit(type(x), 0)+  else:+    return x // y +def sdiv_upN(x,y):+  if y == 0:+    return intlit(type(x), 0)+  else:+    return (x+y-intlit(type(x), 1)) // y+ def smodN(x,y):-  return x % y+  if y == 0:+    return intlit(type(x), 0)+  else:+    return x % y  def udivN(x,y):-  return signed(unsigned(x) // unsigned(y))+  if y == 0:+    return intlit(type(x), 0)+  else:+    return signed(unsigned(x) // unsigned(y)) +def udiv_upN(x,y):+  if y == 0:+    return intlit(type(x), 0)+  else:+    return signed((unsigned(x)+unsigned(y)-unsigned(intlit(type(x),1))) // unsigned(y))+ def umodN(x,y):-  return signed(unsigned(x) % unsigned(y))+  if y == 0:+    return intlit(type(x), 0)+  else:+    return signed(unsigned(x) % unsigned(y))  def squotN(x,y):-  return np.floor_divide(np.abs(x), np.abs(y)) * np.sign(x) * np.sign(y)+  if y == 0:+    return intlit(type(x), 0)+  else:+    return np.floor_divide(np.abs(x), np.abs(y)) * np.sign(x) * np.sign(y)  def sremN(x,y):-  return np.remainder(np.abs(x), np.abs(y)) * np.sign(x)+  if y == 0:+    return intlit(type(x), 0)+  else:+    return np.remainder(np.abs(x), np.abs(y)) * np.sign(x)  def sminN(x,y):   return min(x,y)@@ -171,14 +214,25 @@ def zext_i64_i64(x):   return np.int64(np.uint64(x)) -shl8 = shl16 = shl32 = shl64 = shlN-ashr8 = ashr16 = ashr32 = ashr64 = ashrN sdiv8 = sdiv16 = sdiv32 = sdiv64 = sdivN+sdiv_up8 = sdiv1_up6 = sdiv_up32 = sdiv_up64 = sdiv_upN+sdiv_safe8 = sdiv1_safe6 = sdiv_safe32 = sdiv_safe64 = sdivN+sdiv_up_safe8 = sdiv_up1_safe6 = sdiv_up_safe32 = sdiv_up_safe64 = sdiv_upN smod8 = smod16 = smod32 = smod64 = smodN+smod_safe8 = smod_safe16 = smod_safe32 = smod_safe64 = smodN udiv8 = udiv16 = udiv32 = udiv64 = udivN+udiv_up8 = udiv_up16 = udiv_up32 = udiv_up64 = udivN+udiv_safe8 = udiv_safe16 = udiv_safe32 = udiv_safe64 = udiv_upN+udiv_up_safe8 = udiv_up_safe16 = udiv_up_safe32 = udiv_up_safe64 = udiv_upN umod8 = umod16 = umod32 = umod64 = umodN+umod_safe8 = umod_safe16 = umod_safe32 = umod_safe64 = umodN squot8 = squot16 = squot32 = squot64 = squotN+squot_safe8 = squot_safe16 = squot_safe32 = squot_safe64 = squotN srem8 = srem16 = srem32 = srem64 = sremN+srem_safe8 = srem_safe16 = srem_safe32 = srem_safe64 = sremN++shl8 = shl16 = shl32 = shl64 = shlN+ashr8 = ashr16 = ashr32 = ashr64 = ashrN smax8 = smax16 = smax32 = smax64 = smaxN smin8 = smin16 = smin32 = smin64 = sminN umax8 = umax16 = umax32 = umax64 = umaxN

@@ -5,7 +5,6 @@   ( printAction   , impCodeGenAction   , kernelImpCodeGenAction-  , rangeAction   , metricsAction   ) where@@ -15,14 +14,12 @@  import Futhark.Pipeline import Futhark.Analysis.Alias-import Futhark.Analysis.Range import Futhark.IR import Futhark.IR.Prop.Aliases import Futhark.IR.KernelsMem (KernelsMem) import Futhark.IR.SeqMem (SeqMem) import qualified Futhark.CodeGen.ImpGen.Sequential as ImpGenSequential import qualified Futhark.CodeGen.ImpGen.Kernels as ImpGenKernels-import Futhark.IR.Prop.Ranges (CanBeRanged) import Futhark.Analysis.Metrics  -- | Print the result to stdout, with alias annotations.@@ -33,14 +30,6 @@          , actionProcedure = liftIO . putStrLn . pretty . aliasAnalysis          } --- | Print the result to stdout, with range annotations.-rangeAction :: (ASTLore lore, CanBeRanged (Op lore)) => Action lore-rangeAction =-    Action { actionName = "Range analysis"-           , actionDescription = "Print the program with range annotations added."-           , actionProcedure = liftIO . putStrLn . pretty . rangeAnalysis-           }- -- | Print metrics about AST node counts to stdout. metricsAction :: OpMetrics (Op lore) => Action lore metricsAction =@@ -54,7 +43,7 @@ impCodeGenAction =   Action { actionName = "Compile imperative"          , actionDescription = "Translate program into imperative IL and write it on standard output."-         , actionProcedure = liftIO . putStrLn . pretty <=< ImpGenSequential.compileProg+         , actionProcedure = liftIO . putStrLn . pretty . snd <=< ImpGenSequential.compileProg          }  -- | Convert the program to GPU ImpCode and print it to stdout.@@ -62,5 +51,5 @@ kernelImpCodeGenAction =   Action { actionName = "Compile imperative kernels"          , actionDescription = "Translate program into imperative IL with kernels and write it on standard output."-         , actionProcedure = liftIO . putStrLn . pretty <=< ImpGenKernels.compileProgOpenCL+         , actionProcedure = liftIO . putStrLn . pretty . snd <=< ImpGenKernels.compileProgOpenCL          }

@@ -1,1435 +0,0 @@-{-# LANGUAGE FlexibleInstances, LambdaCase #-}--- | Algebraic simplification.  Slow and limited.  Use very rarely.-module Futhark.Analysis.AlgSimplify-  ( ScalExp-  , Error-  , simplify-  , mkSuffConds-  , RangesRep-  , ppRangesRep-  , linFormScalE-  , pickSymToElim-  )-  where--import qualified Data.Set as S-import qualified Data.Map.Strict as M-import Data.List (sort, sortBy, genericReplicate)-import Control.Monad-import Control.Monad.Reader-import Control.Monad.State--import Futhark.IR hiding (SDiv, SMod, SQuot, SRem, SSignum)-import Futhark.Analysis.ScalExp-import qualified Futhark.IR.Primitive as P---- | Ranges are inclusive.-type RangesRep = M.Map VName (Int, Maybe ScalExp, Maybe ScalExp)---- | Prettyprint a 'RangesRep'.  Do not rely on the format of this--- string.  Does not include the loop nesting depth information.-ppRangesRep :: RangesRep -> String-ppRangesRep = unlines . sort . map ppRange . M.toList-  where ppRange (name, (_, lower, upper)) =-          pretty name ++ ": " ++-          if lower == upper-          then "== " ++ ppBound lower-          else "[" ++ ppBound lower ++ ", " ++-               ppBound upper ++ "]"-        ppBound Nothing = "?"-        ppBound (Just se) = pretty se---- | environment recording the position and---   a list of variable-to-range bindings.-data AlgSimplifyEnv = AlgSimplifyEnv { inSolveLTH0 :: Bool-                                     , ranges :: RangesRep-                                     , maxSteps :: Int-                                     -- ^ The number of-                                     -- simplifications to do before-                                     -- bailing out, to avoid spending-                                     -- too much time.-                                     }---- | Why the algebraic simplification failed.-data Error = StepsExceeded | Error String--type AlgSimplifyM = StateT Int (ReaderT AlgSimplifyEnv (Either Error))--runAlgSimplifier :: Bool -> AlgSimplifyM a -> RangesRep -> Either Error a-runAlgSimplifier s x r = runReaderT (evalStateT x 0) env-  where env = AlgSimplifyEnv { inSolveLTH0 = s-                             , ranges = r-                             , maxSteps = 100 -- heuristically chosen-                             }--step :: AlgSimplifyM ()-step = do modify (1+)-          exceeded <- gets (>) <*> asks maxSteps-          when exceeded stepsExceeded--stepsExceeded :: AlgSimplifyM a-stepsExceeded = lift $ lift $ Left StepsExceeded--badAlgSimplifyM :: String -> AlgSimplifyM a-badAlgSimplifyM = lift . lift . Left . Error---- | Binds an array name to the set of used-array vars-markInSolve :: AlgSimplifyEnv -> AlgSimplifyEnv-markInSolve env =-  env { inSolveLTH0 = True }--markGaussLTH0 :: AlgSimplifyM a -> AlgSimplifyM a-markGaussLTH0 = local markInSolve---------------------------------------------------------------- A Scalar Expression, i.e., ScalExp, is simplified to: -----   1. if numeric: to a normalized sum-of-products form,-----      in which on the outermost level there are N-ary  -----      Min/Max nodes, and the next two levels are a sum -----      of products.                                     -----   2. if boolean: to disjunctive normal form           -----                                                       ----- Corresponding Helper Representations are:             -----   1. NNumExp, i.e., NSum of NProd of ScalExp          -----   2. DNF                                              ----------------------------------------------------------------data NNumExp = NSum   [NNumExp]  PrimType-             | NProd  [ScalExp]  PrimType-               deriving (Eq, Ord, Show)--data BTerm   = NRelExp RelOp0 NNumExp-             | LogCt  !Bool-             | PosId   VName-             | NegId   VName-               deriving (Eq, Ord, Show)-type NAnd    = [BTerm]-type DNF     = [NAnd ]---type NOr     = [BTerm]---type CNF     = [NOr  ]---- | Applies Simplification at Expression level:-simplify :: ScalExp -> RangesRep -> ScalExp-simplify e rangesrep = case runAlgSimplifier False (simplifyScal e) rangesrep of-  Left (Error err) ->-    error $ "Error during algebraic simplification of: " ++ pretty e ++-    "\n"  ++ err-  Left StepsExceeded -> e-  Right e' -> e'---- | Given a symbol i and a scalar expression e, it decomposes---   e = a*i + b and returns (a,b) if possible, otherwise Nothing.-linFormScalE :: VName -> ScalExp -> RangesRep -> Either Error (Maybe (ScalExp,ScalExp))-linFormScalE i e = runAlgSimplifier False (linearFormScalExp i e)---- | Extracts sufficient conditions for a LTH0 relation to hold-mkSuffConds :: ScalExp -> RangesRep -> Either Error [[ScalExp]]-mkSuffConds e = runAlgSimplifier True (gaussElimRel e)--{---- | Test if Simplification engine can handle this kind of expression-canSimplify :: Int -> Either Error ScalExp --[[ScalExp]]-canSimplify i = do-    let (h,_,e2) = mkRelExp i-    case e2 of-        (RelExp LTH0 _) -> do-              -- let e1' = trace (pretty e1) e1-              simplify e2 noLoc h---            runAlgSimplifier False (gaussAllLTH0 False S.empty =<< toNumSofP =<< simplifyScal e) noLoc h-        _ -> simplify e2 noLoc h-- badAlgSimplifyM "canSimplify: unimplemented!"--}------------------------------------------------------------ Assumes the relational expression is simplified  ------ All uses of gaussiam elimination from simplify   ------  must use simplifyNRel, which calls markGaussLTH0------  to set the inSolveLTH0 environment var, so that ------  we do not enter an infinite recurssion!         ------ Returns True or False or the input replation,i.e.------    static-only simplification!                   -----------------------------------------------------------simplifyNRel :: BTerm -> AlgSimplifyM BTerm-simplifyNRel inp_term@(NRelExp LTH0 inp_sofp) = do-    term <- cheapSimplifyNRel inp_term-    in_gauss <- asks inSolveLTH0-    let tp = typeOfNAlg inp_sofp--    if in_gauss || isTrivialNRel term || tp `notElem` map IntType allIntTypes-    then return term-    else do ednf <- markGaussLTH0 $ gaussAllLTH0 True S.empty inp_sofp-            return $ case ednf of-              Val (BoolValue c) -> LogCt c-              _              -> term-    where-        isTrivialNRel (NRelExp _ (NProd [Val _] _)) = True-        isTrivialNRel NRelExp{}                     = False-        isTrivialNRel  _                            = False--        cheapSimplifyNRel :: BTerm -> AlgSimplifyM BTerm-        cheapSimplifyNRel (NRelExp rel (NProd [Val v] _)) =-            LogCt <$> valLTHEQ0 rel v-        cheapSimplifyNRel e = return e-simplifyNRel inp_term =-    return inp_term --- TODO: handle more cases.----gaussEliminateNRel :: BTerm -> AlgSimplifyM DNF---gaussEliminateNRel _ =---    badAlgSimplifyM "gaussElimNRel: unimplemented!"---gaussElimRel :: ScalExp -> AlgSimplifyM [[ScalExp]] -- ScalExp-gaussElimRel (RelExp LTH0 e) = do-    e_sofp <- toNumSofP =<< simplifyScal e-    e_scal<- simplifyScal =<< gaussAllLTH0 False S.empty e_sofp-    e_dnf <- toDNF e_scal-    mapM (mapM (\case-                    LogCt c   -> return $ Val (BoolValue c)-                    PosId i   -> return $ Id  i $ scalExpType e-                    NegId i   -> return $ Id  i $ scalExpType e-                    NRelExp rel ee -> RelExp rel <$> fromNumSofP ee-               )) e_dnf--gaussElimRel _ =-    badAlgSimplifyM "gaussElimRel: only LTH0 Int relations please!"----ppSyms :: S.Set VName -> String---ppSyms ss = foldl (\s x -> s ++ " " ++ (baseString x)) "ElimSyms: " (S.toList ss)---primScalExpLTH0 :: ScalExp -> Bool-primScalExpLTH0 (Val (IntValue v)) = P.intToInt64 v < 0-primScalExpLTH0 _ = False----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------`gaussAllLTH'                                        -------  `static_only':whether only a True/False answer is  -------                 required or actual a sufficient cond-------     `el_syms': the list of already eliminated       -------                 symbols, initialy empty             -------     `sofp':    the expression e in sum-of-product   -------                 form that is compared to 0,         -------                 i.e., e < 0. sofp assumed simplified-------     Result:    is a ScalExp expression, which is    -------                 actually a predicate in DNF form,   -------                 that is a sufficient condition      -------                 for e < 0!                          -------                                                     ------- gaussAllLTH0 is implementing the tracking of Min/Max-------              terms, and uses `gaussOneDefaultLTH0'  -------              to implement gaussian-like elimination -------              to solve the a*i + b < 0 problem.      -------                                                     ------- IMPORTANT: before calling gaussAllLTH0 from outside -------            make sure to set insideSolveLTH0 env     -------            member to True, via markGaussLTH0;       -------            otherwise infinite recursion might happen-------            w.r.t. `simplifyScal'                    ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------type Prod = [ScalExp]-gaussAllLTH0 :: Bool -> S.Set VName -> NNumExp -> AlgSimplifyM ScalExp-gaussAllLTH0 static_only el_syms sofp = do-    step-    let tp  = typeOfNAlg sofp-    rangesrep <- asks ranges-    e_scal <- fromNumSofP sofp-    let mi  = pickSymToElim rangesrep el_syms e_scal--    case mi of-      Nothing -> return $ if primScalExpLTH0 e_scal-                          then Val (BoolValue True)-                          else RelExp LTH0 e_scal-      Just i  -> do-        (jmm, fs0, terms) <- findMinMaxTerm i sofp-        -- i.e., sofp == fs0 * jmm + terms, where-        --       i appears in jmm and jmm = MinMax ...--        fs <- if not (null fs0) then return fs0-              else do one <- getPos1 tp; return [Val one]--        case jmm of-          -------------------------------------------------------------------------          -- A MinMax expression which uses to-be-eliminated symbol i was found ---          -------------------------------------------------------------------------          Just (MaxMin _     []  ) ->-                badAlgSimplifyM "gaussAllLTH0: Empty MinMax Node!"-          Just (MaxMin ismin mmts) -> do-            mone <- getNeg1 tp--            -- fs_lth0 => fs < 0---            fs_lth0 <- if null fs then return $ Val (BoolValue False)---                       else gaussAllLTH0 static_only el_syms (NProd fs tp)-            fsm1    <- toNumSofP =<< simplifyScal =<< fromNumSofP-                         ( NSum [NProd fs tp, NProd [Val mone] tp] tp )-            fs_leq0 <- gaussAllLTH0 static_only el_syms fsm1  -- fs <= 0-            -- mfsm1 = - fs - 1, fs_geq0 => (fs >= 0),-            --             i.e., fs_geq0 => (-fs - 1 < 0)-            mfsm1   <- toNumSofP =<< simplifyScal =<< fromNumSofP-                         ( NSum [NProd (Val mone:fs) tp,NProd [Val mone] tp] tp )-            fs_geq0 <- gaussAllLTH0 static_only el_syms mfsm1--            -- mm_terms are the simplified terms of the MinMax obtained-            -- after inlining everything inside the MinMax, i.e., intially-            -- terms + fs * MinMax ismin [t1,..,tn] -> [fs*t1+terms, ..., fs*tn+terms]-            mm_terms<- mapM (\t -> toNumSofP =<< simplifyScal =<< fromNumSofP-                                   (NSum ( NProd (t:fs) tp:terms ) tp) ) mmts--            -- for every (simplified) `term_i' of the inline MinMax exp,-            --  get the sufficient conditions for `term_i < 0'-            mms     <- mapM (gaussAllLTH0 static_only el_syms) mm_terms--            if static_only-            ---------------------------------------------------------------------            -- returns either Val (BoolValue True) or the original ScalExp relat ---            ---------------------------------------------------------------------            then if ( fs_geq0 == Val (BoolValue True) &&     ismin) ||-                    ( fs_leq0 == Val (BoolValue True) && not ismin)-                 -- at least one term should be < 0!-                 then do let  is_one_true  = Val (BoolValue True ) `elem` mms-                         let are_all_false = all  (== Val (BoolValue False)) mms-                         return $ if       is_one_true  then Val (BoolValue True)-                                  else if are_all_false then Val (BoolValue False)-                                  else RelExp LTH0 e_scal-                 -- otherwise all terms should be all true!-                 else do let are_all_true = all  (== Val (BoolValue True )) mms-                         let is_one_false = Val (BoolValue False) `elem` mms-                         return $ if      are_all_true then Val (BoolValue True )-                                  else if is_one_false then Val (BoolValue False)-                                  else RelExp LTH0 e_scal-            ---------------------------------------------------------------------            -- returns sufficient conditions for the ScalExp relation to hold ---            ---------------------------------------------------------------------            else do-                let mm_fsgeq0 = foldl (if ismin then SLogOr else SLogAnd)-                                      (Val (BoolValue (not ismin))) mms-                let mm_fslth0 = foldl (if ismin then SLogAnd else SLogOr)-                                      (Val (BoolValue      ismin )) mms-                -- the sufficient condition for the original expression, e.g.,-                -- terms + fs * Min [t1,..,tn] < 0 is-                -- (fs >= 0 && (fs*t_1+terms < 0 || ... || fs*t_n+terms < 0) ) ||-                -- (fs <  0 && (fs*t_1+terms < 0 && ... && fs*t_n+terms < 0) )-                return $ SLogOr (SLogAnd fs_geq0 mm_fsgeq0) (SLogAnd fs_leq0 mm_fslth0)--          Just _ -> badAlgSimplifyM "gaussOneLTH0: (Just MinMax) invariant violated!"-          -------------------------------------------------------------------------          -- A MinMax expression which uses (to-be-elim) symbol i was NOT found ---          -------------------------------------------------------------------------          Nothing-> do-            m_sofp <- gaussOneDefaultLTH0 static_only i el_syms sofp-            case m_sofp of-                Nothing -> gaussAllLTH0 static_only (S.insert i el_syms) sofp-                Just res_eofp -> return res_eofp-    where-        findMinMaxTerm :: VName -> NNumExp -> AlgSimplifyM (Maybe ScalExp, Prod, [NNumExp])-        findMinMaxTerm _  (NSum  [] _) = return (Nothing, [], [])-        findMinMaxTerm _  (NSum  [NProd [MaxMin ismin e] _] _) =-            return (Just (MaxMin ismin e), [], [])-        findMinMaxTerm _  (NProd [MaxMin ismin e] _) =-            return (Just (MaxMin ismin e), [], [])--        findMinMaxTerm ii t@NProd{} = do (mm, fs) <- findMinMaxFact ii t-                                         return (mm, fs, [])-        findMinMaxTerm ii (NSum (t:ts) tp)= do-            rangesrep <- asks ranges-            case M.lookup ii rangesrep of-                Just (_, Just _, Just _) -> do-                    f <- findMinMaxFact ii t-                    case f of-                        (Just mm, fs) -> return (Just mm, fs, ts)-                        (Nothing, _ ) -> do (mm, fs', ts') <- findMinMaxTerm ii (NSum ts tp)-                                            return (mm, fs', t:ts')-                _ -> return (Nothing, [], t:ts)--        findMinMaxFact :: VName -> NNumExp -> AlgSimplifyM (Maybe ScalExp, Prod)-        findMinMaxFact _  (NProd []     _ ) = return (Nothing, [])-        findMinMaxFact ii (NProd (f:fs) tp) =-            case f of-                MaxMin ismin ts -> do-                        let id_set = mconcat $ map freeIn ts-                        if ii `nameIn` id_set-                        then return (Just (MaxMin ismin ts), fs)-                        else do (mm, fs') <- findMinMaxFact ii (NProd fs tp)-                                return (mm, f:fs')--                _ -> do (mm, fs') <- findMinMaxFact ii (NProd fs tp)-                        return (mm, f:fs')-        findMinMaxFact ii (NSum [f] _) = findMinMaxFact ii f-        findMinMaxFact _  (NSum _ _) =-            badAlgSimplifyM "findMinMaxFact: NSum argument illegal!"----gaussOneDefaultLTH0 :: Bool -> VName -> S.Set VName -> NNumExp -> AlgSimplifyM (Maybe ScalExp)-gaussOneDefaultLTH0  static_only i elsyms e = do-    aipb <- linearForm i e-    case aipb of-        Nothing     -> return Nothing-        Just (a, b) -> do-            rangesrep <- asks ranges-            one    <- getPos1 (typeOfNAlg e)-            ascal  <- fromNumSofP a-            mam1   <- toNumSofP =<< simplifyScal (SNeg (SPlus ascal (Val one)))-            am1    <- toNumSofP =<< simplifyScal (SMinus ascal (Val one))-            ma     <- toNumSofP =<< simplifyScal (SNeg ascal)--            b_scal<- fromNumSofP b-            mbm1  <- toNumSofP =<< simplifyScal (SNeg (SPlus b_scal (Val one)))--            aleq0 <- simplifyScal =<< gaussAllLTH0 static_only elsyms am1-            ageq0 <- simplifyScal =<< gaussAllLTH0 static_only elsyms mam1--            case M.lookup i rangesrep of-                Nothing ->-                    badAlgSimplifyM "gaussOneDefaultLTH0: sym not in ranges!"-                Just (_, Nothing, Nothing) ->-                    badAlgSimplifyM "gaussOneDefaultLTH0: both bounds are undefined!"--                -- only the lower-bound of i is known!-                Just (_, Just lb, Nothing) -> do-                    alpblth0 <- gaussElimHalf static_only elsyms lb a b-                    and_half <- simplifyScal alpblth0-                    case (and_half, aleq0) of-                        (Val (BoolValue True), Val (BoolValue True)) ->-                                return $ Just and_half-                        _ -> do malmbm1lth0 <- gaussElimHalf static_only elsyms lb ma mbm1-                                other_half  <- simplifyScal malmbm1lth0-                                case (other_half, ageq0) of-                                    (Val (BoolValue True), Val (BoolValue True)) ->-                                            return $ Just (Val (BoolValue False))-                                    _  ->   return Nothing--                Just (_, Nothing, Just ub) -> do-                    aupblth0 <- gaussElimHalf static_only elsyms ub a b-                    and_half <- simplifyScal aupblth0-                    case (and_half, ageq0) of-                        (Val (BoolValue True), Val (BoolValue True)) ->-                                return $ Just and_half-                        _ -> do-                                maumbm1    <- gaussElimHalf static_only elsyms ub ma mbm1-                                other_half <- simplifyScal maumbm1-                                case (other_half, aleq0) of-                                    (Val (BoolValue True), Val (BoolValue True)) ->-                                            return $ Just (Val (BoolValue False))-                                    _  ->   return Nothing--                Just (_, Just lb, Just ub) ->-                    if static_only-                    then if aleq0 == Val (BoolValue True)-                         then do alpblth0 <- simplifyScal =<< gaussElimHalf static_only elsyms lb a b-                                 if alpblth0 == Val (BoolValue True)-                                   then return $ Just (Val (BoolValue True))-                                   else do maubmbm1 <- simplifyScal =<< gaussElimHalf static_only elsyms ub ma mbm1-                                           return $ if maubmbm1 == Val (BoolValue True)-                                                    then Just (Val (BoolValue False))-                                                    else Nothing-                      else if ageq0 == Val (BoolValue True)-                      then do aupblth0 <- simplifyScal =<< gaussElimHalf static_only elsyms ub a b-                              if aupblth0 == Val (BoolValue True)-                              then return $ Just (Val (BoolValue True))-                              else do malbmbm1 <- simplifyScal =<< gaussElimHalf static_only elsyms lb ma mbm1-                                      return $ if malbmbm1 == Val (BoolValue True)-                                               then Just (Val (BoolValue False))-                                               else Nothing-                      else return Nothing-                    else do-                      alpblth0 <- gaussElimHalf static_only elsyms lb a b-                      aupblth0 <- gaussElimHalf static_only elsyms ub a b-                      res <- simplifyScal $ SLogOr (SLogAnd aleq0 alpblth0) (SLogAnd ageq0 aupblth0)-                      return $ Just res--    where-        gaussElimHalf :: Bool -> S.Set VName -> ScalExp -> NNumExp -> NNumExp -> AlgSimplifyM ScalExp-        gaussElimHalf only_static elsyms0 q a b = do-            a_scal <- fromNumSofP a-            b_scal <- fromNumSofP b-            e_num_scal <- simplifyScal (SPlus (STimes a_scal q) b_scal)-            e_num <- toNumSofP e_num_scal-            gaussAllLTH0 only_static elsyms0 e_num---- | Pick a Symbol to Eliminate & Bring To Linear Form-pickSymToElim :: RangesRep -> S.Set VName -> ScalExp -> Maybe VName-pickSymToElim rangesrep elsyms0 e_scal =-    let ids0= namesToList $ freeIn e_scal-        ids1= filter (\s -> not (S.member s elsyms0)) ids0-        ids2= filter (\s -> case M.lookup s rangesrep of-                                Nothing -> False-                                Just _  -> True-                     ) ids1-        ids = sortBy (\n1 n2 -> let n1p = M.lookup n1 rangesrep-                                    n2p = M.lookup n2 rangesrep-                                in case (n1p, n2p) of-                                     (Just (p1,_,_), Just (p2,_,_)) -> compare (-p1) (-p2)-                                     (_            , _            ) -> compare (1::Int) (1::Int)-                     ) ids2-    in  case ids of-            []  -> Nothing-            v:_ -> Just v---linearFormScalExp :: VName -> ScalExp -> AlgSimplifyM (Maybe (ScalExp, ScalExp))-linearFormScalExp sym scl_exp = do-    sofp <- toNumSofP =<< simplifyScal scl_exp-    ab   <- linearForm sym sofp-    case ab of-        Just (a_sofp, b_sofp) -> do-            a <- fromNumSofP a_sofp-            b <- fromNumSofP b_sofp-            a'<- simplifyScal a-            b'<- simplifyScal b-            return $ Just (a', b')-        Nothing ->-            return Nothing--linearForm :: VName -> NNumExp -> AlgSimplifyM (Maybe (NNumExp, NNumExp))-linearForm _ (NProd [] _) =-    badAlgSimplifyM "linearForm: empty Prod!"-linearForm idd ee@NProd{} = linearForm idd (NSum [ee] (typeOfNAlg ee))-linearForm _ (NSum [] _) =-    badAlgSimplifyM "linearForm: empty Sum!"-linearForm idd (NSum terms tp) = do-    terms_d_idd <- mapM  (\t -> do t0 <- case t of-                                            NProd (_:_) _ -> return t-                                            _ -> badAlgSimplifyM "linearForm: ILLEGAL111!!!!"-                                   t_scal <- fromNumSofP t0-                                   simplifyScal $ SDiv t_scal (Id idd (scalExpType t_scal))-                         ) terms-    let myiota  = [1..(length terms)]-    let ia_terms= filter (\(_,t)-> case t of-                                     SDiv _ _ -> False-                                     _           -> True-                         ) (zip myiota terms_d_idd)-    let (a_inds, a_terms) = unzip ia_terms--    let (_, b_terms) = unzip $ filter (\(iii,_) -> iii `notElem` a_inds)-                                      (zip myiota terms)-    -- check that b_terms do not contain idd-    b_succ <- foldM (\acc x ->-                        case x of-                           NProd fs _ -> do let fs_scal = case fs of-                                                            [] -> Val $ IntValue $ Int32Value 1-                                                            f:fs' -> foldl STimes f fs'-                                            let b_ids = freeIn fs_scal-                                            return $ acc && not (idd `nameIn` b_ids)-                           _          -> badAlgSimplifyM "linearForm: ILLEGAL222!!!!"-                    ) True b_terms--    case a_terms of-        t:ts | b_succ -> do-            let a_scal = foldl SPlus t ts-            a_terms_sofp <- toNumSofP =<< simplifyScal a_scal-            b_terms_sofp <- if null b_terms-                            then do zero <- getZero tp; return $ NProd [Val zero] tp-                            else return $ NSum b_terms tp-            return $ Just (a_terms_sofp, b_terms_sofp)-        _ -> return Nothing------------------------------------------------------------------------------------------------------ Main Helper Function: takes a scalar exp,  ----- normalizes and simplifies it               ------------------------------------------------------------------------------------------------------simplifyScal :: ScalExp -> AlgSimplifyM ScalExp--simplifyScal (Val v) = return $ Val v-simplifyScal (Id  x t) = return $ Id  x t--simplifyScal e@SNot{} = fromDNF =<< simplifyDNF =<< toDNF e-simplifyScal e@SLogAnd{} = fromDNF =<< simplifyDNF =<< toDNF e-simplifyScal e@SLogOr{} = fromDNF =<< simplifyDNF =<< toDNF e-simplifyScal e@RelExp{} = fromDNF =<< simplifyDNF =<< toDNF e-------------------------------------------- MaxMin related simplifications -------------------------------------------simplifyScal (MaxMin _ []) =-    badAlgSimplifyM "Scalar MaxMin expression with empty arglist."-simplifyScal (MaxMin _ [e]) = simplifyScal e-simplifyScal (MaxMin ismin es) = do -- helperMinMax ismin  es pos-    -- pos <- asks pos-    es0 <- mapM simplifyScal es-    let evals = filter isValue         es0-        es'   = filter (not . isValue) es0-        mvv = case evals of-                []   -> Nothing-                v:vs -> let myop = if ismin then min else max-                            myval= getValue v-                            oneval = (foldl myop myval . map getValue) vs-                        in  Just $ Val oneval-    -- flatten the result and remove duplicates,-    -- e.g., Max(Max(e1,e2), e1) -> Max(e1,e2,e3)-    case (es', mvv) of-        ([], Just vv) -> return vv-        (_,  Just vv) -> return $ MaxMin ismin $ remDups $ foldl flatop [] $ vv:es'-        (_,  Nothing) -> return $ MaxMin ismin $ remDups $ foldl flatop [] es'-    -- ToDo: This can prove very expensive as compile time-    --       but, IF e2-e1 <= 0 simplifies to True THEN-    --       Min(e1,e2) = e2.   Code example:-    -- e1me2 <- if isMin-    --          then simplifyScal $ AlgOp MINUS e1 e2 pos-    --          else simplifyScal $ AlgOp MINUS e2 e1 pos-    -- e1me2leq0 <- simplifyNRel $ NRelExp LEQ0 e1me2 pos-    -- case e1me2leq0 of-    --    NAnd [LogCt True  _] _ -> simplifyAlgN e1-    --    NAnd [LogCt False _] _ -> simplifyAlgN e2-    where-        isValue :: ScalExp -> Bool-        isValue e = case e of-                      Val _ -> True-                      _     -> False-        getValue :: ScalExp -> PrimValue-        getValue se = case se of-                        Val v -> v-                        _     -> value (0::Int32)-        flatop :: [ScalExp] -> ScalExp -> [ScalExp]-        flatop a e@(MaxMin ismin' ses) =-            a ++ if ismin == ismin' then ses else [e]-        flatop a e = a++[e]-        remDups :: [ScalExp] -> [ScalExp]-        remDups l = S.toList (S.fromList l)--------------------------------------------------------- Plus/Minus related simplifications          ------- BUG: the MinMax pattern matching should     -------      be performed on the simplified subexps --------------------------------------------------------simplifyScal (SPlus e1o e2o) = do-    e1' <- simplifyScal e1o-    e2' <- simplifyScal e2o-    if isMaxMin e1' || isMaxMin e2'-    then helperPlusMinMax $ SPlus e1' e2'-    else normalPlus e1' e2'--    where-      normalPlus :: ScalExp -> ScalExp -> AlgSimplifyM ScalExp-      normalPlus e1 e2 = do-        e1' <- toNumSofP e1-        e2' <- toNumSofP e2-        let tp = scalExpType e1-        let terms = getTerms e1' ++ getTerms e2'-        splittedTerms <- mapM splitTerm terms-        let sortedTerms = sortBy (\(n1,_) (n2,_) -> compare n1 n2) splittedTerms-        -- foldM discriminate: adds together identical terms, and-        -- we reverse the list, to keep it in a ascending order.-        merged <- reverse <$> foldM discriminate [] sortedTerms-        let filtered = filter (\(_,v) -> not $ zeroIsh v ) merged-        if null filtered-        then do-            zero <- getZero tp-            fromNumSofP $ NProd [Val zero] tp-        else do-            terms' <- mapM joinTerm filtered-            fromNumSofP $ NSum terms' tp--simplifyScal (SMinus e1 e2) = do-  let tp = scalExpType e1-  if e1 == e2-    then Val <$> getZero tp-    else do min_1 <- getNeg1 $ scalExpType e1-            simplifyScal $ SPlus e1 $ STimes (Val min_1) e2--simplifyScal (SNeg e) = do-    negOne <- getNeg1 $ scalExpType e-    simplifyScal $ STimes (Val negOne) e--simplifyScal (SAbs e) = return $ SAbs e--simplifyScal (SSignum e) = return $ SSignum e--------------------------------------------------------- Times        related simplifications        ------- BUG: the MinMax pattern matching should     -------      be performed on the simplified subexps --------------------------------------------------------simplifyScal (STimes e1o e2o) = do-    e1'' <- simplifyScal e1o-    e2'' <- simplifyScal e2o-    if isMaxMin e1'' || isMaxMin e2''-    then helperMultMinMax $ STimes e1'' e2''-    else normalTimes e1'' e2''--    where-      normalTimes :: ScalExp -> ScalExp -> AlgSimplifyM ScalExp-      normalTimes e1 e2 = do-        let tp = scalExpType e1-        e1' <- toNumSofP e1-        e2' <- toNumSofP e2-        case (e1', e2') of-            (NProd xs _, y@NProd{}) -> fromNumSofP =<< makeProds xs y-            (NProd xs _, y) -> do-                    prods <- mapM (makeProds xs) $ getTerms y-                    fromNumSofP $ NSum (sort prods) tp-            (x, NProd ys _) -> do-                    prods <- mapM (makeProds ys) $ getTerms x-                    fromNumSofP $ NSum (sort prods) tp-            (NSum xs _, NSum ys _) -> do-                    xsMultChildren <- mapM getMultChildren xs-                    prods <- mapM (\x -> mapM (makeProds x) ys) xsMultChildren-                    fromNumSofP $ NSum (sort $ concat prods) tp--      makeProds :: [ScalExp] -> NNumExp -> AlgSimplifyM NNumExp-      makeProds [] _ =-           badAlgSimplifyM " In simplifyAlgN, makeProds: 1st arg is the empty list! "-      makeProds _ (NProd [] _) =-          badAlgSimplifyM " In simplifyAlgN, makeProds: 2nd arg is the empty list! "-      makeProds _ NSum{} =-          badAlgSimplifyM " In simplifyAlgN, makeProds: e1 * e2: e2 is a sum of sums! "-      makeProds (Val v1:exs) (NProd (Val v2:ys) tp1) = do-          v <- mulVals v1 v2-          return $ NProd (Val v : sort (ys++exs) ) tp1-      makeProds (Val v:exs) (NProd ys tp1) =-          return $ NProd (Val v : sort (ys++exs) ) tp1-      makeProds exs (NProd (Val v : ys) tp1) =-          return $ NProd (Val v : sort (ys++exs) ) tp1-      makeProds exs (NProd ys tp1) =-          return $ NProd (sort (ys++exs)) tp1------------------------------------------------------------------------------------------------------------- DIvide        related simplifications       -------------------------------------------------------------------------------------------------------------simplifyScal (SDiv e1o e2o) = do-    e1' <- simplifyScal e1o-    e2' <- simplifyScal e2o--    if isMaxMin e1' || isMaxMin e2'-    then helperMultMinMax $ SDiv e1' e2'-    else normalFloatDiv e1' e2'--    where-      normalFloatDiv :: ScalExp -> ScalExp -> AlgSimplifyM ScalExp-      normalFloatDiv e1 e2-        | e1 == e2                  = do one <- getPos1 $ scalExpType e1-                                         return $ Val one---        | e1 == (negateSimplified e2) = do mone<- getNeg1 $ scalExpType e1---                                           return $ Val mone-        | otherwise = do-            e1' <- toNumSofP e1-            e2' <- toNumSofP e2-            case e2' of-              NProd fs tp -> do-                e1Split <- mapM splitTerm (getTerms e1')-                case e1Split of-                  []  -> Val <$> getZero tp-                  _   -> do (fs', e1Split')  <- trySimplifyDivRec fs [] e1Split-                            if length fs' == length fs-                            then turnBackAndDiv e1' e2' -- insuccess-                            else do terms_e1' <- mapM joinTerm e1Split'-                                    e1'' <- fromNumSofP $ NSum terms_e1' tp-                                    case fs' of-                                      [] -> return e1''-                                      _  -> do e2'' <- fromNumSofP $ NProd fs' tp-                                               return $ SDiv e1'' e2''--              _ -> turnBackAndDiv e1' e2'--      turnBackAndDiv :: NNumExp -> NNumExp -> AlgSimplifyM ScalExp-      turnBackAndDiv ee1 ee2 = do-        ee1' <- fromNumSofP ee1-        ee2' <- fromNumSofP ee2-        return $ SDiv ee1' ee2'--simplifyScal (SMod e1o e2o) =-    SMod <$> simplifyScal e1o <*> simplifyScal e2o--simplifyScal (SQuot e1o e2o) =-    SQuot <$> simplifyScal e1o <*> simplifyScal e2o--simplifyScal (SRem e1o e2o) =-    SRem <$> simplifyScal e1o <*> simplifyScal e2o------------------------------------------------------------------------------------------------------------- Power        related simplifications        --------------------------------------------------------------------------------------------------------------- cannot handle 0^a, because if a < 0 then it's an error.--- Could be extented to handle negative exponents better, if needed-simplifyScal (SPow e1 e2) = do-    let tp = scalExpType e1-    e1' <- simplifyScal e1-    e2' <- simplifyScal e2--    if isCt1 e1' || isCt0 e2'-    then Val <$> getPos1 tp-    else if isCt1 e2'-    then return e1'-    else case (e1', e2') of-            (Val v1, Val v2)-              | Just v <- powVals v1 v2 -> return $ Val v-            (_, Val (IntValue n)) ->-                if P.intToInt64 n >= 1-                then -- simplifyScal =<< fromNumSofP $ NProd (replicate n e1') tp-                        do new_e <- fromNumSofP $ NProd (genericReplicate (P.intToInt64 n) e1') tp-                           simplifyScal new_e-                else return $ SPow e1' e2'-            (_, _) -> return $ SPow e1' e2'--    where-        powVals :: PrimValue -> PrimValue -> Maybe PrimValue-        powVals (IntValue v1) (IntValue v2) = IntValue <$> P.doPow v1 v2-        powVals _ _ = Nothing----------------------------------------------------------- Helpers for simplifyScal: MinMax related, etc -----------------------------------------------------------isMaxMin :: ScalExp -> Bool-isMaxMin MaxMin{} = True-isMaxMin _        = False--helperPlusMinMax :: ScalExp -> AlgSimplifyM ScalExp-helperPlusMinMax (SPlus (MaxMin ismin es) e) =-    simplifyScal $ MaxMin ismin $ map (`SPlus` e) es-helperPlusMinMax (SPlus e (MaxMin ismin es)) =-    simplifyScal $ MaxMin ismin $ map (SPlus e) es-helperPlusMinMax _ = badAlgSimplifyM "helperPlusMinMax: Reached unreachable case!"--{--helperMinusMinMax :: ScalExp -> AlgSimplifyM ScalExp-helperMinusMinMax (SMinus (MaxMin ismin es) e) =-    simplifyScal $ MaxMin ismin $ map (\x -> SMinus x e) es-helperMinusMinMax (SMinus e (MaxMin ismin es)) =-    simplifyScal $ MaxMin ismin $ map (\x -> SMinus e x) es-helperMinusMinMax _ = do-    pos <- asks pos-    badAlgSimplifyM "helperMinusMinMax: Reached unreachable case!"--}-helperMultMinMax :: ScalExp -> AlgSimplifyM ScalExp-helperMultMinMax (STimes  e em@MaxMin{}) = helperTimesDivMinMax True  True  em e-helperMultMinMax (STimes  em@MaxMin{} e) = helperTimesDivMinMax True  False em e-helperMultMinMax (SDiv e em@MaxMin{}) = helperTimesDivMinMax False True  em e-helperMultMinMax (SDiv em@MaxMin{} e) = helperTimesDivMinMax False False em e-helperMultMinMax _ = badAlgSimplifyM "helperMultMinMax: Reached unreachable case!"--helperTimesDivMinMax :: Bool -> Bool -> ScalExp -> ScalExp -> AlgSimplifyM ScalExp-helperTimesDivMinMax isTimes isRev emo@MaxMin{} e = do-    em <- simplifyScal emo-    case em of-        MaxMin ismin es -> do-            e' <- simplifyScal e-            e'_sop <- toNumSofP e'-            p' <- simplifyNRel $ NRelExp LTH0 e'_sop-            case p' of-                LogCt ctbool -> do---                    let cond = not isTimes && isRev---                    let cond'= if ctbool then cond  else not cond---                    let ismin'= if cond' then ismin else not ismin--                    let cond =  (     isTimes              && not ctbool ) ||-                                ( not isTimes && not isRev && not ctbool ) ||-                                ( not isTimes &&     isRev &&     ctbool  )-                    let ismin' = if cond then ismin else not ismin-                    simplifyScal $ MaxMin ismin' $ map (`mkTimesDiv` e') es--                _  -> if not isTimes then return $ mkTimesDiv em e'-                      else -- e' * MaxMin{...}-                        case e'_sop of-                            NProd _  _  -> return $ mkTimesDiv em e' -- simplifyScal =<< fromNumSofP (NProd (em:fs) tp)-                            NSum  ts tp -> do-                                new_ts <--                                    mapM (\case-                                             NProd fs _ -> return $ NProd (em:fs) tp-                                             _          -> badAlgSimplifyM-                                                           "helperTimesDivMinMax: SofP invariant violated!"-                                         ) ts-                                simplifyScal =<< fromNumSofP ( NSum new_ts tp )-        _ -> simplifyScal $ mkTimesDiv em e-    where-        mkTimesDiv :: ScalExp -> ScalExp -> ScalExp-        mkTimesDiv e1 e2-          | not isTimes = if isRev then SDiv e2 e1 else SDiv e1 e2-          | isRev       = STimes e2 e1-          | otherwise   = STimes e1 e2--helperTimesDivMinMax _ _ _ _ =-  badAlgSimplifyM "helperTimesDivMinMax: Reached unreachable case!"-------------------------------------------------------------------------------------------------------------- translating to and simplifying the          ------- disjunctive normal form: toDNF, simplifyDNF --------------------------------------------------------------------------------------------------------------isTrueDNF :: DNF -> Bool---isTrueDNF [[LogCt True]] = True---isTrueDNF _              = False------getValueDNF :: DNF -> Maybe Bool---getValueDNF [[LogCt True]]  = Just True---getValueDNF [[LogCt False]] = Just True---getValueDNF _               = Nothing---negateBTerm :: BTerm -> AlgSimplifyM BTerm-negateBTerm (LogCt v) = return $ LogCt (not v)-negateBTerm (PosId i) = return $ NegId i-negateBTerm (NegId i) = return $ PosId i-negateBTerm (NRelExp rel e) = do-    let tp = typeOfNAlg e-    case (tp, rel) of-        (IntType it, LTH0) -> do-            se <- fromNumSofP e-            ne <- toNumSofP =<< simplifyScal (SNeg $ SPlus se (Val (value (P.intValue it (1::Int)))))-            return $ NRelExp LTH0 ne-        _ -> NRelExp (if rel == LEQ0 then LTH0 else LEQ0) <$>-             (toNumSofP =<< negateSimplified =<< fromNumSofP e)--bterm2ScalExp :: BTerm -> AlgSimplifyM ScalExp-bterm2ScalExp (LogCt v) = return $ Val $ BoolValue v-bterm2ScalExp (PosId i) = return $ Id i int32-bterm2ScalExp (NegId i) = return $ SNot $ Id i int32-bterm2ScalExp (NRelExp rel e) = RelExp rel <$> fromNumSofP e---- translates from DNF to ScalExp-fromDNF :: DNF -> AlgSimplifyM ScalExp-fromDNF [] = badAlgSimplifyM "fromDNF: empty DNF!"-fromDNF (t:ts) = do-    t' <- translFact t-    foldM (\acc x -> do x' <- translFact x; return $ SLogOr x' acc) t' ts-    where-        translFact [] = badAlgSimplifyM "fromDNF, translFact empty DNF factor!"-        translFact (f:fs) = do-            f' <- bterm2ScalExp f-            foldM (\acc x -> do x' <- bterm2ScalExp x; return $ SLogAnd x' acc) f' fs---- translates (and simplifies numeric expressions?) to DNF form.-toDNF :: ScalExp -> AlgSimplifyM DNF-toDNF (Val  (BoolValue v)) = return [[LogCt v]]-toDNF (Id      idd  _ ) = return [[PosId idd]]-toDNF (RelExp  rel  e ) = do-  let t = scalExpType e-  case t of-    IntType it -> do-      e' <- if rel == LEQ0-            then do m1 <- getNeg1 $ IntType it-                    return $ SPlus e $ Val m1-            else return e-      ne   <- toNumSofP =<< simplifyScal e'-      nrel <- simplifyNRel $ NRelExp LTH0 ne  -- False-      return [[nrel]]--    _   -> do ne   <- toNumSofP =<< simplifyScal e-              nrel <- markGaussLTH0 $ simplifyNRel $ NRelExp rel ne-              return [[nrel]]----toDNF (SNot (SNot     e)) = toDNF e-toDNF (SNot (Val (BoolValue v))) = return [[LogCt $ not v]]-toDNF (SNot (Id idd _)) = return [[NegId idd]]-toDNF (SNot (RelExp rel e)) = do-    let not_rel = if rel == LEQ0 then LTH0 else LEQ0-    neg_e <- simplifyScal (SNeg e)-    toDNF $ RelExp not_rel neg_e----toDNF (SLogOr  e1 e2  ) = do-    e1s <- toDNF e1-    e2s <- toDNF e2-    return $ sort $ e1s ++ e2s-toDNF (SLogAnd e1 e2  ) = do-    -- [t1 ++ t2 | t1 <- toDNF e1, t2 <- toDNF e2]-    e1s <- toDNF e1-    e2s <- toDNF e2-    let lll = map (\t2-> map (++t2) e1s) e2s-    return $ sort $ concat lll-toDNF (SNot (SLogAnd e1 e2)) = do-    e1s <- toDNF (SNot e1)-    e2s <- toDNF (SNot e2)-    return $ sort $ e1s ++ e2s-toDNF (SNot (SLogOr e1 e2)) = do-    -- [t1 ++ t2 | t1 <- dnf $ SNot e1, t2 <- dnf $ SNot e2]-    e1s <- toDNF $ SNot e1-    e2s <- toDNF $ SNot e2-    let lll = map (\t2-> map (++t2) e1s) e2s-    return $ sort $ concat lll-toDNF _            = badAlgSimplifyM "toDNF: not a boolean expression!"------------------------------------------------------------ Simplifying Boolean Expressions:               -------  0. p     AND p == p;       p     OR p == p    -------  1. False AND p == False;   True  OR p == True -------  2. True  AND p == p;       False OR p == p    -------  3.(not p)AND p == FALSE;  (not p)OR p == True -------  4. ToDo: p1 AND p2 == p1 if p1 => p2          -------           p1 AND p2 == False if p1 => not p2 or-------                                 p2 => not p1   -------     Also: p1 OR p2 == p2 if p1 => p2           -------           p1 OR p2 == True if not p1 => p2 or  -------                               not p2 => p1     -------     This boils down to relations:              -------      e1 < 0 => e2 < 0 if e2 <= e1              -----------------------------------------------------------simplifyDNF :: DNF -> AlgSimplifyM DNF-simplifyDNF terms0 = do-    terms1 <- mapM (simplifyAndOr True) terms0-    let terms' = if [LogCt True] `elem` terms1 then [[LogCt True]]-                 else S.toList $ S.fromList $-                        filter (/= [LogCt False]) terms1-    if null terms' then return [[LogCt False]]-    else do-        let len1terms = all ((1==) . length) terms'-        if not len1terms then return terms'-        else do let terms_flat = concat terms'-                terms'' <- simplifyAndOr False terms_flat-                return $ map (:[]) terms''---- big helper function for simplifyDNF-simplifyAndOr :: Bool -> [BTerm] -> AlgSimplifyM [BTerm]-simplifyAndOr _ [] = badAlgSimplifyM "simplifyAndOr: not a boolean expression!"-simplifyAndOr is_and fs =-    if LogCt (not is_and) `elem` fs-         -- False AND p == False-    then return [LogCt $ not is_and]-                    -- (i) p AND p == p,        (ii) True AND p == p-    else do let fs' = S.toList . S.fromList . filter (/=LogCt is_and) $ fs-            if null fs'-            then return [LogCt is_and]-            else do    -- IF p1 => p2 THEN   p1 AND p2 --> p1-                fs''<- foldM (\l x-> do (addx, l') <- trimImplies is_and x l-                                        return $ if addx then x:l' else l'-                             ) [] fs'-                       -- IF p1 => not p2 THEN p1 AND p2 == False-                isF <- foldM (\b x -> if b then return b-                                      else do notx <- negateBTerm x-                                              impliesAny is_and x notx fs''-                             ) False fs''-                return $ if not isF then fs''-                         else if is_and then [LogCt False]-                                        else [LogCt True ]-    where-        -- e1 => e2 ?-        impliesRel :: BTerm -> BTerm -> AlgSimplifyM Bool-        impliesRel (LogCt False) _ = return True-        impliesRel _ (LogCt  True) = return True-        impliesRel (LogCt True)  e = do-            let e' = e -- simplifyNRel e-            return $ e' == LogCt True-        impliesRel e (LogCt False) = do-            e' <- negateBTerm e -- simplifyNRel =<< negateBTerm e-            return $ e' == LogCt True-        impliesRel (NRelExp rel1 e1) (NRelExp rel2 e2) = do-        -- ToDo: implement implies relation!-            --not_aggr <- asks cheap-            let btp = typeOfNAlg e1-            if btp /= typeOfNAlg e2-            then return False-            else do-                one <- getPos1    btp-                e1' <- fromNumSofP e1-                e2' <- fromNumSofP e2-                case (rel1, rel2, btp) of-                    (LTH0, LTH0, IntType _) -> do-                        e2me1m1 <- toNumSofP =<< simplifyScal (SMinus e2' $ SPlus e1' $ Val one)-                        diffrel <- simplifyNRel $ NRelExp LTH0 e2me1m1-                        return $ diffrel == LogCt True-                    (_, _, IntType _) -> badAlgSimplifyM "impliesRel: LEQ0 for Int!"-                    (_, _, _) -> badAlgSimplifyM "impliesRel: exp of illegal type!"-        impliesRel p1 p2-            | p1 == p2  = return True-            | otherwise = return False--        -- trimImplies(true,  x, l) performs: p1 AND p2 == p1 if p1 => p2,-        --   i.e., removes any p in l such that:-        --    (i) x => p orelse if-        --   (ii) p => x then indicates that p should not be added to the reuslt-        -- trimImplies(false, x, l) performs: p1 OR p2 == p2 if p1 => p2,-        --   i.e., removes any p from l such that:-        --    (i) p => x orelse if-        --   (ii) x => p then indicates that p should not be added to the result-        trimImplies :: Bool -> BTerm -> [BTerm] -> AlgSimplifyM (Bool, [BTerm])-        trimImplies _        _ []     = return (True, [])-        trimImplies and_case x (p:ps) = do-            succc <- impliesRel x p-            if succc-            then if and_case then trimImplies and_case x ps else return (False, p:ps)-            else do suc <- impliesRel p x-                    if suc then if and_case then return (False, p:ps) else trimImplies and_case x ps-                    else do (addx, newps) <- trimImplies and_case x ps-                            return (addx, p:newps)--        -- impliesAny(true,  x, notx, l) performs:-        --   x AND p == False if p => not x, where p in l,-        -- impliesAny(true,  x, notx, l) performs:-        --   x OR p == True if not x => p-        -- BUT only when p != x, i.e., avoids comparing x with notx-        impliesAny :: Bool -> BTerm -> BTerm -> [BTerm] -> AlgSimplifyM Bool-        impliesAny _        _ _    []     = return False-        impliesAny and_case x notx (p:ps)-            | x == p = impliesAny and_case x notx ps-            | otherwise = do-                succ' <- if and_case then impliesRel p notx else impliesRel notx p-                if succ' then return True-                else impliesAny and_case x notx ps------------------------------------------------------ Syntax-Directed (Brainless) Translators  -------    scalExp <-> NNumExp                   ------- and negating a scalar expression         -------------------------------------------------------- negates an already simplified scalar expression,---   presumably more efficient than negating and---   then simplifying it.-negateSimplified :: ScalExp -> AlgSimplifyM ScalExp-negateSimplified (SNeg e) = return e-negateSimplified (SNot e) = return e-negateSimplified (SAbs e) = return $ SAbs e-negateSimplified (SSignum e) =-  SSignum <$> negateSimplified e-negateSimplified e@(Val v) = do-    m1 <- getNeg1 $ scalExpType e-    v' <- mulVals m1 v; return $ Val v'-negateSimplified e@Id{} = do-    m1 <- getNeg1 $ scalExpType e-    return $ STimes (Val m1) e-negateSimplified (SMinus e1 e2) = do -- return $ SMinus e2 e1-    e1' <- negateSimplified e1-    return $ SPlus e1' e2-negateSimplified (SPlus e1 e2) = do-    e1' <- negateSimplified e1-    e2' <- negateSimplified e2-    return $ SPlus e1' e2'-negateSimplified e@(SPow _ _) = do-    m1 <- getNeg1 $ scalExpType e-    return $ STimes (Val m1) e-negateSimplified (STimes  e1 e2) = do-    (e1', e2') <- helperNegateMult e1 e2; return $ STimes  e1' e2'-negateSimplified (SDiv e1 e2) = do-    (e1', e2') <- helperNegateMult e1 e2; return $ SDiv e1' e2'-negateSimplified (SMod e1 e2) =-    return $ SMod e1 e2-negateSimplified (SQuot e1 e2) = do-    (e1', e2') <- helperNegateMult e1 e2; return $ SQuot e1' e2'-negateSimplified (SRem e1 e2) =-    return $ SRem e1 e2-negateSimplified (MaxMin ismin ts) =-    MaxMin (not ismin) <$> mapM negateSimplified ts-negateSimplified (RelExp LEQ0 e) =-    RelExp LTH0 <$> negateSimplified e-negateSimplified (RelExp LTH0 e) =-    RelExp LEQ0 <$> negateSimplified e-negateSimplified SLogAnd{} = badAlgSimplifyM "negateSimplified: SLogAnd unimplemented!"-negateSimplified SLogOr{} = badAlgSimplifyM "negateSimplified: SLogOr  unimplemented!"--helperNegateMult :: ScalExp -> ScalExp -> AlgSimplifyM (ScalExp, ScalExp)-helperNegateMult e1 e2 =-    case (e1, e2) of-        (Val _,              _) -> do e1'<- negateSimplified e1;       return (e1', e2)-        (STimes (Val v) e1r, _) -> do ev <- negateSimplified (Val v);  return (STimes ev e1r, e2)-        (_,              Val _) -> do e2'<- negateSimplified e2;       return (e1, e2')-        (_, STimes (Val v) e2r) -> do ev <- negateSimplified (Val v);  return (e1, STimes ev e2r)-        (_,                  _) -> do e1'<- negateSimplified e1;       return (e1', e2)---toNumSofP :: ScalExp -> AlgSimplifyM NNumExp-toNumSofP e@(Val  _) = return $ NProd [e] $ scalExpType e-toNumSofP e@(Id _ _) = return $ NProd [e] $ scalExpType e-toNumSofP e@SDiv{} = return $ NProd [e] $ scalExpType e-toNumSofP e@SPow{} = return $ NProd [e] $ scalExpType e-toNumSofP (SMinus _ _) = badAlgSimplifyM "toNumSofP: SMinus is not in SofP form!"-toNumSofP (SNeg _) = badAlgSimplifyM "toNumSofP: SNeg is not in SofP form!"-toNumSofP (STimes e1 e2) = do-    e2' <- toNumSofP e2-    case e2' of-        NProd es2 t -> return $ NProd (e1:es2) t-        _ -> badAlgSimplifyM "toNumSofP: STimes nor in SofP form!"-toNumSofP (SPlus  e1 e2)   = do-    let t = scalExpType e1-    e1' <- toNumSofP  e1-    e2' <- toNumSofP  e2-    case (e1', e2') of-        (NSum es1 _, NSum es2 _) -> return $ NSum (es1++es2) t-        (NSum es1 _, NProd{}) -> return $ NSum (es1++[e2']) t-        (NProd{}, NSum es2 _) -> return $ NSum (e1':es2)    t-        (NProd{}, NProd{}   ) -> return $ NSum [e1', e2']   t-toNumSofP me@MaxMin{} =-  return $ NProd [me] $ scalExpType me-toNumSofP s_e = return $ NProd [s_e] $ scalExpType s_e---fromNumSofP :: NNumExp -> AlgSimplifyM ScalExp-fromNumSofP (NSum [ ] t) =-    Val <$> getZero t-fromNumSofP (NSum [f] _) = fromNumSofP f-fromNumSofP (NSum (f:fs) t) = do-    fs_e <- fromNumSofP $ NSum fs t-    f_e  <- fromNumSofP f-    return $ SPlus f_e fs_e-fromNumSofP (NProd [] _) =-  badAlgSimplifyM " In fromNumSofP, empty NProd expression! "-fromNumSofP (NProd [f] _)    = return f-fromNumSofP (NProd (f:fs) t) = do-    fs_e <- fromNumSofP $ NProd fs t-    return $ STimes f fs_e---fromNumSofP _ = do---    pos <- asks pos---    badAlgSimplifyM "fromNumSofP: unimplemented!"----------------------------------------------------------------- Helpers for simplifyScal: getTerms, getMultChildren, -------   splitTerm, joinTerm, discriminate------------------------------------------------------------------ get the list of terms of an expression--- BUG for NMinMax -> should convert it back to a ScalExp-getTerms :: NNumExp -> [NNumExp]-getTerms (NSum es _) = es-getTerms e@NProd{} = [e]---- get the factors of a term-getMultChildren :: NNumExp -> AlgSimplifyM [ScalExp]-getMultChildren (NSum _ _) = badAlgSimplifyM "getMultChildren, NaryPlus should not be nested 2 levels deep "-getMultChildren (NProd xs _) = return xs---- split a term into a (multiplicative) value and the rest of the factors.-splitTerm :: NNumExp -> AlgSimplifyM (NNumExp, PrimValue)-splitTerm (NProd [ ] _) = badAlgSimplifyM "splitTerm: Empty n-ary list of factors."-splitTerm (NProd [f] tp) = do-  one <- getPos1 tp-  case f of-      (Val v) -> return (NProd [Val one] tp, v  )-      e       -> return (NProd [e]       tp, one)-splitTerm ne@(NProd (f:fs) tp) =-  case f of-      (Val v) -> return (NProd fs tp, v)-      _       -> do one <- getPos1 tp-                    return (ne, one)-splitTerm e = do-  one <- getPos1 (typeOfNAlg e)-  return (e, one)---- join a value with a list of factors into a term.-joinTerm :: (NNumExp, PrimValue) -> AlgSimplifyM NNumExp-joinTerm ( NSum _ _, _) = badAlgSimplifyM "joinTerm: NaryPlus two levels deep."-joinTerm ( NProd [] _, _) = badAlgSimplifyM "joinTerm: Empty NaryProd."-joinTerm ( NProd (Val l:fs) tp, v) = do-    v' <- mulVals v l-    let v'Lit = Val v'-    return $ NProd (v'Lit:sort fs) tp-joinTerm ( e@(NProd fs tp), v)-  | P.oneIsh v   = return e-  | otherwise = let vExp = Val v-                in return $ NProd (vExp:sort fs) tp---- adds up the values corresponding to identical factors!-discriminate :: [(NNumExp, PrimValue)] -> (NNumExp, PrimValue) -> AlgSimplifyM [(NNumExp, PrimValue)]-discriminate []          e        = return [e]-discriminate e@((k,v):t) (k', v') =-  if k == k'-  then do v'' <- addVals v v'-          return ( (k, v'') : t )-  else return ( (k', v') : e )------------------------------------------------------------ Trivial Utility Functions                      ------------------------------------------------------------getZero :: PrimType -> AlgSimplifyM PrimValue-getZero (IntType t)     = return $ value $ intValue t (0::Int)-getZero tp      = badAlgSimplifyM ("getZero for type: "++pretty tp)--getPos1 :: PrimType -> AlgSimplifyM PrimValue-getPos1 (IntType t)     = return $ value $ intValue t (1::Int)-getPos1 tp      = badAlgSimplifyM ("getOne for type: "++pretty tp)--getNeg1 :: PrimType -> AlgSimplifyM PrimValue-getNeg1 (IntType t)     = return $ value $ intValue t (-1::Int)-getNeg1 tp      = badAlgSimplifyM ("getOne for type: "++pretty tp)--valLTHEQ0 :: RelOp0 -> PrimValue -> AlgSimplifyM Bool-valLTHEQ0 LEQ0 (IntValue iv) = return $ P.intToInt64 iv <= 0-valLTHEQ0 LTH0 (IntValue iv) = return $ P.intToInt64 iv < 0-valLTHEQ0 _ _ = badAlgSimplifyM "valLTHEQ0 for non-numeric type!"--isCt1 :: ScalExp -> Bool-isCt1 (Val v) = P.oneIsh v-isCt1 _ = False--isCt0 :: ScalExp -> Bool-isCt0 (Val v) = P.zeroIsh v-isCt0 _       = False---addVals :: PrimValue -> PrimValue -> AlgSimplifyM PrimValue-addVals (IntValue v1) (IntValue v2) =-  return $ IntValue $ P.doAdd v1 v2-addVals _ _ =-  badAlgSimplifyM "addVals: operands not of (the same) numeral type! "--mulVals :: PrimValue -> PrimValue -> AlgSimplifyM PrimValue-mulVals (IntValue v1) (IntValue v2) =-  return $ IntValue $ P.doMul v1 v2-mulVals v1 v2 =-  badAlgSimplifyM $ "mulVals: operands not of (the same) numeral type! "++-  pretty v1++" "++pretty v2--divVals :: PrimValue -> PrimValue -> AlgSimplifyM PrimValue-divVals (IntValue v1) (IntValue v2) =-  case P.doSDiv v1 v2 of-    Just v -> return $ IntValue v-    Nothing -> badAlgSimplifyM "Division by zero"-divVals _ _ =-  badAlgSimplifyM "divVals: operands not of (the same) numeral type! "--canDivValsEvenly :: PrimValue -> PrimValue -> AlgSimplifyM Bool-canDivValsEvenly (IntValue v1) (IntValue v2) =-  case P.doSMod v1 v2 of-    Just v -> return $ P.zeroIsh $ IntValue v-    Nothing -> return False-canDivValsEvenly _ _ =-  badAlgSimplifyM "canDivValsEvenly: operands not of (the same) numeral type!"---------------------------------------------------------------------------------------------------------------------------------- Helpers for the ScalExp and NNumRelLogExp Datatypes ----------------------------------------------------------------------------------------------------------------------------------typeOfNAlg :: NNumExp -> PrimType-typeOfNAlg (NSum   _   t) = t-typeOfNAlg (NProd  _   t) = t----------------------------------------------- Helpers for Division and Power ----------------------------------------------trySimplifyDivRec :: [ScalExp] -> [ScalExp] -> [(NNumExp, PrimValue)] ->-                     AlgSimplifyM ([ScalExp], [(NNumExp, PrimValue)])-trySimplifyDivRec [] fs' spl_terms =-    return (fs', spl_terms)-trySimplifyDivRec (f:fs) fs' spl_terms = do-    res_tmp <- mapM (tryDivProdByOneFact f) spl_terms-    let (succs, spl_terms') = unzip res_tmp-    if all (==True) succs-    then trySimplifyDivRec fs fs' spl_terms'-    else trySimplifyDivRec fs (fs'++[f]) spl_terms---tryDivProdByOneFact :: ScalExp -> (NNumExp, PrimValue) -> AlgSimplifyM (Bool, (NNumExp, PrimValue))-tryDivProdByOneFact (Val f) (e, v) = do-    succc <- canDivValsEvenly v f-    if succc then do vres <- divVals v f-                     return (True, (e, vres))-             else return (False,(e, v) )--tryDivProdByOneFact _ pev@(NProd [] _, _) = return (False, pev)-tryDivProdByOneFact f pev@(NProd (t:tfs) tp, v) = do-    (succc, newt) <- tryDivTriv t f-    one <- getPos1 tp-    if not succc-    then do (succ', (tfs', v')) <- tryDivProdByOneFact f (NProd tfs tp, v)-            case (succ', tfs') of-                (True,  NProd (Val vv:tfs'') _) -> do-                                    vres <- mulVals v' vv-                                    return (True, (NProd (t:tfs'') tp, vres))-                (True,  NProd tfs'' _) -> return (True, (NProd (t:tfs'') tp, v'))-                (_, _) -> return (False, pev)-    else case (newt, tfs) of-           (Val vv, _) -> do vres <- mulVals vv v-                             return $ if null tfs-                                      then (True, (NProd [Val one] tp, vres))-                                      else (True, (NProd tfs tp, vres))-           (_,      _) -> return (True, (NProd (newt:tfs) tp, v))--tryDivProdByOneFact _ (NSum _ _, _) =-  badAlgSimplifyM "tryDivProdByOneFact: unreachable case NSum reached!"---tryDivTriv :: ScalExp -> ScalExp -> AlgSimplifyM (Bool, ScalExp)-tryDivTriv (SPow a e1) (SPow d e2)-    | a == d && e1 == e2 = do one <- getPos1 $ scalExpType a-                              return (True, Val one)-    | a == d = do-          let tp = scalExpType a-          one <- getPos1 tp-          e1me2 <- simplifyScal $ SMinus e1 e2-          case (tp, e1me2) of-            (IntType _, Val v) | P.zeroIsh v ->-              return (True, Val one)-            (IntType _, Val v) | P.oneIsh v ->-              return (True, a)-            (IntType _, _) -> do-              e2me1 <- negateSimplified e1me2-              e2me1_sop <- toNumSofP e2me1-              p' <- simplifyNRel $ NRelExp LTH0 e2me1_sop-              return $ if p' == LogCt True-                       then (True,  SPow a e1me2)-                       else (False, SDiv (SPow a e1) (SPow d e2))--            (_, _) -> return (False, SDiv (SPow a e1) (SPow d e2))--    | otherwise = return (False, SDiv (SPow a e1) (SPow d e2))--tryDivTriv (SPow a e1) b-    | a == b = do one <- getPos1 $ scalExpType a-                  tryDivTriv (SPow a e1) (SPow a (Val one))-    | otherwise = return (False, SDiv (SPow a e1) b)--tryDivTriv b (SPow a e1)-    | a == b = do one <- getPos1 $ scalExpType a-                  tryDivTriv (SPow a (Val one)) (SPow a e1)-    | otherwise = return (False, SDiv b (SPow a e1))--tryDivTriv t f-    | t == f    = do one <- getPos1 $ scalExpType t-                     return (True,  Val one)-    | otherwise = return (False, SDiv t f)---{--mkRelExp :: Int -> (RangesRep, ScalExp, ScalExp)-mkRelExp 1 =-    let (i',j',n',p',m') = (tident "int i", tident "int j", tident "int n", tident "int p", tident "int m")-        (i,j,n,p,m) = (Id i', Id j', Id n', Id p', Id m')-        one = Val (IntVal 1)-        min_p_nm1 = MaxMin True [p, SMinus n one]-        hash = M.fromList $ [ (identName n', ( 1::Int, Just (Val (IntVal 1)), Nothing ) ),-                               (identName p', ( 1::Int, Just (Val (IntVal 0)), Nothing ) ),-                               (identName i', ( 5::Int, Just (Val (IntVal 0)), Just min_p_nm1 ) )-                             , (identName j', ( 9::Int, Just (Val (IntVal 0)), Just i ) )-                             ] -- M.Map VName (Int, Maybe ScalExp, Maybe ScalExp)-        ij_p_j_p_1_m_m = SMinus (SPlus (STimes i j) (SPlus j one)) m-        rel1 = RelExp LTH0 ij_p_j_p_1_m_m-        m_ij_m_j_m_2 = SNeg ( SPlus (STimes i j) (SPlus j (Val (IntVal 2))) )-        rel2 = RelExp LTH0 m_ij_m_j_m_2--    in (hash, rel1, rel2)-mkRelExp 2 =-    let (i',a',b',l',u') = (tident "int i", tident "int a", tident "int b", tident "int l", tident "int u")-        (i,a,b,l,u) = (Id i', Id a', Id b', Id l', Id u')-        hash = M.fromList $ [ (identName i', ( 5::Int, Just l, Just u ) ) ]-        ai_p_b = SPlus (STimes a i) b-        rel1 = RelExp LTH0 ai_p_b--    in (hash, rel1, rel1)-mkRelExp 3 =-    let (i',j',n',m') = (tident "int i", tident "int j", tident "int n", tident "int m")-        (i,j,n,m) = (Id i', Id j', Id n', Id m')-        one = Val (IntVal 1)-        two = Val (IntVal 2)-        min_j_nm1 = MaxMin True [MaxMin False [Val (IntVal 0), SMinus i (STimes two n)], SMinus n one]-        hash = M.fromList $ [ (identName n', ( 1::Int, Just (Val (IntVal 1)), Nothing ) ),-                               (identName m', ( 2::Int, Just (Val (IntVal 1)), Nothing ) ),-                               (identName i', ( 5::Int, Just (Val (IntVal 0)), Just (SMinus m one) ) )-                             , (identName j', ( 9::Int, Just (Val (IntVal 0)), Just min_j_nm1 ) )-                             ] -- M.Map VName (Int, Maybe ScalExp, Maybe ScalExp)-        ij_m_m = SMinus (STimes i j) m-        rel1 = RelExp LTH0 ij_m_m---        rel3 = RelExp LTH0 (SMinus i (SPlus (STimes two n) j))-        m_ij_m_1 = SMinus (Val (IntVal (-1))) (STimes i j)-        rel2 = RelExp LTH0 m_ij_m_1----        simpl_exp = SDiv (MaxMin True [SMinus (Val (IntVal 0)) (STimes i j), SNeg (STimes i n) ])---                         (STimes i j)---        rel4 = RelExp LTH0 simpl_exp--    in (hash, rel1, rel2)--mkRelExp _ = let hash = M.empty-                 rel = RelExp LTH0 (Val (IntVal (-1)))-             in (hash, rel, rel)--}

@@ -33,8 +33,8 @@  analyseFun :: (ASTLore lore, CanBeAliased (Op lore)) =>               FunDef lore -> FunDef (Aliases lore)-analyseFun (FunDef entry fname restype params body) =-  FunDef entry fname restype params body'+analyseFun (FunDef entry attrs fname restype params body) =+  FunDef entry attrs fname restype params body'   where body' = analyseBody mempty body  -- | Pre-existing aliases for variables.  Used to add transitive@@ -62,7 +62,7 @@ analyseStm aliases (Let pat (StmAux cs attrs dec) e) =   let e' = analyseExp aliases e       pat' = addAliasesToPattern pat e'-      lore' = (Names' $ consumedInExp e', dec)+      lore' = (AliasDec $ consumedInExp e', dec)   in Let pat' (StmAux cs attrs lore') e'  analyseExp :: (ASTLore lore, CanBeAliased (Op lore)) =>@@ -74,11 +74,11 @@   let Body ((tb_als, tb_cons), tb_dec) tb_stms tb_res = analyseBody aliases tb       Body ((fb_als, fb_cons), fb_dec) fb_stms fb_res = analyseBody aliases fb       cons = tb_cons <> fb_cons-      isConsumed v = any (`nameIn` unNames cons) $+      isConsumed v = any (`nameIn` unAliases cons) $                      v : namesToList (M.findWithDefault mempty v aliases)-      notConsumed = Names' . namesFromList .+      notConsumed = AliasDec . namesFromList .                     filter (not . isConsumed) .-                    namesToList . unNames+                    namesToList . unAliases       tb_als' = map notConsumed tb_als       fb_als' = map notConsumed fb_als       tb' = Body ((tb_als', tb_cons), tb_dec) tb_stms tb_res

@@ -96,10 +96,12 @@                                     return body           } --- | The set of all functions that are called noinline somewhere.+-- | The set of all functions that are called noinline somewhere, or+-- have a noinline attribute on their definition. findNoninlined :: Prog SOACS -> S.Set Name findNoninlined prog =-  foldMap onStm $ foldMap (bodyStms . funDefBody) (progFuns prog) <> progConsts prog+  foldMap noinlineDef (progFuns prog) <>+  foldMap onStm (foldMap (bodyStms . funDefBody) (progFuns prog) <> progConsts prog)   where onStm :: Stm -> S.Set Name         onStm (Let _ aux (Apply fname _ _ _))           | "noinline" `inAttrs` stmAuxAttrs aux =@@ -116,3 +118,9 @@                                   return lam                               }                   }++        noinlineDef fd+          | "noinline" `inAttrs` funDefAttrs fd =+              S.singleton $ funDefName fd+          | otherwise =+              mempty

@@ -131,7 +131,6 @@ primOpMetrics Manifest{} = seen "Manifest" primOpMetrics Iota{} = seen "Iota" primOpMetrics Replicate{} = seen "Replicate"-primOpMetrics Repeat{} = seen "Repeat" primOpMetrics Scratch{} = seen "Scratch" primOpMetrics Reshape{} = seen "Reshape" primOpMetrics Rearrange{} = seen "Rearrange"

@@ -184,18 +184,24 @@   fromRational = ValueExp . FloatValue . Float64Value . fromRational  instance Pretty v => IntegralExp (PrimExp v) where-  x `div` y | Just z <- msum [asIntOp SDiv x y, asFloatOp FDiv x y] = constFoldPrimExp z+  x `div` y | Just z <- msum [asIntOp (`SDiv` Unsafe) x y,+                              asFloatOp FDiv x y] =+                constFoldPrimExp z             | otherwise = numBad "div" (x,y) -  x `mod` y | Just z <- msum [asIntOp SMod x y] = z+  x `mod` y | Just z <- msum [asIntOp (`SMod` Unsafe) x y] = z             | otherwise = numBad "mod" (x,y)    x `quot` y | oneIshExp y = x-             | Just z <- msum [asIntOp SQuot x y] = constFoldPrimExp z+             | Just z <- msum [asIntOp (`SQuot` Unsafe) x y] = constFoldPrimExp z              | otherwise = numBad "quot" (x,y) -  x `rem` y | Just z <- msum [asIntOp SRem x y] = constFoldPrimExp z+  x `rem` y | Just z <- msum [asIntOp (`SRem` Unsafe) x y] = constFoldPrimExp z             | otherwise = numBad "rem" (x,y)++  x `divUp` y | Just z <- msum [asIntOp (`SDivUp` Unsafe) x y] =+                  constFoldPrimExp z+              | otherwise = numBad "divRoundingUp" (x,y)    sgn (ValueExp (IntValue i)) = Just $ signum $ valueIntegral i   sgn _ = Nothing

@@ -9,6 +9,8 @@   , replaceInPrimExp   , replaceInPrimExpM   , substituteInPrimExp+  , primExpSlice+  , subExpSlice      -- * Module reexport     , module Futhark.Analysis.PrimExp@@ -103,3 +105,11 @@                     -> PrimExp v -> PrimExp v substituteInPrimExp tab = replaceInPrimExp $ \v t ->   fromMaybe (LeafExp v t) $ M.lookup v tab++-- | Convert a 'SubExp' slice to a 'PrimExp' slice.+primExpSlice :: Slice SubExp -> Slice (PrimExp VName)+primExpSlice = map $ fmap $ primExpFromSubExp int32++-- | Convert a 'PrimExp' slice to a 'SubExp' slice.+subExpSlice :: MonadBinder m => Slice (PrimExp VName) -> m (Slice SubExp)+subExpSlice = mapM $ traverse $ toSubExp "slice"

@@ -4,63 +4,62 @@     leastGeneralGeneralization   ) where -import           Control.Monad import           Data.List (elemIndex) - import           Futhark.Analysis.PrimExp import           Futhark.IR.Syntax.Core (Ext(..))  -- | Generalize two 'PrimExp's of the the same type. leastGeneralGeneralization :: (Eq v) => [(PrimExp v, PrimExp v)] -> PrimExp v -> PrimExp v ->-                              Maybe (PrimExp (Ext v), [(PrimExp v, PrimExp v)])+                              (PrimExp (Ext v), [(PrimExp v, PrimExp v)]) leastGeneralGeneralization m exp1@(LeafExp v1 t1) exp2@(LeafExp v2 _) =   if v1 == v2 then-    Just (LeafExp (Free v1) t1, m)+    (LeafExp (Free v1) t1, m)   else-    Just $ generalize m exp1 exp2+    generalize m exp1 exp2 leastGeneralGeneralization m exp1@(ValueExp v1) exp2@(ValueExp v2) =   if v1 == v2 then-    Just (ValueExp v1, m)+    (ValueExp v1, m)   else-    Just $ generalize m exp1 exp2+    generalize m exp1 exp2 leastGeneralGeneralization m exp1@(BinOpExp op1 e11 e12) exp2@(BinOpExp op2 e21 e22) =-  if op1 == op2 then do-    (e1, m1) <- leastGeneralGeneralization m e11 e21-    (e2, m2) <- leastGeneralGeneralization m1 e12 e22-    return (BinOpExp op1 e1 e2, m2)+  if op1 == op2 then+    let (e1, m1) = leastGeneralGeneralization m e11 e21+        (e2, m2) = leastGeneralGeneralization m1 e12 e22+    in (BinOpExp op1 e1 e2, m2)   else-    Just $ generalize m exp1 exp2+    generalize m exp1 exp2 leastGeneralGeneralization m exp1@(CmpOpExp op1 e11 e12) exp2@(CmpOpExp op2 e21 e22) =-  if op1 == op2 then do-    (e1, m1) <- leastGeneralGeneralization m e11 e21-    (e2, m2) <- leastGeneralGeneralization m1 e12 e22-    return (CmpOpExp op1 e1 e2, m2)+  if op1 == op2 then+    let (e1, m1) = leastGeneralGeneralization m e11 e21+        (e2, m2) = leastGeneralGeneralization m1 e12 e22+    in (CmpOpExp op1 e1 e2, m2)   else-    Just $ generalize m exp1 exp2+    generalize m exp1 exp2 leastGeneralGeneralization m exp1@(UnOpExp op1 e1) exp2@(UnOpExp op2 e2) =-  if op1 == op2 then do-    (e, m1) <- leastGeneralGeneralization m e1 e2-    return (UnOpExp op1 e, m1)+  if op1 == op2 then+    let (e, m1) = leastGeneralGeneralization m e1 e2+    in (UnOpExp op1 e, m1)   else-    Just $ generalize m exp1 exp2+    generalize m exp1 exp2 leastGeneralGeneralization m exp1@(ConvOpExp op1 e1) exp2@(ConvOpExp op2 e2) =-  if op1 == op2 then do-    (e, m1) <- leastGeneralGeneralization m e1 e2-    return (ConvOpExp op1 e, m1)+  if op1 == op2 then+    let (e, m1) = leastGeneralGeneralization m e1 e2+    in (ConvOpExp op1 e, m1)   else-    Just $ generalize m exp1 exp2+    generalize m exp1 exp2 leastGeneralGeneralization m exp1@(FunExp s1 args1 t1) exp2@(FunExp s2 args2 _) =-  if s1 == s2 && length args1 == length args2 then do-    (args, m') <- foldM (\(arg_acc, m_acc) (a1, a2) -> do-                            (a, m'') <- leastGeneralGeneralization m_acc a1 a2-                            return (a : arg_acc, m'')-                        ) ([], m) (zip args1 args2)-    return (FunExp s1 (reverse args) t1, m')+  if s1 == s2 && length args1 == length args2 then+    let (args, m') =+          foldl (\(arg_acc, m_acc) (a1, a2) ->+                    let (a, m'') = leastGeneralGeneralization m_acc a1 a2+                    in  (a : arg_acc, m'')+                ) ([], m) (zip args1 args2)+    in (FunExp s1 (reverse args) t1, m')   else-    Just $ generalize m exp1 exp2+    generalize m exp1 exp2 leastGeneralGeneralization m exp1 exp2 =-  Just $ generalize m exp1 exp2+  generalize m exp1 exp2  generalize :: Eq v => [(PrimExp v, PrimExp v)] -> PrimExp v -> PrimExp v -> (PrimExp (Ext v), [(PrimExp v, PrimExp v)]) generalize m exp1 exp2 =

@@ -1,216 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--- | Perform range analysis of a program or other fragment.-module Futhark.Analysis.Range-       ( rangeAnalysis-       , runRangeM-       , RangeM-       , analyseLambda-       , analyseStms-       )-       where--import qualified Data.Map.Strict as M-import Control.Monad.Reader-import Data.List (nub)--import qualified Futhark.Analysis.ScalExp as SE-import Futhark.IR.Ranges-import Futhark.Analysis.AlgSimplify as AS---- Entry point---- | Perform variable range analysis on the given program, returning a--- program with embedded range annotations.-rangeAnalysis :: (ASTLore lore, CanBeRanged (Op lore)) =>-                 Prog lore -> Prog (Ranges lore)-rangeAnalysis (Prog consts funs) =-  Prog (runRangeM $ mapM analyseStm consts) (map analyseFun funs)---- Implementation--analyseFun :: (ASTLore lore, CanBeRanged (Op lore)) =>-              FunDef lore -> FunDef (Ranges lore)-analyseFun (FunDef entry fname restype params body) =-  runRangeM $ bindFunParams params $-  FunDef entry fname restype params <$> analyseBody body--analyseBody :: (ASTLore lore, CanBeRanged (Op lore)) =>-               Body lore-            -> RangeM (Body (Ranges lore))-analyseBody (Body lore origbnds result) =-  analyseStms origbnds $ \bnds' ->-    return $ mkRangedBody lore bnds' result---- | Perform range analysis on some statements, taking a continuation--- where the ranges of the variables bound by the statements is--- in scope.-analyseStms :: (ASTLore lore, CanBeRanged (Op lore)) =>-               Stms lore-            -> (Stms (Ranges lore) -> RangeM a)-            -> RangeM a-analyseStms = analyseStms' mempty . stmsToList-  where analyseStms' acc [] m =-          m acc-        analyseStms' acc (bnd:bnds) m = do-          bnd' <- analyseStm bnd-          bindPattern (stmPattern bnd') $-            analyseStms' (acc <> oneStm bnd') bnds m--analyseStm :: (ASTLore lore, CanBeRanged (Op lore)) =>-              Stm lore -> RangeM (Stm (Ranges lore))-analyseStm (Let pat lore e) = do-  e' <- analyseExp e-  pat' <- simplifyPatRanges $ addRangesToPattern pat e'-  return $ Let pat' lore e'--analyseExp :: (ASTLore lore, CanBeRanged (Op lore)) =>-              Exp lore-           -> RangeM (Exp (Ranges lore))-analyseExp = mapExpM analyse-  where analyse =-          Mapper { mapOnSubExp = return-                 , mapOnVName = return-                 , mapOnBody = const analyseBody-                 , mapOnRetType = return-                 , mapOnBranchType = return-                 , mapOnFParam = return-                 , mapOnLParam = return-                 , mapOnOp = return . addOpRanges-                 }---- | Perform range analysis on a lambda.-analyseLambda :: (ASTLore lore, CanBeRanged (Op lore)) =>-                 Lambda lore-              -> RangeM (Lambda (Ranges lore))-analyseLambda lam = do-  body <- analyseBody $ lambdaBody lam-  return $ lam { lambdaBody = body-               , lambdaParams = lambdaParams lam-               }---- Monad and utility definitions--type RangeEnv = M.Map VName Range--emptyRangeEnv :: RangeEnv-emptyRangeEnv = M.empty---- | The range analysis monad.-type RangeM = Reader RangeEnv---- | Run a 'RangeM' action.-runRangeM :: RangeM a -> a-runRangeM = flip runReader emptyRangeEnv--bindFunParams :: Typed dec => [Param dec] -> RangeM a -> RangeM a-bindFunParams []             m =-  m-bindFunParams (param:params) m = do-  ranges <- rangesRep-  local bindFunParam $-    local (refineDimensionRanges ranges dims) $-    bindFunParams params m-  where bindFunParam = M.insert (paramName param) unknownRange-        dims = arrayDims $ paramType param--bindPattern :: Typed dec => PatternT (Range, dec) -> RangeM a -> RangeM a-bindPattern pat m = do-  ranges <- rangesRep-  local bindPatElems $-    local (refineDimensionRanges ranges dims)-    m-  where bindPatElems env =-          foldl bindPatElem env $ patternElements pat-        bindPatElem env patElem =-          M.insert (patElemName patElem) (fst $ patElemDec patElem) env-        dims = nub $ concatMap arrayDims $ patternTypes pat--refineDimensionRanges :: AS.RangesRep -> [SubExp]-                      -> RangeEnv -> RangeEnv-refineDimensionRanges ranges = flip $ foldl refineShape-  where refineShape env (Var dim) =-          refineRange ranges dim dimBound env-        refineShape env _ =-          env-        -- A dimension is never negative.-        dimBound :: Range-        dimBound = (Just $ ScalarBound 0,-                    Nothing)--refineRange :: AS.RangesRep -> VName -> Range -> RangeEnv-            -> RangeEnv-refineRange =-  M.insertWith . refinedRange---- New range, old range, result range.-refinedRange :: AS.RangesRep -> Range -> Range -> Range-refinedRange ranges (new_lower, new_upper) (old_lower, old_upper) =-  (simplifyBound ranges $ refineLowerBound new_lower old_lower,-   simplifyBound ranges $ refineUpperBound new_upper old_upper)---- New bound, old bound, result bound.-refineLowerBound :: Bound -> Bound -> Bound-refineLowerBound = flip maximumBound---- New bound, old bound, result bound.-refineUpperBound :: Bound -> Bound -> Bound-refineUpperBound = flip minimumBound--lookupRange :: VName -> RangeM Range-lookupRange = asks . M.findWithDefault unknownRange--simplifyPatRanges :: PatternT (Range, dec)-                  -> RangeM (PatternT (Range, dec))-simplifyPatRanges (Pattern context values) =-  Pattern <$> mapM simplifyPatElemRange context <*> mapM simplifyPatElemRange values-  where simplifyPatElemRange patElem = do-          let (range, innerdec) = patElemDec patElem-          range' <- simplifyRange range-          return $ setPatElemLore patElem (range', innerdec)--simplifyRange :: Range -> RangeM Range-simplifyRange (lower, upper) = do-  ranges <- rangesRep-  lower' <- simplifyBound ranges <$> betterLowerBound lower-  upper' <- simplifyBound ranges <$> betterUpperBound upper-  return (lower', upper')--simplifyBound :: AS.RangesRep -> Bound -> Bound-simplifyBound ranges = fmap $ simplifyKnownBound ranges--simplifyKnownBound :: AS.RangesRep -> KnownBound -> KnownBound-simplifyKnownBound ranges bound-  | Just se <- boundToScalExp bound =-    ScalarBound $ AS.simplify se ranges-simplifyKnownBound ranges (MinimumBound b1 b2) =-  MinimumBound (simplifyKnownBound ranges b1) (simplifyKnownBound ranges b2)-simplifyKnownBound ranges (MaximumBound b1 b2) =-  MaximumBound (simplifyKnownBound ranges b1) (simplifyKnownBound ranges b2)-simplifyKnownBound _ bound =-  bound--betterLowerBound :: Bound -> RangeM Bound-betterLowerBound (Just (ScalarBound (SE.Id v t))) = do-  range <- lookupRange v-  return $ Just $ case range of-    (Just lower, _) -> lower-    _               -> ScalarBound $ SE.Id v t-betterLowerBound bound =-  return bound--betterUpperBound :: Bound -> RangeM Bound-betterUpperBound (Just (ScalarBound (SE.Id v t))) = do-  range <- lookupRange v-  return $ Just $ case range of-    (_, Just upper) -> upper-    _               -> ScalarBound $ SE.Id v t-betterUpperBound bound =-  return bound---- The algebraic simplifier requires a loop nesting level for each--- range.  We just put a zero because I don't think it's used for--- anything in this case.-rangesRep :: RangeM AS.RangesRep-rangesRep = asks $ M.map addLeadingZero-  where addLeadingZero (x,y) =-          (0, boundToScalExp =<< x, boundToScalExp =<< y)