futhark 0.11.2 → 0.12.1

raw patch · 149 files changed

+10430/−9246 lines, 149 filesdep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• docs/Makefile +177/−0
• docs/conf.py +321/−0
• docs/index.rst +57/−0
• docs/man/futhark-bench.rst +131/−0
• docs/man/futhark-c.rst +60/−0
• docs/man/futhark-csharp.rst +65/−0
• docs/man/futhark-csopencl.rst +69/−0
• docs/man/futhark-cuda.rst +61/−0
• docs/man/futhark-dataset.rst +87/−0
• docs/man/futhark-doc.rst +66/−0
• docs/man/futhark-opencl.rst +58/−0
• docs/man/futhark-pkg.rst +167/−0
• docs/man/futhark-pyopencl.rst +69/−0
• docs/man/futhark-python.rst +63/−0
• docs/man/futhark-repl.rst +42/−0
• docs/man/futhark-run.rst +53/−0
• docs/man/futhark-test.rst +224/−0
• docs/man/futhark.rst +57/−0
• futhark.cabal +25/−7
• futlib/math.fut +27/−31
• futlib/soacs.fut +12/−12
• package.yaml +118/−0
• rts/csharp/reader.cs +6/−1
• rts/python/__init__.py +0/−0
• rts/python/values.py +1/−1
• src/Futhark/Analysis/AlgSimplify.hs +5/−5
• src/Futhark/Analysis/CallGraph.hs +3/−3
• src/Futhark/Analysis/DataDependencies.hs +8/−9
• src/Futhark/Analysis/HORepresentation/MapNest.hs +1/−3
• src/Futhark/Analysis/PrimExp.hs +25/−9
• src/Futhark/Analysis/Range.hs +2/−4
• src/Futhark/Analysis/Rephrase.hs +1/−1
• src/Futhark/Analysis/ScalExp.hs +19/−20
• src/Futhark/Analysis/SymbolTable.hs +49/−22
• src/Futhark/Analysis/Usage.hs +6/−7
• src/Futhark/Analysis/UsageTable.hs +4/−4
• src/Futhark/Binder.hs +17/−1
• src/Futhark/CLI/Bench.hs +7/−5
• src/Futhark/CLI/Dataset.hs +1/−1
• src/Futhark/CLI/Dev.hs +1/−1
• src/Futhark/CLI/Test.hs +28/−10
• src/Futhark/CodeGen/Backends/COpenCL.hs +1/−1
• src/Futhark/CodeGen/Backends/GenericC.hs +1/−1
• src/Futhark/CodeGen/Backends/GenericCSharp.hs +1/−0
• src/Futhark/CodeGen/Backends/GenericCSharp/AST.hs +1/−0
• src/Futhark/CodeGen/ImpCode.hs +57/−65
• src/Futhark/CodeGen/ImpCode/Kernels.hs +36/−35
• src/Futhark/CodeGen/ImpCode/OpenCL.hs +1/−1
• src/Futhark/CodeGen/ImpCode/Sequential.hs +1/−1
• src/Futhark/CodeGen/ImpGen.hs +19/−23
• src/Futhark/CodeGen/ImpGen/Kernels.hs +18/−47
• src/Futhark/CodeGen/ImpGen/Kernels/Base.hs +380/−418
• src/Futhark/CodeGen/ImpGen/Kernels/SegGenRed.hs +77/−73
• src/Futhark/CodeGen/ImpGen/Kernels/SegMap.hs +47/−12
• src/Futhark/CodeGen/ImpGen/Kernels/SegRed.hs +118/−110
• src/Futhark/CodeGen/ImpGen/Kernels/SegScan.hs +39/−42
• src/Futhark/CodeGen/ImpGen/Kernels/ToOpenCL.hs +30/−9
• src/Futhark/CodeGen/ImpGen/Kernels/Transpose.hs +2/−4
• src/Futhark/CodeGen/SetDefaultSpace.hs +5/−9
• src/Futhark/Compiler.hs +1/−1
• src/Futhark/Construct.hs +19/−56
• src/Futhark/Doc/Generator.hs +19/−38
• src/Futhark/Internalise.hs +167/−137
• src/Futhark/Internalise/Bindings.hs +2/−0
• src/Futhark/Internalise/Defunctionalise.hs +75/−25
• src/Futhark/Internalise/Lambdas.hs +1/−2
• src/Futhark/Internalise/Monad.hs +3/−3
• src/Futhark/Internalise/Monomorphise.hs +61/−36
• src/Futhark/Internalise/TypesValues.hs +41/−21
• src/Futhark/MonadFreshNames.hs +0/−6
• src/Futhark/Optimise/CSE.hs +10/−33
• src/Futhark/Optimise/DoubleBuffer.hs +47/−91
• src/Futhark/Optimise/Fusion.hs +55/−54
• src/Futhark/Optimise/Fusion/Composing.hs +4/−5
• src/Futhark/Optimise/Fusion/LoopKernel.hs +7/−7
• src/Futhark/Optimise/InPlaceLowering.hs +10/−21
• src/Futhark/Optimise/InPlaceLowering/LowerIntoStm.hs +17/−23
• src/Futhark/Optimise/InPlaceLowering/SubstituteIndices.hs +1/−2
• src/Futhark/Optimise/InliningDeadFun.hs +22/−14
• src/Futhark/Optimise/Simplify/ClosedForm.hs +3/−5
• src/Futhark/Optimise/Simplify/Engine.hs +63/−81
• src/Futhark/Optimise/Simplify/Lore.hs +7/−7
• src/Futhark/Optimise/Simplify/Rule.hs +35/−29
• src/Futhark/Optimise/Simplify/Rules.hs +79/−83
• src/Futhark/Optimise/TileLoops.hs +914/−389
• src/Futhark/Optimise/TileLoops/RegTiling3D.hs +0/−736
• src/Futhark/Optimise/Unstream.hs +25/−59
• src/Futhark/Pass/ExpandAllocations.hs +191/−207
• src/Futhark/Pass/ExplicitAllocations.hs +122/−292
• src/Futhark/Pass/ExtractKernels.hs +719/−1538
• src/Futhark/Pass/ExtractKernels/BlockedKernel.hs +208/−147
• src/Futhark/Pass/ExtractKernels/DistributeNests.hs +915/−0
• src/Futhark/Pass/ExtractKernels/Distribution.hs +55/−65
• src/Futhark/Pass/ExtractKernels/Interchange.hs +1/−2
• src/Futhark/Pass/ExtractKernels/Intragroup.hs +142/−200
• src/Futhark/Pass/ExtractKernels/Kernelise.hs +0/−283
• src/Futhark/Pass/FirstOrderTransform.hs +6/−6
• src/Futhark/Pass/KernelBabysitting.hs +39/−57
• src/Futhark/Pass/ResolveAssertions.hs +1/−1
• src/Futhark/Passes.hs +5/−24
• src/Futhark/Pkg/Solve.hs +1/−1
• src/Futhark/Pkg/Types.hs +1/−1
• src/Futhark/Representation/AST/Attributes/Aliases.hs +7/−8
• src/Futhark/Representation/AST/Attributes/Names.hs +162/−75
• src/Futhark/Representation/AST/Attributes/Patterns.hs +3/−3
• src/Futhark/Representation/AST/Attributes/Ranges.hs +6/−8
• src/Futhark/Representation/AST/Attributes/Scope.hs +2/−3
• src/Futhark/Representation/AST/Attributes/TypeOf.hs +0/−8
• src/Futhark/Representation/AST/Attributes/Types.hs +1/−10
• src/Futhark/Representation/AST/Pretty.hs +11/−9
• src/Futhark/Representation/AST/Syntax.hs +18/−26
• src/Futhark/Representation/AST/Syntax/Core.hs +12/−23
• src/Futhark/Representation/AST/Traversals.hs +79/−18
• src/Futhark/Representation/Aliases.hs +15/−19
• src/Futhark/Representation/ExplicitMemory.hs +46/−85
• src/Futhark/Representation/ExplicitMemory/IndexFunction.hs +3/−4
• src/Futhark/Representation/ExplicitMemory/Simplify.hs +28/−42
• src/Futhark/Representation/Kernels.hs +6/−28
• src/Futhark/Representation/Kernels/Kernel.hs +1020/−966
• src/Futhark/Representation/Kernels/KernelExp.hs +24/−25
• src/Futhark/Representation/Kernels/Simplify.hs +156/−394
• src/Futhark/Representation/Kernels/Sizes.hs +32/−2
• src/Futhark/Representation/Ranges.hs +3/−7
• src/Futhark/Representation/SOACS.hs +2/−9
• src/Futhark/Representation/SOACS/SOAC.hs +12/−12
• src/Futhark/Representation/SOACS/Simplify.hs +72/−54
• src/Futhark/Test.hs +7/−4
• src/Futhark/Test/Values.hs +3/−0
• src/Futhark/Transform/FirstOrderTransform.hs +8/−105
• src/Futhark/Transform/Rename.hs +14/−21
• src/Futhark/Transform/Substitute.hs +6/−3
• src/Futhark/TypeCheck.hs +41/−52
• src/Futhark/Util.hs +2/−0
• src/Futhark/Util/Log.hs +0/−1
• src/Language/Futhark.hs +3/−3
• src/Language/Futhark/Attributes.hs +166/−241
• src/Language/Futhark/Interpreter.hs +49/−41
• src/Language/Futhark/Parser/Lexer.x +1/−1
• src/Language/Futhark/Parser/Parser.y +56/−32
• src/Language/Futhark/Pretty.hs +30/−35
• src/Language/Futhark/Syntax.hs +57/−74
• src/Language/Futhark/Traversals.hs +32/−40
• src/Language/Futhark/TypeChecker.hs +13/−429
• src/Language/Futhark/TypeChecker/Modules.hs +438/−0
• src/Language/Futhark/TypeChecker/Monad.hs +15/−16
• src/Language/Futhark/TypeChecker/Terms.hs +350/−250
• src/Language/Futhark/TypeChecker/Types.hs +86/−117
• src/Language/Futhark/TypeChecker/Unify.hs +212/−144
• src/futhark.hs +0/−3

@@ -0,0 +1,177 @@+# Makefile for Sphinx documentation+#++# You can set these variables from the command line.+SPHINXOPTS    =+SPHINXBUILD   = sphinx-build+PAPER         =+BUILDDIR      = _build++# User-friendly check for sphinx-build+ifeq ($(shell which $(SPHINXBUILD) >/dev/null 2>&1; echo $$?), 1)+$(error The '$(SPHINXBUILD)' command was not found. Make sure you have Sphinx installed, then set the SPHINXBUILD environment variable to point to the full path of the '$(SPHINXBUILD)' executable. Alternatively you can add the directory with the executable to your PATH. If you don't have Sphinx installed, grab it from http://sphinx-doc.org/)+endif++# Internal variables.+PAPEROPT_a4     = -D latex_paper_size=a4+PAPEROPT_letter = -D latex_paper_size=letter+ALLSPHINXOPTS   = -d $(BUILDDIR)/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) .+# the i18n builder cannot share the environment and doctrees with the others+I18NSPHINXOPTS  = $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) .++.PHONY: help clean html dirhtml singlehtml pickle json htmlhelp qthelp devhelp epub latex latexpdf text man changes linkcheck doctest gettext++help:+	@echo "Please use \`make <target>' where <target> is one of"+	@echo "  html       to make standalone HTML files"+	@echo "  dirhtml    to make HTML files named index.html in directories"+	@echo "  singlehtml to make a single large HTML file"+	@echo "  pickle     to make pickle files"+	@echo "  json       to make JSON files"+	@echo "  htmlhelp   to make HTML files and a HTML help project"+	@echo "  qthelp     to make HTML files and a qthelp project"+	@echo "  devhelp    to make HTML files and a Devhelp project"+	@echo "  epub       to make an epub"+	@echo "  latex      to make LaTeX files, you can set PAPER=a4 or PAPER=letter"+	@echo "  latexpdf   to make LaTeX files and run them through pdflatex"+	@echo "  latexpdfja to make LaTeX files and run them through platex/dvipdfmx"+	@echo "  text       to make text files"+	@echo "  man        to make manual pages"+	@echo "  texinfo    to make Texinfo files"+	@echo "  info       to make Texinfo files and run them through makeinfo"+	@echo "  gettext    to make PO message catalogs"+	@echo "  changes    to make an overview of all changed/added/deprecated items"+	@echo "  xml        to make Docutils-native XML files"+	@echo "  pseudoxml  to make pseudoxml-XML files for display purposes"+	@echo "  linkcheck  to check all external links for integrity"+	@echo "  doctest    to run all doctests embedded in the documentation (if enabled)"++clean:+	rm -rf $(BUILDDIR)/*++html:+	$(SPHINXBUILD) -b html $(ALLSPHINXOPTS) $(BUILDDIR)/html+	@echo+	@echo "Build finished. The HTML pages are in $(BUILDDIR)/html."++dirhtml:+	$(SPHINXBUILD) -b dirhtml $(ALLSPHINXOPTS) $(BUILDDIR)/dirhtml+	@echo+	@echo "Build finished. The HTML pages are in $(BUILDDIR)/dirhtml."++singlehtml:+	$(SPHINXBUILD) -b singlehtml $(ALLSPHINXOPTS) $(BUILDDIR)/singlehtml+	@echo+	@echo "Build finished. The HTML page is in $(BUILDDIR)/singlehtml."++pickle:+	$(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) $(BUILDDIR)/pickle+	@echo+	@echo "Build finished; now you can process the pickle files."++json:+	$(SPHINXBUILD) -b json $(ALLSPHINXOPTS) $(BUILDDIR)/json+	@echo+	@echo "Build finished; now you can process the JSON files."++htmlhelp:+	$(SPHINXBUILD) -b htmlhelp $(ALLSPHINXOPTS) $(BUILDDIR)/htmlhelp+	@echo+	@echo "Build finished; now you can run HTML Help Workshop with the" \+	      ".hhp project file in $(BUILDDIR)/htmlhelp."++qthelp:+	$(SPHINXBUILD) -b qthelp $(ALLSPHINXOPTS) $(BUILDDIR)/qthelp+	@echo+	@echo "Build finished; now you can run "qcollectiongenerator" with the" \+	      ".qhcp project file in $(BUILDDIR)/qthelp, like this:"+	@echo "# qcollectiongenerator $(BUILDDIR)/qthelp/Futhark.qhcp"+	@echo "To view the help file:"+	@echo "# assistant -collectionFile $(BUILDDIR)/qthelp/Futhark.qhc"++devhelp:+	$(SPHINXBUILD) -b devhelp $(ALLSPHINXOPTS) $(BUILDDIR)/devhelp+	@echo+	@echo "Build finished."+	@echo "To view the help file:"+	@echo "# mkdir -p $$HOME/.local/share/devhelp/Futhark"+	@echo "# ln -s $(BUILDDIR)/devhelp $$HOME/.local/share/devhelp/Futhark"+	@echo "# devhelp"++epub:+	$(SPHINXBUILD) -b epub $(ALLSPHINXOPTS) $(BUILDDIR)/epub+	@echo+	@echo "Build finished. The epub file is in $(BUILDDIR)/epub."++latex:+	$(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex+	@echo+	@echo "Build finished; the LaTeX files are in $(BUILDDIR)/latex."+	@echo "Run \`make' in that directory to run these through (pdf)latex" \+	      "(use \`make latexpdf' here to do that automatically)."++latexpdf:+	$(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex+	@echo "Running LaTeX files through pdflatex..."+	$(MAKE) -C $(BUILDDIR)/latex all-pdf+	@echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex."++latexpdfja:+	$(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex+	@echo "Running LaTeX files through platex and dvipdfmx..."+	$(MAKE) -C $(BUILDDIR)/latex all-pdf-ja+	@echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex."++text:+	$(SPHINXBUILD) -b text $(ALLSPHINXOPTS) $(BUILDDIR)/text+	@echo+	@echo "Build finished. The text files are in $(BUILDDIR)/text."++man:+	$(SPHINXBUILD) -b man $(ALLSPHINXOPTS) $(BUILDDIR)/man+	@echo+	@echo "Build finished. The manual pages are in $(BUILDDIR)/man."++texinfo:+	$(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo+	@echo+	@echo "Build finished. The Texinfo files are in $(BUILDDIR)/texinfo."+	@echo "Run \`make' in that directory to run these through makeinfo" \+	      "(use \`make info' here to do that automatically)."++info:+	$(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo+	@echo "Running Texinfo files through makeinfo..."+	make -C $(BUILDDIR)/texinfo info+	@echo "makeinfo finished; the Info files are in $(BUILDDIR)/texinfo."++gettext:+	$(SPHINXBUILD) -b gettext $(I18NSPHINXOPTS) $(BUILDDIR)/locale+	@echo+	@echo "Build finished. The message catalogs are in $(BUILDDIR)/locale."++changes:+	$(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) $(BUILDDIR)/changes+	@echo+	@echo "The overview file is in $(BUILDDIR)/changes."++linkcheck:+	$(SPHINXBUILD) -b linkcheck $(ALLSPHINXOPTS) $(BUILDDIR)/linkcheck+	@echo+	@echo "Link check complete; look for any errors in the above output " \+	      "or in $(BUILDDIR)/linkcheck/output.txt."++doctest:+	$(SPHINXBUILD) -b doctest $(ALLSPHINXOPTS) $(BUILDDIR)/doctest+	@echo "Testing of doctests in the sources finished, look at the " \+	      "results in $(BUILDDIR)/doctest/output.txt."++xml:+	$(SPHINXBUILD) -b xml $(ALLSPHINXOPTS) $(BUILDDIR)/xml+	@echo+	@echo "Build finished. The XML files are in $(BUILDDIR)/xml."++pseudoxml:+	$(SPHINXBUILD) -b pseudoxml $(ALLSPHINXOPTS) $(BUILDDIR)/pseudoxml+	@echo+	@echo "Build finished. The pseudo-XML files are in $(BUILDDIR)/pseudoxml."

@@ -0,0 +1,321 @@+#!/usr/bin/env python3+# -*- coding: utf-8 -*-+#+# Futhark documentation build configuration file, created by+# sphinx-quickstart on Tue Mar 24 14:21:12 2015.+#+# This file is execfile()d with the current directory set to its+# containing dir.+#+# Note that not all possible configuration values are present in this+# autogenerated file.+#+# All configuration values have a default; values that are commented out+# serve to show the default.++import sys+import os+import re+from pygments.lexer import RegexLexer+from pygments import token+from sphinx.highlighting import lexers++# If extensions (or modules to document with autodoc) are in another directory,+# add these directories to sys.path here. If the directory is relative to the+# documentation root, use os.path.abspath to make it absolute, like shown here.+#sys.path.insert(0, os.path.abspath('.'))++# -- General configuration ------------------------------------------------++# If your documentation needs a minimal Sphinx version, state it here.+#needs_sphinx = '1.0'++# Add any Sphinx extension module names here, as strings. They can be+# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom+# ones.+extensions = [+    'sphinx.ext.todo',+    'sphinx.ext.mathjax',+]++# Add any paths that contain templates here, relative to this directory.+templates_path = ['_templates']++# The suffix of source filenames.+source_suffix = '.rst'++# The encoding of source files.+#source_encoding = 'utf-8-sig'++# The master toctree document.+master_doc = 'index'++# General information about the project.+project = 'Futhark'+copyright = '2013-2019, DIKU, University of Copenhagen'++# The version info for the project you're documenting, acts as replacement for+# |version| and |release|, also used in various other places throughout the+# built documents.+#+# The short X.Y version.++# No reason for a full YAML parser; let's just hack it.+def get_version():+    # Get lines+    lines = open('../package.yaml', 'r').read().split('\n')+    # Find version line.+    version_line = lines[1]+    return re.search('version: "(.*)"', version_line).group(1)++version = get_version()+# The full version, including alpha/beta/rc tags.+release = version++# The language for content autogenerated by Sphinx. Refer to documentation+# for a list of supported languages.+#language = None++# There are two options for replacing |today|: either, you set today to some+# non-false value, then it is used:+#today = ''+# Else, today_fmt is used as the format for a strftime call.+#today_fmt = '%B %d, %Y'++# List of patterns, relative to source directory, that match files and+# directories to ignore when looking for source files.+exclude_patterns = ['_build']++# The reST default role (used for this markup: `text`) to use for all+# documents.+#default_role = None++# If true, '()' will be appended to :func: etc. cross-reference text.+#add_function_parentheses = True++# If true, the current module name will be prepended to all description+# unit titles (such as .. function::).+#add_module_names = True++# If true, sectionauthor and moduleauthor directives will be shown in the+# output. They are ignored by default.+#show_authors = false++# The name of the Pygments (syntax highlighting) style to use.+pygments_style = 'sphinx'++class FutharkLexer(RegexLexer):+    name = 'Futhark'++    tokens = {+        'root': [+            (r'if|then|else|let|loop|in|val|for|do|with|local|open|include|import|type|entry|module|while|unsafe|module', token.Keyword),+            (r"[a-zA-Z_][a-zA-Z0-9_']*", token.Name),+            (r"-- .*", token.Comment),+            (r'.', token.Text)+        ]+    }+++lexers['futhark'] = FutharkLexer()++highlight_language = 'futhark'++# A list of ignored prefixes for module index sorting.+#modindex_common_prefix = []++# If true, keep warnings as "system message" paragraphs in the built documents.+#keep_warnings = false+++# -- Options for HTML output ----------------------------------------------++# The theme to use for HTML and HTML Help pages.  See the documentation for+# a list of builtin themes.+html_theme = 'futhark'+html_theme_path = ['_theme']++# Theme options are theme-specific and customize the look and feel of a theme+# further.  For a list of options available for each theme, see the+# documentation.+html_theme_options = {}++# Add any paths that contain custom themes here, relative to this directory.+#html_theme_path = []++# The name for this set of Sphinx documents.  If None, it defaults to+# "<project> v<release> documentation".+#html_title = None++# A shorter title for the navigation bar.  Default is the same as html_title.+#html_short_title = None++# The name of an image file (relative to this directory) to place at the top+# of the sidebar.+#html_logo = None++# The name of an image file (within the static path) to use as favicon of the+# docs.  This file should be a Windows icon file (.ico) being 16x16 or 32x32+# pixels large.+#html_favicon = None++# Add any paths that contain custom static files (such as style sheets) here,+# relative to this directory. They are copied after the builtin static files,+# so a file named "default.css" will overwrite the builtin "default.css".+html_static_path = ['_static']++# Add any extra paths that contain custom files (such as robots.txt or+# .htaccess) here, relative to this directory. These files are copied+# directly to the root of the documentation.+#html_extra_path = []++# If not '', a 'Last updated on:' timestamp is inserted at every page bottom,+# using the given strftime format.+#html_last_updated_fmt = '%b %d, %Y'++# If true, SmartyPants will be used to convert quotes and dashes to+# typographically correct entities.+#html_use_smartypants = True++# Custom sidebar templates, maps document names to template names.+html_sidebars = { '**': ['globaltoc.html', 'relations.html', 'sourcelink.html', 'searchbox.html'] }++# Additional templates that should be rendered to pages, maps page names to+# template names.+#html_additional_pages = {}++# If false, no module index is generated.+#html_domain_indices = True++# If false, no index is generated.+#html_use_index = True++# If true, the index is split into individual pages for each letter.+#html_split_index = false++# If true, links to the reST sources are added to the pages.+#html_show_sourcelink = True++# If true, "Created using Sphinx" is shown in the HTML footer. Default is True.+#html_show_sphinx = True++# If true, "(C) Copyright ..." is shown in the HTML footer. Default is True.+#html_show_copyright = True++# If true, an OpenSearch description file will be output, and all pages will+# contain a <link> tag referring to it.  The value of this option must be the+# base URL from which the finished HTML is served.+#html_use_opensearch = ''++# This is the file name suffix for HTML files (e.g. ".xhtml").+#html_file_suffix = None++# Output file base name for HTML help builder.+htmlhelp_basename = 'Futharkdoc'+++# -- Options for LaTeX output ---------------------------------------------++latex_elements = {+# The paper size ('letterpaper' or 'a4paper').+#'papersize': 'letterpaper',++# The font size ('10pt', '11pt' or '12pt').+#'pointsize': '10pt',++# Additional stuff for the LaTeX preamble.+#'preamble': '',+}++# Grouping the document tree into LaTeX files. List of tuples+# (source start file, target name, title,+#  author, documentclass [howto, manual, or own class]).+latex_documents = [+  ('index', 'Futhark.tex', 'Futhark Documentation',+   'DIKU', 'manual'),+]++# The name of an image file (relative to this directory) to place at the top of+# the title page.+#latex_logo = None++# For "manual" documents, if this is true, then toplevel headings are parts,+# not chapters.+#latex_use_parts = false++# If true, show page references after internal links.+#latex_show_pagerefs = false++# If true, show URL addresses after external links.+#latex_show_urls = false++# Documents to append as an appendix to all manuals.+#latex_appendices = []++# If false, no module index is generated.+#latex_domain_indices = True+++# -- Options for manual page output ---------------------------------------++# One entry per manual page. List of tuples+# (source start file, name, description, authors, manual section).+man_pages = [+    ('man/futhark', 'futhark', 'a parallel functional array language',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-c', 'futhark-c', 'compile Futhark to sequential C',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-opencl', 'futhark-opencl', 'compile Futhark to OpenCL',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-cuda', 'futhark-cuda', 'compile Futhark to CUDA',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-python', 'futhark-python', 'compile Futhark to sequential Python',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-pyopencl', 'futhark-pyopencl', 'compile Futhark to Python and OpenCL',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-csharp', 'futhark-csharp', 'compile Futhark to sequential C#',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-csopencl', 'futhark-csopencl', 'compile Futhark to C# and OpenCL',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-run', 'futhark-run', 'interpret Futhark program',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-repl', 'futhark-repl', 'interactive Futhark read-eval-print-loop',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-test', 'futhark-test', 'test Futhark programs',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-bench', 'futhark-bench', 'benchmark Futhark programs',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-doc', 'futhark-doc', 'generate documentation for Futhark code',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-dataset', 'futhark-dataset', 'generate random data sets',+     ['Troels Henriksen (athas@sigkill.dk)'], 1),+    ('man/futhark-pkg', 'futhark-pkg', 'manage Futhark packages',+     ['Troels Henriksen (athas@sigkill.dk)'], 1)+]++# If true, show URL addresses after external links.+#man_show_urls = false+++# -- Options for Texinfo output -------------------------------------------++# Grouping the document tree into Texinfo files. List of tuples+# (source start file, target name, title, author,+#  dir menu entry, description, category)+texinfo_documents = [+  ('index', 'Futhark', 'Futhark Documentation',+   'DIKU', 'Futhark', 'One line description of project.',+   'Miscellaneous'),+]++# Documents to append as an appendix to all manuals.+#texinfo_appendices = []++# If false, no module index is generated.+#texinfo_domain_indices = True++# How to display URL addresses: 'footnote', 'no', or 'inline'.+#texinfo_show_urls = 'footnote'++# If true, do not generate a @detailmenu in the "Top" node's menu.+#texinfo_no_detailmenu = false

@@ -0,0 +1,57 @@+.. Futhark documentation master file, created by+   sphinx-quickstart on Tue Mar 24 14:21:12 2015.+   You can adapt this file completely to your liking, but it should at least+   contain the root `toctree` directive.++Futhark User's Guide+====================++Welcome to the documentation for the Futhark compiler and language.+For a basic introduction, please see `the Futhark website+<http://futhark-lang.org>`_.  To get started, read the page on+:ref:`installation`.  Once the compiler has been installed, you might+want to take a look at :ref:`usage`.  This User's Guide contains a+:ref:`language-reference`, but new Futhark programmers are probably+better served by reading `Parallel Programming in Futhark+<https://futhark-book.readthedocs.io>`_ first.++Documentation for the included basis library is also `available online+<https://futhark-lang.org/docs/>`_.++The particularly interested reader may also want to peruse the+`publications <https://futhark-lang.org/docs.html#publications>`_, or+the `development blog <https://futhark-lang.org/blog.html>`_.++.. toctree::+   :caption: Table of Contents+   :maxdepth: 2+   :numbered:++   installation.rst+   usage.rst+   language-reference.rst+   package-management.rst+   c-porting-guide.rst+   versus-other-languages.rst+   hacking.rst+   binary-data-format.rst++.. toctree::+   :caption: Manual Pages+   :maxdepth: 1++   man/futhark.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+   man/futhark-opencl.rst+   man/futhark-pkg.rst+   man/futhark-pyopencl.rst+   man/futhark-python.rst+   man/futhark-repl.rst+   man/futhark-run.rst+   man/futhark-test.rst

@@ -0,0 +1,131 @@+.. role:: ref(emphasis)++.. _futhark-bench(1):++=============+futhark-bench+=============++SYNOPSIS+========++futhark bench [options...] programs...++DESCRIPTION+===========++This tool is the recommended way to benchmark Futhark programs.+Programs are compiled using the specified backend (``futhark c`` by+default), then run a number of times for each test case, and the+average runtime printed on standard output.  Refer to+:ref:`futhark-test(1)` for information on how to format test data.  A+program will be ignored if it contains no data sets - it will not even+be compiled.++If compilation of a program fails, then ``futhark bench`` will abort+immediately.  If execution of a test set fails, an error message will+be printed and benchmarking will continue (and ``--json`` will write+the file), but a non-zero exit code will be returned at the end.++OPTIONS+=======++--backend=name++  The backend used when compiling Futhark programs (without leading+  ``futhark``, e.g. just ``opencl``).++--entry-point=name++  Only run entry points with this name.++--exclude-case=TAG++  Do not run test cases that contain the given tag.  Cases marked with+  "nobench" or "disable" are ignored by default.++--futhark=program++  The program used to perform operations (eg. compilation).  Defaults+  to the binary running ``futhark bench`` itself.++--ignore-files=REGEX++  Ignore files whose path match the given regular expression.++--json=file++  Write raw results in JSON format to the specified file.++--no-tuning++  Do not look for tuning files.++--pass-option=opt++  Pass an option to benchmark programs that are being run.  For+  example, we might want to run OpenCL programs on a specific device::++    futhark bench prog.fut --backend=opencl --pass-option=-dHawaii++--runner=program++  If set to a non-empty string, compiled programs are not run+  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.++--runs=count++  The number of runs per data set.++--skip-compilation++  Do not run the compiler, and instead assume that each benchmark+  program has already been compiled.  Use with caution.++--timeout=seconds++  If the runtime for a dataset exceeds this integral number of+  seconds, it is aborted.  Note that the time is allotted not *per+  run*, but for *all runs* for a dataset.  A twenty second limit for+  ten runs thus means each run has only two seconds (minus+  initialisation overhead).++  A negative timeout means to wait indefinitely.++--tuning=EXTENSION++  For each program being run, look for a tuning file with this+  extension, which is suffixed to the name of the program.  For+  example, given ``--tuning=tuning`` (the default), the program+  ``foo.fut`` will be passed the tuning file ``foo.fut.tuning`` if it+  exists.++EXAMPLES+========++The following program benchmarks how quickly we can sum arrays of+different sizes::++  -- How quickly can we reduce arrays?+  --+  -- ==+  -- nobench input { 0 }+  -- output { 0 }+  -- input { 100 }+  -- output { 4950 }+  -- compiled input { 100000 }+  -- output { 704982704 }+  -- compiled input { 100000000 }+  -- output { 887459712 }++  let main(n: i32): i32 =+    reduce (+) 0 (iota n)++SEE ALSO+========++:ref:`futhark-c(1)`, :ref:`futhark-test(1)`

@@ -0,0 +1,60 @@+.. role:: ref(emphasis)++.. _futhark-c(1):++=========+futhark-c+=========++SYNOPSIS+========++futhark c [options...] infile++DESCRIPTION+===========++``futhark c`` translates a Futhark program to sequential C code, and+either compiles that C code with gcc(1) to an executable binary+program, or produces a ``.h`` and ``.c`` file that can be linked with+other code..  The standard Futhark optimisation pipeline is used, and+GCC is invoked with ``-O3``, ``-lm``, and ``-std=c99``.++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 ``.c``/``.h``+  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.++--Werror+  Treat warnings as errors.++SEE ALSO+========++:ref:`futhark-opencl(1)`, :ref:`futhark-cuda(1)`, :ref:`futhark-test(1)`

@@ -0,0 +1,65 @@+.. 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.++-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)`

@@ -0,0 +1,69 @@+.. 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.++--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)`

@@ -0,0 +1,61 @@+.. role:: ref(emphasis)++.. _futhark-cuda(1):++==============+futhark-cuda+==============++SYNOPSIS+========++futhark cuda [options...] infile++DESCRIPTION+===========+++``futhark cuda`` translates a Futhark program to C code invoking CUDA+kernels, and either compiles that C code with gcc(1) to an executable+binary program, or produces a ``.h`` and ``.c`` file that can be+linked with other code. The standard Futhark optimisation pipeline is+used, and GCC is invoked with ``-O3``, ``-lm``, and ``-std=c99``. The+resulting program will otherwise behave exactly as one compiled with+``futhark c``.++The generated programs use the NVRTC API for run-time compilation,+which must consequently be available.++OPTIONS+=======++-h+  Print help text to standard output and exit.++--library+  Generate a library instead of an executable.  Appends ``.c``/``.h``+  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.++--Werror+  Treat warnings as errors.++SEE ALSO+========++:ref:`futhark-opencl(1)`

@@ -0,0 +1,87 @@+.. role:: ref(emphasis)++.. _futhark-dataset(1):++===============+futhark-dataset+===============++SYNOPSIS+========++futhark dataset [options...]++DESCRIPTION+===========++Generate random values in Futhark syntax, which can be useful when+generating input datasets for program testing.  All Futhark primitive+types are supported.  Tuples are not supported.  Arrays of specific+(non-random) sizes can be generated.  You can specify maximum and+minimum bounds for values, as well as the random seed used when+generating the data.  The generated values are written to standard+output.++If no ``-g``/``--generate`` options are passed, values are read from+standard input, and printed to standard output in the indicated+format.  The input format (whether textual or binary) is automatically+detected.++OPTIONS+=======++-b, --binary+  Output data in binary Futhark format (must precede --generate).++-g type, --generate type+  Generate a value of the indicated type, e.g. ``-g i32`` or ``-g [10]f32``.++  The type may also be a value, in which case that literal value is+  generated.++-s int+  Set the seed used for the RNG.  Zero by default.++--T-bounds=<min:max>+  Set inclusive lower and upper bounds on generated values of type+  ``T``.  ``T`` is any primitive type, e.g. ``i32`` or ``f32``.  The+  bounds apply to any following uses of the ``-g`` option.++You can alter the output format using the following flags. To use them, add them+before data generation (--generate):++--text+  Output data in text format (must precede --generate). Default.++-t, --type+  Output the types of values (textually) instead of the values+  themselves.  Mostly useful when reading values on stdin.++EXAMPLES+========++Generate a 4 by 2 integer matrix::++  futhark dataset -g [4][2]i32++Generate an array of floating-point numbers and an array of indices into that array::++  futhark dataset -g [10]f32 --i32-bounds=0:9 -g [100]i32++To generate binary data, the ``--binary`` must come before the ``--generate``::++  futhark dataset --binary --generate=[42]i32++Create a binary data file from a data file::++  futhark dataset --binary < any_data > binary_data++Determine the types of values contained in a data file::++  futhark dataset -t < any_data+++SEE ALSO+========++:ref:`futhark-test(1)`, :ref:`futhark-bench(1)`

@@ -0,0 +1,66 @@+.. role:: ref(emphasis)++.. _futhark-doc(1):++===========+futhark-doc+===========++SYNOPSIS+========++futhark doc [options...] dir++DESCRIPTION+===========++``futhark doc`` generates HTML-formatted documentation from Futhark+code.  One HTML file will be created for each ``.fut`` file in the+given directory, as well as any file reachable through ``import``+expressions.  The given Futhark code will be considered as one+cohesive whole, and must be type-correct.++Futhark definitions may be documented by prefixing them with a block+of line comments starting with :literal:`-- |` (see example below).+Simple Markdown syntax is supported within these comments.  A link to+another identifier is possible with the notation+:literal:`\`name\`@namespace`, where ``namespace`` must be either+``term``, ``type``, or ``mtype`` (module names are in the ``term``+namespace).  A file may contain a leading documentation comment, which+will be considered the file *abstract*.++``futhark doc`` will ignore any file whose documentation comment+consists solely of the word "ignore".  This is useful for files that+contain tests, or are otherwise not relevant to the reader of the+documentation.++OPTIONS+=======++-h+  Print help text to standard output and exit.++-o outdir+  The name of the directory that will contain the generated+  documentation.  This option is mandatory.++-v, --verbose+  Print status messages to stderr while running.++-V+  Print version information on standard output and exit.++EXAMPLES+========++.. code-block:: futhark++ -- | Gratuitous re-implementation of `map`@term.+ --+ -- Does exactly the same.+ let mymap = ...++SEE ALSO+========++:ref:`futhark-test(1)`, :ref:`futhark-bench(1)`

@@ -0,0 +1,58 @@+.. role:: ref(emphasis)++.. _futhark-opencl(1):++==============+futhark-opencl+==============++SYNOPSIS+========++futhark opencl [options...] infile++DESCRIPTION+===========+++``futhark opencl`` translates a Futhark program to C code invoking+OpenCL kernels, and either compiles that C code with gcc(1) to an+executable binary program, or produces a ``.h`` and ``.c`` file that+can be linked with other code. The standard Futhark optimisation+pipeline is used, and GCC is invoked with ``-O3``, ``-lm``, and+``-std=c99``. The resulting program will otherwise behave exactly as+one compiled with ``futhark c``.++OPTIONS+=======++-h+  Print help text to standard output and exit.++--library+  Generate a library instead of an executable.  Appends ``.c``/``.h``+  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.++--Werror+  Treat warnings as errors.++SEE ALSO+========++:ref:`futhark-test(1)`, :ref:`futhark-cuda(1)`, :ref:`futhark-c(1)`

@@ -0,0 +1,167 @@+.. role:: ref(emphasis)++.. _futhark-pkg(1):++===========+futhark-pkg+===========++SYNOPSIS+========++futhark pkg add PKGPATH [X.Y.Z]++futhark pkg check++futhark pkg init PKGPATH++futhark pkg fmt++futhark pkg remove PKGPATH++futhark pkg sync++futhark pkg upgrade++futhark pkg versions++DESCRIPTION+===========++This tool is used to modify the package manifest (``futhark.pkg``) and+download the required packages it describes.  ``futhark pkg`` is not a+build system; you will still need to compile your Futhark code with+the usual compilers.  The only purpose of ``futhark pkg`` is to+download code (and perform other package management utility tasks).+This manpage is not a general introduction to package management in+Futhark; see the User's Guide for that.++The ``futhark pkg`` subcommands will modify only two locations in the+file system (relative to the current working directory): the+``futhark.pkg`` file, and the contents of ``lib/``.  When modifying+``lib/``, ``futhark pkg`` constructs the new version in ``lib~new/``+and backs up the old version in ``lib~old``.  If ``futhark pkg``+should fail for any reason, you can recover the old state by moving+``lib~old`` back.  These temporary directories are erased if+``futhark pkg`` finishes without errors.++The ``futhark pkg sync`` and ``futhark pkg init`` subcommands are+the only ones that actually modifies ``lib/``; the others modify only+``futhark.pkg`` and require you to manually run ``futhark pkg sync``+afterwards.++Most commands take a ``-v``/``--verbose`` option that makes+``futhark pkg`` write running diagnostics to stderr.++COMMANDS+========++futhark pkg add PKGPATH [X.Y.Z]+-------------------------------++Add the specified package of the given minimum version as a+requirement to ``futhark.pkg``.  If no version is provided, the newest+one is used.  If the package is already required in ``futhark.pkg``,+the new version requirement will replace the old one.++Note that adding a package does not automatically download it.  Run+``futhark pkg sync`` to do that.++futhark pkg check+-----------------++Verify that the ``futhark.pkg`` is valid, that all required packages+are available in the indicated versions.  This command does not check+that these versions contain well-formed code.  If a package path is+defined in ``futhark.pkg``, also checks that ``.fut`` files are+located at the expected location in the file system.++futhark pkg init PKGPATH+------------------------++Create a new ``futhark.pkg`` defining a package with the given package+path, and initially no requirements.++futhark pkg fmt+---------------++Reformat the ``futhark.pkg`` file, while retaining any comments.++futhark pkg remove PKGPATH+--------------------------++Remove a package from ``futhark.pkg``.  Does *not* remove it from the+``lib/`` directory.++futhark pkg sync+----------------++Populate the ``lib/`` directory with the packages listed in+``futhark.pkg``.  **Warning**: this will delete everything in ``lib/``+that does not relate to a file listed in ``futhark.pkg``, as well as+any local modifications.++futhark pkg upgrade+-------------------++Upgrade all package requirements in ``futhark.pkg`` to the newest+available versions.++futhark pkg versions PKGPATH+----------------------------++Print all available versions for the given package path.++COMMIT VERSIONS+===============++It is possible to use ``futhark pkg`` with packages that have not yet+made proper releases.  This is done via pseudoversions of the form+``0.0.0-yyyymmddhhmmss+commitid``.  The timestamp is not verified+against the actual commit.  The timestamp ensures that newer commits+take precedence if multiple packages depend on a commit version for+the same package.  If ``futhark pkg add`` is given a package with no+releases, the most recent commit will be used.  In this case, the+timestamp is merely set to the current time.++Commit versions are awkward and fragile, and should not be relied+upon.  Issue proper releases (even experimental 0.x version) as soon+as feasible.  Released versions also always take precedence over+commit versions, since any version number will be greater than 0.0.0.++EXAMPLES+========++Create a new package that will be hosted at+``https://github.com/sturluson/edda``::++  futhark pkg init github.com/sturluson/edda++Add a package dependency::++  futhark pkg add github.com/sturluson/hattatal++Download the dependencies::++  futhark pkg sync++And then you're ready to start hacking!  (Except that these packages+do not actually exist.)++BUGS+====++Since the ``lib/`` directory is populated with transitive dependencies+as well, it is possible for a package to depend unwittingly on one of+the dependencies of its dependencies, without the ``futhark.pkg`` file+reflecting this.++There is no caching of zipballs and version lists between invocations,+so the network traffic can be rather heavy.++Only GitHub and GitLab are supported as code hosting sites.++SEE ALSO+========++:ref:`futhark-test(1)`, :ref:`futhark-doc(1)`

@@ -0,0 +1,69 @@+.. role:: ref(emphasis)++.. _futhark-pyopencl(1):++================+futhark-pyopencl+================++SYNOPSIS+========++futhark pyopencl [options...] infile++DESCRIPTION+===========++``futhark pyopencl`` translates a Futhark program to Python code+invoking OpenCL kernels.  By default, the program uses the first+device of the first OpenCL platform - this can be changed by passing+``-p`` and ``-d`` options to the generated program (not to+``futhark pyopencl`` itself).++The resulting program will otherwise behave exactly as one compiled+with ``futhark py``.  While the sequential host-level code is pure+Python and just as slow as in ``futhark py``, parallel sections will+have been compiled to OpenCL, and runs just as fast as when using+``futhark opencl``.  The kernel launch overhead is significantly+higher, however, so a good rule of thumb when using+``futhark pyopencl`` is to aim for having fewer but longer-lasting+parallel sections.++The generated code requires at least PyOpenCL version 2015.2.++OPTIONS+=======++-h+  Print help text to standard output and exit.++--library+  Instead of compiling to an executable program, generate a Python+  module that can be imported by other Python code.  The module will+  contain a class of the same name as the Futhark source file with+  ``.fut`` removed.  Objects of the class define one method per entry+  point in the Futhark program, with matching parameters and return+  value.++-o outfile+  Where to write the resulting binary.  By default, if the source+  program is named 'foo.fut', the binary will be named '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.++--Werror+  Treat warnings as errors.++SEE ALSO+========++:ref:`futhark-py(1)`, :ref:`futhark-opencl(1)`

@@ -0,0 +1,63 @@+.. role:: ref(emphasis)++.. _futhark-py(1):++==============+futhark-python+==============++SYNOPSIS+========++futhark python [options...] infile++DESCRIPTION+===========++``futhark python`` translates a Futhark program to sequential Python+code.++The resulting program will read the arguments to the ``main`` function+from standard input and print its return value on standard output.+The arguments are read and printed in Futhark syntax.++The generated code is very slow, likely too slow to be useful.  It is+more interesting to use this command's big brother,+:ref:`futhark-pyopencl(1)`.++OPTIONS+=======++-h+  Print help text to standard output and exit.++--library+  Instead of compiling to an executable program, generate a Python+  module that can be imported by other Python code.  The module will+  contain a class of the same name as the Futhark source file with+  ``.fut`` removed.  Objects of the class define one method per entry+  point in the Futhark program, with matching parameters and return+  value.++-o outfile+  Where to write the resulting binary.  By default, if the source+  program is named 'foo.fut', the binary will be named '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.++--Werror+  Treat warnings as errors.++SEE ALSO+========++:ref:`futhark-pyopencl(1)`

@@ -0,0 +1,42 @@+.. role:: ref(emphasis)++.. _futhark-repl(1):++============+futhark-repl+============++SYNOPSIS+========++futhark repl++DESCRIPTION+===========++Start an interactive Futhark session.  This will let you interactively+enter expressions and declarations which are then immediately+interpreted.  If the entered line can be either a declaration or an+expression, it is assumed to be a declaration.++Futhark source files can be loaded using the ``:load`` command.  This+will erase any interactively entered definitions.  Use the ``:help``+command to see a list of commands.  All commands are prefixed with a+colon.++``futhark-repl`` uses the Futhark interpreter, which grants access to+certain special functions.  See :ref:`futhark-run(1)` for a description.++OPTIONS+=======++-h+  Print help text to standard output and exit.++-V+  Print version information on standard output and exit.++SEE ALSO+========++:ref:`futhark-run(1)`, :ref:`futhark-test(1)`

@@ -0,0 +1,53 @@+.. role:: ref(emphasis)++.. _futhark-run(1):++===========+futhark-run+===========++SYNOPSIS+========++futhark run [program]++DESCRIPTION+===========++Execute the given program by evaluating the ``main`` function with+arguments read from standard input, and write the results on standard+output.++``futhark-run`` is very slow, and in practice only useful for testing,+teaching, and experimenting with the language.  Certain special+debugging functions are available in ``futhark-run``:++``trace 'a : a -> a``+  Semantically identity, but prints the value on standard output.++``break 'a : a -> a``+  Semantically identity, but interrupts execution at the calling+  point, such that the environment can be inspected.  Continue+  execution by entering an empty input line.  Breakpoints are only+  respected when starting a program from the prompt, not when+  passing a program on the command line.++OPTIONS+=======++-e NAME+  Run the given entry point instead of ``main``.++-h+  Print help text to standard output and exit.++-V+  Print version information on standard output and exit.++-w, --no-warnings+  Disable interpreter warnings.++SEE ALSO+========++:ref:`futhark-repl(1)`, :ref:`futhark-test(1)`

@@ -0,0 +1,224 @@+.. role:: ref(emphasis)++.. _futhark-test(1):++============+futhark-test+============++SYNOPSIS+========++futhark test [options...] infiles...++DESCRIPTION+===========++This tool is used to test Futhark programs based on input/output+datasets.  If a directory is given, all contained files with a+``.fut`` extension are considered.++A Futhark test program is an ordinary Futhark program, with at least+one test block describing input/output test cases and possibly other+options.  A test block consists of commented-out text with the+following overall format::++  description+  ==+  cases...++The ``description`` is an arbitrary (and possibly multiline)+human-readable explanation of the test program.  It is separated from+the test cases by a line containing just ``==``.  Any comment starting+at the beginning of the line, and containing a line consisting of just+``==``, will be considered a test block.  The format of a test case is+as follows::++  [tags { tags... }]+  [entry: names...]+  [compiled|nobench|random] input ({ values... } | @ filename)+  output { values... } | auto output | error: regex++If ``compiled`` is present before the ``input`` keyword, this test+case will never be passed to the interpreter.  This is useful for test+cases that are annoyingly slow to interpret.  The ``nobench`` keyword+is for data sets that are too small to be worth benchmarking, and only+has meaning to :ref:`futhark-bench(1)`.++If ``input`` is preceded by ``random``, the text between the curly+braces must consist of a sequence of Futhark types, including sizes in+the case of arrays.  When ``futhark test`` is run, a file located in a+``data/`` subdirectory, containing values of the indicated types and+shapes is, automatically constructed with ``futhark-dataset``.  Apart+from sizes, integer constants (without any type suffix) are also+permitted.  These become ``ì32`` values.++If ``input`` is followed by an ``@`` and a file name (which must not+contain any whitespace) instead of curly braces, values will be read+from the indicated file.  This is recommended for large data sets.+This notation cannot be used with ``random`` input.++After the ``input`` block, the expected result of the test case is+written as either ``output`` followed by another block of values, or+an expected run-time error, in which a regular expression can be used+to specify the exact error message expected.  If no regular expression+is given, any error message is accepted.  If neither ``output`` nor+``error`` is given, the program will be expected to execute+succesfully, but its output will not be validated.++If ``output`` is preceded by ``auto`` (as in ``auto output``), the+expected values are automatically generated by compiling the program+with ``futhark-c`` and recording its result for the given input (which+must not fail).  This is usually only useful for testing or+benchmarking alternative compilers, and not for testing the+correctness of Futhark programs.++Alternatively, instead of input-output pairs, the test cases can+simply be a description of an expected compile time type error::++  error: regex++This is used to test the type checker.++By default, both the interpreter and compiler is run on all test cases+(except those that have specified ``compiled``), although this can be+changed with command-line options to ``futhark test``.++Tuple syntax is not supported when specifying input and output values.+Instead, you can write an N-tuple as its constituent N values.  Beware+of syntax errors in the values - the errors reported by+``futhark test`` are very poor.++An optional tags specification is permitted in the first test block.+This section can contain arbitrary tags that classify the benchmark::++  tags { names... }++Tag are sequences of alphanumeric characters, dashes, and underscores,+with each tag seperated by whitespace.  Any program with the+``disable`` tag is ignored by ``futhark test``.++Another optional directive is ``entry``, which specifies the entry+point to be used for testing.  This is useful for writing programs+that test libraries with multiple entry points.  Multiple entry points+can be specified on the same line by separating them with space, and+they will all be tested with the same input/output pairs.  The+``entry`` directive affects subsequent input-output pairs in the same+comment block, and may only be present immediately preceding these+input-output pairs.  If no ``entry`` is given, ``main`` is assumed.+See below for an example.++For many usage examples, see the ``tests`` directory in the+Futhark source directory.  A simple example can be found in+``EXAMPLES`` below.++OPTIONS+=======++--backend=program++  The backend used when compiling Futhark programs (without leading+  ``futhark``, e.g. just ``opencl``).++-c+  Only run compiled code - do not run any interpreters.++-C+  Compile the programs, but do not run them.++--exclude=tag++  Do not run test cases that contain the given tag.  Cases marked with+  "disable" are ignored by default.++-i+  Only interpret - do not run any compilers.++-t+  Type-check the programs, but do not run them.++--futhark=program++  The program used to perform operations (eg. compilation).  Defaults+  to the binary running ``futhark test`` itself.++--no-terminal+  Print each result on a line by itself, without line buffering.++--no-tuning++  Do not look for tuning files.++--pass-option=opt++  Pass an option to benchmark programs that are being run.  For+  example, we might want to run OpenCL programs on a specific device::++    futhark-bench prog.fut --backend=opencl --pass-option=-dHawaii++--runner=program++  If set to a non-empty string, compiled programs are not run+  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.++--tuning=EXTENSION++  For each program being run, look for a tuning file with this+  extension, which is suffixed to the name of the program.  For+  example, given ``--tuning=tuning`` (the default), the program+  ``foo.fut`` will be passed the tuning file ``foo.fut.tuning`` if it+  exists.++EXAMPLES+========++The following program tests simple indexing and bounds checking::++  -- Test simple indexing of an array.+  -- ==+  -- tags { firsttag secondtag }+  -- input { [4,3,2,1] 1 }+  -- output { 3 }+  -- input { [4,3,2,1] 5 }+  -- error: Assertion.*failed++  let main (a: []i32) (i: i32): i32 =+    a[i]++The following program contains two entry points, both of which are+tested::++  let add(x: i32, y: i32): i32 = x + y++  -- Test the add1 function.+  -- ==+  -- entry: add1+  -- input { 1 } output { 2 }++  entry add1 (x: i32): i32 = add x 1++  -- Test the sub1 function.+  -- ==+  -- entry: sub1+  -- input { 1 } output { 0 }++  entry sub1 (x: i32): i32 = add x (-1)++The following program contains an entry point that is tested with+randomly generated data::++  -- ==+  -- random input { [100]i32 [100]i32 } auto output+  -- random input { [1000]i32 [1000]i32 } auto output++  let main xs ys = i32.product (map2 (*) xs ys)+++SEE ALSO+========++:ref:`futhark-bench(1)`, :ref:`futhark-repl(1)`

@@ -0,0 +1,57 @@+.. role:: ref(emphasis)++.. _futhark(1):++=======+futhark+=======++SYNOPSIS+========++futhark <subcommand> options...++DESCRIPTION+===========++Futhark is a data-parallel functional array language.  Through various+subcommands, the ``futhark`` tool provides facilities for compiling,+developing, or analysing Futhark programs.  Most subcommands are+documented in their own manpage.  For example, ``futhark opencl`` is+documented as :ref:`futhark-opencl(1)`.  The remaining subcommands are+documented in this page.++COMMANDS+========++futhark check PROGRAM+---------------------++Check whether a Futhark program type checks.++futhark datacmp FILE_A FILE_B+-----------------------------++Check whether the two files contain the same Futhark values.  The+files must be formatted using the general Futhark data format that is+used by all other executable and tools (such as+:ref:`futhark-dataset(1)`).  All discrepancies will be reported.  This+is in contrast to :ref:`futhark-test(1)`, which only reports the first+one.++futhark dev options... PROGRAM+------------------------------++A Futhark compiler development command, intentionally undocumented and+intended for use in developing the Futhark compiler, not for+programmers writing in Futhark.++futhark imports PROGRAM+-----------------------++Print all non-builtin imported Futhark files to stdout, one per line.++SEE ALSO+========++:ref:`futhark-opencl(1)`, :ref:`futhark-c(1)`, :ref:`futhark-py(1)`, :ref:`futhark-pyopencl(1)`, :ref:`futhark-dataset(1)`, :ref:`futhark-doc(1)`, :ref:`futhark-test(1)`, :ref:`futhark-bench(1)`, :ref:`futhark-run(1)`, :ref:`futhark-repl(1)`

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: 1626fa99a399d6063ac04d34f5c73c94719161b2eab8876c29218c389c97d9e9+-- hash: 38e40072e41929349f42259546b30abfbce169d4641549f5f1d5db10f60f2724  name:           futhark-version:        0.11.2+version:        0.12.1 synopsis:       An optimising compiler for a functional, array-oriented language. description:    Futhark is a small programming language designed to be compiled to                 efficient parallel code. It is a statically typed, data-parallel,@@ -25,7 +25,6 @@ license-file:   LICENSE build-type:     Simple extra-source-files:-    rts/python/__init__.py     rts/python/memory.py     rts/python/opencl.py     rts/python/panic.py@@ -55,6 +54,25 @@     futlib/prelude.fut     futlib/soacs.fut     futlib/zip.fut+    docs/Makefile+    docs/conf.py+    docs/index.rst+    docs/man/futhark-bench.rst+    docs/man/futhark-c.rst+    docs/man/futhark-csharp.rst+    docs/man/futhark-csopencl.rst+    docs/man/futhark-cuda.rst+    docs/man/futhark-dataset.rst+    docs/man/futhark-doc.rst+    docs/man/futhark-opencl.rst+    docs/man/futhark-pkg.rst+    docs/man/futhark-pyopencl.rst+    docs/man/futhark-python.rst+    docs/man/futhark-repl.rst+    docs/man/futhark-run.rst+    docs/man/futhark-test.rst+    docs/man/futhark.rst+    package.yaml  source-repository head   type: git@@ -173,18 +191,17 @@       Futhark.Optimise.Simplify.Rule       Futhark.Optimise.Simplify.Rules       Futhark.Optimise.TileLoops-      Futhark.Optimise.TileLoops.RegTiling3D       Futhark.Optimise.Unstream       Futhark.Pass       Futhark.Pass.ExpandAllocations       Futhark.Pass.ExplicitAllocations       Futhark.Pass.ExtractKernels       Futhark.Pass.ExtractKernels.BlockedKernel+      Futhark.Pass.ExtractKernels.DistributeNests       Futhark.Pass.ExtractKernels.Distribution       Futhark.Pass.ExtractKernels.Interchange       Futhark.Pass.ExtractKernels.Intragroup       Futhark.Pass.ExtractKernels.ISRWIM-      Futhark.Pass.ExtractKernels.Kernelise       Futhark.Pass.FirstOrderTransform       Futhark.Pass.KernelBabysitting       Futhark.Pass.ResolveAssertions@@ -252,6 +269,7 @@       Language.Futhark.Syntax       Language.Futhark.Traversals       Language.Futhark.TypeChecker+      Language.Futhark.TypeChecker.Modules       Language.Futhark.TypeChecker.Monad       Language.Futhark.TypeChecker.Terms       Language.Futhark.TypeChecker.Types@@ -272,7 +290,7 @@     , binary >=0.8.3     , blaze-html >=0.9.0.1     , bytestring >=0.10.8-    , containers >=0.5+    , containers >=0.6.2.1     , data-binary-ieee754 >=0.1     , directory >=1.3.0.0     , directory-tree >=0.12.1

@@ -83,7 +83,7 @@   val &: t -> t -> t   val |: t -> t -> t   val ^: t -> t -> t-  val ~: t -> t+  val !: t -> t    val <<: t -> t -> t   val >>: t -> t -> t@@ -205,7 +205,7 @@   let (x: i8) & (y: i8) = intrinsics.and8 x y   let (x: i8) | (y: i8) = intrinsics.or8 x y   let (x: i8) ^ (y: i8) = intrinsics.xor8 x y-  let ~ (x: i8) = intrinsics.complement8 x+  let ! (x: i8) = intrinsics.complement8 x    let (x: i8) << (y: i8) = intrinsics.shl8 x y   let (x: i8) >> (y: i8) = intrinsics.ashr8 x y@@ -234,7 +234,7 @@   let (x: i8) > (y: i8) = intrinsics.slt8 y x   let (x: i8) <= (y: i8) = intrinsics.sle8 x y   let (x: i8) >= (y: i8) = intrinsics.sle8 y x-  let (x: i8) != (y: i8) = ! (x == y)+  let (x: i8) != (y: i8) = intrinsics.! (x == y)    let sgn (x: i8) = intrinsics.ssignum8 x   let abs (x: i8) = intrinsics.abs8 x@@ -249,7 +249,7 @@   let num_bits = 8   let get_bit (bit: i32) (x: t) = to_i32 ((x >> i32 bit) & i32 1)   let set_bit (bit: i32) (x: t) (b: i32) =-    ((x & i32 (intrinsics.~(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))+    ((x & i32 (intrinsics.!(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))    let iota (n: i8) = 0i8..1i8..<n   let replicate 'v (n: i8) (x: v) = map (const x) (iota n)@@ -275,7 +275,7 @@   let (x: i16) & (y: i16) = intrinsics.and16 x y   let (x: i16) | (y: i16) = intrinsics.or16 x y   let (x: i16) ^ (y: i16) = intrinsics.xor16 x y-  let ~ (x: i16) = intrinsics.complement16 x+  let ! (x: i16) = intrinsics.complement16 x    let (x: i16) << (y: i16) = intrinsics.shl16 x y   let (x: i16) >> (y: i16) = intrinsics.ashr16 x y@@ -304,7 +304,7 @@   let (x: i16) > (y: i16) = intrinsics.slt16 y x   let (x: i16) <= (y: i16) = intrinsics.sle16 x y   let (x: i16) >= (y: i16) = intrinsics.sle16 y x-  let (x: i16) != (y: i16) = ! (x == y)+  let (x: i16) != (y: i16) = intrinsics.! (x == y)    let sgn (x: i16) = intrinsics.ssignum16 x   let abs (x: i16) = intrinsics.abs16 x@@ -319,7 +319,7 @@   let num_bits = 16   let get_bit (bit: i32) (x: t) = to_i32 ((x >> i32 bit) & i32 1)   let set_bit (bit: i32) (x: t) (b: i32) =-    ((x & i32 (intrinsics.~(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))+    ((x & i32 (intrinsics.!(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))    let iota (n: i16) = 0i16..1i16..<n   let replicate 'v (n: i16) (x: v) = map (const x) (iota n)@@ -348,7 +348,7 @@   let (x: i32) & (y: i32) = intrinsics.and32 x y   let (x: i32) | (y: i32) = intrinsics.or32 x y   let (x: i32) ^ (y: i32) = intrinsics.xor32 x y-  let ~ (x: i32) = intrinsics.complement32 x+  let ! (x: i32) = intrinsics.complement32 x    let (x: i32) << (y: i32) = intrinsics.shl32 x y   let (x: i32) >> (y: i32) = intrinsics.ashr32 x y@@ -377,7 +377,7 @@   let (x: i32) > (y: i32) = intrinsics.slt32 y x   let (x: i32) <= (y: i32) = intrinsics.sle32 x y   let (x: i32) >= (y: i32) = intrinsics.sle32 y x-  let (x: i32) != (y: i32) = ! (x == y)+  let (x: i32) != (y: i32) = intrinsics.! (x == y)    let sgn (x: i32) = intrinsics.ssignum32 x   let abs (x: i32) = intrinsics.abs32 x@@ -392,7 +392,7 @@   let num_bits = 32   let get_bit (bit: i32) (x: t) = to_i32 ((x >> i32 bit) & i32 1)   let set_bit (bit: i32) (x: t) (b: i32) =-    ((x & i32 (intrinsics.~(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))+    ((x & i32 (intrinsics.!(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))    let iota (n: i32) = 0..1..<n   let replicate 'v (n: i32) (x: v) = map (const x) (iota n)@@ -421,7 +421,7 @@   let (x: i64) & (y: i64) = intrinsics.and64 x y   let (x: i64) | (y: i64) = intrinsics.or64 x y   let (x: i64) ^ (y: i64) = intrinsics.xor64 x y-  let ~ (x: i64) = intrinsics.complement64 x+  let ! (x: i64) = intrinsics.complement64 x    let (x: i64) << (y: i64) = intrinsics.shl64 x y   let (x: i64) >> (y: i64) = intrinsics.ashr64 x y@@ -450,7 +450,7 @@   let (x: i64) > (y: i64) = intrinsics.slt64 y x   let (x: i64) <= (y: i64) = intrinsics.sle64 x y   let (x: i64) >= (y: i64) = intrinsics.sle64 y x-  let (x: i64) != (y: i64) = ! (x == y)+  let (x: i64) != (y: i64) = intrinsics.! (x == y)    let sgn (x: i64) = intrinsics.ssignum64 x   let abs (x: i64) = intrinsics.abs64 x@@ -465,7 +465,7 @@   let num_bits = 64   let get_bit (bit: i32) (x: t) = to_i32 ((x >> i32 bit) & i32 1)   let set_bit (bit: i32) (x: t) (b: i32) =-    ((x & i32 (intrinsics.~(1 intrinsics.<< bit))) | intrinsics.zext_i32_i64 (b intrinsics.<< bit))+    ((x & i32 (intrinsics.!(1 intrinsics.<< bit))) | intrinsics.zext_i32_i64 (b intrinsics.<< bit))    let iota (n: i64) = 0i64..1i64..<n   let replicate 'v (n: i64) (x: v) = map (const x) (iota n)@@ -494,7 +494,7 @@   let (x: u8) & (y: u8) = unsign (intrinsics.and8 (sign x) (sign y))   let (x: u8) | (y: u8) = unsign (intrinsics.or8 (sign x) (sign y))   let (x: u8) ^ (y: u8) = unsign (intrinsics.xor8 (sign x) (sign y))-  let ~ (x: u8) = unsign (intrinsics.complement8 (sign x))+  let ! (x: u8) = unsign (intrinsics.complement8 (sign x))    let (x: u8) << (y: u8) = unsign (intrinsics.shl8 (sign x) (sign y))   let (x: u8) >> (y: u8) = unsign (intrinsics.ashr8 (sign x) (sign y))@@ -523,7 +523,7 @@   let (x: u8) > (y: u8) = intrinsics.ult8 (sign y) (sign x)   let (x: u8) <= (y: u8) = intrinsics.ule8 (sign x) (sign y)   let (x: u8) >= (y: u8) = intrinsics.ule8 (sign y) (sign x)-  let (x: u8) != (y: u8) = ! (x == y)+  let (x: u8) != (y: u8) = intrinsics.! (x == y)    let sgn (x: u8) = unsign (intrinsics.usignum8 (sign x))   let abs (x: u8) = x@@ -538,7 +538,7 @@   let num_bits = 8   let get_bit (bit: i32) (x: t) = to_i32 ((x >> i32 bit) & i32 1)   let set_bit (bit: i32) (x: t) (b: i32) =-    ((x & i32 (intrinsics.~(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))+    ((x & i32 (intrinsics.!(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))    let iota (n: u8) = 0u8..1u8..<n   let replicate 'v (n: u8) (x: v) = map (const x) (iota n)@@ -567,7 +567,7 @@   let (x: u16) & (y: u16) = unsign (intrinsics.and16 (sign x) (sign y))   let (x: u16) | (y: u16) = unsign (intrinsics.or16 (sign x) (sign y))   let (x: u16) ^ (y: u16) = unsign (intrinsics.xor16 (sign x) (sign y))-  let ~ (x: u16) = unsign (intrinsics.complement16 (sign x))+  let ! (x: u16) = unsign (intrinsics.complement16 (sign x))    let (x: u16) << (y: u16) = unsign (intrinsics.shl16 (sign x) (sign y))   let (x: u16) >> (y: u16) = unsign (intrinsics.ashr16 (sign x) (sign y))@@ -596,7 +596,7 @@   let (x: u16) > (y: u16) = intrinsics.ult16 (sign y) (sign x)   let (x: u16) <= (y: u16) = intrinsics.ule16 (sign x) (sign y)   let (x: u16) >= (y: u16) = intrinsics.ule16 (sign y) (sign x)-  let (x: u16) != (y: u16) = ! (x == y)+  let (x: u16) != (y: u16) = intrinsics.! (x == y)    let sgn (x: u16) = unsign (intrinsics.usignum16 (sign x))   let abs (x: u16) = x@@ -611,7 +611,7 @@   let num_bits = 16   let get_bit (bit: i32) (x: t) = to_i32 ((x >> i32 bit) & i32 1)   let set_bit (bit: i32) (x: t) (b: i32) =-    ((x & i32 (intrinsics.~(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))+    ((x & i32 (intrinsics.!(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))    let iota (n: u16) = 0u16..1u16..<n   let replicate 'v (n: u16) (x: v) = map (const x) (iota n)@@ -640,7 +640,7 @@   let (x: u32) & (y: u32) = unsign (intrinsics.and32 (sign x) (sign y))   let (x: u32) | (y: u32) = unsign (intrinsics.or32 (sign x) (sign y))   let (x: u32) ^ (y: u32) = unsign (intrinsics.xor32 (sign x) (sign y))-  let ~ (x: u32) = unsign (intrinsics.complement32 (sign x))+  let ! (x: u32) = unsign (intrinsics.complement32 (sign x))    let (x: u32) << (y: u32) = unsign (intrinsics.shl32 (sign x) (sign y))   let (x: u32) >> (y: u32) = unsign (intrinsics.ashr32 (sign x) (sign y))@@ -669,7 +669,7 @@   let (x: u32) > (y: u32) = intrinsics.ult32 (sign y) (sign x)   let (x: u32) <= (y: u32) = intrinsics.ule32 (sign x) (sign y)   let (x: u32) >= (y: u32) = intrinsics.ule32 (sign y) (sign x)-  let (x: u32) != (y: u32) = ! (x == y)+  let (x: u32) != (y: u32) = intrinsics.! (x == y)    let sgn (x: u32) = unsign (intrinsics.usignum32 (sign x))   let abs (x: u32) = x@@ -684,7 +684,7 @@   let num_bits = 32   let get_bit (bit: i32) (x: t) = to_i32 ((x >> i32 bit) & i32 1)   let set_bit (bit: i32) (x: t) (b: i32) =-    ((x & i32 (intrinsics.~(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))+    ((x & i32 (intrinsics.!(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))    let iota (n: u32) = 0u32..1u32..<n   let replicate 'v (n: u32) (x: v) = map (const x) (iota n)@@ -713,7 +713,7 @@   let (x: u64) & (y: u64) = unsign (intrinsics.and64 (sign x) (sign y))   let (x: u64) | (y: u64) = unsign (intrinsics.or64 (sign x) (sign y))   let (x: u64) ^ (y: u64) = unsign (intrinsics.xor64 (sign x) (sign y))-  let ~ (x: u64) = unsign (intrinsics.complement64 (sign x))+  let ! (x: u64) = unsign (intrinsics.complement64 (sign x))    let (x: u64) << (y: u64) = unsign (intrinsics.shl64 (sign x) (sign y))   let (x: u64) >> (y: u64) = unsign (intrinsics.ashr64 (sign x) (sign y))@@ -742,7 +742,7 @@   let (x: u64) > (y: u64) = intrinsics.ult64 (sign y) (sign x)   let (x: u64) <= (y: u64) = intrinsics.ule64 (sign x) (sign y)   let (x: u64) >= (y: u64) = intrinsics.ule64 (sign y) (sign x)-  let (x: u64) != (y: u64) = ! (x == y)+  let (x: u64) != (y: u64) = intrinsics.! (x == y)    let sgn (x: u64) = unsign (intrinsics.usignum64 (sign x))   let abs (x: u64) = x@@ -757,7 +757,7 @@   let num_bits = 64   let get_bit (bit: i32) (x: t) = to_i32 ((x >> i32 bit) & i32 1)   let set_bit (bit: i32) (x: t) (b: i32) =-    ((x & i32 (intrinsics.~(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))+    ((x & i32 (intrinsics.!(1 intrinsics.<< bit))) | i32 (b intrinsics.<< bit))    let iota (n: u64) = 0u64..1u64..<n   let replicate 'v (n: u64) (x: v) = map (const x) (iota n)@@ -806,7 +806,7 @@   let (x: f64) > (y: f64) = intrinsics.lt64 y x   let (x: f64) <= (y: f64) = intrinsics.le64 x y   let (x: f64) >= (y: f64) = intrinsics.le64 y x-  let (x: f64) != (y: f64) = ! (x == y)+  let (x: f64) != (y: f64) = intrinsics.! (x == y)    let negate (x: t) = -x   let max (x: t) (y: t) = intrinsics.fmax64 x y@@ -849,8 +849,6 @@    let trunc (x: f64) : f64 = i64 (i64m.f64 x) -  let even (x: f64) = i64m.f64 x % 2i64 i64m.== 0i64-   let round = intrinsics.round64    let to_bits (x: f64): u64 = u64m.i64 (intrinsics.to_bits64 x)@@ -917,7 +915,7 @@   let (x: f32) > (y: f32) = intrinsics.lt32 y x   let (x: f32) <= (y: f32) = intrinsics.le32 x y   let (x: f32) >= (y: f32) = intrinsics.le32 y x-  let (x: f32) != (y: f32) = ! (x == y)+  let (x: f32) != (y: f32) = intrinsics.! (x == y)    let negate (x: t) = -x   let max (x: t) (y: t) = intrinsics.fmax32 x y@@ -959,8 +957,6 @@        else if ix > x then i32 (i i32m.- 1i32) else x    let trunc (x: f32) : f32 = i32 (i32m.f32 x)--  let even (x: f32) = i32m.f32 x % 2i32 i32m.== 0i32    let round = intrinsics.round32 

@@ -156,7 +156,7 @@   let (as', is) = intrinsics.partition (3, p', as)   in (as'[0:is[0]], as'[is[0]:is[0]+is[1]], as'[is[0]+is[1]:n]) --- | `stream_red op f as` splits `as` into chunks, applies `f` to each+-- | `reduce_stream op f as` splits `as` into chunks, applies `f` to each -- of these in parallel, and uses `op` (which must be associative) to -- combine the per-chunk results into a final result.  The `i32` -- passed to `f` is the size of the chunk.  This SOAC is useful when@@ -171,38 +171,38 @@ -- **Work:** *O(n)* -- -- **Span:** *O(log(n))*-let stream_red 'a 'b (op: b -> b -> b) (f: i32 -> []a -> b) (as: []a): b =-  intrinsics.stream_red (op, f, as)+let reduce_stream 'a 'b (op: b -> b -> b) (f: i32 -> []a -> b) (as: []a): b =+  intrinsics.reduce_stream (op, f, as) --- | As `stream_red`@term, but the chunks do not necessarily+-- | As `reduce_stream`@term, but the chunks do not necessarily -- correspond to subsequences of the original array (they may be -- interleaved). -- -- **Work:** *O(n)* -- -- **Span:** *O(log(n))*-let stream_red_per 'a 'b (op: b -> b -> b) (f: i32 -> []a -> b) (as: []a): b =-  intrinsics.stream_red_per (op, f, as)+let reduce_stream_per 'a 'b (op: b -> b -> b) (f: i32 -> []a -> b) (as: []a): b =+  intrinsics.reduce_stream_per (op, f, as) --- | Similar to `stream_red`@term, except that each chunk must produce+-- | Similar to `reduce_stream`@term, except that each chunk must produce -- an array *of the same size*.  The per-chunk results are -- concatenated. -- -- **Work:** *O(n)* -- -- **Span:** *O(1)*-let stream_map 'a 'b (f: i32 -> []a -> []b) (as: []a): *[]b =-  intrinsics.stream_map (f, as)+let map_stream 'a 'b (f: i32 -> []a -> []b) (as: []a): *[]b =+  intrinsics.map_stream (f, as) --- | Similar to `stream_map`@term, but the chunks do not necessarily+-- | Similar to `map_stream`@term, but the chunks do not necessarily -- correspond to subsequences of the original array (they may be -- interleaved). -- -- **Work:** *O(n)* -- -- **Span:** *O(1)*-let stream_map_per 'a 'b (f: i32 -> []a -> []b) (as: []a): *[]b =-  intrinsics.stream_map_per (f, as)+let map_stream_per 'a 'b (f: i32 -> []a -> []b) (as: []a): *[]b =+  intrinsics.map_stream_per (f, as)  -- | Return `true` if the given function returns `true` for all -- elements in the array.

@@ -0,0 +1,118 @@+name: futhark+version: "0.12.1"+synopsis: An optimising compiler for a functional, array-oriented language.+description: |+  Futhark is a small programming language designed to be compiled to+  efficient parallel code. It is a statically typed, data-parallel,+  and purely functional array language in the ML family, and comes+  with a heavily optimising ahead-of-time compiler that presently+  generates GPU code via CUDA and OpenCL, although the language itself+  is hardware-agnostic.++  For more information, see the website at https://futhark-lang.org+homepage: https://futhark-lang.org+maintainer: Troels Henriksen athas@sigkill.dk+license: ISC+github: diku-dk/futhark+category: Language++ghc-options: -Wall -Wcompat -Wredundant-constraints -Wincomplete-record-updates -Wmissing-export-lists++extra-source-files:+  - rts/python/*.py+  - rts/c/*.h+  - rts/csharp/*.cs+  - rts/futhark-doc/*.css++  - futlib/*.fut++  - docs/Makefile+  - docs/conf.py+  - docs/index.rst+  - docs/man/*.rst+  - package.yaml++library:+  dependencies:+    - base >= 4 && < 5+    - array >= 0.4+    - binary >= 0.8.3+    - data-binary-ieee754 >= 0.1+    - vector >= 0.12+    - vector-binary-instances >= 0.2.2.0+    - containers >= 0.6.2.1+    - mtl >= 2.2.1+    - transformers >= 0.3+    - srcloc >= 0.4+    - language-c-quote >= 0.12+    - mainland-pretty >= 0.6.1+    - megaparsec >= 7.0.1+    - parser-combinators >= 1.0.0+    - regex-tdfa >= 1.2+    - filepath >= 1.4.1.1+    - dlist >= 0.6.0.1+    - bytestring >= 0.10.8+    - text >= 1.2.2.2+    - neat-interpolation >= 0.3+    - file-embed >= 0.0.9+    - directory >= 1.3.0.0+    - directory-tree >= 0.12.1+    - gitrev >= 1.2.0+    - parallel >= 3.2.1.0+    - blaze-html >= 0.9.0.1+    - template-haskell >= 2.11.1+    - process >= 1.4.3.0+    - markdown >= 0.1.16+    - zlib >= 0.6.1.2+    - versions >= 3.3.1+    - http-client >= 0.5.7.0+    - http-client-tls >= 0.3.5.1+    - http-conduit >= 2.2.4+    - process-extras >= 0.7.2+    - free >= 4.12.4+    - zip-archive >= 0.3.1.1+    - time >= 1.6.0.1+    - ansi-terminal >= 0.6.3.1+    - random+    - temporary+    - aeson >= 1.0.0.0+    - haskeline+    - utf8-string >= 1+    - terminal-size >= 0.3++  build-tools:+    - alex+    - happy++  source-dirs: src++  other-modules:+    - Language.Futhark.Parser.Parser+    - Language.Futhark.Parser.Lexer+    - Paths_futhark++executables:+  futhark: &futhark+    main: src/futhark.hs+    dependencies:+      - base+      - futhark+      - text+    ghc-options: -threaded -rtsopts "-with-rtsopts=-N -qg"++tests:+  unit:+    source-dirs: unittests+    main: futhark_tests.hs+    dependencies:+      - base+      - futhark+      - containers+      - mtl+      - text+      - QuickCheck >= 2.8+      - tasty+      - tasty-quickcheck+      - tasty-hunit+      - megaparsec+      - parser-combinators

@@ -762,7 +762,8 @@         shape[i] = (int) bin_shape;     } -    var elem_size = Marshal.SizeOf(typeof(T));+    // 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];@@ -774,6 +775,10 @@         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)

@@ -542,7 +542,7 @@     # work on things that are insufficiently file-like, like a network     # stream.     bytes = f.get_chars(elem_count * FUTHARK_PRIMTYPES[expected_type]['size'])-    arr = np.fromstring(bytes, dtype='<'+bin_fmt)+    arr = np.fromstring(bytes, dtype=FUTHARK_PRIMTYPES[bin_type_enum]['numpy_type'])     arr.shape = shape      return arr

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, LambdaCase #-}+{-# LANGUAGE FlexibleInstances, LambdaCase #-} module Futhark.Analysis.AlgSimplify   ( ScalExp   , Error@@ -62,7 +62,7 @@  step :: AlgSimplifyM () step = do modify (1+)-          exceeded <- pure (>) <*> get <*> asks maxSteps+          exceeded <- gets (>) <*> asks maxSteps           when exceeded stepsExceeded  stepsExceeded :: AlgSimplifyM a@@ -345,7 +345,7 @@             case f of                 MaxMin ismin ts -> do                         let id_set = mconcat $ map freeIn ts-                        if S.member ii id_set+                        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')@@ -456,7 +456,7 @@ pickSymToElim rangesrep elsyms0 e_scal = --    ranges <- asks ranges --    e_scal <- fromNumSofP e0-    let ids0= S.toList $ freeIn 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@@ -516,7 +516,7 @@                                                             [] -> Val $ IntValue $ Int32Value 1                                                             f:fs' -> foldl STimes f fs'                                             let b_ids = freeIn fs_scal-                                            return $ acc && not (idd `S.member` b_ids)+                                            return $ acc && not (idd `nameIn` b_ids)                            _          -> badAlgSimplifyM "linearForm: ILLEGAL222!!!!"                     ) True b_terms 

@@ -14,9 +14,9 @@  import Futhark.Representation.SOACS -type FunctionTable = M.Map Name FunDef+type FunctionTable = M.Map Name (FunDef SOACS) -buildFunctionTable :: Prog -> FunctionTable+buildFunctionTable :: Prog SOACS -> FunctionTable buildFunctionTable = foldl expand M.empty . progFunctions   where expand ftab f = M.insert (funDefName f) f ftab @@ -27,7 +27,7 @@  -- | @buildCallGraph prog@ build the program's Call Graph. The representation -- is a hashtable that maps function names to a list of callee names.-buildCallGraph :: Prog -> CallGraph+buildCallGraph :: Prog SOACS -> CallGraph buildCallGraph prog = foldl' (buildCGfun ftable) M.empty entry_points   where entry_points = map funDefName $ filter (isJust . funDefEntryPoint) $ progFunctions prog         ftable = buildFunctionTable prog

@@ -8,7 +8,6 @@   where  import qualified Data.Map.Strict as M-import qualified Data.Set as S  import Futhark.Representation.AST @@ -31,8 +30,8 @@               cdeps = depsOf deps c               comb (pe, tres, fres) =                 (patElemName pe,-                 S.unions $ [freeIn pe, cdeps, depsOf tdeps tres, depsOf fdeps fres] ++-                 map (depsOfVar deps) (S.toList $ freeIn pe))+                 mconcat $ [freeIn pe, cdeps, depsOf tdeps tres, depsOf fdeps fres] +++                 map (depsOfVar deps) (namesToList $ freeIn pe))               branchdeps =                 M.fromList $ map comb $ zip3 (patternElements pat)                 (bodyResult tb)@@ -41,15 +40,15 @@          grow deps (Let pat _ e) =           let free = freeIn pat <> freeIn e-              freeDeps = S.unions $ map (depsOfVar deps) $ S.toList free+              freeDeps = mconcat $ map (depsOfVar deps) $ namesToList free           in M.fromList [ (name, freeDeps) | name <- patternNames pat ] `M.union` deps  depsOf :: Dependencies -> SubExp -> Names-depsOf _ (Constant _) = S.empty+depsOf _ (Constant _) = mempty depsOf deps (Var v)   = depsOfVar deps v  depsOfVar :: Dependencies -> VName -> Names-depsOfVar deps name = S.insert name $ M.findWithDefault S.empty name deps+depsOfVar deps name = oneName name <> M.findWithDefault mempty name deps  findNecessaryForReturned :: (Param attr -> Bool) -> [(Param attr, SubExp)]                          -> M.Map VName Names@@ -61,10 +60,10 @@           | otherwise                   = iterateNecessary necessary           where necessary = mconcat $ map dependencies returnedResultSubExps                 usedAfterLoopOrNecessary param =-                  usedAfterLoop param || paramName param `S.member` prev_necessary+                  usedAfterLoop param || paramName param `nameIn` prev_necessary                 returnedResultSubExps =                   map snd $ filter (usedAfterLoopOrNecessary . fst) merge_and_res                 dependencies (Constant _) =-                  S.empty+                  mempty                 dependencies (Var v)      =-                  M.findWithDefault (S.singleton v) v allDependencies+                  M.findWithDefault (oneName v) v allDependencies

@@ -16,11 +16,9 @@ import Data.List import Data.Maybe import qualified Data.Map.Strict as M-import qualified Data.Set as S  import qualified Futhark.Analysis.HORepresentation.SOAC as SOAC import Futhark.Analysis.HORepresentation.SOAC (SOAC)- import qualified Futhark.Representation.SOACS.SOAC as Futhark import Futhark.Transform.Substitute import Futhark.Representation.AST hiding (typeOf)@@ -104,7 +102,7 @@             | otherwise =               Nothing           boundUsedInBody =-            mapMaybe isBound $ S.toList $ freeIn lam+            mapMaybe isBound $ namesToList $ freeIn lam       newParams <- mapM (newIdent' (++"_wasfree")) boundUsedInBody       let subst = M.fromList $                   zip (map identName boundUsedInBody) (map identName newParams)

@@ -80,7 +80,7 @@     FunExp h <$> traverse (traverse f) args <*> pure t  instance FreeIn v => FreeIn (PrimExp v) where-  freeIn = foldMap freeIn+  freeIn' = foldMap freeIn'  -- | Perform quick and dirty constant folding on the top level of a -- PrimExp.  This is necessary because we want to consider@@ -103,6 +103,16 @@ constFoldPrimExp (BinOpExp bop (ValueExp x) (ValueExp y))   | Just z <- doBinOp bop x y =       ValueExp z+constFoldPrimExp (BinOpExp LogAnd x y)+  | oneIshExp x = y+  | oneIshExp y = x+  | zeroIshExp x = x+  | zeroIshExp y = y+constFoldPrimExp (BinOpExp LogOr x y)+  | oneIshExp x = x+  | oneIshExp y = y+  | zeroIshExp x = y+  | zeroIshExp y = x constFoldPrimExp e = e  -- The Num instance performs a little bit of magic: whenever an@@ -161,32 +171,38 @@  -- | Lifted logical conjunction. (.&&.) :: PrimExp v -> PrimExp v -> PrimExp v-x .&&. y = BinOpExp LogAnd x y+x .&&. y = constFoldPrimExp $ BinOpExp LogAnd x y  -- | Lifted logical conjunction. (.||.) :: PrimExp v -> PrimExp v -> PrimExp v-x .||. y = BinOpExp LogOr x y+x .||. y = constFoldPrimExp $ BinOpExp LogOr x y  -- | Lifted relational operators; assuming signed numbers in case of -- integers. (.<.), (.>.), (.<=.), (.>=.), (.==.) :: PrimExp v -> PrimExp v -> PrimExp v-x .<. y = CmpOpExp cmp x y where cmp = case primExpType x of+x .<. y = constFoldPrimExp $+          CmpOpExp cmp x y where cmp = case primExpType x of                                          IntType t -> CmpSlt $ t `min` primExpIntType y                                          FloatType t -> FCmpLt t                                          _ -> CmpLlt-x .<=. y = CmpOpExp cmp x y where cmp = case primExpType x of+x .<=. y = constFoldPrimExp $+           CmpOpExp cmp x y where cmp = case primExpType x of                                           IntType t -> CmpSle $ t `min` primExpIntType y                                           FloatType t -> FCmpLe t                                           _ -> CmpLle-x .==. y = CmpOpExp (CmpEq $ primExpType x `min` primExpType y) x y+x .==. y = constFoldPrimExp $+           CmpOpExp (CmpEq $ primExpType x `min` primExpType y) x y x .>. y = y .<. x x .>=. y = y .<=. x  -- | Lifted bitwise operators. (.&.), (.|.), (.^.) :: PrimExp v -> PrimExp v -> PrimExp v-x .&. y = BinOpExp (And $ primExpIntType x `min` primExpIntType y) x y-x .|. y = BinOpExp (Or $ primExpIntType x `min` primExpIntType y) x y-x .^. y = BinOpExp (Xor $ primExpIntType x `min` primExpIntType y) x y+x .&. y = constFoldPrimExp $+          BinOpExp (And $ primExpIntType x `min` primExpIntType y) x y+x .|. y = constFoldPrimExp $+          BinOpExp (Or $ primExpIntType x `min` primExpIntType y) x y+x .^. y = constFoldPrimExp $+          BinOpExp (Xor $ primExpIntType x `min` primExpIntType y) x y  infix 4 .==., .<., .>., .<=., .>=. infixr 3 .&&.

@@ -96,8 +96,7 @@ runRangeM :: RangeM a -> a runRangeM = flip runReader emptyRangeEnv -bindFunParams :: Typed attr =>-                 [ParamT attr] -> RangeM a -> RangeM a+bindFunParams :: Typed attr => [Param attr] -> RangeM a -> RangeM a bindFunParams []             m =   m bindFunParams (param:params) m = do@@ -108,8 +107,7 @@   where bindFunParam = M.insert (paramName param) unknownRange         dims = arrayDims $ paramType param -bindPattern :: Typed attr =>-               PatternT (Range, attr) -> RangeM a -> RangeM a+bindPattern :: Typed attr => PatternT (Range, attr) -> RangeM a -> RangeM a bindPattern pat m = do   ranges <- rangesRep   local bindPatElems $

@@ -61,7 +61,7 @@ rephrasePatElem rephraser (PatElem ident from) =   PatElem ident <$> rephraser from -rephraseParam :: Monad m => (from -> m to) -> ParamT from -> m (ParamT to)+rephraseParam :: Monad m => (from -> m to) -> Param from -> m (Param to) rephraseParam rephraser (Param name from) =   Param name <$> rephraser from 

@@ -13,7 +13,6 @@ where  import Data.List-import qualified Data.Set as S import Data.Maybe import Data.Monoid ((<>)) @@ -289,22 +288,22 @@                    ]  instance FreeIn ScalExp where-  freeIn (Val   _) = mempty-  freeIn (Id i _)  = S.singleton i-  freeIn (SNeg  e) = freeIn e-  freeIn (SNot  e) = freeIn e-  freeIn (SAbs  e) = freeIn e-  freeIn (SSignum e) = freeIn e-  freeIn (SPlus x y)   = freeIn x <> freeIn y-  freeIn (SMinus x y)  = freeIn x <> freeIn y-  freeIn (SPow x y)    = freeIn x <> freeIn y-  freeIn (STimes x y)  = freeIn x <> freeIn y-  freeIn (SDiv x y) = freeIn x <> freeIn y-  freeIn (SMod x y) = freeIn x <> freeIn y-  freeIn (SQuot x y) = freeIn x <> freeIn y-  freeIn (SRem x y) = freeIn x <> freeIn y-  freeIn (SLogOr x y)  = freeIn x <> freeIn y-  freeIn (SLogAnd x y) = freeIn x <> freeIn y-  freeIn (RelExp LTH0 e) = freeIn e-  freeIn (RelExp LEQ0 e) = freeIn e-  freeIn (MaxMin _  es) = mconcat $ map freeIn es+  freeIn' (Val   _) = mempty+  freeIn' (Id i _) = fvName i+  freeIn' (SNeg  e) = freeIn' e+  freeIn' (SNot  e) = freeIn' e+  freeIn' (SAbs  e) = freeIn' e+  freeIn' (SSignum e) = freeIn' e+  freeIn' (SPlus x y) = freeIn' x <> freeIn' y+  freeIn' (SMinus x y) = freeIn' x <> freeIn' y+  freeIn' (SPow x y) = freeIn' x <> freeIn' y+  freeIn' (STimes x y) = freeIn' x <> freeIn' y+  freeIn' (SDiv x y) = freeIn' x <> freeIn' y+  freeIn' (SMod x y) = freeIn' x <> freeIn' y+  freeIn' (SQuot x y) = freeIn' x <> freeIn' y+  freeIn' (SRem x y) = freeIn' x <> freeIn' y+  freeIn' (SLogOr x y)  = freeIn' x <> freeIn' y+  freeIn' (SLogAnd x y) = freeIn' x <> freeIn' y+  freeIn' (RelExp LTH0 e) = freeIn' e+  freeIn' (RelExp LEQ0 e) = freeIn' e+  freeIn' (MaxMin _  es) = freeIn' es

@@ -3,7 +3,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeFamilies #-} module Futhark.Analysis.SymbolTable-  ( SymbolTable (bindings, loopDepth, availableAtClosestLoop)+  ( SymbolTable (bindings, loopDepth, availableAtClosestLoop, simplifyMemory)   , empty   , fromScope   , toScope@@ -51,6 +51,8 @@     -- * Misc   , enclosingLoopVars   , rangesRep+  , hideIf+  , hideCertified   )   where @@ -67,7 +69,7 @@ import Prelude hiding (elem, lookup)  import Futhark.Analysis.PrimExp.Convert-import Futhark.Representation.AST hiding (FParam, ParamT (..), lookupType)+import Futhark.Representation.AST hiding (FParam, lookupType) import qualified Futhark.Representation.AST as AST import Futhark.Analysis.ScalExp @@ -84,6 +86,10 @@   , availableAtClosestLoop :: Names     -- ^ Which names are available just before the most enclosing     -- loop?+  , simplifyMemory :: Bool+    -- ^ We are in a situation where we should+    -- simplify/hoist/un-existentialise memory as much as possible -+    -- typically, inside a kernel.   }  instance Semigroup (SymbolTable lore) where@@ -92,13 +98,14 @@                 , bindings = bindings table1 <> bindings table2                 , availableAtClosestLoop = availableAtClosestLoop table1 <>                                            availableAtClosestLoop table2+                , simplifyMemory = simplifyMemory table1 || simplifyMemory table2                 }  instance Monoid (SymbolTable lore) where   mempty = empty  empty :: SymbolTable lore-empty = SymbolTable 0 M.empty mempty+empty = SymbolTable 0 M.empty mempty False  fromScope :: Attributes lore => Scope lore -> SymbolTable lore fromScope = M.foldlWithKey' insertFreeVar' empty@@ -144,8 +151,8 @@                    -> (FreeVarEntry fromlore -> Entry tolore)                    -> SymbolTable fromlore                    -> SymbolTable tolore-genCastSymbolTable loopVar letBound fParam lParam freeVar (SymbolTable depth entries loopfree) =-  SymbolTable depth (M.map onEntry entries) loopfree+genCastSymbolTable loopVar letBound fParam lParam freeVar vtable =+  vtable { bindings = M.map onEntry $ bindings vtable }   where onEntry (LoopVar entry) = loopVar entry         onEntry (LetBound entry) = letBound entry         onEntry (FParam entry) = fParam entry@@ -154,7 +161,7 @@  deepen :: SymbolTable lore -> SymbolTable lore deepen vtable = vtable { loopDepth = loopDepth vtable + 1,-                         availableAtClosestLoop = S.fromList $ M.keys $ bindings vtable+                         availableAtClosestLoop = namesFromList $ M.keys $ bindings vtable                        }  -- | Indexing a delayed array if possible.@@ -540,7 +547,7 @@           -> SymbolTable lore           -> SymbolTable lore insertStm stm vtable =-  flip (foldl' $ flip consume) stm_consumed $+  flip (foldl' $ flip consume) (namesToList stm_consumed) $   flip (foldl' addRevAliases) (patternElements $ stmPattern stm) $   insertEntries (zip names $ map LetBound $ bindingEntries stm vtable) vtable   where names = patternNames $ stmPattern stm@@ -548,19 +555,19 @@         stm_consumed = expandAliases (Aliases.consumedInStm stm) vtable         addRevAliases vtable' pe =           vtable' { bindings = adjustSeveral update inedges $ bindings vtable' }-          where inedges = expandAliases (Aliases.aliasesOf pe) vtable'+          where inedges = namesToList $ expandAliases (Aliases.aliasesOf pe) vtable'                 update (LetBound entry) =                   LetBound entry-                  { letBoundAliases = patElemName pe `S.insert` letBoundAliases entry }+                  { letBoundAliases = oneName (patElemName pe) <> letBoundAliases entry }                 update (FParam entry) =                   FParam entry-                  { fparamAliases = patElemName pe `S.insert` fparamAliases entry }+                  { fparamAliases = oneName (patElemName pe) <> fparamAliases entry }                 update e = e  expandAliases :: Names -> SymbolTable lore -> Names-expandAliases names vtable = names `S.union` aliasesOfAliases+expandAliases names vtable = names <> aliasesOfAliases   where aliasesOfAliases =-          mconcat . map (`lookupAliases` vtable) . S.toList $ names+          mconcat . map (`lookupAliases` vtable) . namesToList $ names  insertFParam :: Attributes lore =>                 AST.FParam lore@@ -731,26 +738,28 @@         let candidates = freeIn e_scal             sym0 = AS.pickSymToElim ranges elsyms0 e_scal         case sym0 of-            Just sy -> let trclsyms = foldl trClSymsInRange S.empty $ S.toList $-                                        candidates `S.difference` S.singleton sy-                       in  if   S.member sy trclsyms+            Just sy -> let trclsyms = foldl trClSymsInRange mempty $ namesToList $+                                      candidates `namesSubtract` oneName sy+                       in  if   sy `nameIn` trclsyms                            then pickRefinedSym (S.insert sy elsyms0) e_scal                            else sym0             Nothing -> sym0+       -- computes the transitive closure of the symbols appearing       -- in the ranges of a symbol-      trClSymsInRange :: S.Set VName -> VName -> S.Set VName+      trClSymsInRange :: Names -> VName -> Names       trClSymsInRange cur_syms sym =-        if S.member sym cur_syms then cur_syms+        if sym `nameIn` cur_syms then cur_syms         else case M.lookup sym ranges of-               Just (_,lb,ub) -> let sym_bds = concatMap (S.toList . freeIn) (catMaybes [lb, ub])+               Just (_,lb,ub) -> let sym_bds = concatMap (namesToList . freeIn) (catMaybes [lb, ub])                                  in  foldl trClSymsInRange-                                           (S.insert sym cur_syms)-                                           (S.toList $ S.fromList sym_bds)-               Nothing        -> S.insert sym cur_syms+                                           (oneName sym <> cur_syms)+                                           sym_bds+               Nothing        -> oneName sym <> cur_syms  consume :: Attributes lore => VName -> SymbolTable lore -> SymbolTable lore-consume consumee vtable = foldl' consume' vtable $ expandAliases (S.singleton consumee) vtable+consume consumee vtable = foldl' consume' vtable $ namesToList $+                          expandAliases (oneName consumee) vtable   where consume' vtable' v | Just e <- lookup v vtable = insertEntry v (consume'' e) vtable'                            | otherwise                 = vtable'         consume'' (FreeVar e)  = FreeVar e { freeVarConsumed = True }@@ -794,3 +803,21 @@ isAtLeast :: VName -> Int -> SymbolTable lore -> SymbolTable lore isAtLeast name x =   setLowerBound name $ fromIntegral x++-- | Hide definitions of those entries that satisfy some predicate.+hideIf :: (Entry lore -> Bool) -> SymbolTable lore -> SymbolTable lore+hideIf hide vtable = vtable { bindings = M.map maybeHide $ bindings vtable }+  where maybeHide entry+          | hide entry = FreeVar FreeVarEntry { freeVarAttr = entryInfo entry+                                              , freeVarStmDepth = bindingDepth entry+                                              , freeVarRange = valueRange entry+                                              , freeVarIndex = \_ _ -> Nothing+                                              , freeVarConsumed = consumed entry+                                              }+          | otherwise = entry++-- | Hide these definitions, if they are protected by certificates in+-- the set of names.+hideCertified :: Names -> SymbolTable lore -> SymbolTable lore+hideCertified to_hide = hideIf $ maybe False hide . entryStm+  where hide = any (`nameIn` to_hide) . unCertificates . stmCerts

@@ -2,7 +2,6 @@ module Futhark.Analysis.Usage ( usageInStm ) where  import Data.Foldable-import qualified Data.Set as S  import Futhark.Representation.AST import Futhark.Representation.AST.Attributes.Aliases@@ -16,25 +15,25 @@            UT.usages (freeIn e)]   where usageInPat =           UT.usages (mconcat (map freeIn $ patternElements pat)-                     `S.difference`-                     S.fromList (patternNames pat))+                     `namesSubtract`+                     namesFromList (patternNames pat))         usageInExpLore =           UT.usages $ freeIn lore  usageInExp :: Aliased lore => Exp lore -> UT.UsageTable usageInExp (Apply _ args _ _) =   mconcat [ mconcat $ map UT.consumedUsage $-            S.toList $ subExpAliases arg+            namesToList $ subExpAliases arg           | (arg,d) <- args, d == Consume ] usageInExp (DoLoop _ merge _ _) =   mconcat [ mconcat $ map UT.consumedUsage $-            S.toList $ subExpAliases se+            namesToList $ subExpAliases se           | (v,se) <- merge, unique $ paramDeclType v ] usageInExp (If _ tbranch fbranch _) =-  fold $ map UT.consumedUsage $ S.toList $+  fold $ map UT.consumedUsage $ namesToList $   consumedInBody tbranch <> consumedInBody fbranch usageInExp (BasicOp (Update src _ _)) =   UT.consumedUsage src usageInExp (Op op) =-  mconcat $ map UT.consumedUsage (S.toList $ consumedInOp op)+  mconcat $ map UT.consumedUsage (namesToList $ consumedInOp op) usageInExp _ = UT.empty

@@ -27,7 +27,6 @@ import qualified Data.Foldable as Foldable import Data.List (foldl') import qualified Data.Map.Strict as M-import qualified Data.Set as S  import Prelude hiding (lookup) @@ -72,7 +71,8 @@ -- | Expand the usage table based on aliasing information. expand :: (VName -> Names) -> UsageTable -> UsageTable expand look (UsageTable m) = UsageTable $ foldl' grow m $ M.toList m-  where grow m' (k, v) = foldl' (grow'' $ v `withoutU` presentU) m' $ look k+  where grow m' (k, v) = foldl' (grow'' $ v `withoutU` presentU) m' $+                         namesToList $ look k         grow'' v m'' k = M.insertWith (<>) k v m''  keys :: UsageTable -> [VName]@@ -94,10 +94,10 @@  allConsumed :: UsageTable -> Names allConsumed (UsageTable m) =-  S.fromList . map fst . filter (matches consumedU . snd) $ M.toList m+  namesFromList . map fst . filter (matches consumedU . snd) $ M.toList m  usages :: Names -> UsageTable-usages names = UsageTable $ M.fromList [ (name, presentU) | name <- S.toList names ]+usages names = UsageTable $ M.fromList [ (name, presentU) | name <- namesToList names ]  usage :: VName -> Usages -> UsageTable usage name uses = UsageTable $ M.singleton name uses

@@ -5,7 +5,8 @@ module Futhark.Binder   ( -- * A concrete @MonadBinder@ monad.     BinderT-  , runBinderT+  , runBinderT, runBinderT_+  , runBinderT', runBinderT'_   , BinderOps (..)   , bindableMkExpAttrB   , bindableMkBodyB@@ -106,6 +107,21 @@ runBinderT (BinderT m) scope = do   (x, (stms, _)) <- runStateT m (mempty, scope)   return (x, stms)++runBinderT_ :: MonadFreshNames m =>+                BinderT lore m a -> Scope lore -> m (Stms lore)+runBinderT_ m = fmap snd . runBinderT m++runBinderT' :: (MonadFreshNames m, HasScope somelore m, SameScope somelore lore) =>+               BinderT lore m a+            -> m (a, Stms lore)+runBinderT' m = do+  scope <- askScope+  runBinderT m $ castScope scope++runBinderT'_ :: (MonadFreshNames m, HasScope somelore m, SameScope somelore lore) =>+                BinderT lore m a -> m (Stms lore)+runBinderT'_ = fmap snd . runBinderT'  runBinder :: (MonadFreshNames m,               HasScope somelore m, SameScope somelore lore) =>

@@ -19,6 +19,7 @@ import System.Console.GetOpt import System.FilePath import System.Directory+import System.Environment import System.IO import System.IO.Temp import System.Timeout@@ -35,7 +36,7 @@  data BenchOptions = BenchOptions                    { optBackend :: String-                   , optFuthark :: String+                   , optFuthark :: Maybe String                    , optRunner :: String                    , optRuns :: Int                    , optExtraOptions :: [String]@@ -49,7 +50,7 @@                    }  initialBenchOptions :: BenchOptions-initialBenchOptions = BenchOptions "c" "futhark" "" 10 [] Nothing (-1) False+initialBenchOptions = BenchOptions "c" Nothing "" 10 [] Nothing (-1) False                       ["nobench", "disable"] [] Nothing (Just "tuning")  -- | The name we use for compiled programs.@@ -133,6 +134,8 @@         else do         putStr $ "Compiling " ++ program ++ "...\n" +        futhark <- maybe getExecutablePath return $ optFuthark opts+         ref_res <- runExceptT $ ensureReferenceOutput futhark "c" program cases         case ref_res of           Left err -> do@@ -154,7 +157,6 @@     _ ->       return $ Left Skipped   where hasRuns (InputOutputs _ runs) = not $ null runs-        futhark = optFuthark opts  runBenchmark :: BenchOptions -> (FilePath, [InputOutputs]) -> IO [BenchResult] runBenchmark opts (program, cases) = mapM forInputOutputs $ filter relevant cases@@ -327,9 +329,9 @@      "PROGRAM")     "The compiler used (defaults to 'futhark-c')."   , Option [] ["futhark"]-    (ReqArg (\prog -> Right $ \config -> config { optFuthark = prog })+    (ReqArg (\prog -> Right $ \config -> config { optFuthark = Just prog })      "PROGRAM")-    "The binary used for operations (defaults to 'futhark')."+    "The binary used for operations (defaults to same binary as 'futhark bench')."   , Option [] ["runner"]     (ReqArg (\prog -> Right $ \config -> config { optRunner = prog }) "PROGRAM")     "The program used to run the Futhark-generated programs (defaults to nothing)."

@@ -140,7 +140,7 @@ toValueType TERecord{} = Left "Cannot handle records yet." toValueType TEApply{} = Left "Cannot handle type applications yet." toValueType TEArrow{} = Left "Cannot generate functions."-toValueType TEEnum{} = Left "Cannot handle enums yet."+toValueType TESum{} = Left "Cannot handle sumtypes yet." toValueType (TEUnique t _) = toValueType t toValueType (TEArray t d _) = do   d' <- constantDim d

@@ -376,7 +376,7 @@               prog <- runPipelineOnProgram (futharkConfig config) id file               runPolyPasses config prog -runPolyPasses :: Config -> SOACS.Prog -> FutharkM ()+runPolyPasses :: Config -> Prog SOACS -> FutharkM () runPolyPasses config prog = do     prog' <- foldM (runPolyPass pipeline_config) (SOACS prog) (getFutharkPipeline config)     case (prog', futharkAction config) of

@@ -19,6 +19,7 @@ import qualified Data.Text.IO as T import System.Console.ANSI import System.Process.ByteString (readProcessWithExitCode)+import System.Environment import System.Exit import System.FilePath import System.Console.GetOpt@@ -98,14 +99,15 @@                    GpuPipeline ->                      check "--gpu"   where check opt = do+          futhark <- io $ maybe getExecutablePath return $ configFuthark programs           (code, output, err) <--            io $ readProcessWithExitCode (configFuthark programs) ["dev", opt, "--metrics", program] ""+            io $ readProcessWithExitCode futhark ["dev", opt, "--metrics", program] ""           let output' = T.decodeUtf8 output           case code of             ExitSuccess               | [(m, [])] <- reads $ T.unpack output' -> return m               | otherwise -> throwError $ "Could not read metrics output:\n" <> output'-            ExitFailure 127 -> throwError $ progNotFound $ T.pack $ configFuthark programs+            ExitFailure 127 -> throwError $ progNotFound $ T.pack futhark             ExitFailure _ -> throwError $ T.decodeUtf8 err  testMetrics :: ProgConfig -> FilePath -> StructureTest -> TestM ()@@ -122,7 +124,7 @@             Just actual_occurences               | expected_occurences /= actual_occurences ->                 throwError $ name <> " should have occurred " <> T.pack (show expected_occurences) <>-              " times, but occured " <> T.pack (show actual_occurences) <> " times."+              " times, but occurred " <> T.pack (show actual_occurences) <> " times."             _ -> return ()  testWarnings :: [WarningTest] -> SBS.ByteString -> TestM ()@@ -134,7 +136,8 @@           | otherwise = return ()  runTestCase :: TestCase -> TestM ()-runTestCase (TestCase mode program testcase progs) =+runTestCase (TestCase mode program testcase progs) = do+  futhark <- io $ maybe getExecutablePath return $ configFuthark progs   case testAction testcase of      CompileTimeFailure expected_error ->@@ -180,7 +183,6 @@       unless (mode == Compile || mode == Compiled) $         context "Interpreting" $           accErrors_ $ map (runInterpretedEntry futhark program) ios-  where futhark = configFuthark progs  runInterpretedEntry :: String -> FilePath -> InputOutputs -> TestM() runInterpretedEntry futhark program (InputOutputs entry run_cases) =@@ -317,6 +319,19 @@ excludedTest config =   any (`elem` configExclude config) . testTags . testCaseTest +-- | Exclude those test cases that have tags we do not wish to run.+excludeCases :: TestConfig -> TestCase -> TestCase+excludeCases config tcase =+  tcase { testCaseTest = onTest $ testCaseTest tcase }+  where onTest (ProgramTest desc tags action) =+          ProgramTest desc tags $ onAction action+        onAction (RunCases ios stest wtest) =+          RunCases (map onIOs ios) stest wtest+        onAction action = action+        onIOs (InputOutputs entry runs) =+          InputOutputs entry $ filter (not . any excluded . runTags) runs+        excluded = (`elem` configExclude config) . T.pack+ statusTable :: TestStatus -> String statusTable ts = buildTable rows 1   where rows =@@ -383,7 +398,7 @@   replicateM_ concurrency $ forkIO $ runTest testmvar reportmvar    let (excluded, included) = partition (excludedTest config) all_tests-  _ <- forkIO $ mapM_ (putMVar testmvar) included+  _ <- forkIO $ mapM_ (putMVar testmvar . excludeCases config) included   isTTY <- (&& not (configLineOutput config)) <$> hIsTerminalDevice stdout    let report | isTTY = reportTable@@ -476,7 +491,7 @@                            , configPrograms =                              ProgConfig                              { configBackend = "c"-                             , configFuthark = "futhark"+                             , configFuthark = Nothing                              , configRunner = ""                              , configExtraOptions = []                              , configExtraCompilerOptions = []@@ -487,7 +502,7 @@  data ProgConfig = ProgConfig                   { configBackend :: String-                  , configFuthark :: FilePath+                  , configFuthark :: Maybe FilePath                   , configRunner :: FilePath                   , configExtraCompilerOptions :: [String]                   , configTuning :: Maybe String@@ -505,7 +520,7 @@  setFuthark :: FilePath -> ProgConfig -> ProgConfig setFuthark futhark config =-  config { configFuthark = futhark }+  config { configFuthark = Just futhark }  setRunner :: FilePath -> ProgConfig -> ProgConfig setRunner runner config =@@ -548,7 +563,7 @@     "Backend used for compilation (defaults to 'c')."   , Option [] ["futhark"]     (ReqArg (Right . changeProgConfig . setFuthark) "PROGRAM")-    "Program to run for subcommands (defaults to 'futhark')."+    "Program to run for subcommands (defaults to same binary as 'futhark test')."   , Option [] ["runner"]     (ReqArg (Right . changeProgConfig . setRunner) "PROGRAM")     "The program used to run the Futhark-generated programs (defaults to nothing)."@@ -564,6 +579,9 @@   , Option [] ["pass-compiler-option"]     (ReqArg (Right . changeProgConfig . addCompilerOption) "OPT")     "Pass this option to the compiler (or typechecker if in -t mode)."+  , Option [] ["no-tuning"]+    (NoArg $ Right $ changeProgConfig $ \config -> config { configTuning = Nothing })+    "Do not load tuning files."   ]  main :: String -> [String] -> IO ()

@@ -320,7 +320,7 @@           |]          setKernelArg i (SharedMemoryKArg num_bytes) = do-          num_bytes' <- GC.compileExp $ innerExp num_bytes+          num_bytes' <- GC.compileExp $ unCount num_bytes           GC.stm [C.cstm|             OPENCL_SUCCEED_OR_RETURN(clSetKernelArg(ctx->$id:name, $int:i, $exp:num_bytes', NULL));             |]

@@ -1,4 +1,4 @@-{-# LANGUAGE QuasiQuotes, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE QuasiQuotes, GeneralizedNewtypeDeriving, FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-orphans #-}

@@ -39,6 +39,7 @@    , CompilerEnv(..)   , CompilerState(..)+  , CompilerAcc   , stm   , stms   , atInit

@@ -10,6 +10,7 @@   , CSUInt(..)   , CSFloat(..)   , CSIdx (..)+  , ArgMemType(..)   , CSArg (..)   , CSStmt(..)   , module Language.Futhark.Core

@@ -1,7 +1,5 @@ {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TupleSections #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Imperative intermediate language used as a stepping stone in code generation. -- -- This is a generic representation parametrised on an extensible@@ -38,7 +36,6 @@   , ArrayContents(..)      -- * Typed enumerations-  , Count (..)   , Bytes   , Elements   , elements@@ -56,6 +53,7 @@   , module Language.Futhark.Core   , module Futhark.Representation.Primitive   , module Futhark.Analysis.PrimExp+  , module Futhark.Representation.Kernels.Sizes   )   where @@ -63,7 +61,6 @@ import Data.List import Data.Loc import Data.Traversable-import qualified Data.Set as S  import Language.Futhark.Core import Futhark.Representation.Primitive@@ -71,9 +68,9 @@   (Space(..), SpaceId, ErrorMsg(..), ErrorMsgPart(..)) import Futhark.Representation.AST.Attributes.Names import Futhark.Representation.AST.Pretty ()-import Futhark.Util.IntegralExp import Futhark.Analysis.PrimExp import Futhark.Util.Pretty hiding (space)+import Futhark.Representation.Kernels.Sizes (Count(..))  data Size = ConstSize Int64           | VarSize VName@@ -160,7 +157,7 @@               -- This is mostly used for constant arrays, but also for               -- some bookkeeping data, like the synchronisation               -- counts used to implement reduction.-            | Allocate VName (Count Bytes) Space+            | Allocate VName (Count Bytes Exp) Space               -- ^ Memory space must match the corresponding               -- 'DeclareMem'.             | Free VName Space@@ -171,11 +168,11 @@               -- is the last reference.  There is no guarantee that               -- all memory blocks will be freed with this statement.               -- Backends are free to ignore it entirely.-            | Copy VName (Count Bytes) Space VName (Count Bytes) Space (Count Bytes)+            | Copy VName (Count Bytes Exp) Space VName (Count Bytes Exp) Space (Count Bytes Exp)               -- ^ Destination, offset in destination, destination               -- space, source, offset in source, offset space, number               -- of bytes.-            | Write VName (Count Elements) PrimType Space Volatility Exp+            | Write VName (Count Elements Exp) PrimType Space Volatility Exp             | SetScalar VName Exp             | SetMem VName VName Space               -- ^ Must be in same space.@@ -210,7 +207,7 @@  data ExpLeaf = ScalarVar VName              | SizeOf PrimType-             | Index VName (Count Elements) PrimType Space Volatility+             | Index VName (Count Elements Exp) PrimType Space Volatility            deriving (Eq, Show)  type Exp = PrimExp ExpLeaf@@ -220,32 +217,27 @@          | MemArg VName          deriving (Show) --- | A wrapper around 'Imp.Exp' that maintains a unit as a phantom--- type.-newtype Count u = Count { innerExp :: Exp }-                deriving (Eq, Show, Num, IntegralExp, FreeIn, Pretty)- -- | Phantom type for a count of elements. data Elements  -- | Phantom type for a count of bytes. data Bytes -elements :: Exp -> Count Elements+elements :: Exp -> Count Elements Exp elements = Count -bytes :: Exp -> Count Bytes+bytes :: Exp -> Count Bytes Exp bytes = Count  -- | Convert a count of elements into a count of bytes, given the -- per-element size.-withElemType :: Count Elements -> PrimType -> Count Bytes+withElemType :: Count Elements Exp -> PrimType -> Count Bytes Exp withElemType (Count e) t = bytes $ e * LeafExp (SizeOf t) (IntType Int32) -dimSizeToExp :: DimSize -> Count Elements+dimSizeToExp :: DimSize -> Count Elements Exp dimSizeToExp = elements . sizeToExp -memSizeToExp :: MemSize -> Count Bytes+memSizeToExp :: MemSize -> Count Bytes Exp memSizeToExp = bytes . sizeToExp  sizeToExp :: Size -> Exp@@ -259,7 +251,7 @@ vi32 :: VName -> Exp vi32 = flip var $ IntType Int32 -index :: VName -> Count Elements -> PrimType -> Space -> Volatility -> Exp+index :: VName -> Count Elements Exp -> PrimType -> Space -> Volatility -> Exp index arr i t s vol = LeafExp (Index arr i t s vol) t  -- Prettyprinting definitions.@@ -457,65 +449,65 @@     pure $ DebugPrint s v  declaredIn :: Code a -> Names-declaredIn (DeclareMem name _) = S.singleton name-declaredIn (DeclareScalar name _) = S.singleton name-declaredIn (DeclareArray name _ _ _) = S.singleton name+declaredIn (DeclareMem name _) = oneName name+declaredIn (DeclareScalar name _) = oneName name+declaredIn (DeclareArray name _ _ _) = oneName name declaredIn (If _ t f) = declaredIn t <> declaredIn f declaredIn (x :>>: y) = declaredIn x <> declaredIn y-declaredIn (For i _ _ body) = S.singleton i <> declaredIn body+declaredIn (For i _ _ body) = oneName i <> declaredIn body declaredIn (While _ body) = declaredIn body declaredIn (Comment _ body) = declaredIn body declaredIn _ = mempty  instance FreeIn a => FreeIn (Code a) where-  freeIn (x :>>: y) =-    freeIn x <> freeIn y `S.difference` declaredIn x-  freeIn Skip =+  freeIn' (x :>>: y) =+    fvBind (declaredIn x) $ freeIn' x <> freeIn' y+  freeIn' Skip =     mempty-  freeIn (For i _ bound body) =-    i `S.delete` (freeIn bound <> freeIn body)-  freeIn (While cond body) =-    freeIn cond <> freeIn body-  freeIn DeclareMem{} =+  freeIn' (For i _ bound body) =+    fvBind (oneName i) $ freeIn' bound <> freeIn' body+  freeIn' (While cond body) =+    freeIn' cond <> freeIn' body+  freeIn' DeclareMem{} =     mempty-  freeIn DeclareScalar{} =+  freeIn' DeclareScalar{} =     mempty-  freeIn DeclareArray{} =+  freeIn' DeclareArray{} =     mempty-  freeIn (Allocate name size _) =-    freeIn name <> freeIn size-  freeIn (Free name _) =-    freeIn name-  freeIn (Copy dest x _ src y _ n) =-    freeIn dest <> freeIn x <> freeIn src <> freeIn y <> freeIn n-  freeIn (SetMem x y _) =-    freeIn x <> freeIn y-  freeIn (Write v i _ _ _ e) =-    freeIn v <> freeIn i <> freeIn e-  freeIn (SetScalar x y) =-    freeIn x <> freeIn y-  freeIn (Call dests _ args) =-    freeIn dests <> freeIn args-  freeIn (If cond t f) =-    freeIn cond <> freeIn t <> freeIn f-  freeIn (Assert e _ _) =-    freeIn e-  freeIn (Op op) =-    freeIn op-  freeIn (Comment _ code) =-    freeIn code-  freeIn (DebugPrint _ v) =-    maybe mempty (freeIn . snd) v+  freeIn' (Allocate name size _) =+    freeIn' name <> freeIn' size+  freeIn' (Free name _) =+    freeIn' name+  freeIn' (Copy dest x _ src y _ n) =+    freeIn' dest <> freeIn' x <> freeIn' src <> freeIn' y <> freeIn' n+  freeIn' (SetMem x y _) =+    freeIn' x <> freeIn' y+  freeIn' (Write v i _ _ _ e) =+    freeIn' v <> freeIn' i <> freeIn' e+  freeIn' (SetScalar x y) =+    freeIn' x <> freeIn' y+  freeIn' (Call dests _ args) =+    freeIn' dests <> freeIn' args+  freeIn' (If cond t f) =+    freeIn' cond <> freeIn' t <> freeIn' f+  freeIn' (Assert e _ _) =+    freeIn' e+  freeIn' (Op op) =+    freeIn' op+  freeIn' (Comment _ code) =+    freeIn' code+  freeIn' (DebugPrint _ v) =+    maybe mempty (freeIn' . snd) v  instance FreeIn ExpLeaf where-  freeIn (Index v e _ _ _) = freeIn v <> freeIn e-  freeIn (ScalarVar v) = freeIn v-  freeIn (SizeOf _) = mempty+  freeIn' (Index v e _ _ _) = freeIn' v <> freeIn' e+  freeIn' (ScalarVar v) = freeIn' v+  freeIn' (SizeOf _) = mempty  instance FreeIn Arg where-  freeIn (MemArg m) = freeIn m-  freeIn (ExpArg e) = freeIn e+  freeIn' (MemArg m) = freeIn' m+  freeIn' (ExpArg e) = freeIn' e  instance FreeIn Size where-  freeIn (VarSize name) = S.singleton name-  freeIn (ConstSize _) = mempty+  freeIn' (VarSize name) = fvName name+  freeIn' (ConstSize _) = mempty

@@ -69,7 +69,7 @@             deriving (Show)  -- ^ In-kernel name and per-workgroup size in bytes.-type LocalMemoryUse = (VName, Either (Count Bytes) KernelConstExp)+type LocalMemoryUse = (VName, Either (Count Bytes Exp) KernelConstExp)  data KernelUse = ScalarUse VName PrimType                | MemoryUse VName@@ -85,7 +85,7 @@         sameKernel _ _ = False  -- | Get an atomic operator corresponding to a binary operator.-atomicBinOp :: BinOp -> Maybe (VName -> VName -> Count Elements -> Exp -> AtomicOp)+atomicBinOp :: BinOp -> Maybe (VName -> VName -> Count Elements Imp.Exp -> Exp -> AtomicOp) atomicBinOp = flip lookup [ (Add Int32, AtomicAdd)                           , (SMax Int32, AtomicSMax)                           , (SMin Int32, AtomicSMin)@@ -121,17 +121,18 @@     ppr c  instance FreeIn HostOp where-  freeIn (CallKernel c) = freeIn c-  freeIn (CmpSizeLe dest _ _ x) =-    freeIn dest <> freeIn x-  freeIn (GetSizeMax dest _) =-    freeIn dest-  freeIn (GetSize dest _ _) =-    freeIn dest+  freeIn' (CallKernel c) =+    freeIn' c+  freeIn' (CmpSizeLe dest _ _ x) =+    freeIn' dest <> freeIn' x+  freeIn' (GetSizeMax dest _) =+    freeIn' dest+  freeIn' (GetSize dest _ _) =+    freeIn' dest  instance FreeIn Kernel where-  freeIn kernel = freeIn (kernelBody kernel) <>-                  freeIn [kernelNumGroups kernel, kernelGroupSize kernel]+  freeIn' kernel = freeIn' (kernelBody kernel) <>+                   freeIn' [kernelNumGroups kernel, kernelGroupSize kernel]  instance Pretty Kernel where   ppr kernel =@@ -152,35 +153,35 @@               | GlobalBarrier               | MemFenceLocal               | MemFenceGlobal-              | PrivateAlloc VName (Count Bytes)-              | LocalAlloc VName (Either (Count Bytes) KernelConstExp)+              | PrivateAlloc VName (Count Bytes Imp.Exp)+              | LocalAlloc VName (Either (Count Bytes Imp.Exp) KernelConstExp)               deriving (Show)  -- Atomic operations return the value stored before the update. -- This value is stored in the first VName.-data AtomicOp = AtomicAdd VName VName (Count Elements) Exp-              | AtomicSMax VName VName (Count Elements) Exp-              | AtomicSMin VName VName (Count Elements) Exp-              | AtomicUMax VName VName (Count Elements) Exp-              | AtomicUMin VName VName (Count Elements) Exp-              | AtomicAnd VName VName (Count Elements) Exp-              | AtomicOr VName VName (Count Elements) Exp-              | AtomicXor VName VName (Count Elements) Exp-              | AtomicCmpXchg VName VName (Count Elements) Exp Exp-              | AtomicXchg VName VName (Count Elements) Exp+data AtomicOp = AtomicAdd VName VName (Count Elements Imp.Exp) Exp+              | AtomicSMax VName VName (Count Elements Imp.Exp) Exp+              | AtomicSMin VName VName (Count Elements Imp.Exp) Exp+              | AtomicUMax VName VName (Count Elements Imp.Exp) Exp+              | AtomicUMin VName VName (Count Elements Imp.Exp) Exp+              | AtomicAnd VName VName (Count Elements Imp.Exp) Exp+              | AtomicOr VName VName (Count Elements Imp.Exp) Exp+              | AtomicXor VName VName (Count Elements Imp.Exp) Exp+              | AtomicCmpXchg VName VName (Count Elements Imp.Exp) Exp Exp+              | AtomicXchg VName VName (Count Elements Imp.Exp) Exp               deriving (Show)  instance FreeIn AtomicOp where-  freeIn (AtomicAdd _ arr i x) = freeIn arr <> freeIn i <> freeIn x-  freeIn (AtomicSMax _ arr i x) = freeIn arr <> freeIn i <> freeIn x-  freeIn (AtomicSMin _ arr i x) = freeIn arr <> freeIn i <> freeIn x-  freeIn (AtomicUMax _ arr i x) = freeIn arr <> freeIn i <> freeIn x-  freeIn (AtomicUMin _ arr i x) = freeIn arr <> freeIn i <> freeIn x-  freeIn (AtomicAnd _ arr i x) = freeIn arr <> freeIn i <> freeIn x-  freeIn (AtomicOr _ arr i x) = freeIn arr <> freeIn i <> freeIn x-  freeIn (AtomicXor _ arr i x) = freeIn arr <> freeIn i <> freeIn x-  freeIn (AtomicCmpXchg _ arr i x y) = freeIn arr <> freeIn i <> freeIn x <> freeIn y-  freeIn (AtomicXchg _ arr i x) = freeIn arr <> freeIn i <> freeIn x+  freeIn' (AtomicAdd _ arr i x) = freeIn' arr <> freeIn' i <> freeIn' x+  freeIn' (AtomicSMax _ arr i x) = freeIn' arr <> freeIn' i <> freeIn' x+  freeIn' (AtomicSMin _ arr i x) = freeIn' arr <> freeIn' i <> freeIn' x+  freeIn' (AtomicUMax _ arr i x) = freeIn' arr <> freeIn' i <> freeIn' x+  freeIn' (AtomicUMin _ arr i x) = freeIn' arr <> freeIn' i <> freeIn' x+  freeIn' (AtomicAnd _ arr i x) = freeIn' arr <> freeIn' i <> freeIn' x+  freeIn' (AtomicOr _ arr i x) = freeIn' arr <> freeIn' i <> freeIn' x+  freeIn' (AtomicXor _ arr i x) = freeIn' arr <> freeIn' i <> freeIn' x+  freeIn' (AtomicCmpXchg _ arr i x y) = freeIn' arr <> freeIn' i <> freeIn' x <> freeIn' y+  freeIn' (AtomicXchg _ arr i x) = freeIn' arr <> freeIn' i <> freeIn' x  instance Pretty KernelOp where   ppr (GetGroupId dest i) =@@ -247,8 +248,8 @@     parens (commasep [ppr arr <> brackets (ppr ind), ppr x])  instance FreeIn KernelOp where-  freeIn (Atomic _ op) = freeIn op-  freeIn _ = mempty+  freeIn' (Atomic _ op) = freeIn' op+  freeIn' _ = mempty  brace :: Doc -> Doc brace body = text " {" </> indent 2 body </> text "}"

@@ -54,7 +54,7 @@                  -- ^ Pass the value of this scalar expression as argument.                | MemKArg VName                  -- ^ Pass this pointer as argument.-               | SharedMemoryKArg (Count Bytes)+               | SharedMemoryKArg (Count Bytes Exp)                  -- ^ Create this much local memory per workgroup.                deriving (Show) 

@@ -31,4 +31,4 @@   ppr _ = empty  instance FreeIn Sequential where-  freeIn _ = mempty+  freeIn' _ = mempty

@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts, LambdaCase, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts, LambdaCase, FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ConstraintKinds #-} module Futhark.CodeGen.ImpGen@@ -122,11 +122,11 @@ type CopyCompiler lore op = PrimType                            -> MemLocation                            -> MemLocation-                           -> Count Elements -- ^ Number of row elements of the source.+                           -> Count Elements Imp.Exp -- ^ Number of row elements of the source.                            -> ImpM lore op ()  -- | An alternate way of compiling an allocation.-type AllocCompiler lore op = VName -> Count Bytes -> ImpM lore op ()+type AllocCompiler lore op = VName -> Count Bytes Imp.Exp -> ImpM lore op ()  data Operations lore op = Operations { opsExpCompiler :: ExpCompiler lore op                                      , opsOpCompiler :: OpCompiler lore op@@ -265,11 +265,11 @@         -> Either InternalError (a, State lore op, Imp.Code op) runImpM (ImpM m) ops space fname = runRWST m $ newEnv ops space fname -subImpM_ :: Operations lore' op' -> ImpM lore' op' a+subImpM_ :: Operations lore op' -> ImpM lore op' a          -> ImpM lore op (Imp.Code op') subImpM_ ops m = snd <$> subImpM ops m -subImpM :: Operations lore' op' -> ImpM lore' op' a+subImpM :: Operations lore op' -> ImpM lore op' a         -> ImpM lore op (a, Imp.Code op') subImpM ops (ImpM m) = do   env <- ask@@ -280,15 +280,12 @@                      , envOpCompiler = opsOpCompiler ops                      , envAllocCompilers = opsAllocCompilers ops                      }-                 s { stateVTable = M.map scrubExps $ stateVTable s+                 s { stateVTable = stateVTable s                    , stateFunctions = mempty } of     Left err -> throwError err     Right (x, s', code) -> do       putNameSource $ stateNameSource s'       return (x, code)-  where scrubExps (ArrayVar _ entry) = ArrayVar Nothing entry-        scrubExps (MemVar _ entry) = MemVar Nothing entry-        scrubExps (ScalarVar _ entry) = ScalarVar Nothing entry  -- | Execute a code generation action, returning the code that was -- emitted.@@ -536,8 +533,8 @@            e_code <- collect $ compileExp pat e           (live_after, bs_code) <- collect' $ compileStms' (patternAllocs pat <> allocs) bs-          let dies_here v = not (v `S.member` live_after) &&-                            v `S.member` freeIn e_code+          let dies_here v = not (v `nameIn` live_after) &&+                            v `nameIn` freeIn e_code               to_free = S.filter (dies_here . fst) allocs            emit e_code@@ -701,7 +698,7 @@       let srcloc = entryArrayLocation yentry           rows = case drop i $ entryArrayShape yentry of                   []  -> error $ "defCompileBasicOp Concat: empty array shape for " ++ pretty y-                  r:_ -> innerExp $ Imp.dimSizeToExp r+                  r:_ -> unCount $ Imp.dimSizeToExp r       copy (elemType $ patElemType pe) destloc srcloc $ arrayOuterSize yentry       emit $ Imp.SetScalar offs_glb $ Imp.var offs_glb int32 + rows @@ -943,13 +940,13 @@               return $ ScalarDestination name  fullyIndexArray :: VName -> [Imp.Exp]-                -> ImpM lore op (VName, Imp.Space, Count Elements)+                -> ImpM lore op (VName, Imp.Space, Count Elements Imp.Exp) fullyIndexArray name indices = do   arr <- lookupArray name   fullyIndexArray' (entryArrayLocation arr) indices  fullyIndexArray' :: MemLocation -> [Imp.Exp]-                 -> ImpM lore op (VName, Imp.Space, Count Elements)+                 -> ImpM lore op (VName, Imp.Space, Count Elements Imp.Exp) fullyIndexArray' (MemLocation mem _ ixfun) indices = do   space <- entryMemSpace <$> lookupMemory mem   return (mem, space,@@ -976,10 +973,10 @@ strideArray (MemLocation mem shape ixfun) stride =   MemLocation mem shape $ IxFun.strideIndex ixfun stride -arrayOuterSize :: ArrayEntry -> Count Elements+arrayOuterSize :: ArrayEntry -> Count Elements Imp.Exp arrayOuterSize = arrayDimSize 0 -arrayDimSize :: Int -> ArrayEntry -> Count Elements+arrayDimSize :: Int -> ArrayEntry -> Count Elements Imp.Exp arrayDimSize i =   product . map Imp.dimSizeToExp . take 1 . drop i . entryArrayShape @@ -1020,7 +1017,7 @@     let ivars = map Imp.vi32 is         destidx = IxFun.index destIxFun ivars         srcidx = IxFun.index srcIxFun ivars-        bounds = map innerExp $ n : drop 1 (map Imp.dimSizeToExp srcshape)+        bounds = map unCount $ n : drop 1 (map Imp.dimSizeToExp srcshape)     srcspace <- entryMemSpace <$> lookupMemory srcmem     destspace <- entryMemSpace <$> lookupMemory destmem     vol <- asks envVolatility@@ -1108,12 +1105,11 @@      (_, ScalarVar _ (ScalarEntry _)) | not $ null src_is ->       compilerBugS $-      unwords ["copyDWIMDest: prim-typed source", pretty src, "with nonzero indices."]-+      unwords ["copyDWIMDest: prim-typed source", pretty src, "with nonzero indices", pretty src_is]      (ScalarDestination name, _) | not $ null dest_is ->       compilerBugS $-      unwords ["copyDWIMDest: prim-typed target", pretty name, "with nonzero indices."]+      unwords ["copyDWIMDest: prim-typed target", pretty name, "with nonzero indices", pretty dest_is]      (ScalarDestination name, ScalarVar _ (ScalarEntry pt)) ->       emit $ Imp.SetScalar name $ Imp.var src pt@@ -1183,7 +1179,7 @@  -- | The number of bytes needed to represent the array in a -- straightforward contiguous format.-typeSize :: Type -> Count Bytes+typeSize :: Type -> Count Bytes Imp.Exp typeSize t = Imp.bytes $ Imp.LeafExp (Imp.SizeOf $ elemType t) int32 *              product (map (toExp' int32) (arrayDims t)) @@ -1227,14 +1223,14 @@   addVar name' $ MemVar Nothing $ MemEntry space   return name' -sAlloc_ :: VName -> Count Bytes -> Space -> ImpM lore op ()+sAlloc_ :: VName -> Count Bytes Imp.Exp -> Space -> ImpM lore op () sAlloc_ name' size' space = do   allocator <- asks $ M.lookup space . envAllocCompilers   case allocator of     Nothing -> emit $ Imp.Allocate name' size' space     Just allocator' -> allocator' name' size' -sAlloc :: String -> Count Bytes -> Space -> ImpM lore op VName+sAlloc :: String -> Count Bytes Imp.Exp -> Space -> ImpM lore op VName sAlloc name size space = do   name' <- sDeclareMem name space   sAlloc_ name' size space

@@ -33,11 +33,11 @@ callKernelOperations :: Operations ExplicitMemory Imp.HostOp callKernelOperations =   Operations { opsExpCompiler = expCompiler-                    , opsCopyCompiler = callKernelCopy-                    , opsOpCompiler = opCompiler-                    , opsStmsCompiler = defCompileStms-                    , opsAllocCompilers = mempty-                    }+             , opsCopyCompiler = callKernelCopy+             , opsOpCompiler = opCompiler+             , opsStmsCompiler = defCompileStms+             , opsAllocCompilers = mempty+             }  compileProg :: MonadFreshNames m => Prog ExplicitMemory -> m (Either InternalError Imp.Program) compileProg prog =@@ -59,8 +59,8 @@     =<< toExp x opCompiler (Pattern _ [pe]) (Inner (GetSizeMax size_class)) =   sOp $ Imp.GetSizeMax (patElemName pe) size_class-opCompiler dest (Inner (HostOp kernel)) =-  kernelCompiler dest kernel+opCompiler dest (Inner (SegOp op)) =+  segOpCompiler dest op opCompiler pat e =   compilerBugS $ "opCompiler: Invalid pattern\n  " ++   pretty pat ++ "\nfor expression\n  " ++ pretty e@@ -71,46 +71,17 @@   where f (name, x) = (keyWithEntryPoint fname name, x) sizeClassWithEntryPoint _ size_class = size_class -kernelCompiler :: Pattern ExplicitMemory -> Kernel InKernel-               -> CallKernelGen ()--kernelCompiler pat (Kernel desc space _ kernel_body) = do-  (constants, init_constants) <- kernelInitialisationSetSpace space $ return ()--  forM_ (kernelHints desc) $ \(s,v) -> do-    ty <- case v of-      Constant pv -> return $ Prim $ primValueType pv-      Var vn -> lookupType vn-    unless (primType ty) $ fail $ concat [ "debugKernelHint '", s, "'"-                                         , " in kernel '", kernelName desc, "'"-                                         , " did not have primType value." ]--    emit $ Imp.DebugPrint s $ Just (elemType ty, toExp' (elemType ty) v)--  let virt_groups = toExp' int32 (spaceNumVirtGroups space)-  sKernel constants (kernelName desc) $ do-    init_constants-    virtualiseGroups constants virt_groups $ \group_id -> do-      let flat_id =-            if kernelGroupIdVar constants /= group_id-            then Imp.vi32 group_id * kernelGroupSize constants + kernelLocalThreadId constants-            else kernelGlobalThreadId constants-      setSpaceIndices flat_id space-      compileKernelStms constants (kernelBodyStms kernel_body) $-        zipWithM_ (compileKernelResult constants) (patternElements pat) $-        kernelBodyResult kernel_body--kernelCompiler pat (SegMap space _ body) =-  compileSegMap pat space body--kernelCompiler pat (SegRed space reds _ body) =-  compileSegRed pat space reds body--kernelCompiler pat (SegScan space red_op nes _ kbody) =-  compileSegScan pat space red_op nes kbody--kernelCompiler pat (SegGenRed space ops _ body) =-  compileSegGenRed pat space ops body+segOpCompiler :: Pattern ExplicitMemory -> SegOp ExplicitMemory -> CallKernelGen ()+segOpCompiler pat (SegMap lvl space _ kbody) =+  compileSegMap pat lvl space kbody+segOpCompiler pat (SegRed lvl@SegThread{} space reds _ kbody) =+  compileSegRed pat lvl space reds kbody+segOpCompiler pat (SegScan lvl@SegThread{} space scan_op nes _ kbody) =+  compileSegScan pat lvl space scan_op nes kbody+segOpCompiler pat (SegGenRed (SegThread num_groups group_size _) space ops _ kbody) =+  compileSegGenRed pat num_groups group_size space ops kbody+segOpCompiler pat segop =+  compilerBugS $ "segOpCompiler: unexpected " ++ pretty (segLevel segop) ++ " for rhs of pattern " ++ pretty pat  expCompiler :: ExpCompiler ExplicitMemory Imp.HostOp 

@@ -3,29 +3,25 @@ {-# LANGUAGE TypeFamilies #-} module Futhark.CodeGen.ImpGen.Kernels.Base   ( KernelConstants (..)-  , inKernelOperations   , keyWithEntryPoint   , CallKernelGen   , InKernelGen   , computeThreadChunkSize-  , simpleKernelConstants-  , kernelInitialisation-  , kernelInitialisationSimple-  , kernelInitialisationSetSpace-  , setSpaceIndices-  , makeAllMemoryGlobal-  , allThreads-  , compileKernelStms   , groupReduce   , groupScan   , isActive-  , sKernel+  , sKernelThread+  , sKernelGroup+  , sKernelSimple   , sReplicate   , sIota   , sCopy-  , compileKernelResult+  , compileThreadResult+  , compileGroupResult   , virtualiseGroups +  , getSize+   , atomicUpdate   , atomicUpdateLocking   , Locking(..)@@ -33,13 +29,12 @@   )   where -import Control.Arrow ((&&&)) import Control.Monad.Except import Control.Monad.Reader import Data.Maybe import qualified Data.Map.Strict as M-import qualified Data.Set as S import Data.List+import Data.Loc  import Prelude hiding (quot, rem) @@ -50,268 +45,257 @@ import qualified Futhark.CodeGen.ImpCode.Kernels as Imp import Futhark.CodeGen.ImpCode.Kernels (elements) import Futhark.CodeGen.ImpGen-import Futhark.Util.IntegralExp (quotRoundingUp, quot, rem, IntegralExp)-import Futhark.Util (splitAt3, maybeNth, takeLast)+import Futhark.Util.IntegralExp (quotRoundingUp, quot, rem)+import Futhark.Util (chunks, maybeNth)  type CallKernelGen = ImpM ExplicitMemory Imp.HostOp-type InKernelGen = ImpM InKernel Imp.KernelOp+type InKernelGen = ImpM ExplicitMemory Imp.KernelOp  data KernelConstants = KernelConstants-                       { kernelOuterVTable :: VTable ExplicitMemory -- XXX-                       , kernelGlobalThreadId :: Imp.Exp+                       { kernelGlobalThreadId :: Imp.Exp                        , kernelLocalThreadId :: Imp.Exp                        , kernelGroupId :: Imp.Exp                        , kernelGlobalThreadIdVar :: VName                        , kernelLocalThreadIdVar :: VName                        , kernelGroupIdVar :: VName-                       , kernelGroupSize :: Imp.Exp                        , kernelNumGroups :: Imp.Exp+                       , kernelGroupSize :: Imp.Exp                        , kernelNumThreads :: Imp.Exp                        , kernelWaveSize :: Imp.Exp-                       , kernelDimensions :: [(VName, Imp.Exp)]                        , kernelThreadActive :: Imp.Exp-                       , kernelStreamed :: [(VName, Imp.DimSize)]-                       -- ^ Chunk sizes and their maximum size.  Hint-                       -- for unrolling.                        } -inKernelOperations :: KernelConstants -> Operations InKernel Imp.KernelOp-inKernelOperations constants =-  (defaultOperations $ compileInKernelOp constants)-  { opsCopyCompiler = inKernelCopy-  , opsExpCompiler = inKernelExpCompiler-  , opsStmsCompiler = \_ -> compileKernelStms constants-  , opsAllocCompilers =-      M.fromList [ (Space "local", allocLocal)-                 , (Space "private", allocPrivate) ]-  }-  where allocLocal :: AllocCompiler InKernel Imp.KernelOp-        allocLocal mem size = do-          size' <- localMemSize (kernelOuterVTable constants) size-          sOp $ Imp.LocalAlloc mem size'-        allocPrivate mem size =-          sOp $ Imp.PrivateAlloc mem size- keyWithEntryPoint :: Name -> Name -> Name keyWithEntryPoint fname key =   nameFromString $ nameToString fname ++ "." ++ nameToString key --- | We have no bulk copy operation (e.g. memmove) inside kernels, so--- turn any copy into a loop.-inKernelCopy :: CopyCompiler InKernel Imp.KernelOp-inKernelCopy = copyElementWise+noAssert :: MonadError InternalError m => [SrcLoc] -> m a+noAssert locs =+  compilerLimitationS $+  unlines [ "Cannot compile assertion at " +++            intercalate " -> " (reverse $ map locStr locs) +++            " inside parallel kernel."+          , "As a workaround, surround the expression with 'unsafe'."] -compileInKernelOp :: KernelConstants -> Pattern InKernel -> Op InKernel-                  -> InKernelGen ()-compileInKernelOp _ (Pattern _ [mem]) (Alloc size (Space "private")) = do++allocLocal, allocPrivate :: AllocCompiler ExplicitMemory Imp.KernelOp+allocLocal mem size = do+  vtable <- getVTable+  size' <- localMemSize vtable size+  sOp $ Imp.LocalAlloc mem size'+allocPrivate mem size =+  sOp $ Imp.PrivateAlloc mem size++kernelAlloc :: KernelConstants+            -> Pattern ExplicitMemory+            -> SubExp -> Space+            -> ImpM ExplicitMemory Imp.KernelOp ()+kernelAlloc _ (Pattern _ [_]) _ (Space space)+  | space `M.member` allScalarMemory =+      return () -- Handled by the declaration of the memory block,+                -- which is then translated to an actual scalar+                -- variable during C code generation.+kernelAlloc _ (Pattern _ [mem]) size (Space "private") = do   size' <- toExp size-  sOp $ Imp.PrivateAlloc (patElemName mem) $ Imp.bytes size'-compileInKernelOp constants (Pattern _ [mem]) (Alloc size (Space "local")) = do-  size' <- localMemSize (kernelOuterVTable constants) . Imp.bytes =<<-           toExp size-  sOp $ Imp.LocalAlloc (patElemName mem) size'-compileInKernelOp _ (Pattern _ [mem]) Alloc{} =+  allocPrivate (patElemName mem) $ Imp.bytes size'+kernelAlloc _ (Pattern _ [mem]) size (Space "local") = do+  size' <- toExp size+  allocLocal (patElemName mem) $ Imp.bytes size'+kernelAlloc _ (Pattern _ [mem]) _ _ =   compilerLimitationS $ "Cannot allocate memory block " ++ pretty mem ++ " in kernel."-compileInKernelOp _ dest Alloc{} =+kernelAlloc _ dest _ _ =   compilerBugS $ "Invalid target for in-kernel allocation: " ++ show dest-compileInKernelOp constants pat (Inner op) =-  compileKernelExp constants pat op -inKernelExpCompiler :: ExpCompiler InKernel Imp.KernelOp-inKernelExpCompiler _ (BasicOp (Assert _ _ (loc, locs))) =-  compilerLimitationS $-  unlines [ "Cannot compile assertion at " ++-            intercalate " -> " (reverse $ map locStr $ loc:locs) ++-            " inside parallel kernel."-          , "As a workaround, surround the expression with 'unsafe'."]--- The static arrays stuff does not work inside kernels.-inKernelExpCompiler (Pattern _ [dest]) (BasicOp (ArrayLit es _)) =+splitSpace :: (ToExp w, ToExp i, ToExp elems_per_thread) =>+              Pattern ExplicitMemory -> SplitOrdering -> w -> i -> elems_per_thread+           -> ImpM lore op ()+splitSpace (Pattern [] [size]) o w i elems_per_thread = do+  num_elements <- Imp.elements <$> toExp w+  i' <- toExp i+  elems_per_thread' <- Imp.elements <$> toExp elems_per_thread+  computeThreadChunkSize o i' elems_per_thread' num_elements (patElemName size)+splitSpace pat _ _ _ _ =+  compilerBugS $ "Invalid target for splitSpace: " ++ pretty pat++compileThreadExp :: ExpCompiler ExplicitMemory Imp.KernelOp+compileThreadExp _ (BasicOp (Assert _ _ (loc, locs))) = noAssert $ loc:locs+compileThreadExp (Pattern _ [dest]) (BasicOp (ArrayLit es _)) =   forM_ (zip [0..] es) $ \(i,e) ->   copyDWIM (patElemName dest) [fromIntegral (i::Int32)] e []-inKernelExpCompiler dest e =+compileThreadExp dest e =   defCompileExp dest e -compileKernelExp :: KernelConstants -> Pattern InKernel -> KernelExp InKernel-                 -> InKernelGen ()+-- | Assign iterations of a for-loop to threads in the workgroup.  The+-- passed-in function is invoked with the (symbolic) iteration.  For+-- multidimensional loops, use 'groupCoverSpace'.+groupLoop :: KernelConstants -> Imp.Exp+          -> (Imp.Exp -> InKernelGen ()) -> InKernelGen ()+groupLoop constants n f = do+  i <- newVName "i" -compileKernelExp _ pat (Barrier ses) = do-  forM_ (zip (patternNames pat) ses) $ \(d, se) ->-    copyDWIM d [] se []+  -- Compute how many elements this thread is responsible for.+  -- Formula: (n - ltid) / group_size (rounded up).+  let ltid = kernelLocalThreadId constants+      elems_for_this = (n - ltid) `quotRoundingUp` kernelGroupSize constants++  sFor i Int32 elems_for_this $ f $ Imp.vi32 i++-- | Iterate collectively though a multidimensional space, such that+-- all threads in the group participate.  The passed-in function is+-- invoked with a (symbolic) point in the index space.+groupCoverSpace :: KernelConstants -> [Imp.Exp]+                -> ([Imp.Exp] -> InKernelGen ()) -> InKernelGen ()+groupCoverSpace constants ds f =+  groupLoop constants (product ds) $ \i -> do+    let is = unflattenIndex ds $+             i * kernelGroupSize constants ++             kernelLocalThreadId constants+    f is++groupCopy :: KernelConstants -> VName -> [Imp.Exp] -> SubExp -> [Imp.Exp] -> InKernelGen ()+groupCopy constants to to_is from from_is = do+  ds <- mapM toExp . arrayDims =<< subExpType from+  groupCoverSpace constants ds $ \is ->+    copyDWIM to (to_is++ is) from (from_is ++ is)++compileGroupExp :: KernelConstants -> ExpCompiler ExplicitMemory Imp.KernelOp+compileGroupExp _ _ (BasicOp (Assert _ _ (loc, locs))) = noAssert $ loc:locs+-- The static arrays stuff does not work inside kernels.+compileGroupExp _ (Pattern _ [dest]) (BasicOp (ArrayLit es _)) =+  forM_ (zip [0..] es) $ \(i,e) ->+  copyDWIM (patElemName dest) [fromIntegral (i::Int32)] e []+compileGroupExp constants (Pattern _ [dest]) (BasicOp (Copy arr)) = do+  groupCopy constants (patElemName dest) [] (Var arr) []   sOp Imp.LocalBarrier+compileGroupExp constants (Pattern _ [dest]) (BasicOp (Manifest _ arr)) = do+  groupCopy constants (patElemName dest) [] (Var arr) []+  sOp Imp.LocalBarrier+compileGroupExp constants (Pattern _ [dest]) (BasicOp (Replicate ds se)) = do+  ds' <- mapM toExp $ shapeDims ds+  groupCoverSpace constants ds' $ \is ->+    copyDWIM (patElemName dest) is se (drop (shapeRank ds) is)+compileGroupExp constants (Pattern _ [dest]) (BasicOp (Iota n e s _)) = do+  n' <- toExp n+  e' <- toExp e+  s' <- toExp s+  groupLoop constants n' $ \i' -> do+    x <- dPrimV "x" $ e' + i' * s'+    copyDWIM (patElemName dest) [i'] (Var x) [] -compileKernelExp _ (Pattern [] [size]) (SplitSpace o w i elems_per_thread) = do-  num_elements <- Imp.elements <$> toExp w-  i' <- toExp i-  elems_per_thread' <- Imp.elements <$> toExp elems_per_thread-  computeThreadChunkSize o i' elems_per_thread' num_elements (patElemName size)+compileGroupExp _ dest e =+  defCompileExp dest e -compileKernelExp constants pat (Combine (CombineSpace scatter cspace) _ aspace body) = do-  -- First we compute how many times we have to iterate to cover-  -- cspace with our group size.  It is a fairly common case that-  -- we statically know that this requires 1 iteration, so we-  -- could detect it and not generate a loop in that case.-  -- However, it seems to have no impact on performance (an extra-  -- conditional jump), so for simplicity we just always generate-  -- the loop.-  let cspace_dims = map (streamBounded . snd) cspace-      num_iters-        | cspace_dims == [kernelGroupSize constants] = 1-        | otherwise = product cspace_dims `quotRoundingUp`-                      kernelGroupSize constants+sanityCheckLevel :: SegLevel -> InKernelGen ()+sanityCheckLevel SegThread{} = return ()+sanityCheckLevel SegThreadScalar{} = return ()+sanityCheckLevel SegGroup{} =+  fail "compileGroupOp: unexpected group-level SegOp." -  iter <- newVName "comb_iter"+compileGroupSpace :: KernelConstants -> SegLevel -> SegSpace -> InKernelGen ()+compileGroupSpace constants lvl space = do+  sanityCheckLevel lvl -  sFor iter Int32 num_iters $ do-    mapM_ ((`dPrim_` int32) . fst) cspace-    -- Compute the *flat* array index.-    cid <- dPrimV "flat_comb_id" $-      Imp.var iter int32 * kernelGroupSize constants +-      kernelLocalThreadId constants+  let (ltids, dims) = unzip $ unSegSpace space+  dims' <- mapM toExp dims+  zipWithM_ dPrimV_ ltids $ unflattenIndex dims' $ kernelLocalThreadId constants -    -- Turn it into a nested array index.-    zipWithM_ (<--) (map fst cspace) $ unflattenIndex cspace_dims (Imp.var cid int32)+  dPrimV_ (segFlat space) $ kernelLocalThreadId constants -    -- Construct the body.  This is mostly about the book-keeping-    -- for the scatter-like part.-    let (scatter_ws, scatter_ns, _scatter_vs) = unzip3 scatter-        scatter_ws_repl = concat $ zipWith replicate scatter_ns scatter_ws-        (scatter_pes, normal_pes) =-          splitAt (sum scatter_ns) $ patternElements pat-        (res_is, res_vs, res_normal) =-          splitAt3 (sum scatter_ns) (sum scatter_ns) $ bodyResult body+compileGroupOp :: KernelConstants -> OpCompiler ExplicitMemory Imp.KernelOp -    -- Execute the body if we are within bounds.-    sWhen (isActive cspace .&&. isActive aspace) $ allThreads constants $-      compileStms (freeIn $ bodyResult body) (bodyStms body) $ do+compileGroupOp constants pat (Alloc size space) =+  kernelAlloc constants pat size space -      forM_ (zip4 scatter_ws_repl res_is res_vs scatter_pes) $-        \(w, res_i, res_v, scatter_pe) -> do-          let res_i' = toExp' int32 res_i-              w'     = toExp' int32 w-              -- We have to check that 'res_i' is in-bounds wrt. an array of size 'w'.-              in_bounds = 0 .<=. res_i' .&&. res_i' .<. w'-          sWhen in_bounds $ copyDWIM (patElemName scatter_pe) [res_i'] res_v []+compileGroupOp _ pat (Inner (SplitSpace o w i elems_per_thread)) =+  splitSpace pat o w i elems_per_thread -      forM_ (zip normal_pes res_normal) $ \(pe, res) ->-        copyDWIM (patElemName pe) local_index res []+compileGroupOp constants pat (Inner (SegOp (SegMap lvl space _ body))) = do+  void $ compileGroupSpace constants lvl space -  sOp Imp.LocalBarrier+  sWhen (isActive $ unSegSpace space) $+    compileStms mempty (kernelBodyStms body) $+    zipWithM_ (compileThreadResult space constants) (patternElements pat) $+    kernelBodyResult body -  where streamBounded (Var v)-          | Just x <- lookup v $ kernelStreamed constants =-              Imp.sizeToExp x-        streamBounded se = toExp' int32 se+  sOp Imp.LocalBarrier -        local_index = map (toExp' int32 . Var . fst) cspace+compileGroupOp constants pat (Inner (SegOp (SegScan lvl space scan_op _ _ body))) = do+  compileGroupSpace constants lvl space+  let (ltids, dims) = unzip $ unSegSpace space+  dims' <- mapM toExp dims -compileKernelExp constants (Pattern _ dests) (GroupReduce w lam input) = do-  w' <- toExp w-  groupReduce constants w' lam $ map snd input+  sWhen (isActive $ unSegSpace space) $+    compileStms mempty (kernelBodyStms body) $+    forM_ (zip (patternNames pat) $ kernelBodyResult body) $ \(dest, res) ->+    copyDWIM dest+    (map (`Imp.var` int32) ltids)+    (kernelResultSubExp res) []    sOp Imp.LocalBarrier -  -- The final result will be stored in element 0 of the local memory array.-  forM_ (zip dests input) $ \(dest, (_, arr)) ->-    copyDWIM (patElemName dest) [] (Var arr) [0]+  let segment_size = last dims'+      crossesSegment from to = (to-from) .>. (to `rem` segment_size)+  groupScan constants (Just crossesSegment) (product dims') scan_op $+    patternNames pat -compileKernelExp constants _ (GroupScan w lam input) = do-  w' <- toExp w-  groupScan constants Nothing w' lam $ map snd input+compileGroupOp constants pat (Inner (SegOp (SegRed lvl space ops _ body))) = do+  compileGroupSpace constants lvl space -compileKernelExp constants (Pattern _ final) (GroupStream w maxchunk lam accs _arrs) = do-  let GroupStreamLambda block_size block_offset acc_params arr_params body = lam-      block_offset' = Imp.var block_offset int32-  w' <- toExp w-  max_block_size <- toExp maxchunk+  let (ltids, dims) = unzip $ unSegSpace space+      (red_pes, map_pes) =+        splitAt (segRedResults ops) $ patternElements pat -  dLParams (acc_params++arr_params)-  forM_ (zip acc_params accs) $ \(p, acc) ->-    copyDWIM (paramName p) [] acc []-  dPrim_ block_size int32+  dims' <- mapM toExp dims -  -- If the GroupStream is morally just a do-loop, generate simpler code.-  case mapM isSimpleThreadInSpace $ stmsToList $ bodyStms body of-    Just stms' | ValueExp x <- max_block_size, oneIsh x -> do-      let body' = body { bodyStms = stmsFromList stms' }-          body'' = allThreads constants $-                   compileLoopBody acc_params body'-      block_size <-- 1+  let mkTempArr t =+        sAllocArray "red_arr" (elemType t) (Shape dims <> arrayShape t) $ Space "local"+  tmp_arrs <- mapM mkTempArr $ concatMap (lambdaReturnType . segRedLambda) ops+  let tmps_for_ops = chunks (map (length . segRedNeutral) ops) tmp_arrs -      -- Check if loop is candidate for unrolling.-      let loop =-            case w of-              Var w_var | Just w_bound <- lookup w_var $ kernelStreamed constants,-                          w_bound /= Imp.ConstSize 1 ->-                          -- Candidate for unrolling, so generate two loops.-                          sIf (w' .==. Imp.sizeToExp w_bound)-                          (sFor block_offset Int32 (Imp.sizeToExp w_bound) body'')-                          (sFor block_offset Int32 w' body'')-              _ -> sFor block_offset Int32 w' body''+  sWhen (isActive $ unSegSpace space) $+    compileStms mempty (kernelBodyStms body) $ do+    let (red_res, map_res) =+          splitAt (segRedResults ops) $ kernelBodyResult body+    forM_ (zip tmp_arrs red_res) $ \(dest, res) ->+      copyDWIM dest (map (`Imp.var` int32) ltids) (kernelResultSubExp res) []+    zipWithM_ (compileThreadResult space constants) map_pes map_res -      if kernelThreadActive constants == Imp.ValueExp (BoolValue True)-        then loop-        else sWhen (kernelThreadActive constants) loop+  sOp Imp.LocalBarrier -    _ -> do-      dPrim_ block_offset int32-      let body' = streaming constants block_size maxchunk $-                  compileBody' acc_params body+  case dims' of+    [dim'] -> do+      forM_ (zip ops tmps_for_ops) $ \(op, tmps) ->+        groupReduce constants dim' (segRedLambda op) tmps -      block_offset <-- 0+      sOp Imp.LocalBarrier -      let not_at_end = block_offset' .<. w'-          set_block_size =-            sIf (w' - block_offset' .<. max_block_size)-            (block_size <-- (w' - block_offset'))-            (block_size <-- max_block_size)-          increase_offset =-            block_offset <-- block_offset' + max_block_size+      forM_ (zip red_pes tmp_arrs) $ \(pe, arr) ->+        copyDWIM (patElemName pe) [] (Var arr) [0] -      -- Three cases to consider for simpler generated code based-      -- on max block size: (0) if full input size, do not-      -- generate a loop; (1) if one, generate for-loop (2)-      -- otherwise, generate chunked while-loop.-      if max_block_size == w' then-        (block_size <-- w') >> body'-      else if max_block_size == Imp.ValueExp (value (1::Int32)) then do-             block_size <-- w'-             sFor block_offset Int32 w' body'-           else-             sWhile not_at_end $-             set_block_size >> body' >> increase_offset+    _ -> do+      let segment_size = last dims'+          crossesSegment from to = (to-from) .>. (to `rem` segment_size) -  forM_ (zip final acc_params) $ \(pe, p) ->-    copyDWIM (patElemName pe) [] (Var $ paramName p) []+      forM_ (zip ops tmps_for_ops) $ \(op, tmps) ->+        groupScan constants (Just crossesSegment) (product dims') (segRedLambda op) tmps -  where isSimpleThreadInSpace (Let _ _ Op{}) = Nothing-        isSimpleThreadInSpace bnd = Just bnd+      sOp Imp.LocalBarrier -compileKernelExp _ _ (GroupGenReduce w arrs op bucket values locks) = do-  -- Check if bucket is in-bounds-  bucket' <- mapM toExp bucket-  w' <- mapM toExp w-  num_locks <- toExp' int32 . arraySize 0 <$> lookupType locks-  let locking = Locking locks 0 1 0 $ (`rem` num_locks) . sum-      values_params = takeLast (length values) $ lambdaParams op+      let segment_is = map Imp.vi32 $ init ltids+      forM_ (zip red_pes tmp_arrs) $ \(pe, arr) ->+        copyDWIM (patElemName pe) segment_is (Var arr) (segment_is ++ [last dims'-1]) -  sWhen (indexInBounds bucket' w') $ do-    forM_ (zip values_params values) $ \(p, v) ->-      copyDWIM (paramName p) [] v []-    atomicUpdate DefaultSpace arrs bucket' op locking-  where indexInBounds inds bounds =-          foldl1 (.&&.) $ zipWith checkBound inds bounds-          where checkBound ind bound = 0 .<=. ind .&&. ind .<. bound -compileKernelExp _ dest e =-  compilerBugS $ unlines ["Invalid target", "  " ++ show dest,-                          "for kernel expression", "  " ++ pretty e]+compileGroupOp _ pat _ =+  compilerBugS $ "compileGroupOp: cannot compile rhs of binding " ++ pretty pat -streaming :: KernelConstants -> VName -> SubExp -> InKernelGen () -> InKernelGen ()-streaming constants chunksize bound m = do-  bound' <- subExpToDimSize bound-  let constants' =-        constants { kernelStreamed = (chunksize, bound') : kernelStreamed constants }-  emit =<< subImpM_ (inKernelOperations constants') m+compileThreadOp :: KernelConstants -> OpCompiler ExplicitMemory Imp.KernelOp+compileThreadOp constants pat (Alloc size space) =+  kernelAlloc constants pat size space+compileThreadOp _ pat (Inner (SplitSpace o w i elems_per_thread)) =+  splitSpace pat o w i elems_per_thread+compileThreadOp _ pat _ =+  compilerBugS $ "compileThreadOp: cannot compile rhs of binding " ++ pretty pat  -- | Locking strategy used for an atomic update. data Locking =@@ -504,14 +488,14 @@                      a -> [VName]                   -> CallKernelGen [Imp.KernelUse] computeKernelUses kernel_body bound_in_kernel = do-  let actually_free = freeIn kernel_body `S.difference` S.fromList bound_in_kernel+  let actually_free = freeIn kernel_body `namesSubtract` namesFromList bound_in_kernel   -- Compute the variables that we need to pass to the kernel.   nub <$> readsFromSet actually_free  readsFromSet :: Names -> CallKernelGen [Imp.KernelUse] readsFromSet free =   fmap catMaybes $-  forM (S.toList free) $ \var -> do+  forM (namesToList free) $ \var -> do     t <- lookupType var     vtable <- getVTable     case t of@@ -524,9 +508,9 @@           Nothing | bt == Cert -> return Nothing                   | otherwise  -> return $ Just $ Imp.ScalarUse var bt -localMemSize :: VTable ExplicitMemory -> Imp.Count Imp.Bytes-             -> ImpM lore op (Either (Imp.Count Imp.Bytes) Imp.KernelConstExp)-localMemSize vtable e = isConstExp vtable (Imp.innerExp e) >>= \case+localMemSize :: VTable ExplicitMemory -> Imp.Count Imp.Bytes Imp.Exp+             -> ImpM lore op (Either (Imp.Count Imp.Bytes Imp.Exp) Imp.KernelConstExp)+localMemSize vtable e = isConstExp vtable (Imp.unCount e) >>= \case   Just e' | isStaticExp e' -> return $ Right e'   _ -> return $ Left e @@ -563,61 +547,54 @@  computeThreadChunkSize :: SplitOrdering                        -> Imp.Exp-                       -> Imp.Count Imp.Elements-                       -> Imp.Count Imp.Elements+                       -> Imp.Count Imp.Elements Imp.Exp+                       -> Imp.Count Imp.Elements Imp.Exp                        -> VName                        -> ImpM lore op () computeThreadChunkSize (SplitStrided stride) thread_index elements_per_thread num_elements chunk_var = do   stride' <- toExp stride   chunk_var <--     Imp.BinOpExp (SMin Int32)-    (Imp.innerExp elements_per_thread)-    ((Imp.innerExp num_elements - thread_index) `quotRoundingUp` stride')+    (Imp.unCount elements_per_thread)+    ((Imp.unCount num_elements - thread_index) `quotRoundingUp` stride')  computeThreadChunkSize SplitContiguous thread_index elements_per_thread num_elements chunk_var = do   starting_point <- dPrimV "starting_point" $-    thread_index * Imp.innerExp elements_per_thread+    thread_index * Imp.unCount elements_per_thread   remaining_elements <- dPrimV "remaining_elements" $-    Imp.innerExp num_elements - Imp.var starting_point int32+    Imp.unCount num_elements - Imp.var starting_point int32    let no_remaining_elements = Imp.var remaining_elements int32 .<=. 0-      beyond_bounds = Imp.innerExp num_elements .<=. Imp.var starting_point int32+      beyond_bounds = Imp.unCount num_elements .<=. Imp.var starting_point int32    sIf (no_remaining_elements .||. beyond_bounds)     (chunk_var <-- 0)     (sIf is_last_thread-       (chunk_var <-- Imp.innerExp last_thread_elements)-       (chunk_var <-- Imp.innerExp elements_per_thread))+       (chunk_var <-- Imp.unCount last_thread_elements)+       (chunk_var <-- Imp.unCount elements_per_thread))   where last_thread_elements =           num_elements - Imp.elements thread_index * elements_per_thread         is_last_thread =-          Imp.innerExp num_elements .<.-          (thread_index + 1) * Imp.innerExp elements_per_thread+          Imp.unCount num_elements .<.+          (thread_index + 1) * Imp.unCount elements_per_thread -kernelInitialisationSimple :: Imp.Exp -> Imp.Exp-                           -> Maybe (VName, VName, VName)-                           -> CallKernelGen (KernelConstants, ImpM InKernel Imp.KernelOp ())-kernelInitialisationSimple num_groups group_size names = do-  (global_tid, local_tid, group_id) <--    case names of Nothing ->-                    (,,)-                    <$> newVName "global_tid"-                    <*> newVName "local_tid"-                    <*> newVName "group_id"-                  Just (global_tid, local_tid, group_id) ->-                    return (global_tid, local_tid, group_id)+kernelInitialisationSimple :: Count NumGroups Imp.Exp -> Count GroupSize Imp.Exp+                           -> CallKernelGen (KernelConstants, InKernelGen ())+kernelInitialisationSimple (Count num_groups) (Count group_size) = do+  global_tid <- newVName "global_tid"+  local_tid <- newVName "local_tid"+  group_id <- newVName "group_tid"   wave_size <- newVName "wave_size"   inner_group_size <- newVName "group_size"-  vtable <- getVTable   let constants =-        KernelConstants vtable+        KernelConstants         (Imp.var global_tid int32)         (Imp.var local_tid int32)         (Imp.var group_id int32)         global_tid local_tid group_id-        group_size num_groups (group_size*num_groups)-        (Imp.var wave_size int32) []-        true mempty+        num_groups group_size (group_size*num_groups)+        (Imp.var wave_size int32)+        true    let set_constants = do         dPrim_ global_tid int32@@ -634,61 +611,6 @@    return (constants, set_constants) -kernelInitialisationSetSpace :: KernelSpace -> InKernelGen ()-                             -> CallKernelGen (KernelConstants, ImpM InKernel Imp.KernelOp ())-kernelInitialisationSetSpace space set_space = do-  group_size <- toExp $ spaceGroupSize space-  num_groups <- toExp $ spaceNumGroups space--  (constants, set_constants) <--    kernelInitialisationSimple num_groups group_size $-    Just (spaceGlobalId space, spaceLocalId space, spaceGroupId space)--  let set_constants' = do-        set_constants-        case spaceStructure space of-          FlatThreadSpace is_and_dims ->-            mapM_ ((`dPrim_` int32) . fst) is_and_dims-          NestedThreadSpace is_and_dims -> do-            let (gtids, _, ltids, _) = unzip4 is_and_dims-            mapM_ (`dPrim_` int32) $ gtids ++ ltids-        set_space--  let (space_is, space_dims) = unzip $ spaceDimensions space-  space_dims' <- mapM toExp space_dims--  return (constants { kernelThreadActive =-                        if null $ spaceDimensions space-                        then true-                        else isActive $ spaceDimensions space-                    , kernelDimensions =-                        zip space_is space_dims'-                    },-          set_constants')--kernelInitialisation :: KernelSpace-                     -> CallKernelGen (KernelConstants, ImpM InKernel Imp.KernelOp ())-kernelInitialisation space =-  kernelInitialisationSetSpace space $-  setSpaceIndices (Imp.var (spaceGlobalId space) int32) space--setSpaceIndices :: Imp.Exp -> KernelSpace -> InKernelGen ()-setSpaceIndices gtid space =-  case spaceStructure space of-    FlatThreadSpace is_and_dims ->-      flatSpaceWith gtid is_and_dims-    NestedThreadSpace is_and_dims -> do-      let (gtids, gdims, ltids, ldims) = unzip4 is_and_dims-      gdims' <- mapM toExp gdims-      ldims' <- mapM toExp ldims-      let (gtid_es, ltid_es) = unzip $ unflattenNestedIndex gdims' ldims' gtid-      zipWithM_ (<--) gtids gtid_es-      zipWithM_ (<--) ltids ltid_es-  where flatSpaceWith base is_and_dims = do-          let (is, dims) = unzip is_and_dims-          dims' <- mapM toExp dims-          zipWithM_ (<--) is $ unflattenIndex dims' base- isActive :: [(VName, SubExp)] -> Imp.Exp isActive limit = case actives of                     [] -> Imp.ValueExp $ BoolValue True@@ -697,19 +619,6 @@         actives = zipWith active is $ map (toExp' Bool) ws         active i = (Imp.var i int32 .<.) -unflattenNestedIndex :: IntegralExp num => [num] -> [num] -> num -> [(num,num)]-unflattenNestedIndex global_dims group_dims global_id =-  zip global_is local_is-  where num_groups_dims = zipWith quotRoundingUp global_dims group_dims-        group_size = product group_dims-        group_id = global_id `Futhark.Util.IntegralExp.quot` group_size-        local_id = global_id `Futhark.Util.IntegralExp.rem` group_size--        group_is = unflattenIndex num_groups_dims group_id-        local_is = unflattenIndex group_dims local_id-        global_is = zipWith (+) local_is $ zipWith (*) group_is group_dims-- -- | Change every memory block to be in the global address space, -- except those who are in the local memory space.  This only affects -- generated code - we still need to make sure that the memory is@@ -725,13 +634,6 @@         globalMemory entry =           entry -allThreads :: KernelConstants -> InKernelGen () -> InKernelGen ()-allThreads constants = emit <=< subImpM_ (inKernelOperations constants')-  where constants' =-          constants { kernelThreadActive = Imp.ValueExp (BoolValue True) }--- writeParamToLocalMemory :: Typed (MemBound u) =>                            Imp.Exp -> (VName, t) -> Param (MemBound u)                         -> ImpM lore op ()@@ -852,9 +754,9 @@ groupScan :: KernelConstants           -> Maybe (Imp.Exp -> Imp.Exp -> Imp.Exp)           -> Imp.Exp-          -> Lambda InKernel+          -> Lambda ExplicitMemory           -> [VName]-          -> ImpM InKernel Imp.KernelOp ()+          -> ImpM ExplicitMemory Imp.KernelOp () groupScan constants seg_flag w lam arrs = do   when (any (not . primType . paramType) $ lambdaParams lam) $     compilerLimitationS "Cannot compile parallel scans with array element type."@@ -940,7 +842,7 @@             -> Imp.Exp             -> Imp.Exp             -> [(VName, t)]-            -> Lambda InKernel+            -> Lambda ExplicitMemory             -> InKernelGen () inBlockScan seg_flag lockstep_width block_size active ltid acc_local_mem scan_lam = everythingVolatile $ do   skip_threads <- dPrim "skip_threads" int32@@ -987,40 +889,13 @@   where block_id = ltid `quot` block_size         in_block_id = ltid - block_id * block_size -compileKernelStms :: KernelConstants -> Stms InKernel-                  -> InKernelGen a-                  -> InKernelGen a-compileKernelStms constants ungrouped_bnds m =-  compileGroupedKernelStms' $ groupStmsByGuard constants $ stmsToList ungrouped_bnds-  where compileGroupedKernelStms' [] = m-        compileGroupedKernelStms' ((g, bnds):rest_bnds) = do-          dScopes (map ((Just . stmExp) &&& (castScope . scopeOf)) bnds)-          protect g $ mapM_ compileKernelStm bnds-          compileGroupedKernelStms' rest_bnds--        protect Nothing body_m =-          body_m-        protect (Just (Imp.ValueExp (BoolValue True))) body_m =-          body_m-        protect (Just g) body_m =-          sWhen g $ allThreads constants body_m--        compileKernelStm (Let pat _ e) = compileExp pat e--groupStmsByGuard :: KernelConstants-                     -> [Stm InKernel]-                     -> [(Maybe Imp.Exp, [Stm InKernel])]-groupStmsByGuard constants bnds =-  map collapse $ groupBy sameGuard $ zip (map bindingGuard bnds) bnds-  where bindingGuard (Let _ _ Op{}) = Nothing-        bindingGuard _ = Just $ kernelThreadActive constants--        sameGuard (g1, _) (g2, _) = g1 == g2--        collapse [] =-          (Nothing, [])-        collapse l@((g,_):_) =-          (g, map snd l)+getSize :: String -> Imp.SizeClass -> CallKernelGen VName+getSize desc sclass = do+  size <- dPrim desc int32+  fname <- asks envFunction+  let size_key = keyWithEntryPoint fname $ nameFromString $ pretty size+  sOp $ Imp.GetSize size size_key sclass+  return size  computeMapKernelGroups :: Imp.Exp -> CallKernelGen (Imp.Exp, Imp.Exp) computeMapKernelGroups kernel_size = do@@ -1030,15 +905,15 @@       group_size_key = keyWithEntryPoint fname $ nameFromString $ pretty group_size   sOp $ Imp.GetSize group_size group_size_key Imp.SizeGroup   num_groups <- dPrimV "num_groups" $ kernel_size `quotRoundingUp` Imp.ConvOpExp (SExt Int32 Int32) group_size_var-  return (Imp.var group_size int32, Imp.var num_groups int32)+  return (Imp.var num_groups int32, Imp.var group_size int32)  simpleKernelConstants :: Imp.Exp -> String-                      -> CallKernelGen (KernelConstants, ImpM InKernel Imp.KernelOp ())+                      -> CallKernelGen (KernelConstants, InKernelGen ()) simpleKernelConstants kernel_size desc = do   thread_gtid <- newVName $ desc ++ "_gtid"   thread_ltid <- newVName $ desc ++ "_ltid"   group_id <- newVName $ desc ++ "_gid"-  (group_size, num_groups) <- computeMapKernelGroups kernel_size+  (num_groups, group_size) <- computeMapKernelGroups kernel_size   let set_constants = do         dPrim_ thread_gtid int32         dPrim_ thread_ltid int32@@ -1048,12 +923,11 @@         sOp (Imp.GetGroupId group_id 0)  -  vtable <- getVTable-  return (KernelConstants vtable+  return (KernelConstants           (Imp.var thread_gtid int32) (Imp.var thread_ltid int32) (Imp.var group_id int32)           thread_gtid thread_ltid group_id-          group_size num_groups (group_size*num_groups) 0-          [] (Imp.var thread_gtid int32 .<. kernel_size) mempty,+          num_groups group_size (group_size*num_groups) 0+          (Imp.var thread_gtid int32 .<. kernel_size),            set_constants) @@ -1065,13 +939,13 @@ -- *physical* threads (hardware parallelism), not the amount of -- application parallelism. virtualiseGroups :: KernelConstants+                 -> SegVirt                  -> Imp.Exp                  -> (VName -> InKernelGen ())                  -> InKernelGen ()-virtualiseGroups constants required_groups m-  | kernelNumGroups constants == required_groups =-      m $ kernelGroupIdVar constants-  | otherwise = do+virtualiseGroups constants SegNoVirt _ m =+  m $ kernelGroupIdVar constants+virtualiseGroups constants SegVirt required_groups m = do   phys_group_id <- dPrim "phys_group_id" int32   sOp $ Imp.GetGroupId phys_group_id 0   let iterations = (required_groups - Imp.vi32 phys_group_id) `quotRoundingUp`@@ -1080,21 +954,79 @@   sFor i Int32 iterations $     m =<< dPrimV "virt_group_id" (Imp.vi32 phys_group_id + Imp.vi32 i * kernelNumGroups constants) -sKernel :: KernelConstants -> String -> ImpM InKernel Imp.KernelOp a -> CallKernelGen ()-sKernel constants name m = do-  body <- makeAllMemoryGlobal $ subImpM_ (inKernelOperations constants) m-  uses <- computeKernelUses body mempty+sKernelThread, sKernelGroup :: String+                            -> Count NumGroups Imp.Exp -> Count GroupSize Imp.Exp+                            -> VName+                            -> (KernelConstants -> InKernelGen ())+                            -> CallKernelGen ()+(sKernelThread, sKernelGroup) = (sKernel' threadOperations kernelGlobalThreadId,+                                 sKernel' groupOperations kernelGroupId)+  where sKernel' ops flatf name num_groups group_size v f = do+          (constants, set_constants) <- kernelInitialisationSimple num_groups group_size+          let name' = nameFromString $ name ++ "_" ++ show (baseTag v)+          sKernel (ops constants) constants name' $ do+            set_constants+            dPrimV_ v $ flatf constants+            f constants +sKernel :: Operations ExplicitMemory Imp.KernelOp+        -> KernelConstants -> Name -> ImpM ExplicitMemory Imp.KernelOp a -> CallKernelGen ()+sKernel ops constants name m = do+  body <- makeAllMemoryGlobal $ subImpM_ ops m+  uses <- computeKernelUses body mempty   emit $ Imp.Op $ Imp.CallKernel Imp.Kernel     { Imp.kernelBody = body     , Imp.kernelUses = uses     , Imp.kernelNumGroups = [kernelNumGroups constants]     , Imp.kernelGroupSize = [kernelGroupSize constants]-    , Imp.kernelName =-        nameFromString $ name ++ "_" ++ show tag+    , Imp.kernelName = name     }-  where tag = baseTag $ kernelGlobalThreadIdVar constants +-- | A kernel with the given number of threads, running per-thread code.+sKernelSimple :: String -> Imp.Exp+              -> (KernelConstants -> InKernelGen ())+              -> CallKernelGen ()+sKernelSimple name kernel_size f = do+  (constants, init_constants) <- simpleKernelConstants kernel_size name+  let name' = nameFromString $ name ++ "_" +++              show (baseTag $ kernelGlobalThreadIdVar constants)+  sKernel (threadOperations constants) constants name' $ do+    init_constants+    f constants++copyInGroup :: CopyCompiler ExplicitMemory Imp.KernelOp+copyInGroup pt destloc srcloc n = do+  dest_space <- entryMemSpace <$> lookupMemory (memLocationName destloc)+  src_space <- entryMemSpace <$> lookupMemory (memLocationName srcloc)++  if isScalarMem dest_space && isScalarMem src_space+    then memLocationName destloc <-- Imp.var (memLocationName srcloc) pt+    else copyElementWise pt destloc srcloc n++  where isScalarMem (Space space) = space `M.member` allScalarMemory+        isScalarMem DefaultSpace = False++threadOperations, groupOperations :: KernelConstants+                                  -> Operations ExplicitMemory Imp.KernelOp+threadOperations constants =+  (defaultOperations $ compileThreadOp constants)+  { opsCopyCompiler = copyElementWise+  , opsExpCompiler = compileThreadExp+  , opsStmsCompiler = \_ -> defCompileStms mempty+  , opsAllocCompilers =+      M.fromList [ (Space "local", allocLocal)+                 , (Space "private", allocPrivate) ]+  }+groupOperations constants =+  (defaultOperations $ compileGroupOp constants)+  { opsCopyCompiler = copyInGroup+  , opsExpCompiler = compileGroupExp constants+  , opsStmsCompiler = \_ -> defCompileStms mempty+  , opsAllocCompilers =+      M.fromList [ (Space "local", allocLocal)+                 , (Space "private", allocPrivate) ]+  }+ -- | Perform a Replicate with a kernel. sReplicate :: VName -> Shape -> SubExp            -> CallKernelGen ()@@ -1106,8 +1038,10 @@     simpleKernelConstants (product dims) "replicate"    let is' = unflattenIndex dims $ kernelGlobalThreadId constants+      name = nameFromString $ "replicate_" +++             show (baseTag $ kernelGlobalThreadIdVar constants) -  sKernel constants "replicate" $ do+  sKernel (threadOperations constants) constants name $ do     set_constants     sWhen (kernelThreadActive constants) $       copyDWIM arr is' se $ drop (length ds) is'@@ -1119,7 +1053,10 @@   destloc <- entryArrayLocation <$> lookupArray arr   (constants, set_constants) <- simpleKernelConstants n "iota" -  sKernel constants "iota" $ do+  let name = nameFromString $ "iota_" +++             show (baseTag $ kernelGlobalThreadIdVar constants)++  sKernel (threadOperations constants) constants name $ do     set_constants     let gtid = kernelGlobalThreadId constants     sWhen (kernelThreadActive constants) $ do@@ -1132,7 +1069,7 @@ sCopy :: PrimType       -> MemLocation       -> MemLocation-      -> Imp.Count Imp.Elements+      -> Imp.Count Imp.Elements Imp.Exp       -> CallKernelGen () sCopy bt   destloc@(MemLocation destmem _ _)@@ -1141,12 +1078,15 @@   -- Note that the shape of the destination and the source are   -- necessarily the same.   let shape = map Imp.sizeToExp srcshape-      shape_se = map (Imp.innerExp . dimSizeToExp) srcshape-      kernel_size = Imp.innerExp n * product (drop 1 shape)+      shape_se = map (Imp.unCount . dimSizeToExp) srcshape+      kernel_size = Imp.unCount n * product (drop 1 shape)    (constants, set_constants) <- simpleKernelConstants kernel_size "copy" -  sKernel constants "copy" $ do+  let name = nameFromString $ "copy_" +++             show (baseTag $ kernelGlobalThreadIdVar constants)++  sKernel (threadOperations constants) constants name $ do     set_constants      let gtid = kernelGlobalThreadId constants@@ -1160,66 +1100,85 @@       Imp.Write destmem destidx bt destspace Imp.Nonvolatile $       Imp.index srcmem srcidx bt srcspace Imp.Nonvolatile +compileGroupResult :: SegSpace+                   -> KernelConstants -> PatElem ExplicitMemory -> KernelResult+                   -> InKernelGen () -compileKernelResult :: KernelConstants -> PatElem InKernel -> KernelResult-                    -> InKernelGen ()+compileGroupResult _ constants pe (TileReturns [(w,per_group_elems)] what) = do+  dest_loc <- entryArrayLocation <$> lookupArray (patElemName pe)+  let dest_loc_offset = offsetArray dest_loc offset+      dest' = arrayDestination dest_loc_offset+  n <- toExp . arraySize 0 =<< lookupType what -compileKernelResult constants pe (GroupsReturn what) = do-  i <- newVName "i"+  -- Avoid loop for the common case where each thread is statically+  -- known to write at most one element.+  if toExp' int32 per_group_elems == kernelGroupSize constants+    then sWhen (offset + ltid .<. toExp' int32 w) $+         copyDWIMDest dest' [ltid] (Var what) [ltid]+    else do+    i <- newVName "i"+    sFor i Int32 (n `quotRoundingUp` kernelGroupSize constants) $ do+      j <- fmap Imp.vi32 $ dPrimV "j" $+           kernelGroupSize constants * Imp.vi32 i + ltid+      sWhen (j .<. n) $ copyDWIMDest dest' [j] (Var what) [j]+  where ltid = kernelLocalThreadId constants+        offset = toExp' int32 per_group_elems * kernelGroupId constants +compileGroupResult space constants pe (TileReturns dims what) = do+  let gids = map fst $ unSegSpace space+      out_tile_sizes = map (toExp' int32 . snd) dims+      local_is = unflattenIndex out_tile_sizes $ kernelLocalThreadId constants+      group_is = zipWith (*) (map Imp.vi32 gids) out_tile_sizes+  is_for_thread <- mapM (dPrimV "thread_out_index") $ zipWith (+) group_is local_is++  sWhen (isActive $ zip is_for_thread $ map fst dims) $+    copyDWIM (patElemName pe) (map Imp.vi32 is_for_thread) (Var what) local_is++compileGroupResult space constants pe (Returns what) = do   in_local_memory <- arrayInLocalMemory what-  let me = kernelLocalThreadId constants+  let gids = map (Imp.vi32 . fst) $ unSegSpace space -  if not in_local_memory then do-    who' <- toExp $ intConst Int32 0-    sWhen (me .==. who') $-      copyDWIM (patElemName pe) [kernelGroupId constants] what []-    else do+  if not in_local_memory then+    sWhen (kernelLocalThreadId constants .==. 0) $+    copyDWIM (patElemName pe) gids what []+    else       -- If the result of the group is an array in local memory, we       -- store it by collective copying among all the threads of the       -- group.  TODO: also do this if the array is in global memory       -- (but this is a bit more tricky, synchronisation-wise).-      ---      -- We do the reads/writes multidimensionally, but the loop is-      -- single-dimensional.-      ws <- mapM toExp . arrayDims =<< subExpType what-      -- Compute how many elements this thread is responsible for.-      -- Formula: (w - ltid) / group_size (rounded up).-      let w = product ws-          ltid = kernelLocalThreadId constants-          group_size = kernelGroupSize constants-          to_write = (w - ltid) `quotRoundingUp` group_size-          is = unflattenIndex ws $ Imp.vi32 i * group_size + ltid+      groupCopy constants (patElemName pe) gids what [] -      sFor i Int32 to_write $-        copyDWIM (patElemName pe) (kernelGroupId constants : is) what is+compileGroupResult _ _ _ WriteReturns{} =+  compilerLimitationS "compileGroupResult: WriteReturns not handled yet." -compileKernelResult constants pe (ThreadsReturn what) = do-  let is = map (Imp.vi32 . fst) $ kernelDimensions constants-  sWhen (kernelThreadActive constants) $ copyDWIM (patElemName pe) is what []+compileGroupResult _ _ _ ConcatReturns{} =+  compilerLimitationS "compileGroupResult: ConcatReturns not handled yet." -compileKernelResult constants pe (ConcatReturns SplitContiguous _ per_thread_elems moffset what) = do+compileThreadResult :: SegSpace+                    -> KernelConstants -> PatElem ExplicitMemory -> KernelResult+                    -> InKernelGen ()++compileThreadResult space _ pe (Returns what) = do+  let is = map (Imp.vi32 . fst) $ unSegSpace space+  copyDWIM (patElemName pe) is what []++compileThreadResult _ constants pe (ConcatReturns SplitContiguous _ per_thread_elems what) = do   dest_loc <- entryArrayLocation <$> lookupArray (patElemName pe)   let dest_loc_offset = offsetArray dest_loc offset       dest' = arrayDestination dest_loc_offset   copyDWIMDest dest' [] (Var what) []-  where offset = case moffset of-                   Nothing -> toExp' int32 per_thread_elems *-                              kernelGlobalThreadId constants-                   Just se -> toExp' int32 se+  where offset = toExp' int32 per_thread_elems * kernelGlobalThreadId constants -compileKernelResult constants pe (ConcatReturns (SplitStrided stride) _ _ moffset what) = do+compileThreadResult _ constants pe (ConcatReturns (SplitStrided stride) _ _ what) = do   dest_loc <- entryArrayLocation <$> lookupArray (patElemName pe)   let dest_loc' = strideArray                   (offsetArray dest_loc offset) $                   toExp' int32 stride       dest' = arrayDestination dest_loc'   copyDWIMDest dest' [] (Var what) []-  where offset = case moffset of-                   Nothing -> kernelGlobalThreadId constants-                   Just se -> toExp' int32 se+  where offset = kernelGlobalThreadId constants -compileKernelResult constants pe (WriteReturn rws _arr dests) = do+compileThreadResult _ constants pe (WriteReturns rws _arr dests) = do   rws' <- mapM toExp rws   forM_ dests $ \(is, e) -> do     is' <- mapM toExp is@@ -1227,6 +1186,9 @@         write = foldl (.&&.) (kernelThreadActive constants) $                 zipWith condInBounds is' rws'     sWhen write $ copyDWIM (patElemName pe) (map (toExp' int32) is) e []++compileThreadResult _ _ _ TileReturns{} =+  compilerBugS "compileThreadResult: TileReturns unhandled."  arrayInLocalMemory :: SubExp -> InKernelGen Bool arrayInLocalMemory (Var name) = do

@@ -68,18 +68,18 @@                                    }  data SegGenRedSlug = SegGenRedSlug-                     { slugOp :: GenReduceOp InKernel+                     { slugOp :: GenReduceOp ExplicitMemory                      , slugNumSubhistos :: VName                      , slugSubhistos :: [SubhistosInfo]                      }  -- | Figure out how much memory is needed per histogram, and compute -- some other auxiliary information.-computeHistoUsage :: KernelSpace-                  -> GenReduceOp InKernel-                  -> CallKernelGen (Imp.Count Imp.Bytes, SegGenRedSlug)+computeHistoUsage :: SegSpace+                  -> GenReduceOp ExplicitMemory+                  -> CallKernelGen (Imp.Count Imp.Bytes Imp.Exp, SegGenRedSlug) computeHistoUsage space op = do-  let segment_dims = init $ spaceDimensions space+  let segment_dims = init $ unSegSpace space       num_segments = length segment_dims    op_h <- fmap (sum . map typeSize) $ mapM lookupType $ genReduceDest op@@ -113,7 +113,7 @@              let subhistos_mem_size =                   Imp.bytes $-                  Imp.innerExp (Imp.elements num_elems `Imp.withElemType` elemType dest_t)+                  Imp.unCount (Imp.elements num_elems `Imp.withElemType` elemType dest_t)              sAlloc_ subhistos_mem subhistos_mem_size $ Space "device"             sReplicate subhistos (Shape (map snd segment_dims ++@@ -129,20 +129,20 @@    return (op_h, SegGenRedSlug op num_subhistos subhisto_infos) -localMemLockArray :: KernelSpace -> Type-localMemLockArray space = Array int32 (Shape [spaceGroupSize space]) NoUniqueness+localMemLockArray :: Count GroupSize SubExp -> Type+localMemLockArray (Count group_size) = Array int32 (Shape [group_size]) NoUniqueness  -- | How many bytes will be spent on lock arrays if we use a local -- memory implementation?-localMemLockUsage :: KernelSpace -> [SegGenRedSlug] -> Imp.Count Imp.Bytes-localMemLockUsage space slugs =+localMemLockUsage :: Count GroupSize SubExp -> [SegGenRedSlug] -> Imp.Count Imp.Bytes Imp.Exp+localMemLockUsage group_size slugs =   if any (isRight . atomicUpdateLocking . genReduceOp . slugOp) slugs-  then typeSize $ localMemLockArray space+  then typeSize $ localMemLockArray group_size   else 0  prepareAtomicUpdateGlobal :: Maybe Locking -> [VName] -> SegGenRedSlug                           -> CallKernelGen (Maybe Locking,-                                            [Imp.Exp] -> ImpM InKernel Imp.KernelOp ())+                                            [Imp.Exp] -> InKernelGen ()) prepareAtomicUpdateGlobal l dests slug =   -- We need a separate lock array if the operators are not all of a   -- particularly simple form that permits pure atomic operations.@@ -172,7 +172,7 @@                                 -> CallKernelGen                                    [(VName,                                      [VName],-                                     [Imp.Exp] -> ImpM InKernel Imp.KernelOp ())]+                                     [Imp.Exp] -> InKernelGen ())] prepareIntermediateArraysGlobal num_threads = fmap snd . mapAccumLM onOp Nothing   where     onOp l slug@(SegGenRedSlug op num_subhistos subhisto_info) = do@@ -217,26 +217,26 @@       return (l', (num_subhistos, dests, do_op))  genRedKernelGlobal :: [PatElem ExplicitMemory]-                  -> KernelSpace-                  -> [SegGenRedSlug]-                  -> KernelBody InKernel-                  -> CallKernelGen ()-genRedKernelGlobal map_pes space slugs kbody = do-  (base_constants, init_constants) <- kernelInitialisationSetSpace space $ return ()-  let constants = base_constants { kernelThreadActive = true }-      (space_is, space_sizes) = unzip $ spaceDimensions space+                   -> Count NumGroups SubExp -> Count GroupSize SubExp+                   -> SegSpace+                   -> [SegGenRedSlug]+                   -> KernelBody ExplicitMemory+                   -> CallKernelGen ()+genRedKernelGlobal map_pes num_groups group_size space slugs kbody = do+  num_groups' <- traverse toExp num_groups+  group_size' <- traverse toExp group_size+  let (space_is, space_sizes) = unzip $ unSegSpace space       space_sizes_64 = map (i32Toi64 . toExp' int32) space_sizes       total_w_64 = product space_sizes_64+      num_threads = unCount num_groups' * unCount group_size' -  histograms <- prepareIntermediateArraysGlobal (kernelNumThreads constants) slugs+  histograms <- prepareIntermediateArraysGlobal num_threads slugs    elems_per_thread_64 <- dPrimV "elems_per_thread_64" $                          total_w_64 `quotRoundingUp`-                         ConvOpExp (SExt Int32 Int64) (kernelNumThreads constants)--  sKernel constants "seggenred_global" $ allThreads constants $ do-    init_constants+                         ConvOpExp (SExt Int32 Int64) num_threads +  sKernelThread "seggenred_global" num_groups' group_size' (segFlat space) $ \constants -> do     -- Compute subhistogram index for each thread, per histogram.     subhisto_inds <- forM histograms $ \(num_histograms, _, _) ->       dPrimV "subhisto_ind" $@@ -276,7 +276,7 @@         sComment "save map-out results" $           forM_ (zip map_pes map_res) $ \(pe, res) ->           copyDWIM (patElemName pe)-          (map ((`Imp.var` int32) . fst) $ kernelDimensions constants)+          (map ((`Imp.var` int32) . fst) $ unSegSpace space)           (kernelResultSubExp res) []          let (buckets, vs) = splitAt (length slugs) red_res@@ -301,19 +301,19 @@                   copyDWIM (paramName p) [] (kernelResultSubExp res) is                 do_op (bucket_is ++ is) -prepareIntermediateArraysLocal :: KernelSpace -> KernelConstants+prepareIntermediateArraysLocal :: Count NumGroups SubExp -> Count GroupSize SubExp                                -> VName -> [SegGenRedSlug]                                -> CallKernelGen                                   [([VName],+                                    KernelConstants ->                                     InKernelGen ([VName],-                                                 [Imp.Exp] -> ImpM InKernel Imp.KernelOp ()))]-prepareIntermediateArraysLocal space constants num_subhistos_per_group =+                                                 [Imp.Exp] -> InKernelGen ()))]+prepareIntermediateArraysLocal num_groups group_size num_subhistos_per_group =   fmap snd . mapAccumLM onOp Nothing   where     onOp l (SegGenRedSlug op num_subhistos subhisto_info) = do -      num_subhistos <---        toExp' int32 (spaceNumGroups space)+      num_subhistos <-- toExp' int32 (unCount num_groups)        emit $ Imp.DebugPrint "Number of subhistograms in global memory" $         Just (int32, Imp.vi32 num_subhistos)@@ -325,20 +325,20 @@       -- operators need locking.       (l', mk_op) <-         case (l, atomicUpdateLocking $ genReduceOp op) of-          (_, Left f) -> return (l, return f)-          (Just l', Right f) -> return (l, return $ f l')+          (_, Left f) -> return (l, const $ return f)+          (Just l', Right f) -> return (l, const $ return $ f l')           (Nothing, Right f) -> do             locks <- newVName "locks"-            num_locks <- toExp $ spaceGroupSize space+            num_locks <- toExp $ unCount group_size              let dims = map (toExp' int32) $                        Var num_subhistos_per_group :                        shapeDims (genReduceShape op) ++                        [genReduceWidth op]                 l' = Locking locks 0 1 0 ((`rem` num_locks) . flattenIndex dims)-                locks_t = localMemLockArray space+                locks_t = localMemLockArray group_size -                mk_op = do+                mk_op constants = do                   locks_mem <- sAlloc "locks_mem" (typeSize locks_t) $ Space "local"                   dArray locks int32 (arrayShape locks_t) $                     ArrayIn locks_mem $ IxFun.iota $@@ -353,7 +353,7 @@        -- Initialise local-memory sub-histograms.  These are       -- represented as two-dimensional arrays.-      let init_local_subhistos = do+      let init_local_subhistos constants = do             local_subhistos <-               forM (genReduceDest op) $ \dest -> do                 dest_t <- lookupType dest@@ -363,7 +363,7 @@                 sAllocArray "subhistogram_local"                   (elemType dest_t) sub_local_shape (Space "local") -            do_op <- mk_op+            do_op <- mk_op constants              return (local_subhistos, do_op (Space "local") local_subhistos) @@ -376,34 +376,34 @@  genRedKernelLocal :: VName                   -> [PatElem ExplicitMemory]-                  -> KernelSpace+                  -> Count NumGroups SubExp -> Count GroupSize SubExp+                  -> SegSpace                   -> [SegGenRedSlug]-                  -> KernelBody InKernel+                  -> KernelBody ExplicitMemory                   -> CallKernelGen ()-genRedKernelLocal num_subhistos_per_group_var map_pes space slugs kbody = do-  (base_constants, init_constants) <- kernelInitialisationSetSpace space $ return ()-  let (space_is, space_sizes) = unzip $ spaceDimensions space+genRedKernelLocal num_subhistos_per_group_var map_pes num_groups group_size space slugs kbody = do+  num_groups' <- traverse toExp num_groups+  group_size' <- traverse toExp group_size+  let num_threads = unCount num_groups' * unCount group_size'+      (space_is, space_sizes) = unzip $ unSegSpace space       segment_dims = init space_sizes       num_segments = length segment_dims-      constants = base_constants { kernelThreadActive = true }       space_sizes_64 = map (i32Toi64 . toExp' int32) space_sizes       total_w_64 = product space_sizes_64       num_subhistos_per_group = Imp.var num_subhistos_per_group_var int32    emit $ Imp.DebugPrint "Number of local subhistograms per group" $ Just (int32, num_subhistos_per_group) -  init_histograms <- prepareIntermediateArraysLocal space constants num_subhistos_per_group_var slugs+  init_histograms <- prepareIntermediateArraysLocal num_groups group_size num_subhistos_per_group_var slugs    elems_per_thread_64 <- dPrimV "elems_per_thread_64" $                          total_w_64 `quotRoundingUp`-                         ConvOpExp (SExt Int32 Int64) (kernelNumThreads constants)--  sKernel constants "seggenred_local" $ allThreads constants $ do-    init_constants+                         ConvOpExp (SExt Int32 Int64) num_threads +  sKernelThread "seggenred_local" num_groups' group_size' (segFlat space) $ \constants -> do     histograms <- forM init_histograms $                   \(glob_subhistos, init_local_subhistos) -> do-      (local_subhistos, do_op) <- init_local_subhistos+      (local_subhistos, do_op) <- init_local_subhistos constants       return (zip glob_subhistos local_subhistos, do_op)      -- Find index of local subhistograms updated by this thread.  We@@ -496,7 +496,7 @@         sComment "save map-out results" $           forM_ (zip map_pes map_res) $ \(pe, se) ->           copyDWIM (patElemName pe)-          (map ((`Imp.var` int32) . fst) $ kernelDimensions constants) se []+          (map (`Imp.var` int32) space_is) se []          forM_ (zip4 (map slugOp slugs) histograms buckets (perOp vs)) $           \(GenReduceOp dest_w _ _ shape lam,@@ -585,22 +585,25 @@ -- well as collapsing the subhistograms produced (which are always in -- global memory, but their number may vary). compileSegGenRed :: Pattern ExplicitMemory-                 -> KernelSpace-                 -> [GenReduceOp InKernel]-                 -> KernelBody InKernel+                 -> Count NumGroups SubExp -> Count GroupSize SubExp+                 -> SegSpace+                 -> [GenReduceOp ExplicitMemory]+                 -> KernelBody ExplicitMemory                  -> CallKernelGen ()-compileSegGenRed (Pattern _ pes) space ops kbody = do+compileSegGenRed (Pattern _ pes) num_groups group_size space ops kbody = do+  group_size' <- traverse toExp group_size+   let num_red_res = length ops + sum (map (length . genReduceNeutral) ops)       (all_red_pes, map_pes) = splitAt num_red_res pes    let t = 8 * 4-  g <- toExp $ spaceGroupSize space+      g = unCount group_size'   lmax <- dPrim "lmax" int32   sOp $ Imp.GetSizeMax lmax Imp.SizeLocalMemory    (op_hs, slugs) <- unzip <$> mapM (computeHistoUsage space) ops   h <- fmap (`Imp.var` int32) $-       dPrimV "h" $ Imp.innerExp $ sum op_hs+       dPrimV "h" $ Imp.unCount $ sum op_hs   coop <- fmap (`Imp.var` int32) $           dPrimV "coop" $ h `quotRoundingUp` t @@ -613,10 +616,11 @@     emit $ Imp.DebugPrint "Memory per set of subhistograms" $ Just (int32, h)     emit $ Imp.DebugPrint "Desired group size" $ Just (int32, g) -    sIf (Imp.innerExp (localMemLockUsage space slugs) + h * Imp.vi32 lh .<=. Imp.vi32 lmax+    sIf (Imp.unCount (localMemLockUsage group_size slugs) + h * Imp.vi32 lh+         .<=. Imp.vi32 lmax          .&&. coop .<=. g)-      (genRedKernelLocal lh map_pes space slugs kbody)-      (genRedKernelGlobal map_pes space slugs kbody)+      (genRedKernelLocal lh map_pes num_groups group_size space slugs kbody)+      (genRedKernelGlobal map_pes num_groups group_size space slugs kbody)      let pes_per_op = chunks (map (length . genReduceDest) ops) all_red_pes @@ -645,21 +649,21 @@         subhistogram_id <- newVName "subhistogram_id"         vector_ids <- mapM (const $ newVName "vector_id") $                       shapeDims $ genReduceShape op-        gtid <- newVName $ baseString $ spaceGlobalId space-        let segred_space =-              space { spaceStructure =-                        FlatThreadSpace $-                        segment_dims ++-                        [(bucket_id, num_buckets)] ++-                        zip vector_ids (shapeDims $ genReduceShape op) ++-                        [(subhistogram_id, Var num_histos)]-                    , spaceGlobalId = gtid-                    } +        flat_gtid <- newVName "flat_gtid"++        let lvl = SegThread num_groups group_size SegVirt+            segred_space =+              SegSpace flat_gtid $+              segment_dims +++              [(bucket_id, num_buckets)] +++              zip vector_ids (shapeDims $ genReduceShape op) +++              [(subhistogram_id, Var num_histos)]+         let segred_op = SegRedOp Commutative (genReduceOp op) (genReduceNeutral op) mempty-        compileSegRed' (Pattern [] red_pes) segred_space [segred_op] $ \_ red_cont ->+        compileSegRed' (Pattern [] red_pes) lvl segred_space [segred_op] $ \_ red_cont ->           red_cont $ flip map subhistos $ \subhisto ->             (Var subhisto, map (`Imp.var` int32) $               map fst segment_dims ++ [subhistogram_id, bucket_id] ++ vector_ids) -  where segment_dims = init $ spaceDimensions space+  where segment_dims = init $ unSegSpace space

@@ -1,7 +1,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} module Futhark.CodeGen.ImpGen.Kernels.SegMap-  ( compileSegMap ) where+  ( compileSegMap )+where  import Control.Monad.Except @@ -9,18 +10,52 @@  import Futhark.Representation.ExplicitMemory import Futhark.CodeGen.ImpGen.Kernels.Base+import Futhark.CodeGen.ImpGen+import qualified Futhark.CodeGen.ImpCode.Kernels as Imp+import Futhark.Util.IntegralExp (quotRoundingUp) --- | Compile 'SegMap' instance to host-level code with calls to--- various kernels.+-- | Compile 'SegMap' instance code. compileSegMap :: Pattern ExplicitMemory-              -> KernelSpace-              -> KernelBody InKernel+              -> SegLevel+              -> SegSpace+              -> KernelBody ExplicitMemory               -> CallKernelGen ()-compileSegMap pat space kbody = do-  (constants, init_constants) <- kernelInitialisation space -  sKernel constants "segmap" $ do-    init_constants-    compileKernelStms constants (kernelBodyStms kbody) $-      zipWithM_ (compileKernelResult constants) (patternElements pat) $-      kernelBodyResult kbody+compileSegMap _ SegThreadScalar{} _ _ =+  fail "compileSegMap: SegThreadScalar cannot be compiled at top level."++compileSegMap pat lvl space kbody = do+  let (is, dims) = unzip $ unSegSpace space+  dims' <- mapM toExp dims++  num_groups' <- traverse toExp $ segNumGroups lvl+  group_size' <- traverse toExp $ segGroupSize lvl++  case lvl of+    SegThreadScalar{} ->+      fail "compileSegMap: SegThreadScalar cannot be compiled at top level."++    SegThread{} ->+      sKernelThread "segmap" num_groups' group_size' (segFlat space) $ \constants -> do+      let virt_num_groups = product dims' `quotRoundingUp` unCount group_size'+      virtualiseGroups constants (segVirt lvl) virt_num_groups $ \group_id -> do+        let global_tid = Imp.vi32 group_id * unCount group_size' ++                         kernelLocalThreadId constants++        zipWithM_ dPrimV_ is $ unflattenIndex dims' global_tid++        sWhen (isActive $ unSegSpace space) $+          compileStms mempty (kernelBodyStms kbody) $+          zipWithM_ (compileThreadResult space constants) (patternElements pat) $+          kernelBodyResult kbody++    SegGroup{} ->+      sKernelGroup "segmap_intragroup" num_groups' group_size' (segFlat space) $ \constants -> do+      let virt_num_groups = product dims'+      virtualiseGroups constants (segVirt lvl) virt_num_groups $ \group_id -> do++        zipWithM_ dPrimV_ is $ unflattenIndex dims' $ Imp.vi32 group_id++        compileStms mempty (kernelBodyStms kbody) $+          zipWithM_ (compileGroupResult space constants) (patternElements pat) $+          kernelBodyResult kbody

@@ -44,6 +44,7 @@ module Futhark.CodeGen.ImpGen.Kernels.SegRed   ( compileSegRed   , compileSegRed'+  , DoSegBody   )   where @@ -74,41 +75,42 @@ -- | Compile 'SegRed' instance to host-level code with calls to -- various kernels. compileSegRed :: Pattern ExplicitMemory-              -> KernelSpace-              -> [SegRedOp InKernel]-              -> KernelBody InKernel+              -> SegLevel -> SegSpace+              -> [SegRedOp ExplicitMemory]+              -> KernelBody ExplicitMemory               -> CallKernelGen ()-compileSegRed pat space reds body =-  compileSegRed' pat space reds $ \constants red_cont ->-  compileKernelStms constants (kernelBodyStms body) $ do+compileSegRed pat lvl space reds body =+  compileSegRed' pat lvl space reds $ \constants red_cont ->+  compileStms mempty (kernelBodyStms body) $ do   let (red_res, map_res) = splitAt (segRedResults reds) $ kernelBodyResult body    sComment "save map-out results" $ do     let map_arrs = drop (segRedResults reds) $ patternElements pat-    zipWithM_ (compileKernelResult constants) map_arrs map_res+    zipWithM_ (compileThreadResult space constants) map_arrs map_res    red_cont $ zip (map kernelResultSubExp red_res) $ repeat []  -- | Like 'compileSegRed', but where the body is a monadic action. compileSegRed' :: Pattern ExplicitMemory-               -> KernelSpace-               -> [SegRedOp InKernel]+               -> SegLevel -> SegSpace+               -> [SegRedOp ExplicitMemory]                -> DoSegBody                -> CallKernelGen ()-compileSegRed' pat space reds body+compileSegRed' pat lvl space reds body   | genericLength reds > maxNumOps =       compilerLimitationS $       "compileSegRed': at most " ++ show maxNumOps ++ " reduction operators are supported."-  | [(_, Constant (IntValue (Int32Value 1))), _] <- spaceDimensions space =-      nonsegmentedReduction pat space reds body+  | [(_, Constant (IntValue (Int32Value 1))), _] <- unSegSpace space =+      nonsegmentedReduction pat num_groups group_size space reds body   | otherwise = do-      segment_size <--        toExp $ last $ map snd $ spaceDimensions space-      group_size <- toExp $ spaceGroupSize space-      let use_small_segments = segment_size * 2 .<. group_size+      group_size' <- toExp $ unCount group_size+      segment_size <- toExp $ last $ segSpaceDims space+      let use_small_segments = segment_size * 2 .<. group_size'       sIf use_small_segments-        (smallSegmentsReduction pat space reds body)-        (largeSegmentsReduction pat space reds body)+        (smallSegmentsReduction pat num_groups group_size space reds body)+        (largeSegmentsReduction pat num_groups group_size space reds body)+  where num_groups = segNumGroups lvl+        group_size = segGroupSize lvl  -- | Prepare intermediate arrays for the reduction.  Prim-typed -- arguments go in local memory (so we need to do the allocation of@@ -116,19 +118,21 @@ -- global memory.  Allocations for the former have already been -- performed.  This policy is baked into how the allocations are done -- in ExplicitAllocations.-intermediateArrays :: KernelSpace -> SegRedOp InKernel -> InKernelGen [VName]-intermediateArrays space (SegRedOp _ red_op nes _) = do+intermediateArrays :: Count GroupSize SubExp -> SubExp+                   -> SegRedOp ExplicitMemory+                   -> InKernelGen [VName]+intermediateArrays (Count group_size) num_threads (SegRedOp _ red_op nes _) = do   let red_op_params = lambdaParams red_op       (red_acc_params, _) = splitAt (length nes) red_op_params   forM red_acc_params $ \p ->     case paramAttr p of       MemArray pt shape _ (ArrayIn mem _) -> do-        let shape' = Shape [spaceNumThreads space] <> shape+        let shape' = Shape [num_threads] <> shape         sArray "red_arr" pt shape' $           ArrayIn mem $ IxFun.iota $ map (primExpFromSubExp int32) $ shapeDims shape'       _ -> do         let pt = elemType $ paramType p-            shape = Shape [spaceGroupSize space]+            shape = Shape [group_size]         sAllocArray "red_arr" pt shape $ Space "local"  -- | Arrays for storing group results.@@ -137,8 +141,10 @@ -- because they are also used for keeping vectorised accumulators for -- first-stage reduction, if necessary.  When actually storing group -- results, the first index is set to 0.-groupResultArrays :: SubExp -> SubExp -> [SegRedOp InKernel] -> CallKernelGen [[VName]]-groupResultArrays virt_num_groups group_size reds =+groupResultArrays :: Count NumGroups SubExp -> Count GroupSize SubExp+                  -> [SegRedOp ExplicitMemory]+                  -> CallKernelGen [[VName]]+groupResultArrays (Count virt_num_groups) (Count group_size) reds =   forM reds $ \(SegRedOp _ lam _ shape) ->     forM (lambdaReturnType lam) $ \t -> do     let pt = elemType t@@ -149,47 +155,43 @@     sAllocArrayPerm "group_res_arr" pt full_shape (Space "device") perm  nonsegmentedReduction :: Pattern ExplicitMemory-                      -> KernelSpace-                      -> [SegRedOp InKernel]+                      -> Count NumGroups SubExp -> Count GroupSize SubExp -> SegSpace+                      -> [SegRedOp ExplicitMemory]                       -> DoSegBody                       -> CallKernelGen ()-nonsegmentedReduction segred_pat space reds body = do-  (base_constants, init_constants) <- kernelInitialisationSetSpace space $ return ()-  let constants = base_constants { kernelThreadActive = true }-      global_tid = kernelGlobalThreadId constants-      (_, w) = last $ spaceDimensions space+nonsegmentedReduction segred_pat num_groups group_size space reds body = do+  let (gtids, dims) = unzip $ unSegSpace space+  dims' <- mapM toExp dims +  num_groups' <- traverse toExp num_groups+  group_size' <- traverse toExp group_size++  let global_tid = Imp.vi32 $ segFlat space+      w = last dims'+   counter <-     sStaticArray "counter" (Space "device") int32 $     Imp.ArrayValues $ replicate (fromIntegral maxNumOps) $ IntValue $ Int32Value 0 -  -- The group-result arrays have an extra dimension (of size-  -- groupsize) because they are also used for keeping vectorised-  -- accumulators for first-stage reduction, if necessary.  When-  -- actually storing group results, the first index is set to 0.-  reds_group_res_arrs <- groupResultArrays (spaceNumGroups space) (spaceGroupSize space) reds--  num_threads <- dPrimV "num_threads" $ kernelNumThreads constants+  reds_group_res_arrs <- groupResultArrays num_groups group_size reds -  sKernel constants "segred_nonseg" $ allThreads constants $ do-    init_constants+  num_threads <- dPrimV "num_threads" $ unCount num_groups' * unCount group_size' +  sKernelThread "segred_nonseg" num_groups' group_size' (segFlat space) $ \constants -> do     sync_arr <- sAllocArray "sync_arr" Bool (Shape [intConst Int32 1]) $ Space "local"-    reds_arrs <- mapM (intermediateArrays space) reds+    reds_arrs <- mapM (intermediateArrays group_size (Var num_threads)) reds      -- Since this is the nonsegmented case, all outer segment IDs must     -- necessarily be 0.-    let gtids = map fst $ spaceDimensions space-    forM_ (init gtids) $ \v ->-      v <-- 0+    forM_ gtids $ \v -> dPrimV_ v 0 -    num_elements <- Imp.elements <$> toExp w+    let num_elements = Imp.elements w     let elems_per_thread = num_elements `quotRoundingUp` Imp.elements (kernelNumThreads constants)      slugs <- mapM (segRedOpSlug (kernelLocalThreadId constants) (kernelGroupId constants)) $              zip3 reds reds_arrs reds_group_res_arrs     reds_op_renamed <--      reductionStageOne constants num_elements+      reductionStageOne constants (zip gtids dims') num_elements       global_tid elems_per_thread num_threads       slugs body @@ -206,24 +208,26 @@         sync_arr group_res_arrs red_arrs  smallSegmentsReduction :: Pattern ExplicitMemory-                       -> KernelSpace-                       -> [SegRedOp InKernel]+                       -> Count NumGroups SubExp -> Count GroupSize SubExp+                       -> SegSpace+                       -> [SegRedOp ExplicitMemory]                        -> DoSegBody                        -> CallKernelGen ()-smallSegmentsReduction (Pattern _ segred_pes) space reds body = do-  (base_constants, init_constants) <- kernelInitialisationSetSpace space $ return ()-  let constants = base_constants { kernelThreadActive = true }--  let (gtids, dims) = unzip $ spaceDimensions space+smallSegmentsReduction (Pattern _ segred_pes) num_groups group_size space reds body = do+  let (gtids, dims) = unzip $ unSegSpace space   dims' <- mapM toExp dims    let segment_size = last dims'   -- Careful to avoid division by zero now.   segment_size_nonzero_v <- dPrimV "segment_size_nonzero" $                             BinOpExp (SMax Int32) 1 segment_size++  num_groups' <- traverse toExp num_groups+  group_size' <- traverse toExp group_size+  num_threads <- dPrimV "num_threads" $ unCount num_groups' * unCount group_size'   let segment_size_nonzero = Imp.var segment_size_nonzero_v int32       num_segments = product $ init dims'-      segments_per_group = kernelGroupSize constants `quot` segment_size_nonzero+      segments_per_group = unCount group_size' `quot` segment_size_nonzero       required_groups = num_segments `quotRoundingUp` segments_per_group    emit $ Imp.DebugPrint "\n# SegRed-small" Nothing@@ -232,15 +236,14 @@   emit $ Imp.DebugPrint "segments_per_group" $ Just (int32, segments_per_group)   emit $ Imp.DebugPrint "required_groups" $ Just (int32, required_groups) -  sKernel constants "segred_small" $ allThreads constants $ do-    init_constants+  sKernelThread "segred_small" num_groups' group_size' (segFlat space) $ \constants -> do -    reds_arrs <- mapM (intermediateArrays space) reds+    reds_arrs <- mapM (intermediateArrays group_size (Var num_threads)) reds      -- We probably do not have enough actual workgroups to cover the     -- entire iteration space.  Some groups thus have to perform double     -- duty; we put an outer loop to accomplish this.-    virtualiseGroups constants required_groups $ \group_id_var' -> do+    virtualiseGroups constants SegVirt required_groups $ \group_id_var' -> do       let group_id' = Imp.vi32 group_id_var'       -- Compute the 'n' input indices.  The outer 'n-1' correspond to       -- the segment ID, and are computed from the group id.  The inner@@ -249,8 +252,8 @@           segment_index = (ltid `quot` segment_size_nonzero) + (group_id' * segments_per_group)           index_within_segment = ltid `rem` segment_size -      zipWithM_ (<--) (init gtids) $ unflattenIndex (init dims') segment_index-      last gtids <-- index_within_segment+      zipWithM_ dPrimV_ (init gtids) $ unflattenIndex (init dims') segment_index+      dPrimV_ (last gtids) index_within_segment        let out_of_bounds =             forM_ (zip reds reds_arrs) $ \(SegRedOp _ _ nes _, red_arrs) ->@@ -294,38 +297,41 @@       sOp Imp.LocalBarrier  largeSegmentsReduction :: Pattern ExplicitMemory-                       -> KernelSpace-                       -> [SegRedOp InKernel]+                       -> Count NumGroups SubExp -> Count GroupSize SubExp+                       -> SegSpace+                       -> [SegRedOp ExplicitMemory]                        -> DoSegBody                        -> CallKernelGen ()-largeSegmentsReduction segred_pat space reds body = do-  (base_constants, init_constants) <- kernelInitialisationSetSpace space $ return ()-  let (gtids, dims) = unzip $ spaceDimensions space+largeSegmentsReduction segred_pat num_groups group_size space reds body = do+  let (gtids, dims) = unzip $ unSegSpace space   dims' <- mapM toExp dims   let segment_size = last dims'       num_segments = product $ init dims' +  num_groups' <- traverse toExp num_groups+  group_size' <- traverse toExp group_size+   let (groups_per_segment, elems_per_thread) =         groupsPerSegmentAndElementsPerThread segment_size num_segments-        (kernelNumGroups base_constants) (kernelGroupSize base_constants)-  virt_num_groups <- dPrimV "virt_num_groups" $+        num_groups' group_size'+  virt_num_groups <- dPrimV "vit_num_groups" $     groups_per_segment * num_segments -  threads_per_segment <- dPrimV "thread_per_segment" $-    groups_per_segment * kernelGroupSize base_constants+  num_threads <- dPrimV "num_threads" $ unCount num_groups' * unCount group_size' -  let constants = base_constants { kernelThreadActive = true }+  threads_per_segment <- dPrimV "thread_per_segment" $+    groups_per_segment * unCount group_size'    emit $ Imp.DebugPrint "\n# SegRed-large" Nothing   emit $ Imp.DebugPrint "num_segments" $ Just (int32, num_segments)   emit $ Imp.DebugPrint "segment_size" $ Just (int32, segment_size)   emit $ Imp.DebugPrint "virt_num_groups" $ Just (int32, Imp.vi32 virt_num_groups)-  emit $ Imp.DebugPrint "num_groups" $ Just (int32, kernelNumGroups constants)-  emit $ Imp.DebugPrint "group_size" $ Just (int32, kernelGroupSize constants)-  emit $ Imp.DebugPrint "elems_per_thread" $ Just (int32, Imp.innerExp elems_per_thread)+  emit $ Imp.DebugPrint "num_groups" $ Just (int32, Imp.unCount num_groups')+  emit $ Imp.DebugPrint "group_size" $ Just (int32, Imp.unCount group_size')+  emit $ Imp.DebugPrint "elems_per_thread" $ Just (int32, Imp.unCount elems_per_thread)   emit $ Imp.DebugPrint "groups_per_segment" $ Just (int32, groups_per_segment) -  reds_group_res_arrs <- groupResultArrays (Var virt_num_groups) (spaceGroupSize space) reds+  reds_group_res_arrs <- groupResultArrays (Count (Var virt_num_groups)) group_size reds    -- In principle we should have a counter for every segment.  Since   -- the number of segments is a dynamic quantity, we would have to@@ -342,35 +348,33 @@     sStaticArray "counter" (Space "device") int32 $     Imp.ArrayZeros num_counters -  sKernel constants "segred_large" $ allThreads constants $ do-    init_constants+  sKernelThread "segred_large" num_groups' group_size' (segFlat space) $ \constants -> do -    reds_arrs <- mapM (intermediateArrays space) reds+    reds_arrs <- mapM (intermediateArrays group_size (Var num_threads)) reds     sync_arr <- sAllocArray "sync_arr" Bool (Shape [intConst Int32 1]) $ Space "local"      -- We probably do not have enough actual workgroups to cover the     -- entire iteration space.  Some groups thus have to perform double     -- duty; we put an outer loop to accomplish this.-    virtualiseGroups constants (Imp.vi32 virt_num_groups) $ \group_id_var -> do-+    virtualiseGroups constants SegVirt (Imp.vi32 virt_num_groups) $ \group_id_var -> do       let segment_gtids = init gtids           group_id = Imp.vi32 group_id_var-          group_size = kernelGroupSize constants           flat_segment_id = group_id `quot` groups_per_segment           local_tid = kernelLocalThreadId constants -          global_tid = (group_id * group_size + local_tid)-                       `rem` (group_size * groups_per_segment)+          global_tid = (group_id * unCount group_size' + local_tid)+                       `rem` (unCount group_size' * groups_per_segment)           w = last dims           first_group_for_segment = flat_segment_id * groups_per_segment -      zipWithM_ (<--) segment_gtids $ unflattenIndex (init dims') flat_segment_id+      zipWithM_ dPrimV_ segment_gtids $ unflattenIndex (init dims') flat_segment_id+      dPrim_ (last gtids) int32       num_elements <- Imp.elements <$> toExp w        slugs <- mapM (segRedOpSlug local_tid group_id) $                zip3 reds reds_arrs reds_group_res_arrs       reds_op_renamed <--        reductionStageOne constants num_elements+        reductionStageOne constants (zip gtids dims') num_elements         global_tid elems_per_thread threads_per_segment         slugs body @@ -399,20 +403,22 @@        sIf (groups_per_segment .==. 1) one_group_per_segment multiple_groups_per_segment --- Careful to avoid division by zero here.-groupsPerSegmentAndElementsPerThread :: Imp.Exp -> Imp.Exp -> Imp.Exp -> Imp.Exp-                                     -> (Imp.Exp, Imp.Count Imp.Elements)+-- Careful to avoid division by zero here.  We have at least one group+-- per segment.+groupsPerSegmentAndElementsPerThread :: Imp.Exp -> Imp.Exp+                                     -> Count NumGroups Imp.Exp -> Count GroupSize Imp.Exp+                                     -> (Imp.Exp, Imp.Count Imp.Elements Imp.Exp) groupsPerSegmentAndElementsPerThread segment_size num_segments num_groups_hint group_size =   let groups_per_segment =-        num_groups_hint `quotRoundingUp` BinOpExp (SMax Int32) 1 num_segments+        unCount num_groups_hint `quotRoundingUp` BinOpExp (SMax Int32) 1 num_segments       elements_per_thread =-        segment_size `quotRoundingUp` (group_size * groups_per_segment)+        segment_size `quotRoundingUp` (unCount group_size * groups_per_segment)   in (groups_per_segment, Imp.elements elements_per_thread)  -- | A SegRedOp with auxiliary information. data SegRedOpSlug =   SegRedOpSlug-  { slugOp :: SegRedOp InKernel+  { slugOp :: SegRedOp ExplicitMemory   , slugArrs :: [VName]     -- ^ The arrays used for computing the intra-group reduction     -- (either local or global memory).@@ -420,10 +426,10 @@     -- ^ Places to store accumulator in stage 1 reduction.   } -slugBody :: SegRedOpSlug -> Body InKernel+slugBody :: SegRedOpSlug -> Body ExplicitMemory slugBody = lambdaBody . segRedLambda . slugOp -slugParams :: SegRedOpSlug -> [LParam InKernel]+slugParams :: SegRedOpSlug -> [LParam ExplicitMemory] slugParams = lambdaParams . segRedLambda . slugOp  slugNeutral :: SegRedOpSlug -> [SubExp]@@ -435,11 +441,11 @@ slugsComm :: [SegRedOpSlug] -> Commutativity slugsComm = mconcat . map (segRedComm . slugOp) -accParams, nextParams :: SegRedOpSlug -> [LParam InKernel]+accParams, nextParams :: SegRedOpSlug -> [LParam ExplicitMemory] accParams slug = take (length (slugNeutral slug)) $ slugParams slug nextParams slug = drop (length (slugNeutral slug)) $ slugParams slug -segRedOpSlug :: Imp.Exp -> Imp.Exp -> (SegRedOp InKernel, [VName], [VName]) -> InKernelGen SegRedOpSlug+segRedOpSlug :: Imp.Exp -> Imp.Exp -> (SegRedOp ExplicitMemory, [VName], [VName]) -> InKernelGen SegRedOpSlug segRedOpSlug local_tid group_id (op, group_res_arrs, param_arrs) =   SegRedOpSlug op group_res_arrs <$>   zipWithM mkAcc (lambdaParams (segRedLambda op)) param_arrs@@ -452,16 +458,16 @@               return (param_arr, [local_tid, group_id])  reductionStageZero :: KernelConstants-                   -> Imp.Count Imp.Elements+                   -> [(VName, Imp.Exp)]+                   -> Imp.Count Imp.Elements Imp.Exp                    -> Imp.Exp-                   -> Imp.Count Imp.Elements+                   -> Imp.Count Imp.Elements Imp.Exp                    -> VName                    -> [SegRedOpSlug]                    -> DoSegBody-                   -> InKernelGen ([Lambda InKernel], InKernelGen ())-reductionStageZero constants num_elements global_tid elems_per_thread threads_per_segment slugs body = do--  let (gtids, _dims) = unzip $ kernelDimensions constants+                   -> InKernelGen ([Lambda ExplicitMemory], InKernelGen ())+reductionStageZero constants ispace num_elements global_tid elems_per_thread threads_per_segment slugs body = do+  let (gtids, _dims) = unzip ispace       gtid = last gtids       local_tid = kernelLocalThreadId constants @@ -512,8 +518,8 @@       (bound, check_bounds) =         case comm of           Commutative -> (Imp.var chunk_size int32, id)-          Noncommutative -> (Imp.innerExp elems_per_thread,-                             sWhen (Imp.var gtid int32 .<. Imp.innerExp num_elements))+          Noncommutative -> (Imp.unCount elems_per_thread,+                             sWhen (Imp.var gtid int32 .<. Imp.unCount num_elements))    sFor i Int32 bound $ do     gtid <--@@ -524,7 +530,7 @@         Noncommutative ->           let index_in_segment = global_tid `quot` kernelGroupSize constants           in local_tid +-             (index_in_segment * Imp.innerExp elems_per_thread + Imp.var i int32) *+             (index_in_segment * Imp.unCount elems_per_thread + Imp.var i int32) *              kernelGroupSize constants      check_bounds $ sComment "apply map function" $@@ -563,16 +569,17 @@   return (slugs_op_renamed, doTheReduction)  reductionStageOne :: KernelConstants-                  -> Imp.Count Imp.Elements+                  -> [(VName, Imp.Exp)]+                  -> Imp.Count Imp.Elements Imp.Exp                   -> Imp.Exp-                  -> Imp.Count Imp.Elements+                  -> Imp.Count Imp.Elements Imp.Exp                   -> VName                   -> [SegRedOpSlug]                   -> DoSegBody-                  -> InKernelGen [Lambda InKernel]-reductionStageOne constants num_elements global_tid elems_per_thread threads_per_segment slugs body = do+                  -> InKernelGen [Lambda ExplicitMemory]+reductionStageOne constants ispace num_elements global_tid elems_per_thread threads_per_segment slugs body = do   (slugs_op_renamed, doTheReduction) <--    reductionStageZero constants num_elements global_tid elems_per_thread threads_per_segment slugs body+    reductionStageZero constants ispace num_elements global_tid elems_per_thread threads_per_segment slugs body    case slugsComm slugs of     Noncommutative ->@@ -591,8 +598,8 @@                   -> Imp.Exp                   -> Imp.Exp                   -> SegRedOpSlug-                  -> [LParam InKernel]-                  -> Lambda InKernel -> [SubExp]+                  -> [LParam ExplicitMemory]+                  -> Lambda ExplicitMemory -> [SubExp]                   -> Imp.Exp -> VName -> Imp.Exp -> VName -> [VName] -> [VName]                   -> InKernelGen () reductionStageTwo constants segred_pes@@ -618,6 +625,7 @@     sWrite sync_arr [0] $ Imp.var old_counter int32 .==. groups_per_segment - 1    sOp Imp.LocalBarrier+  sOp Imp.GlobalBarrier    is_last_group <- dPrim "is_last_group" Bool   copyDWIM is_last_group [] (Var sync_arr) [0]

@@ -19,9 +19,9 @@ import qualified Futhark.Representation.ExplicitMemory.IndexFunction as IxFun import Futhark.Util.IntegralExp (quotRoundingUp, quot, rem) -makeLocalArrays :: SubExp -> SubExp -> [SubExp] -> Lambda InKernel+makeLocalArrays :: Count GroupSize SubExp -> SubExp -> [SubExp] -> Lambda ExplicitMemory                 -> InKernelGen [VName]-makeLocalArrays group_size num_threads nes scan_op = do+makeLocalArrays (Count group_size) num_threads nes scan_op = do   let (scan_x_params, _scan_y_params) =         splitAt (length nes) $ lambdaParams scan_op   forM scan_x_params $ \p ->@@ -39,18 +39,21 @@  -- | Produce partially scanned intervals; one per workgroup. scanStage1 :: Pattern ExplicitMemory-           -> KernelSpace-           -> Lambda InKernel -> [SubExp]-           -> KernelBody InKernel+           -> Count NumGroups SubExp -> Count GroupSize SubExp -> SegSpace+           -> Lambda ExplicitMemory -> [SubExp]+           -> KernelBody ExplicitMemory            -> CallKernelGen (Imp.Exp, CrossesSegment)-scanStage1 (Pattern _ pes) space scan_op nes kbody = do-  (base_constants, init_constants) <- kernelInitialisationSetSpace space $ return ()-  let (gtids, dims) = unzip $ spaceDimensions space+scanStage1 (Pattern _ pes) num_groups group_size space scan_op nes kbody = do+  num_groups' <- traverse toExp num_groups+  group_size' <- traverse toExp group_size+  num_threads <- dPrimV "num_threads" $+                 unCount num_groups' * unCount group_size'++  let (gtids, dims) = unzip $ unSegSpace space   dims' <- mapM toExp dims-  let constants = base_constants { kernelThreadActive = true }-      num_elements = product dims'-      elems_per_thread = num_elements `quotRoundingUp` kernelNumThreads constants-      elems_per_group = kernelGroupSize constants * elems_per_thread+  let num_elements = product dims'+      elems_per_thread = num_elements `quotRoundingUp` Imp.vi32 num_threads+      elems_per_group = unCount group_size' * elems_per_thread    -- Squirrel away a copy of the operator with unique names that we   -- can pass to groupScan.@@ -62,12 +65,9 @@             (to-from) .>. (to `rem` segment_size)           _ -> Nothing -  sKernel constants "scan_stage1" $ allThreads constants $ do-    init_constants-+  sKernelThread "scan_stage1" num_groups' group_size' (segFlat space) $ \constants -> do     local_arrs <--      makeLocalArrays (spaceGroupSize space) (spaceNumThreads space)-      nes scan_op+      makeLocalArrays group_size (Var num_threads) nes scan_op      -- The variables from scan_op will be used for the carry and such     -- in the big chunking loop.@@ -86,7 +86,7 @@       flat_idx <- dPrimV "flat_idx" $                   Imp.var chunk_offset int32 + kernelLocalThreadId constants       -- Construct segment indices.-      zipWithM_ (<--) gtids $ unflattenIndex dims' $ Imp.var flat_idx int32+      zipWithM_ dPrimV_ gtids $ unflattenIndex dims' $ Imp.var flat_idx int32        let in_bounds =             foldl1 (.&&.) $ zipWith (.<.) (map (`Imp.var` int32) gtids) dims'@@ -148,26 +148,23 @@   return (elems_per_group, crossesSegment)  scanStage2 :: Pattern ExplicitMemory-           -> Imp.Exp -> CrossesSegment -> KernelSpace-           -> Lambda InKernel -> [SubExp]+           -> Imp.Exp -> Count NumGroups SubExp -> CrossesSegment -> SegSpace+           -> Lambda ExplicitMemory -> [SubExp]            -> CallKernelGen ()-scanStage2 (Pattern _ pes) elems_per_group crossesSegment space scan_op nes = do-  -- A single group, with one thread for each group in stage 1.-  group_size <- toExp $ spaceNumGroups space-  (constants, init_constants) <--    kernelInitialisationSimple 1 group_size Nothing+scanStage2 (Pattern _ pes) elems_per_group num_groups crossesSegment space scan_op nes = do+  -- Our group size is the number of groups for the stage 1 kernel.+  let group_size = Count $ unCount num_groups+  group_size' <- traverse toExp group_size -  let (gtids, dims) = unzip $ spaceDimensions space+  let (gtids, dims) = unzip $ unSegSpace space   dims' <- mapM toExp dims   let crossesSegment' = do         f <- crossesSegment         Just $ \from to ->           f ((from + 1) * elems_per_group - 1) ((to + 1) * elems_per_group - 1) -  sKernel constants "scan_stage2" $ do-    init_constants--    local_arrs <- makeLocalArrays (spaceNumGroups space) (spaceNumGroups space)+  sKernelThread  "scan_stage2" 1 group_size' (segFlat space) $ \constants -> do+    local_arrs <- makeLocalArrays group_size (unCount group_size)                   nes scan_op      flat_idx <- dPrimV "flat_idx" $@@ -195,15 +192,14 @@       (Var arr) [kernelLocalThreadId constants]  scanStage3 :: Pattern ExplicitMemory-           -> Imp.Exp -> CrossesSegment -> KernelSpace-           -> Lambda InKernel -> [SubExp]+           -> Imp.Exp -> CrossesSegment -> SegSpace+           -> Lambda ExplicitMemory -> [SubExp]            -> CallKernelGen () scanStage3 (Pattern _ pes) elems_per_group crossesSegment space scan_op nes = do-  let (gtids, dims) = unzip $ spaceDimensions space+  let (gtids, dims) = unzip $ unSegSpace space   dims' <- mapM toExp dims-  (constants, init_constants) <- simpleKernelConstants (product dims') "scan"-  sKernel constants "scan_stage3" $ do-    init_constants+  sKernelSimple "scan_stage3" (product dims') $ \constants -> do+    dPrimV_ (segFlat space) $ kernelGlobalThreadId constants     -- Compute our logical index.     zipWithM_ dPrimV_ gtids $ unflattenIndex dims' $ kernelGlobalThreadId constants     -- Figure out which group this element was originally in.@@ -242,17 +238,18 @@ -- | Compile 'SegScan' instance to host-level code with calls to -- various kernels. compileSegScan :: Pattern ExplicitMemory-               -> KernelSpace-               -> Lambda InKernel -> [SubExp]-               -> KernelBody InKernel+               -> SegLevel -> SegSpace+               -> Lambda ExplicitMemory -> [SubExp]+               -> KernelBody ExplicitMemory                -> CallKernelGen ()-compileSegScan pat space scan_op nes kbody = do-  (elems_per_group, crossesSegment) <- scanStage1 pat space scan_op nes kbody+compileSegScan pat lvl space scan_op nes kbody = do+  (elems_per_group, crossesSegment) <-+    scanStage1 pat (segNumGroups lvl) (segGroupSize lvl) space scan_op nes kbody    emit $ Imp.DebugPrint "\n# SegScan" Nothing   emit $ Imp.DebugPrint "elems_per_group" $ Just (int32, elems_per_group)    scan_op' <- renameLambda scan_op   scan_op'' <- renameLambda scan_op-  scanStage2 pat elems_per_group crossesSegment space scan_op' nes+  scanStage2 pat elems_per_group (segNumGroups lvl) crossesSegment space scan_op' nes   scanStage3 pat elems_per_group crossesSegment space scan_op'' nes

@@ -28,6 +28,7 @@ import Futhark.CodeGen.ImpCode.OpenCL hiding (Program) import qualified Futhark.CodeGen.ImpCode.OpenCL as ImpOpenCL import Futhark.MonadFreshNames+import Futhark.Representation.ExplicitMemory (allScalarMemory) import Futhark.Util (zEncodeString) import Futhark.Util.Pretty (pretty) @@ -169,7 +170,7 @@           mem_aligned <- newVName $ baseString mem ++ "_aligned"           return (Just $ SharedMemoryKArg size,                   Just [C.cparam|__local volatile typename int64_t* $id:mem_aligned|],-                  [C.citem|__local volatile char* restrict $id:mem = $id:mem_aligned;|])+                  [C.citem|__local volatile char* restrict $id:mem = (__local volatile char*)$id:mem_aligned;|])         prepareLocalMemory TargetOpenCL (mem, Right size) = do           let size' = compilePrimExp size           return (Nothing, Nothing,@@ -262,7 +263,7 @@   cudaAtomicOps :: [C.Definition]-cudaAtomicOps = (return mkOp <*> opNames <*> types) ++ extraOps+cudaAtomicOps = (mkOp <$> opNames <*> types) ++ extraOps   where     mkOp (clName, cuName) t =       [C.cedecl|static inline $ty:t $id:clName(volatile $ty:t *p, $ty:t val) {@@ -294,7 +295,7 @@ typedef char int8_t; typedef short int16_t; typedef int int32_t;-typedef long int64_t;+typedef long long int64_t; typedef unsigned char uint8_t; typedef unsigned short uint16_t; typedef unsigned int uint32_t;@@ -408,8 +409,8 @@ inKernelOperations = GenericC.Operations                      { GenericC.opsCompiler = kernelOps                      , GenericC.opsMemoryType = kernelMemoryType-                     , GenericC.opsWriteScalar = GenericC.writeScalarPointerWithQuals pointerQuals-                     , GenericC.opsReadScalar = GenericC.readScalarPointerWithQuals pointerQuals+                     , GenericC.opsWriteScalar = kernelWriteScalar+                     , GenericC.opsReadScalar = kernelReadScalar                      , GenericC.opsAllocate = cannotAllocate                      , GenericC.opsDeallocate = cannotDeallocate                      , GenericC.opsCopy = copyInKernel@@ -438,7 +439,7 @@         kernelOps MemFenceGlobal =           GenericC.stm [C.cstm|mem_fence_global();|]         kernelOps (PrivateAlloc name size) = do-          size' <- GenericC.compileExp $ innerExp size+          size' <- GenericC.compileExp $ unCount size           name' <- newVName $ pretty name ++ "_backing"           GenericC.item [C.citem|__private char $id:name'[$exp:size'];|]           GenericC.stm [C.cstm|$id:name = $id:name';|]@@ -455,7 +456,7 @@           return [C.cty|$tyquals:(volatile++quals) $ty:t|]          doAtomic s old arr ind val op ty = do-          ind' <- GenericC.compileExp $ innerExp ind+          ind' <- GenericC.compileExp $ unCount ind           val' <- GenericC.compileExp val           cast <- atomicCast s ty           GenericC.stm [C.cstm|$id:old = $id:op(&(($ty:cast *)$id:arr)[$exp:ind'], ($ty:ty) $exp:val');|]@@ -485,14 +486,14 @@           doAtomic s old arr ind val "atomic_xor" [C.cty|unsigned int|]          atomicOps s (AtomicCmpXchg old arr ind cmp val) = do-          ind' <- GenericC.compileExp $ innerExp ind+          ind' <- GenericC.compileExp $ unCount ind           cmp' <- GenericC.compileExp cmp           val' <- GenericC.compileExp val           cast <- atomicCast s [C.cty|int|]           GenericC.stm [C.cstm|$id:old = atomic_cmpxchg(&(($ty:cast *)$id:arr)[$exp:ind'], $exp:cmp', $exp:val');|]          atomicOps s (AtomicXchg old arr ind val) = do-          ind' <- GenericC.compileExp $ innerExp ind+          ind' <- GenericC.compileExp $ unCount ind           val' <- GenericC.compileExp val           cast <- atomicCast s [C.cty|int|]           GenericC.stm [C.cstm|$id:old = atomic_xchg(&(($ty:cast *)$id:arr)[$exp:ind'], $exp:val');|]@@ -513,9 +514,29 @@         noStaticArrays _ _ _ _ =           fail "Cannot create static array in kernel." +        kernelMemoryType space+          | Just t <- M.lookup space allScalarMemory =+              return $ GenericC.primTypeToCType t+         kernelMemoryType space = do           quals <- pointerQuals space           return [C.cty|$tyquals:quals $ty:defaultMemBlockType|]++        kernelWriteScalar dest _ _ space _ v+          | space `M.member` allScalarMemory =+              GenericC.stm [C.cstm|$exp:dest = $exp:v;|]++        kernelWriteScalar dest i elemtype space vol v =+          GenericC.writeScalarPointerWithQuals pointerQuals+          dest i elemtype space vol v++        kernelReadScalar dest _ _ space _+          | space `M.member` allScalarMemory =+              return dest++        kernelReadScalar dest i elemtype space vol =+          GenericC.readScalarPointerWithQuals pointerQuals+          dest i elemtype space vol  --- Checking requirements 

@@ -6,13 +6,11 @@   )   where -import qualified Data.Set as S- import Prelude hiding (quot, rem)  import Futhark.CodeGen.ImpCode.Kernels import Futhark.Representation.AST.Attributes.Types-import Futhark.Representation.AST.Attributes.Names (freeIn)+import Futhark.Representation.AST.Attributes.Names (freeIn, namesToList) import Futhark.Util.IntegralExp (IntegralExp, quot, rem, quotRoundingUp)  -- | Which form of transposition to generate code for.@@ -256,7 +254,7 @@                  , [actual_dim, actual_dim `quot` elemsPerThread, 1])          uses = map (`ScalarUse` int32)-               (S.toList $ mconcat $ map freeIn+               (namesToList $ mconcat $ map freeIn                 [basic_odata_offset, basic_idata_offset, num_arrays,                  width, height, input_size, output_size, mulx, muly]) ++                map MemoryUse [odata, idata]

@@ -40,7 +40,7 @@  setBodySpace :: Space -> Code op -> Code op setBodySpace space (Allocate v e old_space) =-  Allocate v (setCountSpace space e) $ setSpace space old_space+  Allocate v (fmap (setExpSpace space) e) $ setSpace space old_space setBodySpace space (Free v old_space) =   Free v $ setSpace space old_space setBodySpace space (DeclareMem name old_space) =@@ -49,13 +49,13 @@   DeclareArray name space t vs setBodySpace space (Copy dest dest_offset dest_space src src_offset src_space n) =   Copy-  dest (setCountSpace space dest_offset) dest_space'-  src (setCountSpace space src_offset) src_space' $-  setCountSpace space n+  dest (fmap (setExpSpace space) dest_offset) dest_space'+  src (fmap (setExpSpace space) src_offset) src_space' $+  fmap (setExpSpace space) n   where dest_space' = setSpace space dest_space         src_space' = setSpace space src_space setBodySpace space (Write dest dest_offset bt dest_space vol e) =-  Write dest (setCountSpace space dest_offset) bt (setSpace space dest_space)+  Write dest (fmap (setExpSpace space) dest_offset) bt (setSpace space dest_space)   vol (setExpSpace space e) setBodySpace space (c1 :>>: c2) =   setBodySpace space c1 :>>: setBodySpace space c2@@ -85,10 +85,6 @@   DebugPrint s $ fmap (fmap (setExpSpace space)) v setBodySpace _ (Op op) =   Op op--setCountSpace :: Space -> Count a -> Count a-setCountSpace space (Count e) =-  Count $ setExpSpace space e  setExpSpace :: Space -> Exp -> Exp setExpSpace space = fmap setLeafSpace

@@ -119,7 +119,7 @@                          , pipelineValidate = True                          } -typeCheckInternalProgram :: I.Prog -> FutharkM ()+typeCheckInternalProgram :: I.Prog I.SOACS -> FutharkM () typeCheckInternalProgram prog =   case I.checkProg prog of     Left err -> internalErrorS ("After internalisation:\n" ++ show err) (Just prog)

@@ -1,6 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} module Futhark.Construct   ( letSubExp@@ -28,7 +27,7 @@   , eDivRoundingUp   , eRoundToMultipleOf   , eSliceArray-  , eSplitArray+  , eBlank    , eOutOfBounds   , eWriteArray@@ -46,6 +45,7 @@   , fullSlice   , fullSliceNum   , isFullSlice+  , sliceAt   , ifCommon    , module Futhark.Binder@@ -53,9 +53,6 @@   -- * Result types   , instantiateShapes   , instantiateShapes'-  , instantiateShapesFromIdentList-  , instantiateExtTypes-  , instantiateIdents   , removeExistentials    -- * Convenience@@ -75,7 +72,6 @@ import Futhark.Representation.AST import Futhark.MonadFreshNames import Futhark.Binder-import Futhark.Util  letSubExp :: MonadBinder m =>              String -> Exp (Lore m) -> m SubExp@@ -274,18 +270,6 @@   return $ BasicOp $ Index arr $ fullSlice arr_t $ skips ++ [slice i' n']   where slice j m = DimSlice j m (constant (1::Int32)) --- | Construct an 'Index' expressions that splits an array in different parts along the outer dimension.-eSplitArray :: MonadBinder m =>-               VName -> [m (Exp (Lore m))] -> m [Exp (Lore m)]-eSplitArray arr sizes = do-  sizes' <- mapM (letSubExp "split_size") =<< sequence sizes-  -- Compute the starting offset for each slice.-  (_, offsets) <- mapAccumLM increase (intConst Int32 0) sizes'-  zipWithM (eSliceArray 0 arr) (map eSubExp offsets) (map eSubExp sizes')-  where increase offset size = do-          offset' <- letSubExp "offset" $ BasicOp $ BinOp (Add Int32) offset size-          return (offset', offset)- -- | Are these indexes out-of-bounds for the array? eOutOfBounds :: MonadBinder m =>                 VName -> [m (Exp (Lore m))] -> m (Exp (Lore m))@@ -325,6 +309,12 @@     If outside_bounds outside_bounds_branch in_bounds_branch $     ifCommon [arr_t] +-- | Construct an unspecified value of the given type.+eBlank :: MonadBinder m => Type -> m (Exp (Lore m))+eBlank (Prim t) = return $ BasicOp $ SubExp $ Constant $ blankPrimValue t+eBlank (Array pt shape _) = return $ BasicOp $ Scratch pt $ shapeDims shape+eBlank Mem{} = fail "eBlank: cannot create blank memory"+ -- | Sign-extend to the given integer type. asIntS :: MonadBinder m => IntType -> SubExp -> m SubExp asIntS = asInt SExt@@ -383,16 +373,24 @@            , lambdaBody       = body            } +sliceDim :: SubExp -> DimIndex SubExp+sliceDim d = DimSlice (constant (0::Int32)) d (constant (1::Int32))+ -- | @fullSlice t slice@ returns @slice@, but with 'DimSlice's of -- entire dimensions appended to the full dimensionality of @t@.  This -- function is used to turn incomplete indexing complete, as required -- by 'Index'. fullSlice :: Type -> [DimIndex SubExp] -> Slice SubExp fullSlice t slice =-  slice ++-  map (\d -> DimSlice (constant (0::Int32)) d (constant (1::Int32)))-  (drop (length slice) $ arrayDims t)+  slice ++ map sliceDim (drop (length slice) $ arrayDims t) +-- | @ sliceAt t n slice@ returns @slice@ but with 'DimSlice's of the+-- outer @n@ dimensions prepended, and as many appended as to make it+-- a full slice.  This is a generalisation of 'fullSlice'.+sliceAt :: Type -> Int -> [DimIndex SubExp] -> Slice SubExp+sliceAt t n slice =+  fullSlice t $ map sliceDim (take n $ arrayDims t) ++ slice+ -- | Like 'fullSlice', but the dimensions are simply numeric. fullSliceNum :: Num d => [d] -> [DimIndex d] -> Slice d fullSliceNum dims slice =@@ -466,41 +464,6 @@   where instantiate _ = do v <- lift $ newIdent "size" $ Prim int32                            tell [v]                            return $ Var $ identName v--instantiateShapesFromIdentList :: [Ident] -> [ExtType] -> [Type]-instantiateShapesFromIdentList idents ts =-  evalState (instantiateShapes instantiate ts) idents-  where instantiate _ = do-          idents' <- get-          case idents' of-            [] -> fail "instantiateShapesFromIdentList: insufficiently sized context"-            ident:idents'' -> do put idents''-                                 return $ Var $ identName ident--instantiateExtTypes :: [VName] -> [ExtType] -> [Ident]-instantiateExtTypes names rt =-  let (shapenames,valnames) = splitAt (shapeContextSize rt) names-      shapes = [ Ident name (Prim int32) | name <- shapenames ]-      valts  = instantiateShapesFromIdentList shapes rt-      vals   = [ Ident name t | (name,t) <- zip valnames valts ]-  in shapes ++ vals--instantiateIdents :: [VName] -> [ExtType]-                  -> Maybe ([Ident], [Ident])-instantiateIdents names ts-  | let n = shapeContextSize ts,-    n + length ts == length names = do-    let (context, vals) = splitAt n names-        nextShape _ = do-          (context', remaining) <- get-          case remaining of []   -> lift Nothing-                            x:xs -> do let ident = Ident x (Prim int32)-                                       put (context'++[ident], xs)-                                       return $ Var x-    (ts', (context', _)) <--      runStateT (instantiateShapes nextShape ts) ([],context)-    return (context', zipWith Ident vals ts')-  | otherwise = Nothing  removeExistentials :: ExtType -> Type -> Type removeExistentials t1 t2 =