futhark 0.22.1 → 0.22.2

raw patch · 301 files changed

+4647/−4922 lines, 301 filesdep +prettyprinterdep +prettyprinter-ansi-terminaldep ~lspPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: prettyprinter, prettyprinter-ansi-terminal

Dependency ranges changed: lsp

API changes (from Hackage documentation)

Files

• docs/man/futhark-pyopencl.rst +1/−1
• futhark.cabal +58/−3
• prelude/math.fut +10/−0
• prelude/soacs.fut +2/−4
• rts/c/half.h +18/−0
• rts/c/scalar.h +32/−0
• rts/c/scalar_f16.h +16/−0
• rts/python/opencl.py +1/−2
• rts/python/scalar.py +9/−0
• src/Futhark/AD/Derivatives.hs +3/−2
• src/Futhark/AD/Fwd.hs +7/−12
• src/Futhark/AD/Rev.hs +5/−9
• src/Futhark/AD/Rev/Loop.hs +5/−8
• src/Futhark/AD/Rev/Map.hs +0/−4
• src/Futhark/AD/Rev/Monad.hs +6/−11
• src/Futhark/AD/Rev/Reduce.hs +0/−4
• src/Futhark/AD/Rev/SOAC.hs +1/−5
• src/Futhark/AD/Rev/Scatter.hs +0/−4
• src/Futhark/Actions.hs +27/−30
• src/Futhark/Analysis/Alias.hs +1/−2
• src/Futhark/Analysis/CallGraph.hs +8/−10
• src/Futhark/Analysis/DataDependencies.hs +2/−4
• src/Futhark/Analysis/HORep/MapNest.hs +3/−5
• src/Futhark/Analysis/HORep/SOAC.hs +18/−18
• src/Futhark/Analysis/Interference.hs +4/−6
• src/Futhark/Analysis/LastUse.hs +1/−5
• src/Futhark/Analysis/MemAlias.hs +4/−6
• src/Futhark/Analysis/Metrics.hs +2/−7
• src/Futhark/Analysis/Metrics/Type.hs +2/−2
• src/Futhark/Analysis/PrimExp.hs +13/−15
• src/Futhark/Analysis/PrimExp/Convert.hs +2/−2
• src/Futhark/Analysis/PrimExp/Parse.hs +1/−3
• src/Futhark/Analysis/PrimExp/Simplify.hs +0/−2
• src/Futhark/Analysis/Rephrase.hs +0/−2
• src/Futhark/Analysis/SymbolTable.hs +3/−5
• src/Futhark/Analysis/UsageTable.hs +2/−2
• src/Futhark/Bench.hs +9/−12
• src/Futhark/Builder.hs +3/−9
• src/Futhark/Builder/Class.hs +1/−2
• src/Futhark/CLI/Autotune.hs +4/−7
• src/Futhark/CLI/Bench.hs +21/−17
• src/Futhark/CLI/C.hs +0/−2
• src/Futhark/CLI/CUDA.hs +0/−2
• src/Futhark/CLI/Check.hs +3/−3
• src/Futhark/CLI/Datacmp.hs +1/−3
• src/Futhark/CLI/Dataset.hs +13/−15
• src/Futhark/CLI/Defs.hs +3/−5
• src/Futhark/CLI/Dev.hs +30/−32
• src/Futhark/CLI/Doc.hs +2/−4
• src/Futhark/CLI/LSP.hs +0/−1
• src/Futhark/CLI/Literate.hs +60/−53
• src/Futhark/CLI/Main.hs +27/−29
• src/Futhark/CLI/Misc.hs +2/−4
• src/Futhark/CLI/Multicore.hs +0/−2
• src/Futhark/CLI/MulticoreISPC.hs +0/−2
• src/Futhark/CLI/MulticoreWASM.hs +0/−2
• src/Futhark/CLI/OpenCL.hs +0/−2
• src/Futhark/CLI/Pkg.hs +6/−9
• src/Futhark/CLI/PyOpenCL.hs +0/−2
• src/Futhark/CLI/Python.hs +0/−2
• src/Futhark/CLI/Query.hs +2/−2
• src/Futhark/CLI/REPL.hs +52/−54
• src/Futhark/CLI/Run.hs +33/−37
• src/Futhark/CLI/Test.hs +26/−24
• src/Futhark/CLI/WASM.hs +0/−2
• src/Futhark/CodeGen/Backends/CCUDA.hs +8/−10
• src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs +10/−9
• src/Futhark/CodeGen/Backends/COpenCL.hs +8/−11
• src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs +16/−17
• src/Futhark/CodeGen/Backends/GenericC.hs +15/−93
• src/Futhark/CodeGen/Backends/GenericC/CLI.hs +22/−19
• src/Futhark/CodeGen/Backends/GenericC/Code.hs +12/−16
• src/Futhark/CodeGen/Backends/GenericC/EntryPoints.hs +4/−9
• src/Futhark/CodeGen/Backends/GenericC/Fun.hs +83/−0
• src/Futhark/CodeGen/Backends/GenericC/Monad.hs +10/−13
• src/Futhark/CodeGen/Backends/GenericC/Options.hs +4/−4
• src/Futhark/CodeGen/Backends/GenericC/Pretty.hs +33/−0
• src/Futhark/CodeGen/Backends/GenericC/Server.hs +6/−11
• src/Futhark/CodeGen/Backends/GenericC/Types.hs +8/−13
• src/Futhark/CodeGen/Backends/GenericPython.hs +24/−28
• src/Futhark/CodeGen/Backends/GenericPython/AST.hs +97/−97
• src/Futhark/CodeGen/Backends/GenericWASM.hs +3/−4
• src/Futhark/CodeGen/Backends/MulticoreC.hs +10/−11
• src/Futhark/CodeGen/Backends/MulticoreISPC.hs +27/−30
• src/Futhark/CodeGen/Backends/MulticoreWASM.hs +5/−7
• src/Futhark/CodeGen/Backends/PyOpenCL.hs +24/−15
• src/Futhark/CodeGen/Backends/PyOpenCL/Boilerplate.hs +9/−9
• src/Futhark/CodeGen/Backends/SequentialC.hs +4/−6
• src/Futhark/CodeGen/Backends/SequentialC/Boilerplate.hs +2/−2
• src/Futhark/CodeGen/Backends/SequentialPython.hs +4/−4
• src/Futhark/CodeGen/Backends/SequentialWASM.hs +4/−6
• src/Futhark/CodeGen/Backends/SimpleRep.hs +4/−6
• src/Futhark/CodeGen/ImpCode.hs +95/−96
• src/Futhark/CodeGen/ImpCode/GPU.hs +99/−102
• src/Futhark/CodeGen/ImpCode/Multicore.hs +37/−39
• src/Futhark/CodeGen/ImpCode/OpenCL.hs +3/−3
• src/Futhark/CodeGen/ImpCode/Sequential.hs +1/−1
• src/Futhark/CodeGen/ImpGen.hs +44/−50
• src/Futhark/CodeGen/ImpGen/GPU.hs +8/−11
• src/Futhark/CodeGen/ImpGen/GPU/Base.hs +10/−11
• src/Futhark/CodeGen/ImpGen/GPU/Group.hs +5/−6
• src/Futhark/CodeGen/ImpGen/GPU/SegHist.hs +3/−5
• src/Futhark/CodeGen/ImpGen/GPU/SegMap.hs +1/−2
• src/Futhark/CodeGen/ImpGen/GPU/SegRed.hs +2/−3
• src/Futhark/CodeGen/ImpGen/GPU/SegScan.hs +3/−3
• src/Futhark/CodeGen/ImpGen/GPU/SegScan/SinglePass.hs +2/−3
• src/Futhark/CodeGen/ImpGen/GPU/SegScan/TwoPass.hs +2/−3
• src/Futhark/CodeGen/ImpGen/GPU/ToOpenCL.hs +22/−23
• src/Futhark/CodeGen/ImpGen/Multicore.hs +3/−4
• src/Futhark/CodeGen/ImpGen/Multicore/Base.hs +4/−4
• src/Futhark/CodeGen/ImpGen/Multicore/SegHist.hs +1/−1
• src/Futhark/CodeGen/ImpGen/Multicore/SegMap.hs +2/−2
• src/Futhark/CodeGen/ImpGen/Multicore/SegRed.hs +1/−1
• src/Futhark/CodeGen/ImpGen/Multicore/SegScan.hs +1/−1
• src/Futhark/CodeGen/ImpGen/OpenCL.hs +1/−1
• src/Futhark/CodeGen/ImpGen/Sequential.hs +2/−3
• src/Futhark/CodeGen/OpenCL/Heuristics.hs +1/−1
• src/Futhark/CodeGen/RTS/C.hs +1/−1
• src/Futhark/CodeGen/RTS/JavaScript.hs +1/−1
• src/Futhark/CodeGen/RTS/Python.hs +1/−1
• src/Futhark/Compiler.hs +18/−21
• src/Futhark/Compiler/Program.hs +22/−23
• src/Futhark/Construct.hs +5/−8
• src/Futhark/Doc/Generator.hs +16/−18
• src/Futhark/Error.hs +15/−12
• src/Futhark/FreshNames.hs +0/−2
• src/Futhark/IR/Aliases.hs +11/−15
• src/Futhark/IR/GPU.hs +1/−2
• src/Futhark/IR/GPU/Op.hs +33/−38
• src/Futhark/IR/GPU/Simplify.hs +5/−9
• src/Futhark/IR/GPU/Sizes.hs +12/−16
• src/Futhark/IR/GPUMem.hs +3/−7
• src/Futhark/IR/MC.hs +4/−6
• src/Futhark/IR/MC/Op.hs +10/−12
• src/Futhark/IR/MCMem.hs +2/−6
• src/Futhark/IR/Mem.hs +82/−93
• src/Futhark/IR/Mem/IxFun.hs +18/−22
• src/Futhark/IR/Mem/Simplify.hs +5/−9
• src/Futhark/IR/Parse.hs +15/−19
• src/Futhark/IR/Pretty.hs +220/−205
• src/Futhark/IR/Prop.hs +2/−6
• src/Futhark/IR/Prop/Aliases.hs +2/−4
• src/Futhark/IR/Prop/Names.hs +4/−6
• src/Futhark/IR/Prop/Patterns.hs +0/−1
• src/Futhark/IR/Prop/Scope.hs +4/−10
• src/Futhark/IR/Prop/TypeOf.hs +0/−3
• src/Futhark/IR/Prop/Types.hs +2/−5
• src/Futhark/IR/Rep.hs +1/−2
• src/Futhark/IR/RetType.hs +1/−2
• src/Futhark/IR/SOACS.hs +1/−2
• src/Futhark/IR/SOACS/SOAC.hs +108/−116
• src/Futhark/IR/SOACS/Simplify.hs +6/−10
• src/Futhark/IR/SegOp.hs +102/−107
• src/Futhark/IR/Seq.hs +3/−4
• src/Futhark/IR/SeqMem.hs +2/−6
• src/Futhark/IR/Syntax.hs +6/−9
• src/Futhark/IR/Syntax/Core.hs +5/−8
• src/Futhark/IR/TypeCheck.hs +137/−155
• src/Futhark/Internalise.hs +2/−3
• src/Futhark/Internalise/AccurateSizes.hs +2/−4
• src/Futhark/Internalise/Bindings.hs +2/−3
• src/Futhark/Internalise/Defunctionalise.hs +20/−25
• src/Futhark/Internalise/Defunctorise.hs +4/−7
• src/Futhark/Internalise/Entry.hs +8/−11
• src/Futhark/Internalise/Exps.hs +41/−43
• src/Futhark/Internalise/Lambdas.hs +0/−2
• src/Futhark/Internalise/LiftLambdas.hs +2/−6
• src/Futhark/Internalise/Monad.hs +2/−7
• src/Futhark/Internalise/Monomorphise.hs +12/−17
• src/Futhark/Internalise/TypesValues.hs +6/−10
• src/Futhark/LSP/Compile.hs +2/−2
• src/Futhark/LSP/Diagnostic.hs +8/−10
• src/Futhark/LSP/Handlers.hs +1/−3
• src/Futhark/LSP/PositionMapping.hs +3/−3
• src/Futhark/LSP/State.hs +1/−1
• src/Futhark/LSP/Tool.hs +1/−3
• src/Futhark/MonadFreshNames.hs +8/−9
• src/Futhark/Optimise/BlkRegTiling.hs +12/−13
• src/Futhark/Optimise/CSE.hs +5/−8
• src/Futhark/Optimise/DoubleBuffer.hs +2/−8
• src/Futhark/Optimise/EntryPointMem.hs +2/−7
• src/Futhark/Optimise/Fusion.hs +8/−11
• src/Futhark/Optimise/Fusion/Composing.hs +2/−2
• src/Futhark/Optimise/Fusion/GraphRep.hs +18/−20
• src/Futhark/Optimise/Fusion/TryFusion.hs +4/−6
• src/Futhark/Optimise/GenRedOpt.hs +3/−4
• src/Futhark/Optimise/HistAccs.hs +1/−1
• src/Futhark/Optimise/InPlaceLowering.hs +4/−9
• src/Futhark/Optimise/InPlaceLowering/LowerIntoStm.hs +0/−1
• src/Futhark/Optimise/InPlaceLowering/SubstituteIndices.hs +2/−3
• src/Futhark/Optimise/InliningDeadFun.hs +3/−6
• src/Futhark/Optimise/MemoryBlockMerging.hs +5/−7
• src/Futhark/Optimise/MemoryBlockMerging/GreedyColoring.hs +3/−3
• src/Futhark/Optimise/MergeGPUBodies.hs +4/−4
• src/Futhark/Optimise/ReduceDeviceSyncs.hs +3/−5
• src/Futhark/Optimise/ReduceDeviceSyncs/MigrationTable.hs +8/−8
• src/Futhark/Optimise/ReduceDeviceSyncs/MigrationTable/Graph.hs +3/−3
• src/Futhark/Optimise/Simplify.hs +3/−5
• src/Futhark/Optimise/Simplify/Engine.hs +4/−10
• src/Futhark/Optimise/Simplify/Rep.hs +4/−7
• src/Futhark/Optimise/Simplify/Rule.hs +2/−5
• src/Futhark/Optimise/Simplify/Rules.hs +4/−6
• src/Futhark/Optimise/Simplify/Rules/BasicOp.hs +1/−4
• src/Futhark/Optimise/Simplify/Rules/ClosedForm.hs +1/−3
• src/Futhark/Optimise/Simplify/Rules/Index.hs +1/−1
• src/Futhark/Optimise/Simplify/Rules/Loop.hs +2/−4
• src/Futhark/Optimise/Simplify/Rules/Match.hs +2/−4
• src/Futhark/Optimise/Simplify/Rules/Simple.hs +1/−3
• src/Futhark/Optimise/Sink.hs +4/−6
• src/Futhark/Optimise/TileLoops.hs +4/−5
• src/Futhark/Optimise/TileLoops/Shared.hs +3/−5
• src/Futhark/Optimise/Unstream.hs +3/−4
• src/Futhark/Pass.hs +2/−4
• src/Futhark/Pass/ExpandAllocations.hs +7/−9
• src/Futhark/Pass/ExplicitAllocations.hs +13/−20
• src/Futhark/Pass/ExplicitAllocations/GPU.hs +3/−5
• src/Futhark/Pass/ExplicitAllocations/MC.hs +1/−3
• src/Futhark/Pass/ExplicitAllocations/SegOp.hs +1/−3
• src/Futhark/Pass/ExplicitAllocations/Seq.hs +0/−3
• src/Futhark/Pass/ExtractKernels.hs +1/−8
• src/Futhark/Pass/ExtractKernels/BlockedKernel.hs +0/−2
• src/Futhark/Pass/ExtractKernels/DistributeNests.hs +3/−10
• src/Futhark/Pass/ExtractKernels/Distribution.hs +7/−13
• src/Futhark/Pass/ExtractKernels/ISRWIM.hs +0/−1
• src/Futhark/Pass/ExtractKernels/Interchange.hs +0/−2
• src/Futhark/Pass/ExtractKernels/Intragroup.hs +4/−7
• src/Futhark/Pass/ExtractKernels/StreamKernel.hs +1/−3
• src/Futhark/Pass/ExtractKernels/ToGPU.hs +2/−4
• src/Futhark/Pass/ExtractMulticore.hs +2/−5
• src/Futhark/Pass/FirstOrderTransform.hs +0/−1
• src/Futhark/Pass/KernelBabysitting.hs +1/−2
• src/Futhark/Pass/Simplify.hs +7/−9
• src/Futhark/Passes.hs +4/−6
• src/Futhark/Pipeline.hs +3/−8
• src/Futhark/Pkg/Info.hs +7/−9
• src/Futhark/Pkg/Solve.hs +3/−6
• src/Futhark/Pkg/Types.hs +6/−8
• src/Futhark/Script.hs +32/−35
• src/Futhark/Test.hs +15/−17
• src/Futhark/Test/Spec.hs +8/−11
• src/Futhark/Test/Values.hs +8/−10
• src/Futhark/Tools.hs +0/−1
• src/Futhark/Transform/CopyPropagate.hs +1/−4
• src/Futhark/Transform/FirstOrderTransform.hs +3/−5
• src/Futhark/Transform/Rename.hs +1/−6
• src/Futhark/Transform/Substitute.hs +1/−4
• src/Futhark/Util.hs +22/−144
• src/Futhark/Util/CMath.hs +148/−0
• src/Futhark/Util/Console.hs +0/−26
• src/Futhark/Util/Log.hs +5/−9
• src/Futhark/Util/Pretty.hs +138/−53
• src/Futhark/Util/ProgressBar.hs +2/−4
• src/Futhark/Util/Table.hs +28/−25
• src/Futhark/Version.hs +2/−2
• src/Language/Futhark/Core.hs +23/−22
• src/Language/Futhark/FreeVars.hs +2/−2
• src/Language/Futhark/Interpreter.hs +160/−285
• src/Language/Futhark/Interpreter/Values.hs +266/−0
• src/Language/Futhark/Parser.hs +1/−22
• src/Language/Futhark/Parser/Lexer.x +0/−3
• src/Language/Futhark/Parser/Lexer/Tokens.hs +5/−7
• src/Language/Futhark/Parser/Lexer/Wrapper.hs +6/−6
• src/Language/Futhark/Parser/Monad.hs +14/−40
• src/Language/Futhark/Parser/Parser.y +6/−104
• src/Language/Futhark/Prelude.hs +3/−5
• src/Language/Futhark/Pretty.hs +392/−390
• src/Language/Futhark/Primitive.hs +162/−134
• src/Language/Futhark/Primitive/Parse.hs +3/−5
• src/Language/Futhark/Prop.hs +13/−24
• src/Language/Futhark/Query.hs +2/−4
• src/Language/Futhark/Semantic.hs +31/−24
• src/Language/Futhark/Syntax.hs +37/−51
• src/Language/Futhark/Traversals.hs +2/−5
• src/Language/Futhark/Tuple.hs +2/−2
• src/Language/Futhark/TypeChecker.hs +14/−15
• src/Language/Futhark/TypeChecker/Match.hs +7/−9
• src/Language/Futhark/TypeChecker/Modules.hs +23/−26
• src/Language/Futhark/TypeChecker/Monad.hs +42/−40
• src/Language/Futhark/TypeChecker/Terms.hs +66/−72
• src/Language/Futhark/TypeChecker/Terms/DoLoop.hs +8/−12
• src/Language/Futhark/TypeChecker/Terms/Monad.hs +79/−85
• src/Language/Futhark/TypeChecker/Terms/Pat.hs +12/−16
• src/Language/Futhark/TypeChecker/Types.hs +31/−37
• src/Language/Futhark/TypeChecker/Unify.hs +118/−123
• src/Language/Futhark/Warnings.hs +24/−25
• src/main.hs +1/−1
• unittests/Futhark/AD/DerivativesTests.hs +4/−4
• unittests/Futhark/BenchTests.hs +2/−2
• unittests/Futhark/IR/Mem/IxFun/Alg.hs +17/−17
• unittests/Futhark/IR/Mem/IxFunTests.hs +9/−9
• unittests/Futhark/IR/Mem/IxFunWrapper.hs +2/−2
• unittests/Futhark/IR/PropTests.hs +2/−3
• unittests/Futhark/IR/Syntax/CoreTests.hs +3/−4
• unittests/Futhark/Optimise/MemoryBlockMerging/GreedyColoringTests.hs +15/−7
• unittests/Futhark/Pkg/SolveTests.hs +2/−4
• unittests/Language/Futhark/CoreTests.hs +0/−1
• unittests/Language/Futhark/PrimitiveTests.hs +0/−1
• unittests/Language/Futhark/SyntaxTests.hs +6/−7
• unittests/Language/Futhark/TypeChecker/TypesTests.hs +11/−11
• unittests/Language/Futhark/TypeCheckerTests.hs +1/−1
• unittests/futhark_tests.hs +10/−10

@@ -34,7 +34,7 @@ OPTIONS ======= -Accepts the same options as :ref:`futhark-c(1)`.+Accepts the same options as :ref:`futhark-opencl(1)`.  SEE ALSO ========

@@ -1,6 +1,6 @@ cabal-version: 2.4 name:           futhark-version:        0.22.1+version:        0.22.2 synopsis:       An optimising compiler for a functional, array-oriented language.  description:    Futhark is a small programming language designed to be compiled to@@ -89,6 +89,56 @@ common common   ghc-options: -Wall -Wcompat -Wno-incomplete-uni-patterns -Wredundant-constraints -Wincomplete-record-updates -Wmissing-export-lists -Wunused-packages   default-language: Haskell2010+  default-extensions:+    OverloadedStrings+    -- The following extensions correspond to the GHC2021 language,+    -- but we want to remain compatible with GHC 9.0, so we cannot use+    -- it just yet.+    BangPatterns+    BinaryLiterals+    ConstrainedClassMethods+    ConstraintKinds+    DeriveDataTypeable+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveLift+    DeriveTraversable+    DoAndIfThenElse+    EmptyCase+    EmptyDataDecls+    EmptyDataDeriving+    ExistentialQuantification+    ExplicitForAll+    FlexibleContexts+    FlexibleInstances+    ForeignFunctionInterface+    GADTSyntax+    GeneralisedNewtypeDeriving+    HexFloatLiterals+    ImplicitPrelude+    ImportQualifiedPost+    InstanceSigs+    KindSignatures+    MonomorphismRestriction+    MultiParamTypeClasses+    NamedFieldPuns+    NamedWildCards+    NumericUnderscores+    PatternGuards+    PolyKinds+    PostfixOperators+    RankNTypes+    RelaxedPolyRec+    ScopedTypeVariables+    StandaloneDeriving+    StandaloneKindSignatures+    StarIsType+    TraditionalRecordSyntax+    TupleSections+    TypeApplications+    TypeOperators+    TypeSynonymInstances  library   import: common@@ -160,8 +210,10 @@       Futhark.CodeGen.Backends.GenericC.CLI       Futhark.CodeGen.Backends.GenericC.Code       Futhark.CodeGen.Backends.GenericC.EntryPoints+      Futhark.CodeGen.Backends.GenericC.Fun       Futhark.CodeGen.Backends.GenericC.Monad       Futhark.CodeGen.Backends.GenericC.Options+      Futhark.CodeGen.Backends.GenericC.Pretty       Futhark.CodeGen.Backends.GenericC.Server       Futhark.CodeGen.Backends.GenericC.Types       Futhark.CodeGen.Backends.GenericPython@@ -345,7 +397,7 @@       Futhark.Transform.Rename       Futhark.Transform.Substitute       Futhark.Util-      Futhark.Util.Console+      Futhark.Util.CMath       Futhark.Util.IntegralExp       Futhark.Util.Loc       Futhark.Util.Log@@ -357,6 +409,7 @@       Language.Futhark       Language.Futhark.Core       Language.Futhark.Interpreter+      Language.Futhark.Interpreter.Values       Language.Futhark.FreeVars       Language.Futhark.Parser       Language.Futhark.Parser.Monad@@ -423,7 +476,7 @@     , haskeline     , language-c-quote >= 0.12     , lens-    , lsp == 1.5.*+    , lsp >= 1.5.0     , mainland-pretty >=0.7.1     , cmark-gfm >=0.2.1     , megaparsec >=9.0.0@@ -447,6 +500,8 @@     , zlib >=0.6.1.2     , statistics     , mwc-random+    , prettyprinter >= 1.7+    , prettyprinter-ansi-terminal >= 1.1  executable futhark   import: common

@@ -242,6 +242,10 @@   -- | The difference between 1.0 and the next larger representable   -- number.   val epsilon: t++  -- | Produces the next representable number from `x` in the+  -- direction of `y`.+  val nextafter : (x: t) -> (y: t) -> t }  -- | Boolean numbers.  When converting from a number to `bool`, 0 is@@ -953,6 +957,8 @@    def round = intrinsics.round64 +  def nextafter x y = intrinsics.nextafter64 (x,y)+   def to_bits (x: f64): u64 = u64m.i64 (intrinsics.to_bits64 x)   def from_bits (x: u64): f64 = intrinsics.from_bits64 (intrinsics.sign_i64 x) @@ -1065,6 +1071,8 @@    def round = intrinsics.round32 +  def nextafter x y = intrinsics.nextafter32 (x,y)+   def to_bits (x: f32): u32 = u32m.i32 (intrinsics.to_bits32 x)   def from_bits (x: u32): f32 = intrinsics.from_bits32 (intrinsics.sign_i32 x) @@ -1180,6 +1188,8 @@   def trunc (x: f16) : f16 = i16 (i16m.f16 x)    def round = intrinsics.round16++  def nextafter x y = intrinsics.nextafter16 (x,y)    def to_bits (x: f16): u16 = u16m.i16 (intrinsics.to_bits16 x)   def from_bits (x: u16): f16 = intrinsics.from_bits16 (intrinsics.sign_i16 x)

@@ -128,8 +128,7 @@ -- **Span:** *O(n ✕ W(op))* in the worst case (all updates to same -- position), but *O(W(op))* in the best case. ----- In practice, the *O(n)* behaviour only occurs if *m* is also very--- large.+-- In practice, linear span only occurs if *k* is also very large. def hist 'a [n] (op: a -> a -> a) (ne: a) (k: i64) (is: [n]i64) (as: [n]a) : *[k]a =   intrinsics.hist_1d (1, map (\_ -> ne) (0..1..<k), op, ne, is, as) @@ -142,8 +141,7 @@ -- **Span:** *O(n ✕ W(op))* in the worst case (all updates to same -- position), but *O(W(op))* in the best case. ----- In practice, the *O(n)* behaviour only occurs if *m* is also very--- large.+-- In practice, linear span only occurs if *k* is also very large. def reduce_by_index 'a [k] [n] (dest : *[k]a) (f : a -> a -> a) (ne : a) (is : [n]i64) (as : [n]a) : *[k]a =   intrinsics.hist_1d (1, dest, f, ne, is, as) 

@@ -235,4 +235,22 @@   return u.y; } +static uint16_t halfbitsnextafter(uint16_t from, uint16_t to) {+  int fabs = from & 0x7FFF, tabs = to & 0x7FFF;+  if(fabs > 0x7C00 || tabs > 0x7C00) {+    return ((from&0x7FFF)>0x7C00) ? (from|0x200) : (to|0x200);+  }+  if(from == to || !(fabs|tabs)) {+    return to;+  }+  if(!fabs) {+    return (to&0x8000)+1;+  }+  unsigned int out =+    from ++    (((from>>15)^(unsigned int)((from^(0x8000|(0x8000-(from>>15))))<(to^(0x8000|(0x8000-(to>>15))))))<<1)+    - 1;+  return out;+}+ // End of half.h.

@@ -1925,6 +1925,10 @@   return ceil(x); } +static inline float futrts_nextafter32(float x, float y) {+  return nextafter(x, y);+}+ static inline float futrts_lerp32(float v0, float v1, float t) {   return mix(v0, v1, t); }@@ -2117,6 +2121,16 @@   return ceil(x); } +extern "C" unmasked uniform float nextafterf(uniform float x, uniform float y);+static inline float futrts_nextafter32(float x, float y) {+  float res;+  foreach_active (i) {+    uniform float r = nextafterf(extract(x, i), extract(y, i));+    res = insert(res, i, r);+  }+  return res;+}+ static inline float futrts_lerp32(float v0, float v1, float t) {   return v0 + (v1 - v0) * t; }@@ -2243,6 +2257,10 @@   return ceilf(x); } +static inline float futrts_nextafter32(float x, float y) {+  return nextafterf(x, y);+}+ static inline float futrts_lerp32(float v0, float v1, float t) {   return v0 + (v1 - v0) * t; }@@ -2529,6 +2547,16 @@   return ceil(x); } +extern "C" unmasked uniform double nextafter(uniform float x, uniform double y);+static inline float futrts_nextafter64(double x, double y) {+  double res;+  foreach_active (i) {+    uniform double r = nextafter(extract(x, i), extract(y, i));+    res = insert(res, i, r);+  }+  return res;+}+ static inline double futrts_floor64(double x) {   return floor(x); }@@ -2841,6 +2869,10 @@  static inline double futrts_ceil64(double x) {   return ceil(x);+}++static inline float futrts_nextafter64(float x, float y) {+  return nextafter(x, y); }  static inline double futrts_floor64(double x) {

@@ -317,6 +317,10 @@   return ceil(x); } +static inline f16 futrts_nextafter16(f16 x, f16 y) {+  return nextafter(x, y);+}+ static inline f16 futrts_lerp16(f16 v0, f16 v1, f16 t) {   return mix(v0, v1, t); }@@ -463,6 +467,10 @@   return (float16)ceil((float)x); } +static inline f16 futrts_nextafter16(f16 x, f16 y) {+  return (float16)futrts_nextafter32((float)x, (float) y);+}+ static inline f16 futrts_lerp16(f16 v0, f16 v1, f16 t) {   return v0 + (v1 - v0) * t; }@@ -589,6 +597,10 @@   return hceil(x); } +static inline f16 futrts_nextafter16(f16 x, f16 y) {+  return __ushort_as_half(halfbitsnextafter(__half_as_ushort(x), __half_as_ushort(y)));+}+ static inline f16 futrts_lerp16(f16 v0, f16 v1, f16 t) {   return v0 + (v1 - v0) * t; }@@ -781,6 +793,10 @@  static inline f16 futrts_ceil16(f16 x) {   return futrts_ceil32(x);+}++static inline f16 futrts_nextafter16(f16 x, f16 y) {+  return halfbits2float(halfbitsnextafter(float2halfbits(x), float2halfbits(y))); }  static inline f16 futrts_lerp16(f16 v0, f16 v1, f16 t) {

@@ -74,6 +74,7 @@  def initialise_opencl_object(self,                              program_src='',+                             build_options=[],                              command_queue=None,                              interactive=False,                              platform_pref=None,@@ -214,8 +215,6 @@     # compiler should provide us with the variables to which     # parameters are mapped.     if (len(program_src) >= 0):-        build_options = []-         build_options += ["-DLOCKSTEP_WIDTH={}".format(lockstep_width)]          build_options += ["-D{}={}".format(s.

@@ -508,6 +508,9 @@ def futhark_floor64(x):   return np.floor(x) +def futhark_nextafter64(x, y):+  return np.nextafter(x, y)+ def futhark_isnan64(x):   return np.isnan(x) @@ -603,6 +606,9 @@ def futhark_floor32(x):   return np.floor(x) +def futhark_nextafter32(x, y):+  return np.nextafter(x, y)+ def futhark_isnan32(x):   return np.isnan(x) @@ -697,6 +703,9 @@  def futhark_floor16(x):   return np.floor(x)++def futhark_nextafter16(x, y):+  return np.nextafter(x, y)  def futhark_isnan16(x):   return np.isnan(x)

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- -- | Partial derivatives of scalar Futhark operations and built-in functions. module Futhark.AD.Derivatives   ( pdBuiltin,@@ -371,6 +369,9 @@ pdBuiltin "floor16" [_] = Just [fConst Float16 0] pdBuiltin "floor32" [_] = Just [fConst Float32 0] pdBuiltin "floor64" [_] = Just [fConst Float64 0]+pdBuiltin "nextafter16" [_, _] = Just [fConst Float16 1, fConst Float16 0]+pdBuiltin "nextafter32" [_, _] = Just [fConst Float32 1, fConst Float32 0]+pdBuiltin "nextafter64" [_, _] = Just [fConst Float64 1, fConst Float64 0] pdBuiltin "clz8" [_] = Just [iConst Int32 0] pdBuiltin "clz16" [_] = Just [iConst Int32 0] pdBuiltin "clz32" [_] = Just [iConst Int32 0]

@@ -1,8 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} @@ -12,10 +7,10 @@ import Control.Monad.RWS.Strict import Control.Monad.State.Strict import Data.Bifunctor (second)-import qualified Data.Kind+import Data.Kind qualified import Data.List (transpose) import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.Map as M+import Data.Map qualified as M import Futhark.AD.Derivatives import Futhark.Analysis.PrimExp.Convert import Futhark.Builder@@ -24,7 +19,7 @@  zeroTan :: Type -> ADM SubExp zeroTan (Prim t) = pure $ constant $ blankPrimValue t-zeroTan t = error $ "zeroTan on non-primitive type: " ++ pretty t+zeroTan t = error $ "zeroTan on non-primitive type: " ++ prettyString t  zeroExp :: Type -> Exp SOACS zeroExp (Prim pt) =@@ -262,7 +257,7 @@     Rotate rots arr -> do       arr_tan <- tangent arr       addStm $ Let pat_tan aux $ BasicOp $ Rotate rots arr_tan-    _ -> error $ "basicFwd: Unsupported op " ++ pretty op+    _ -> error $ "basicFwd: Unsupported op " ++ prettyString op  fwdLambda :: Lambda SOACS -> ADM (Lambda SOACS) fwdLambda l@(Lambda params body ret) =@@ -401,7 +396,7 @@       let arg_pes = zipWith primExpFromSubExp argts (map fst args)       case pdBuiltin f arg_pes of         Nothing ->-          error $ "No partial derivative defined for builtin function: " ++ pretty f+          error $ "No partial derivative defined for builtin function: " ++ prettyString f         Just derivs -> do           let convertTo tt e                 | e_t == tt = e@@ -411,7 +406,7 @@                       (FloatType tt', FloatType ft) -> ConvOpExp (FPConv ft tt') e                       (Bool, FloatType ft) -> ConvOpExp (FToB ft) e                       (FloatType tt', Bool) -> ConvOpExp (BToF tt') e-                      _ -> error $ "fwdStm.convertTo: " ++ pretty (f, tt, e_t)+                      _ -> error $ "fwdStm.convertTo: " ++ prettyString (f, tt, e_t)                 where                   e_t = primExpType e           zipWithM_ (letBindNames . pure) (patNames pat_tan)@@ -459,7 +454,7 @@     removeIndexTans _ ps = ps fwdStm (Let pat aux (Op soac)) = fwdSOAC pat aux soac fwdStm stm =-  error $ "unhandled forward mode AD for Stm: " ++ pretty stm ++ "\n" ++ show stm+  error $ "unhandled forward mode AD for Stm: " ++ prettyString stm ++ "\n" ++ show stm  fwdBody :: Body SOACS -> ADM (Body SOACS) fwdBody (Body _ stms res) = buildBody_ $ do

@@ -1,7 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}  -- Naming scheme:@@ -15,7 +11,7 @@ import Control.Monad import Data.List ((\\)) import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.Map as M+import Data.Map qualified as M import Futhark.AD.Derivatives import Futhark.AD.Rev.Loop import Futhark.AD.Rev.Monad@@ -30,7 +26,7 @@  patName :: Pat Type -> ADM VName patName (Pat [pe]) = pure $ patElemName pe-patName pat = error $ "Expected single-element pattern: " ++ pretty pat+patName pat = error $ "Expected single-element pattern: " ++ prettyString pat  -- The vast majority of BasicOps require no special treatment in the -- forward pass and produce one value (and hence one adjoint).  We@@ -252,12 +248,12 @@           convert (FloatType ft) (FloatType tt) = ConvOpExp (FPConv ft tt)           convert Bool (FloatType tt) = ConvOpExp (BToF tt)           convert (FloatType ft) Bool = ConvOpExp (FToB ft)-          convert ft tt = error $ "diffStm.convert: " ++ pretty (f, ft, tt)+          convert ft tt = error $ "diffStm.convert: " ++ prettyString (f, ft, tt)        contribs <-         case pdBuiltin f arg_pes of           Nothing ->-            error $ "No partial derivative defined for builtin function: " ++ pretty f+            error $ "No partial derivative defined for builtin function: " ++ prettyString f           Just derivs ->             forM (zip derivs argts) $ \(deriv, argt) ->               letExp "contrib" <=< toExp . convert ret argt $ pat_adj' ~*~ deriv@@ -313,7 +309,7 @@         let body' = Body () stms $ take (length inputs) res <> takeLast (length get_adjs_for) res         ts' <- mapM lookupType get_adjs_for         pure $ Lambda params body' $ take (length inputs) ts <> ts'-diffStm stm _ = error $ "diffStm unhandled:\n" ++ pretty stm+diffStm stm _ = error $ "diffStm unhandled:\n" ++ prettyString stm  diffStms :: Stms SOACS -> ADM () diffStms all_stms

@@ -1,6 +1,3 @@-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}  module Futhark.AD.Rev.Loop (diffLoop, stripmineStms) where@@ -8,10 +5,10 @@ import Control.Monad import Data.Foldable (toList) import Data.List (nub, (\\))-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe import Futhark.AD.Rev.Monad-import qualified Futhark.Analysis.Alias as Alias+import Futhark.Analysis.Alias qualified as Alias import Futhark.Analysis.PrimExp.Convert import Futhark.Builder import Futhark.IR.Aliases (consumedInStms)@@ -38,7 +35,7 @@   a bindForLoop (DoLoop val_pats form@(ForLoop i it bound loop_vars) body) f =   f val_pats form i it bound loop_vars body-bindForLoop e _ = error $ "bindForLoop: not a for-loop:\n" <> pretty e+bindForLoop e _ = error $ "bindForLoop: not a for-loop:\n" <> prettyString e  -- | A convenience function to rename a for-loop and then bind the -- renamed components.@@ -94,7 +91,7 @@       pure (pure (subExpRes bound_plus_one) <> bodyResult body)   res <- letTupExp' "loop" $ DoLoop ((bound_param, bound_init) : val_pats) (WhileLoop b) body'   pure $ head res-computeWhileIters e = error $ "convertWhileIters: not a while-loop:\n" <> pretty e+computeWhileIters e = error $ "convertWhileIters: not a while-loop:\n" <> prettyString e  -- | Converts a 'WhileLoop' into a 'ForLoop'. Requires that the -- surrounding 'DoLoop' is annotated with a @#[bound(n)]@ attribute,@@ -113,7 +110,7 @@             (resultBodyM $ map (Var . paramName . fst) val_pats)         ]     pure $ DoLoop val_pats (ForLoop i Int64 bound_se mempty) body'-convertWhileLoop _ e = error $ "convertWhileLoopBound: not a while-loop:\n" <> pretty e+convertWhileLoop _ e = error $ "convertWhileLoopBound: not a while-loop:\n" <> prettyString e  -- | @nestifyLoop n bound loop@ transforms a loop into a depth-@n@ loop nest -- of @bound@-iteration loops. This transformation does not preserve

@@ -1,7 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}  module Futhark.AD.Rev.Map (vjpMap) where

@@ -1,8 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}  -- Naming scheme:@@ -61,9 +56,9 @@ import Control.Monad.State.Strict import Data.Bifunctor (second) import Data.List (foldl')-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe-import qualified Futhark.Analysis.Alias as Alias+import Futhark.Analysis.Alias qualified as Alias import Futhark.Analysis.PrimExp.Convert import Futhark.Builder import Futhark.IR.Aliases (consumedInStms)@@ -78,7 +73,7 @@   BasicOp $ SubExp $ Constant $ blankPrimValue pt zeroExp (Array pt shape _) =   BasicOp $ Replicate shape $ Constant $ blankPrimValue pt-zeroExp t = error $ "zeroExp: " ++ pretty t+zeroExp t = error $ "zeroExp: " ++ prettyString t  onePrim :: PrimType -> PrimValue onePrim (IntType it) = IntValue $ intValue it (1 :: Int)@@ -90,7 +85,7 @@ oneExp (Prim t) = BasicOp $ SubExp $ constant $ onePrim t oneExp (Array pt shape _) =   BasicOp $ Replicate shape $ Constant $ onePrim pt-oneExp t = error $ "oneExp: " ++ pretty t+oneExp t = error $ "oneExp: " ++ prettyString t  -- | Whether 'Sparse' should check bounds or assume they are correct. -- The latter results in simpler code.@@ -271,7 +266,7 @@     onConsumed v = do       v_t <- lookupType v       case v_t of-        Acc {} -> error $ "copyConsumedArrsInBody: Acc " <> pretty v+        Acc {} -> error $ "copyConsumedArrsInBody: Acc " <> prettyString v         Array {} -> M.singleton v <$> letExp (baseString v <> "_ad_copy") (BasicOp $ Copy v)         _ -> pure mempty @@ -360,7 +355,7 @@       lam <- addLambda $ rowType x_t       pure $ Op $ Screma (arraySize 0 x_t) [x, y] (mapSOAC lam)     _ ->-      error $ "addExp: unexpected type: " ++ pretty x_t+      error $ "addExp: unexpected type: " ++ prettyString x_t  lookupAdj :: VName -> ADM Adj lookupAdj v = do

@@ -1,7 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}  module Futhark.AD.Rev.Reduce

@@ -1,7 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}  module Futhark.AD.Rev.SOAC (vjpSOAC) where@@ -87,4 +83,4 @@ vjpSOAC ops pat aux (Scatter w lam ass written_info) m =   vjpScatter ops pat aux (w, lam, ass, written_info) m vjpSOAC _ _ _ soac _ =-  error $ "vjpSOAC unhandled:\n" ++ pretty soac+  error $ "vjpSOAC unhandled:\n" ++ prettyString soac

@@ -1,7 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}  module Futhark.AD.Rev.Scatter (vjpScatter) where

@@ -1,6 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}- -- | All (almost) compiler pipelines end with an 'Action', which does -- something with the result of the pipeline. module Futhark.Actions@@ -30,26 +27,26 @@ import Control.Monad.IO.Class import Data.List (intercalate) import Data.Maybe (fromMaybe)-import qualified Data.Text as T-import qualified Data.Text.IO as T+import Data.Text qualified as T+import Data.Text.IO qualified as T import Futhark.Analysis.Alias import Futhark.Analysis.CallGraph (buildCallGraph)-import qualified Futhark.Analysis.Interference as Interference-import qualified Futhark.Analysis.LastUse as LastUse-import qualified Futhark.Analysis.MemAlias as MemAlias+import Futhark.Analysis.Interference qualified as Interference+import Futhark.Analysis.LastUse qualified as LastUse+import Futhark.Analysis.MemAlias qualified as MemAlias import Futhark.Analysis.Metrics-import qualified Futhark.CodeGen.Backends.CCUDA as CCUDA-import qualified Futhark.CodeGen.Backends.COpenCL as COpenCL-import qualified Futhark.CodeGen.Backends.MulticoreC as MulticoreC-import qualified Futhark.CodeGen.Backends.MulticoreISPC as MulticoreISPC-import qualified Futhark.CodeGen.Backends.MulticoreWASM as MulticoreWASM-import qualified Futhark.CodeGen.Backends.PyOpenCL as PyOpenCL-import qualified Futhark.CodeGen.Backends.SequentialC as SequentialC-import qualified Futhark.CodeGen.Backends.SequentialPython as SequentialPy-import qualified Futhark.CodeGen.Backends.SequentialWASM as SequentialWASM-import qualified Futhark.CodeGen.ImpGen.GPU as ImpGenGPU-import qualified Futhark.CodeGen.ImpGen.Multicore as ImpGenMulticore-import qualified Futhark.CodeGen.ImpGen.Sequential as ImpGenSequential+import Futhark.CodeGen.Backends.CCUDA qualified as CCUDA+import Futhark.CodeGen.Backends.COpenCL qualified as COpenCL+import Futhark.CodeGen.Backends.MulticoreC qualified as MulticoreC+import Futhark.CodeGen.Backends.MulticoreISPC qualified as MulticoreISPC+import Futhark.CodeGen.Backends.MulticoreWASM qualified as MulticoreWASM+import Futhark.CodeGen.Backends.PyOpenCL qualified as PyOpenCL+import Futhark.CodeGen.Backends.SequentialC qualified as SequentialC+import Futhark.CodeGen.Backends.SequentialPython qualified as SequentialPy+import Futhark.CodeGen.Backends.SequentialWASM qualified as SequentialWASM+import Futhark.CodeGen.ImpGen.GPU qualified as ImpGenGPU+import Futhark.CodeGen.ImpGen.Multicore qualified as ImpGenMulticore+import Futhark.CodeGen.ImpGen.Sequential qualified as ImpGenSequential import Futhark.Compiler.CLI import Futhark.IR import Futhark.IR.GPUMem (GPUMem)@@ -62,7 +59,7 @@ import System.Directory import System.Exit import System.FilePath-import qualified System.Info+import System.Info qualified  -- | Print the result to stdout. printAction :: ASTRep rep => Action rep@@ -70,7 +67,7 @@   Action     { actionName = "Prettyprint",       actionDescription = "Prettyprint the resulting internal representation on standard output.",-      actionProcedure = liftIO . putStrLn . pretty+      actionProcedure = liftIO . putStrLn . prettyString     }  -- | Print the result to stdout, alias annotations.@@ -79,7 +76,7 @@   Action     { actionName = "Prettyprint",       actionDescription = "Prettyprint the resulting internal representation on standard output.",-      actionProcedure = liftIO . putStrLn . pretty . aliasAnalysis+      actionProcedure = liftIO . putStrLn . prettyString . aliasAnalysis     }  -- | Print last use information to stdout.@@ -88,7 +85,7 @@   Action     { actionName = "print last use gpu",       actionDescription = "Print last use information on gpu.",-      actionProcedure = liftIO . putStrLn . pretty . LastUse.analyseGPUMem+      actionProcedure = liftIO . print . LastUse.analyseGPUMem     }  -- | Print interference information to stdout.@@ -97,7 +94,7 @@   Action     { actionName = "print interference gpu",       actionDescription = "Print interference information on gpu.",-      actionProcedure = liftIO . putStrLn . pretty . Interference.analyseProgGPU+      actionProcedure = liftIO . print . Interference.analyseProgGPU     }  -- | Print memory alias information to stdout@@ -106,7 +103,7 @@   Action     { actionName = "print mem alias gpu",       actionDescription = "Print memory alias information on gpu.",-      actionProcedure = liftIO . putStrLn . pretty . MemAlias.analyzeGPUMem+      actionProcedure = liftIO . print . MemAlias.analyzeGPUMem     }  -- | Print call graph to stdout.@@ -115,7 +112,7 @@   Action     { actionName = "call-graph",       actionDescription = "Prettyprint the callgraph of the result to standard output.",-      actionProcedure = liftIO . putStrLn . pretty . buildCallGraph+      actionProcedure = liftIO . putStrLn . prettyString . buildCallGraph     }  -- | Print metrics about AST node counts to stdout.@@ -133,7 +130,7 @@   Action     { actionName = "Compile imperative",       actionDescription = "Translate program into imperative IL and write it on standard output.",-      actionProcedure = liftIO . putStrLn . pretty . snd <=< ImpGenSequential.compileProg+      actionProcedure = liftIO . putStrLn . prettyString . snd <=< ImpGenSequential.compileProg     }  -- | Convert the program to GPU ImpCode and print it to stdout.@@ -142,7 +139,7 @@   Action     { actionName = "Compile imperative kernels",       actionDescription = "Translate program into imperative IL with kernels and write it on standard output.",-      actionProcedure = liftIO . putStrLn . pretty . snd <=< ImpGenGPU.compileProgOpenCL+      actionProcedure = liftIO . putStrLn . prettyString . snd <=< ImpGenGPU.compileProgOpenCL     }  -- | Convert the program to CPU multicore ImpCode and print it to stdout.@@ -151,7 +148,7 @@   Action     { actionName = "Compile to imperative multicore",       actionDescription = "Translate program into imperative multicore IL and write it on standard output.",-      actionProcedure = liftIO . putStrLn . pretty . snd <=< ImpGenMulticore.compileProg+      actionProcedure = liftIO . putStrLn . prettyString . snd <=< ImpGenMulticore.compileProg     }  -- Lines that we prepend (in comments) to generated code.

@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}  -- | Alias analysis of a full Futhark program.  Takes as input a@@ -22,7 +21,7 @@ where  import Data.List (foldl')-import qualified Data.Map as M+import Data.Map qualified as M import Futhark.IR.Aliases  -- | Perform alias analysis on a Futhark program.

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- -- | This module exports functionality for generating a call graph of -- an Futhark program. module Futhark.Analysis.CallGraph@@ -15,9 +13,9 @@  import Control.Monad.Writer.Strict import Data.List (foldl')-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Data.Maybe (isJust)-import qualified Data.Set as S+import Data.Set qualified as S import Futhark.IR.SOACS import Futhark.Util.Pretty @@ -141,17 +139,17 @@         }  instance Pretty FunCalls where-  ppr = stack . map f . M.toList . fcMap+  pretty = stack . map f . M.toList . fcMap     where-      f (x, (attrs, y)) = "=>" <+> ppr y <+> parens ("at" <+> ppr x <+> ppr attrs)+      f (x, (attrs, y)) = "=>" <+> pretty y <+> parens ("at" <+> pretty x <+> pretty attrs)  instance Pretty CallGraph where-  ppr (CallGraph fg cg) =+  pretty (CallGraph fg cg) =     stack $       punctuate line $         ppFunCalls ("called at top level", cg) : map ppFunCalls (M.toList fg)     where       ppFunCalls (f, fcalls) =-        ppr f-          </> text (map (const '=') (nameToString f))-          </> indent 2 (ppr fcalls)+        pretty f+          </> pretty (map (const '=') (nameToString f))+          </> indent 2 (pretty fcalls)

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}- -- | Facilities for inspecting the data dependencies of a program. module Futhark.Analysis.DataDependencies   ( Dependencies,@@ -8,8 +6,8 @@   ) where -import qualified Data.List as L-import qualified Data.Map.Strict as M+import Data.List qualified as L+import Data.Map.Strict qualified as M import Futhark.IR  -- | A mapping from a variable name @v@, to those variables on which

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}  module Futhark.Analysis.HORep.MapNest@@ -15,13 +13,13 @@ where  import Data.List (find)-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Data.Maybe import Futhark.Analysis.HORep.SOAC (SOAC)-import qualified Futhark.Analysis.HORep.SOAC as SOAC+import Futhark.Analysis.HORep.SOAC qualified as SOAC import Futhark.Construct import Futhark.IR hiding (typeOf)-import qualified Futhark.IR.SOACS.SOAC as Futhark+import Futhark.IR.SOACS.SOAC qualified as Futhark import Futhark.Transform.Substitute  data Nesting rep = Nesting

@@ -72,7 +72,7 @@  import Data.Foldable as Foldable import Data.Maybe-import qualified Data.Sequence as Seq+import Data.Sequence qualified as Seq import Futhark.Construct hiding (toExp) import Futhark.IR hiding   ( Iota,@@ -81,17 +81,17 @@     Reshape,     typeOf,   )-import qualified Futhark.IR as Futhark+import Futhark.IR qualified as Futhark import Futhark.IR.SOACS.SOAC   ( HistOp (..),     ScremaForm (..),     scremaType,   )-import qualified Futhark.IR.SOACS.SOAC as Futhark+import Futhark.IR.SOACS.SOAC qualified as Futhark import Futhark.Transform.Rename (renameLambda) import Futhark.Transform.Substitute-import Futhark.Util.Pretty (ppr, text)-import qualified Futhark.Util.Pretty as PP+import Futhark.Util.Pretty (pretty)+import Futhark.Util.Pretty qualified as PP  -- | A single, simple transformation.  If you want several, don't just -- create a list, use 'ArrayTransforms' instead.@@ -388,30 +388,30 @@   deriving (Eq, Show)  instance PP.Pretty Input where-  ppr (Input (ArrayTransforms ts) arr _) = foldl f (ppr arr) ts+  pretty (Input (ArrayTransforms ts) arr _) = foldl f (pretty arr) ts     where       f e (Rearrange cs perm) =-        text "rearrange" <> ppr cs <> PP.apply [PP.apply (map ppr perm), e]+        "rearrange" <> pretty cs <> PP.apply [PP.apply (map pretty perm), e]       f e (Reshape cs ReshapeArbitrary shape) =-        text "reshape" <> ppr cs <> PP.apply [ppr shape, e]+        "reshape" <> pretty cs <> PP.apply [pretty shape, e]       f e (ReshapeOuter cs ReshapeArbitrary shape) =-        text "reshape_outer" <> ppr cs <> PP.apply [ppr shape, e]+        "reshape_outer" <> pretty cs <> PP.apply [pretty shape, e]       f e (ReshapeInner cs ReshapeArbitrary shape) =-        text "reshape_inner" <> ppr cs <> PP.apply [ppr shape, e]+        "reshape_inner" <> pretty cs <> PP.apply [pretty shape, e]       f e (Reshape cs ReshapeCoerce shape) =-        text "coerce" <> ppr cs <> PP.apply [ppr shape, e]+        "coerce" <> pretty cs <> PP.apply [pretty shape, e]       f e (ReshapeOuter cs ReshapeCoerce shape) =-        text "coerce_outer" <> ppr cs <> PP.apply [ppr shape, e]+        "coerce_outer" <> pretty cs <> PP.apply [pretty shape, e]       f e (ReshapeInner cs ReshapeCoerce shape) =-        text "coerce_inner" <> ppr cs <> PP.apply [ppr shape, e]+        "coerce_inner" <> pretty cs <> PP.apply [pretty shape, e]       f e (Replicate cs ne) =-        text "replicate" <> ppr cs <> PP.apply [ppr ne, e]+        "replicate" <> pretty cs <> PP.apply [pretty ne, e]  instance PrettyRep rep => PP.Pretty (SOAC rep) where-  ppr (Screma w form arrs) = Futhark.ppScrema w arrs form-  ppr (Hist len ops bucket_fun imgs) = Futhark.ppHist len imgs ops bucket_fun-  ppr (Stream w lam nes arrs) = Futhark.ppStream w arrs nes lam-  ppr (Scatter w lam arrs dests) = Futhark.ppScatter w arrs lam dests+  pretty (Screma w form arrs) = Futhark.ppScrema w arrs form+  pretty (Hist len ops bucket_fun imgs) = Futhark.ppHist len imgs ops bucket_fun+  pretty (Stream w lam nes arrs) = Futhark.ppStream w arrs nes lam+  pretty (Scatter w lam arrs dests) = Futhark.ppScatter w arrs lam dests  -- | Returns the inputs used in a SOAC. inputs :: SOAC rep -> [Input]

@@ -1,5 +1,3 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}  -- | Interference analysis for Futhark programs.@@ -10,13 +8,13 @@ import Data.Function ((&)) import Data.Functor ((<&>)) import Data.Map (Map)-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe (catMaybes, fromMaybe, mapMaybe) import Data.Set (Set)-import qualified Data.Set as S+import Data.Set qualified as S import Futhark.Analysis.LastUse (LastUseMap)-import qualified Futhark.Analysis.LastUse as LastUse-import qualified Futhark.Analysis.MemAlias as MemAlias+import Futhark.Analysis.LastUse qualified as LastUse+import Futhark.Analysis.MemAlias qualified as MemAlias import Futhark.IR.GPUMem import Futhark.Util (invertMap) 

@@ -1,7 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}  -- | Provides last-use analysis for Futhark programs.@@ -19,7 +15,7 @@ import Data.Foldable import Data.Function ((&)) import Data.Map (Map)-import qualified Data.Map as M+import Data.Map qualified as M import Data.Tuple import Futhark.Analysis.Alias (aliasAnalysis) import Futhark.IR.Aliases

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}  module Futhark.Analysis.MemAlias@@ -14,9 +12,9 @@ import Data.Bifunctor import Data.Function ((&)) import Data.Functor ((<&>))-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe (fromMaybe, mapMaybe)-import qualified Data.Set as S+import Data.Set qualified as S import Futhark.IR.GPUMem import Futhark.IR.SeqMem import Futhark.Util@@ -45,9 +43,9 @@   mempty = MemAliases mempty  instance Pretty MemAliases where-  ppr (MemAliases m) = stack $ map f $ M.toList m+  pretty (MemAliases m) = stack $ map f $ M.toList m     where-      f (v, vs) = ppr v <+> "aliases:" </> indent 2 (oneLine $ ppr vs)+      f (v, vs) = pretty v <+> "aliases:" </> indent 2 (oneLine $ pretty vs)  addAlias :: VName -> VName -> MemAliases -> MemAliases addAlias v1 v2 m =

@@ -1,8 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Trustworthy #-}- -- | Abstract Syntax Tree metrics.  This is used in the @futhark test@ -- program, for the @structure@ stanzas. module Futhark.Analysis.Metrics@@ -22,9 +17,9 @@  import Control.Monad.Writer import Data.List (tails)-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Futhark.Analysis.Metrics.Type import Futhark.IR 

@@ -3,9 +3,9 @@ -- test modules. module Futhark.Analysis.Metrics.Type (AstMetrics (..)) where -import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T  -- | AST metrics are simply a collection from identifiable node names -- to the number of times that node appears.

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}  -- | A primitive expression is an expression where the non-leaves are@@ -73,8 +71,8 @@  import Control.Category import Control.Monad-import qualified Data.Map as M-import qualified Data.Set as S+import Data.Map qualified as M+import Data.Set qualified as S import Data.Traversable import Futhark.IR.Prop.Names import Futhark.Util.IntegralExp@@ -535,7 +533,7 @@  numBad :: Pretty a => String -> a -> b numBad s x =-  error $ "Invalid argument to PrimExp method " ++ s ++ ": " ++ pretty x+  error $ "Invalid argument to PrimExp method " ++ s ++ ": " ++ prettyString x  -- | Evaluate a 'PrimExp' in the given monad.  Invokes 'fail' on type -- errors.@@ -566,9 +564,9 @@ evalBad op arg =   fail $     "evalPrimExp: Type error when applying "-      ++ pretty op+      ++ prettyString op       ++ " to "-      ++ pretty arg+      ++ prettyString arg  -- | The type of values returned by a 'PrimExp'.  This function -- returning does not imply that the 'PrimExp' is type-correct.@@ -684,16 +682,16 @@ -- Prettyprinting instances  instance Pretty v => Pretty (PrimExp v) where-  ppr (LeafExp v _) = ppr v-  ppr (ValueExp v) = ppr v-  ppr (BinOpExp op x y) = ppr op <+> parens (ppr x) <+> parens (ppr y)-  ppr (CmpOpExp op x y) = ppr op <+> parens (ppr x) <+> parens (ppr y)-  ppr (ConvOpExp op x) = ppr op <+> parens (ppr x)-  ppr (UnOpExp op x) = ppr op <+> parens (ppr x)-  ppr (FunExp h args _) = text h <+> parens (commasep $ map ppr args)+  pretty (LeafExp v _) = pretty v+  pretty (ValueExp v) = pretty v+  pretty (BinOpExp op x y) = pretty op <+> parens (pretty x) <+> parens (pretty y)+  pretty (CmpOpExp op x y) = pretty op <+> parens (pretty x) <+> parens (pretty y)+  pretty (ConvOpExp op x) = pretty op <+> parens (pretty x)+  pretty (UnOpExp op x) = pretty op <+> parens (pretty x)+  pretty (FunExp h args _) = pretty h <+> parens (commasep $ map pretty args)  instance Pretty v => Pretty (TPrimExp t v) where-  ppr = ppr . untyped+  pretty = pretty . untyped  -- | Produce a mapping from the leaves of the 'PrimExp' to their -- designated types.

@@ -25,9 +25,9 @@   ) where -import qualified Control.Monad.Fail as Fail+import Control.Monad.Fail qualified as Fail import Control.Monad.Identity-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Data.Maybe import Futhark.Analysis.PrimExp import Futhark.Construct

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- -- | Building blocks for parsing prim primexpressions.  *Not* an infix -- representation. module Futhark.Analysis.PrimExp.Parse@@ -12,7 +10,7 @@ where  import Data.Functor-import qualified Data.Text as T+import Data.Text qualified as T import Data.Void import Futhark.Analysis.PrimExp import Futhark.Util.Pretty (prettyText)

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}- -- | Defines simplification functions for 'PrimExp's. module Futhark.Analysis.PrimExp.Simplify (simplifyPrimExp, simplifyExtPrimExp) where 

@@ -1,5 +1,3 @@-{-# LANGUAGE ConstraintKinds #-}- -- | Facilities for changing the rep of some fragment, with no -- context.  We call this "rephrasing", for no deep reason. module Futhark.Analysis.Rephrase

@@ -1,5 +1,3 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}  module Futhark.Analysis.SymbolTable@@ -56,13 +54,13 @@ import Control.Arrow ((&&&)) import Control.Monad import Data.List (elemIndex, foldl')-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Data.Maybe import Data.Ord import Futhark.Analysis.PrimExp.Convert import Futhark.IR hiding (FParam, lookupType)-import qualified Futhark.IR as AST-import qualified Futhark.IR.Prop.Aliases as Aliases+import Futhark.IR qualified as AST+import Futhark.IR.Prop.Aliases qualified as Aliases import Prelude hiding (elem, lookup)  data SymbolTable rep = SymbolTable

@@ -27,8 +27,8 @@ where  import Data.Bits-import qualified Data.Foldable as Foldable-import qualified Data.IntMap.Strict as IM+import Data.Foldable qualified as Foldable+import Data.IntMap.Strict qualified as IM import Data.List (foldl') import Futhark.IR import Futhark.IR.Prop.Aliases

@@ -1,6 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}- -- | Facilities for handling Futhark benchmark results.  A Futhark -- benchmark program is just like a Futhark test program. module Futhark.Bench@@ -20,17 +17,17 @@  import Control.Applicative import Control.Monad.Except-import qualified Data.Aeson as JSON-import qualified Data.Aeson.Key as JSON-import qualified Data.Aeson.KeyMap as JSON-import qualified Data.ByteString.Char8 as SBS-import qualified Data.ByteString.Lazy.Char8 as LBS-import qualified Data.DList as DL-import qualified Data.Map as M+import Data.Aeson qualified as JSON+import Data.Aeson.Key qualified as JSON+import Data.Aeson.KeyMap qualified as JSON+import Data.ByteString.Char8 qualified as SBS+import Data.ByteString.Lazy.Char8 qualified as LBS+import Data.DList qualified as DL+import Data.Map qualified as M import Data.Maybe-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time.Clock-import qualified Data.Vector.Unboxed as U+import Data.Vector.Unboxed qualified as U import Futhark.Server import Futhark.Test import Statistics.Autocorrelation (autocorrelation)

@@ -1,10 +1,4 @@-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} @@ -37,7 +31,7 @@ import Control.Monad.Reader import Control.Monad.State.Strict import Control.Monad.Writer-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Futhark.Builder.Class import Futhark.IR @@ -108,9 +102,9 @@       Nothing -> do         known <- BuilderT $ gets $ M.keys . snd         error . unlines $-          [ "BuilderT.lookupType: unknown variable " ++ pretty name,+          [ "BuilderT.lookupType: unknown variable " ++ prettyString name,             "Known variables: ",-            unwords $ map pretty known+            unwords $ map prettyString known           ]       Just t' -> pure $ typeOf t'   askScope = BuilderT $ gets snd

@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}  -- | This module defines a convenience typeclass for creating@@ -22,7 +21,7 @@   ) where -import qualified Data.Kind+import Data.Kind qualified import Futhark.IR import Futhark.MonadFreshNames 

@@ -1,17 +1,14 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}- -- | @futhark autotune@ module Futhark.CLI.Autotune (main) where  import Control.Monad-import qualified Data.ByteString.Char8 as SBS+import Data.ByteString.Char8 qualified as SBS import Data.Function (on) import Data.List (elemIndex, intersect, isPrefixOf, minimumBy, sort, sortOn)-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe-import qualified Data.Set as S-import qualified Data.Text as T+import Data.Set qualified as S+import Data.Text qualified as T import Data.Tree import Futhark.Bench import Futhark.Server

@@ -1,6 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}- -- | @futhark bench@ module Futhark.CLI.Bench (main) where @@ -8,26 +5,25 @@ import Control.Exception import Control.Monad import Control.Monad.Except hiding (throwError)-import qualified Data.ByteString.Char8 as SBS-import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.ByteString.Char8 qualified as SBS+import Data.ByteString.Lazy.Char8 qualified as LBS import Data.Either import Data.Function ((&)) import Data.IORef import Data.List (sortBy)-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe import Data.Ord-import qualified Data.Text as T-import qualified Data.Text.IO as T+import Data.Text qualified as T+import Data.Text.IO qualified as T import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)-import qualified Data.Vector.Unboxed as U+import Data.Vector.Unboxed qualified as U import Futhark.Bench import Futhark.Server import Futhark.Test import Futhark.Util (atMostChars, fancyTerminal, pmapIO)-import Futhark.Util.Console import Futhark.Util.Options-import Futhark.Util.Pretty (prettyText)+import Futhark.Util.Pretty (AnsiStyle, Color (..), annotate, bold, color, line, pretty, prettyText, putDoc) import Futhark.Util.ProgressBar import Statistics.Resampling (Estimator (..), resample) import Statistics.Resampling.Bootstrap (bootstrapBCA)@@ -42,6 +38,14 @@ import Text.Printf import Text.Regex.TDFA +putStyleLn :: AnsiStyle -> T.Text -> IO ()+putStyleLn s t = putDoc $ annotate s (pretty t <> line)++putRedLn, putBoldRedLn, putBoldLn :: T.Text -> IO ()+putRedLn = putStyleLn (color Red)+putBoldRedLn = putStyleLn (color Red <> bold)+putBoldLn = putStyleLn bold+ data BenchOptions = BenchOptions   { optBackend :: String,     optFuthark :: Maybe String,@@ -185,7 +189,7 @@                case res of                 Left (err, errstr) -> do-                  putStrLn $ inRed err+                  putRedLn $ T.pack err                   maybe (pure ()) SBS.putStrLn errstr                   pure $ Left FailedToCompile                 Right () ->@@ -211,8 +215,8 @@   where     onError :: SomeException -> IO (Maybe a)     onError e = do-      putStrLn $ inBold $ inRed $ "\nFailed to run " ++ program-      putStrLn $ inRed $ show e+      putBoldRedLn $ "\nFailed to run " <> T.pack program+      putRedLn $ T.pack $ show e       pure Nothing  -- Truncate dataset name display after this many characters.@@ -227,7 +231,7 @@     mapM (forInputOutputs server tuning_desc) $ filter relevant cases   where     forInputOutputs server tuning_desc (InputOutputs entry_name runs) = do-      putStr $ inBold $ "\n" ++ program' ++ tuning_desc ++ ":\n"+      putBoldLn $ "\n" <> T.pack program' <> T.pack tuning_desc <> ":"       BenchResult program' . catMaybes         <$> mapM (runBenchmarkCase server opts futhark program entry_name pad_to) runs       where@@ -392,7 +396,7 @@   case res of     Left err -> liftIO $ do       putStrLn ""-      putStrLn $ inRed $ T.unpack err+      putRedLn err       pure $ Just $ DataResult dataset_desc $ Left err     Right (runtimes, errout) -> do       let vec_runtimes = U.fromList $ map (fromIntegral . runMicroseconds) runtimes@@ -421,7 +425,7 @@   foldMap matchMap $ T.lines t   where     mem_regex = "Peak memory usage for space '([^']+)': ([0-9]+) bytes." :: T.Text-    matchMap line = case (line =~ mem_regex :: (T.Text, T.Text, T.Text, [T.Text])) of+    matchMap l = case (l =~ mem_regex :: (T.Text, T.Text, T.Text, [T.Text])) of       (_, _, _, [device, bytes]) -> M.singleton device (read $ T.unpack bytes)       _ -> mempty 

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}- -- | @futhark c@ module Futhark.CLI.C (main) where 

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}- -- | @futhark cuda@ module Futhark.CLI.CUDA (main) where 

@@ -5,7 +5,7 @@ import Control.Monad.IO.Class import Futhark.Compiler import Futhark.Util.Options-import Futhark.Util.Pretty (pretty)+import Futhark.Util.Pretty (hPutDoc) import Language.Futhark.Warnings import System.IO @@ -31,6 +31,6 @@       (warnings, _, _) <- readProgramOrDie file       when (checkWarn cfg && anyWarnings warnings) $         liftIO $-          hPutStrLn stderr $-            pretty warnings+          hPutDoc stderr $+            prettyWarnings warnings     _ -> Nothing

@@ -1,10 +1,8 @@-{-# LANGUAGE OverloadedStrings #-}- -- | @futhark datacmp@ module Futhark.CLI.Datacmp (main) where  import Control.Exception-import qualified Data.ByteString.Lazy.Char8 as BS+import Data.ByteString.Lazy.Char8 qualified as BS import Futhark.Data.Compare import Futhark.Data.Reader import Futhark.Util.Options

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Strict #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -7,15 +6,15 @@  import Control.Monad import Control.Monad.ST-import qualified Data.Binary as Bin-import qualified Data.ByteString.Lazy.Char8 as BS-import qualified Data.Text as T-import qualified Data.Text.IO as T+import Data.Binary qualified as Bin+import Data.ByteString.Lazy.Char8 qualified as BS+import Data.Text qualified as T+import Data.Text.IO qualified as T import Data.Vector.Generic (freeze)-import qualified Data.Vector.Storable as SVec-import qualified Data.Vector.Storable.Mutable as USVec+import Data.Vector.Storable qualified as SVec+import Data.Vector.Storable.Mutable qualified as USVec import Data.Word-import qualified Futhark.Data as V+import Futhark.Data qualified as V import Futhark.Data.Reader (readValues) import Futhark.Util (convFloat) import Futhark.Util.Options@@ -26,7 +25,6 @@   ( FloatValue (..),     IntValue (..),     PrimValue (..),-    Value,     ValueType,   ) import System.Exit@@ -108,7 +106,7 @@                       }                 Left err ->                   Left $ do-                    hPutStrLn stderr err+                    T.hPutStrLn stderr err                     exitFailure           )           "TYPE"@@ -116,9 +114,9 @@       "Generate a random value of this type.",     Option       []-      ["text"]+      ["pretty"]       (NoArg $ Right $ \opts -> opts {format = Text})-      "Output data in text format (must precede --generate).",+      "Output data in pretty format (must precede --generate).",     Option       "b"       ["binary"]@@ -172,7 +170,7 @@  tryMakeGenerator ::   String ->-  Either String (RandomConfiguration -> OutputFormat -> Word64 -> IO ())+  Either T.Text (RandomConfiguration -> OutputFormat -> Word64 -> IO ()) tryMakeGenerator t   | Just vs <- readValues $ BS.pack t =       pure $ \_ fmt _ -> mapM_ (outValue fmt) vs@@ -187,7 +185,7 @@     outValue Binary = BS.putStr . Bin.encode     outValue Type = T.putStrLn . V.valueTypeText . V.valueType -toValueType :: UncheckedTypeExp -> Either String V.ValueType+toValueType :: UncheckedTypeExp -> Either T.Text V.ValueType toValueType TETuple {} = Left "Cannot handle tuples yet." toValueType TERecord {} = Left "Cannot handle records yet." toValueType TEApply {} = Left "Cannot handle type applications yet."@@ -208,7 +206,7 @@     m = map f [minBound .. maxBound]     f t = (nameFromText (V.primTypeText t), t) toValueType (TEVar v _) =-  Left $ "Unknown type " ++ pretty v+  Left $ "Unknown type " <> prettyText v  -- | Closed interval, as in @System.Random@. type Range a = (a, a)

@@ -1,11 +1,9 @@-{-# LANGUAGE OverloadedStrings #-}- -- | @futhark defs@ module Futhark.CLI.Defs (main) where -import qualified Data.Sequence as Seq-import qualified Data.Text as T-import qualified Data.Text.IO as T+import Data.Sequence qualified as Seq+import Data.Text qualified as T+import Data.Text.IO qualified as T import Futhark.Compiler import Futhark.Util.Loc import Futhark.Util.Options

@@ -1,30 +1,28 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}- -- | Futhark Compiler Driver module Futhark.CLI.Dev (main) where  import Control.Category (id) import Control.Monad import Control.Monad.State+import Data.Kind qualified import Data.List (intersperse) import Data.Maybe-import qualified Data.Text as T-import qualified Data.Text.IO as T+import Data.Text qualified as T+import Data.Text.IO qualified as T import Futhark.Actions-import qualified Futhark.Analysis.Alias as Alias+import Futhark.Analysis.Alias qualified as Alias import Futhark.Analysis.Metrics (OpMetrics) import Futhark.Compiler.CLI hiding (compilerMain)-import Futhark.IR (ASTRep, Op, Prog, pretty)-import qualified Futhark.IR.GPU as GPU-import qualified Futhark.IR.GPUMem as GPUMem-import qualified Futhark.IR.MC as MC-import qualified Futhark.IR.MCMem as MCMem+import Futhark.IR (ASTRep, Op, Prog, prettyString)+import Futhark.IR.GPU qualified as GPU+import Futhark.IR.GPUMem qualified as GPUMem+import Futhark.IR.MC qualified as MC+import Futhark.IR.MCMem qualified as MCMem import Futhark.IR.Parse import Futhark.IR.Prop.Aliases (CanBeAliased)-import qualified Futhark.IR.SOACS as SOACS-import qualified Futhark.IR.Seq as Seq-import qualified Futhark.IR.SeqMem as SeqMem+import Futhark.IR.SOACS qualified as SOACS+import Futhark.IR.Seq qualified as Seq+import Futhark.IR.SeqMem qualified as SeqMem import Futhark.IR.TypeCheck (Checkable, checkProg) import Futhark.Internalise.Defunctionalise as Defunctionalise import Futhark.Internalise.Defunctorise as Defunctorise@@ -36,7 +34,7 @@ import Futhark.Optimise.HistAccs import Futhark.Optimise.InPlaceLowering import Futhark.Optimise.InliningDeadFun-import qualified Futhark.Optimise.MemoryBlockMerging as MemoryBlockMerging+import Futhark.Optimise.MemoryBlockMerging qualified as MemoryBlockMerging import Futhark.Optimise.ReduceDeviceSyncs (reduceDeviceSyncs) import Futhark.Optimise.Sink import Futhark.Optimise.TileLoops@@ -44,8 +42,8 @@ import Futhark.Pass import Futhark.Pass.AD import Futhark.Pass.ExpandAllocations-import qualified Futhark.Pass.ExplicitAllocations.GPU as GPU-import qualified Futhark.Pass.ExplicitAllocations.Seq as Seq+import Futhark.Pass.ExplicitAllocations.GPU qualified as GPU+import Futhark.Pass.ExplicitAllocations.Seq qualified as Seq import Futhark.Pass.ExtractKernels import Futhark.Pass.ExtractMulticore import Futhark.Pass.FirstOrderTransform@@ -54,7 +52,7 @@ import Futhark.Passes import Futhark.Util.Log import Futhark.Util.Options-import qualified Futhark.Util.Pretty as PP+import Futhark.Util.Pretty qualified as PP import Language.Futhark.Core (locStr, nameFromString) import Language.Futhark.Parser (SyntaxError (..), parseFuthark) import System.Exit@@ -127,13 +125,13 @@   representation (SeqMem _) = "SeqMem"  instance PP.Pretty UntypedPassState where-  ppr (SOACS prog) = PP.ppr prog-  ppr (GPU prog) = PP.ppr prog-  ppr (MC prog) = PP.ppr prog-  ppr (Seq prog) = PP.ppr prog-  ppr (SeqMem prog) = PP.ppr prog-  ppr (MCMem prog) = PP.ppr prog-  ppr (GPUMem prog) = PP.ppr prog+  pretty (SOACS prog) = PP.pretty prog+  pretty (GPU prog) = PP.pretty prog+  pretty (MC prog) = PP.pretty prog+  pretty (Seq prog) = PP.pretty prog+  pretty (SeqMem prog) = PP.pretty prog+  pretty (MCMem prog) = PP.pretty prog+  pretty (GPUMem prog) = PP.pretty prog  newtype UntypedPass   = UntypedPass@@ -151,7 +149,7 @@   | MCMemAction (BackendAction MCMem.MCMem)   | SeqMemAction (BackendAction SeqMem.SeqMem)   | PolyAction-      ( forall rep.+      ( forall (rep :: Data.Kind.Type).         ( ASTRep rep,           (CanBeAliased (Op rep)),           (OpMetrics (Op rep))@@ -400,12 +398,12 @@       "Disable type-checking.",     Option       []-      ["pretty-print"]+      ["prettyString-print"]       ( NoArg $           Right $ \opts ->             opts {futharkPipeline = PrettyPrint}       )-      "Parse and pretty-print the AST of the given program.",+      "Parse and prettyString-print the AST of the given program.",     Option       []       ["backend"]@@ -656,7 +654,7 @@           p =             mapM_ putStrLn               . intersperse ""-              . map (if futharkPrintAST config then show else pretty)+              . map (if futharkPrintAST config then show else prettyString)            readProgram' = readProgramFile (futharkEntryPoints (futharkConfig config)) file @@ -665,10 +663,10 @@           maybe_prog <- parseFuthark file <$> T.readFile file           case maybe_prog of             Left (SyntaxError loc err) ->-              fail $ "Syntax error at " <> locStr loc <> ":\n" <> err+              fail $ "Syntax error at " <> locStr loc <> ":\n" <> T.unpack err             Right prog               | futharkPrintAST config -> print prog-              | otherwise -> putStrLn $ pretty prog+              | otherwise -> putStrLn $ prettyString prog         TypeCheck -> do           (_, imports, _) <- readProgram'           liftIO $@@ -676,7 +674,7 @@               putStrLn $                 if futharkPrintAST config                   then show $ fileProg fm-                  else pretty $ fileProg fm+                  else prettyString $ fileProg fm         Defunctorise -> do           (_, imports, src) <- readProgram'           liftIO $ p $ evalState (Defunctorise.transformProg imports) src

@@ -1,7 +1,5 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}  -- | @futhark doc@ module Futhark.CLI.Doc (main) where@@ -9,8 +7,8 @@ import Control.Monad.State import Data.FileEmbed import Data.List (nubBy)-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as T+import Data.Text.Lazy qualified as T+import Data.Text.Lazy.IO qualified as T import Futhark.Compiler (Imports, dumpError, fileProg, newFutharkConfig, readProgramFiles) import Futhark.Doc.Generator import Futhark.Pipeline (FutharkM, Verbosity (..), runFutharkM)

@@ -1,4 +1,3 @@-{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ExplicitNamespaces #-}  -- | @futhark lsp@

@@ -1,29 +1,25 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}- -- | @futhark literate@ module Futhark.CLI.Literate (main) where -import qualified Codec.BMP as BMP+import Codec.BMP qualified as BMP import Control.Monad.Except import Control.Monad.State hiding (State) import Data.Bifunctor (first, second) import Data.Bits-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as LBS+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as LBS import Data.Char import Data.Functor import Data.Int (Int64) import Data.List (foldl', transpose)-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe-import qualified Data.Set as S-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as T-import qualified Data.Vector.Storable as SVec-import qualified Data.Vector.Storable.ByteString as SVec+import Data.Set qualified as S+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Text.IO qualified as T+import Data.Vector.Storable qualified as SVec+import Data.Vector.Storable.ByteString qualified as SVec import Data.Void import Data.Word (Word32, Word8) import Futhark.Data@@ -41,7 +37,7 @@   ) import Futhark.Util.Options import Futhark.Util.Pretty (prettyText, prettyTextOneLine)-import qualified Futhark.Util.Pretty as PP+import Futhark.Util.Pretty qualified as PP import Futhark.Util.ProgressBar import System.Directory   ( copyFile,@@ -106,78 +102,73 @@ varsInDirective (DirectiveGnuplot e _) = varsInExp e varsInDirective (DirectiveVideo e _) = varsInExp e -pprDirective :: Bool -> Directive -> PP.Doc+pprDirective :: Bool -> Directive -> PP.Doc a pprDirective _ (DirectiveRes e) =-  "> " <> PP.align (PP.ppr e)+  "> " <> PP.align (PP.pretty e) pprDirective _ (DirectiveBrief f) =   pprDirective False f pprDirective _ (DirectiveCovert f) =   pprDirective False f pprDirective _ (DirectiveImg e params) =-  "> :img "-    <> PP.align (PP.ppr e)-    <> if null params' then mempty else PP.stack $ ";" : params'+  ("> :img " <> PP.align (PP.pretty e))+    <> if null params' then mempty else ";" <> PP.hardline <> PP.stack params'   where-    params' =-      catMaybes-        [ p "file" imgFile PP.ppr-        ]-    p s f ppr = do+    params' = catMaybes [p "file" imgFile PP.pretty]+    p s f pretty = do       x <- f params-      Just $ s <> ": " <> ppr x+      Just $ s <> ": " <> pretty x pprDirective True (DirectivePlot e (Just (h, w))) =   PP.stack-    [ "> :plot2d " <> PP.ppr e <> ";",-      "size: (" <> PP.ppr w <> "," <> PP.ppr h <> ")"+    [ "> :plot2d " <> PP.pretty e <> ";",+      "size: (" <> PP.pretty w <> "," <> PP.pretty h <> ")"     ] pprDirective _ (DirectivePlot e _) =-  "> :plot2d " <> PP.align (PP.ppr e)+  "> :plot2d " <> PP.align (PP.pretty e) pprDirective True (DirectiveGnuplot e script) =   PP.stack $-    "> :gnuplot " <> PP.align (PP.ppr e) <> ";"-      : map PP.strictText (T.lines script)+    "> :gnuplot " <> PP.align (PP.pretty e) <> ";"+      : map PP.pretty (T.lines script) pprDirective False (DirectiveGnuplot e _) =-  "> :gnuplot " <> PP.align (PP.ppr e)+  "> :gnuplot " <> PP.align (PP.pretty e) pprDirective False (DirectiveVideo e _) =-  "> :video " <> PP.align (PP.ppr e)+  "> :video " <> PP.align (PP.pretty e) pprDirective True (DirectiveVideo e params) =-  "> :video "-    <> PP.ppr e-    <> if null params' then mempty else PP.stack $ ";" : params'+  ("> :video " <> PP.pretty e)+    <> if null params' then mempty else ";" <> PP.hardline <> PP.stack params'   where     params' =       catMaybes-        [ p "fps" videoFPS PP.ppr,+        [ p "fps" videoFPS PP.pretty,           p "loop" videoLoop ppBool,           p "autoplay" videoAutoplay ppBool,-          p "format" videoFormat PP.strictText,-          p "file" videoFile PP.ppr+          p "format" videoFormat PP.pretty,+          p "file" videoFile PP.pretty         ]     ppBool b = if b then "true" else "false"-    p s f ppr = do+    p s f pretty = do       x <- f params-      Just $ s <> ": " <> ppr x+      Just $ s <> ": " <> pretty x  instance PP.Pretty Directive where-  ppr = pprDirective True+  pretty = pprDirective True  data Block   = BlockCode T.Text   | BlockComment T.Text-  | BlockDirective Directive+  | BlockDirective Directive T.Text   deriving (Show)  varsInScripts :: [Block] -> S.Set EntryName varsInScripts = foldMap varsInBlock   where-    varsInBlock (BlockDirective d) = varsInDirective d+    varsInBlock (BlockDirective d _) = varsInDirective d     varsInBlock BlockCode {} = mempty     varsInBlock BlockComment {} = mempty  type Parser = Parsec Void T.Text  postlexeme :: Parser ()-postlexeme = void $ hspace *> optional (try $ eol *> "-- " *> postlexeme)+postlexeme = void $ hspace *> optional (try $ eol *> "--" *> postlexeme)  lexeme :: Parser a -> Parser a lexeme p = p <* postlexeme@@ -289,10 +280,26 @@ afterExp :: Parser () afterExp = choice [atStartOfLine, void eol] +withParsedSource :: Parser a -> (a -> T.Text -> b) -> Parser b+withParsedSource p f = do+  s <- getInput+  bef <- getOffset+  x <- p+  aft <- getOffset+  pure $ f x $ T.take (aft - bef) s++stripCommentPrefix :: T.Text -> T.Text+stripCommentPrefix = T.unlines . map onLine . T.lines+  where+    onLine s+      | "-- " `T.isPrefixOf` s = T.drop 3 s+      | otherwise = T.drop 2 s+ parseBlock :: Parser Block parseBlock =   choice-    [ token "-- >" $> BlockDirective <*> parseDirective,+    [ withParsedSource (token "-- >" *> parseDirective) $ \d s ->+        BlockDirective d $ stripCommentPrefix s,       BlockCode <$> parseTestBlock,       BlockCode <$> parseBlockCode,       BlockComment <$> parseBlockComment@@ -860,18 +867,18 @@ processBlock _ (BlockCode code)   | T.null code = pure (Success, "\n", mempty)   | otherwise = pure (Success, "\n```futhark\n" <> code <> "```\n\n", mempty)-processBlock _ (BlockComment text) =-  pure (Success, text, mempty)-processBlock env (BlockDirective directive) = do+processBlock _ (BlockComment pretty) =+  pure (Success, pretty, mempty)+processBlock env (BlockDirective directive text) = do   when (scriptVerbose (envOpts env) > 0) $-    T.hPutStrLn stderr . prettyText $-      "Processing " <> PP.align (PP.ppr directive) <> "..."+    T.hPutStrLn stderr . PP.docText $+      "Processing " <> PP.align (PP.pretty directive) <> "..."   let prompt = case directive of         DirectiveCovert _ -> mempty         DirectiveBrief _ ->-          "```\n" <> prettyText (pprDirective False directive) <> "\n```\n"+          "```\n" <> PP.docText (pprDirective False directive) <> "\n```\n"         _ ->-          "```\n" <> prettyText (pprDirective True directive) <> "\n```\n"+          "```\n" <> text <> "```\n"       env' = env {envHash = hashText (envHash env <> prettyText directive)}   (r, files) <- runScriptM $ processDirective env' directive   case r of

@@ -1,38 +1,36 @@-{-# LANGUAGE OverloadedStrings #-}- -- | The main function for the @futhark@ command line program. module Futhark.CLI.Main (main) where  import Control.Exception import Data.List (sortOn) import Data.Maybe-import qualified Data.Text as T-import qualified Data.Text.IO as T-import qualified Futhark.CLI.Autotune as Autotune-import qualified Futhark.CLI.Bench as Bench-import qualified Futhark.CLI.C as C-import qualified Futhark.CLI.CUDA as CCUDA-import qualified Futhark.CLI.Check as Check-import qualified Futhark.CLI.Datacmp as Datacmp-import qualified Futhark.CLI.Dataset as Dataset-import qualified Futhark.CLI.Defs as Defs-import qualified Futhark.CLI.Dev as Dev-import qualified Futhark.CLI.Doc as Doc-import qualified Futhark.CLI.LSP as LSP-import qualified Futhark.CLI.Literate as Literate-import qualified Futhark.CLI.Misc as Misc-import qualified Futhark.CLI.Multicore as Multicore-import qualified Futhark.CLI.MulticoreISPC as MulticoreISPC-import qualified Futhark.CLI.MulticoreWASM as MulticoreWASM-import qualified Futhark.CLI.OpenCL as OpenCL-import qualified Futhark.CLI.Pkg as Pkg-import qualified Futhark.CLI.PyOpenCL as PyOpenCL-import qualified Futhark.CLI.Python as Python-import qualified Futhark.CLI.Query as Query-import qualified Futhark.CLI.REPL as REPL-import qualified Futhark.CLI.Run as Run-import qualified Futhark.CLI.Test as Test-import qualified Futhark.CLI.WASM as WASM+import Data.Text qualified as T+import Data.Text.IO qualified as T+import Futhark.CLI.Autotune qualified as Autotune+import Futhark.CLI.Bench qualified as Bench+import Futhark.CLI.C qualified as C+import Futhark.CLI.CUDA qualified as CCUDA+import Futhark.CLI.Check qualified as Check+import Futhark.CLI.Datacmp qualified as Datacmp+import Futhark.CLI.Dataset qualified as Dataset+import Futhark.CLI.Defs qualified as Defs+import Futhark.CLI.Dev qualified as Dev+import Futhark.CLI.Doc qualified as Doc+import Futhark.CLI.LSP qualified as LSP+import Futhark.CLI.Literate qualified as Literate+import Futhark.CLI.Misc qualified as Misc+import Futhark.CLI.Multicore qualified as Multicore+import Futhark.CLI.MulticoreISPC qualified as MulticoreISPC+import Futhark.CLI.MulticoreWASM qualified as MulticoreWASM+import Futhark.CLI.OpenCL qualified as OpenCL+import Futhark.CLI.Pkg qualified as Pkg+import Futhark.CLI.PyOpenCL qualified as PyOpenCL+import Futhark.CLI.Python qualified as Python+import Futhark.CLI.Query qualified as Query+import Futhark.CLI.REPL qualified as REPL+import Futhark.CLI.Run qualified as Run+import Futhark.CLI.Test qualified as Test+import Futhark.CLI.WASM qualified as WASM import Futhark.Error import Futhark.Util (maxinum) import Futhark.Util.Options

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}- -- | Various small subcommands that are too simple to deserve their own file. module Futhark.CLI.Misc   ( mainImports,@@ -12,11 +10,11 @@ where  import Control.Monad.State-import qualified Data.ByteString.Lazy as BS+import Data.ByteString.Lazy qualified as BS import Data.Function (on) import Data.List (isInfixOf, nubBy) import Data.Loc (L (..), startPos)-import qualified Data.Text.IO as T+import Data.Text.IO qualified as T import Futhark.Compiler import Futhark.Test import Futhark.Util (hashText, interactWithFileSafely)

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}- -- | @futhark multicore@ module Futhark.CLI.Multicore (main) where 

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}- -- | @futhark multicore@ module Futhark.CLI.MulticoreISPC (main) where 

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}- -- | @futhark wasm-multicore@ module Futhark.CLI.MulticoreWASM (main) where 

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}- -- | @futhark opencl@ module Futhark.CLI.OpenCL (main) where 

@@ -1,20 +1,17 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}- -- | @futhark pkg@ module Futhark.CLI.Pkg (main) where -import qualified Codec.Archive.Zip as Zip+import Codec.Archive.Zip qualified as Zip import Control.Monad.IO.Class import Control.Monad.Reader import Control.Monad.State-import qualified Data.ByteString.Lazy as LBS+import Data.ByteString.Lazy qualified as LBS import Data.List (intercalate, isPrefixOf)-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe import Data.Monoid-import qualified Data.Text as T-import qualified Data.Text.IO as T+import Data.Text qualified as T+import Data.Text.IO qualified as T import Futhark.Pkg.Info import Futhark.Pkg.Solve import Futhark.Pkg.Types@@ -25,7 +22,7 @@ import System.Environment import System.Exit import System.FilePath-import qualified System.FilePath.Posix as Posix+import System.FilePath.Posix qualified as Posix import System.IO import Prelude 

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}- -- | @futhark pyopencl@ module Futhark.CLI.PyOpenCL (main) where 

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}- -- | @futhark py@ module Futhark.CLI.Python (main) where 

@@ -21,12 +21,12 @@         case atPos imports $ Pos file line' col' 0 of           Nothing -> putStrLn "No information available."           Just (AtName qn def loc) -> do-            putStrLn $ "Name: " ++ pretty qn+            putStrLn $ "Name: " ++ prettyString qn             putStrLn $ "Position: " ++ locStr (srclocOf loc)             case def of               Nothing -> pure ()               Just (BoundTerm t defloc) -> do-                putStrLn $ "Type: " ++ pretty t+                putStrLn $ "Type: " ++ prettyString t                 putStrLn $ "Definition: " ++ locStr (srclocOf defloc)               Just (BoundType defloc) ->                 putStrLn $ "Definition: " ++ locStr (srclocOf defloc)

@@ -1,8 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE ScopedTypeVariables #-}  -- | @futhark repl@ module Futhark.CLI.REPL (main) where@@ -13,37 +9,41 @@ import Control.Monad.Free.Church import Control.Monad.State import Data.Char-import Data.List (intercalate, intersperse)-import qualified Data.List.NonEmpty as NE-import qualified Data.Map as M+import Data.List (intersperse)+import Data.List.NonEmpty qualified as NE+import Data.Map qualified as M import Data.Maybe-import qualified Data.Text as T-import qualified Data.Text.IO as T+import Data.Text qualified as T+import Data.Text.IO qualified as T import Data.Version import Futhark.Compiler import Futhark.MonadFreshNames import Futhark.Util (fancyTerminal) import Futhark.Util.Options+import Futhark.Util.Pretty (AnsiStyle, Color (..), Doc, annotate, bgColorDull, bold, brackets, color, docText, docTextForHandle, hardline, pretty, putDoc, putDocLn, (<+>)) import Futhark.Version import Language.Futhark-import qualified Language.Futhark.Interpreter as I+import Language.Futhark.Interpreter qualified as I import Language.Futhark.Parser-import qualified Language.Futhark.Semantic as T-import qualified Language.Futhark.TypeChecker as T+import Language.Futhark.Semantic qualified as T+import Language.Futhark.TypeChecker qualified as T import NeatInterpolation (text)-import qualified System.Console.Haskeline as Haskeline+import System.Console.Haskeline qualified as Haskeline import System.Directory import System.FilePath+import System.IO (stdout) import Text.Read (readMaybe) -banner :: String+banner :: Doc AnsiStyle banner =-  unlines-    [ "|// |\\    |   |\\  |\\   /",-      "|/  | \\   |\\  |\\  |/  /",-      "|   |  \\  |/  |   |\\  \\",-      "|   |   \\ |   |   | \\  \\"+  mconcat . map ((<> hardline) . decorate . pretty) $+    [ "┃╱╱ ┃╲    ┃   ┃╲  ┃╲   ╱" :: T.Text,+      "┃╱  ┃ ╲   ┃╲  ┃╲  ┃╱  ╱ ",+      "┃   ┃  ╲  ┃╱  ┃   ┃╲  ╲ ",+      "┃   ┃   ╲ ┃   ┃   ┃ ╲  ╲"     ]+  where+    decorate = annotate (bgColorDull Red <> bold <> color White)  -- | Run @futhark repl@. main :: String -> [String] -> IO ()@@ -58,11 +58,11 @@ repl :: Maybe FilePath -> IO () repl maybe_prog = do   when fancyTerminal $ do-    putStr banner+    putDoc banner     putStrLn $ "Version " ++ showVersion version ++ "."     putStrLn "Copyright (C) DIKU, University of Copenhagen, released under the ISC license."     putStrLn ""-    putStrLn "Run :help for a list of commands."+    putDoc $ "Run" <+> annotate bold ":help" <+> "for a list of commands."     putStrLn ""    let toploop s = do@@ -85,7 +85,7 @@             case maybe_new_state of               Right new_state -> toploop new_state               Left err -> do-                liftIO $ putStrLn err+                liftIO $ putDocLn err                 toploop s'           Right _ -> pure () @@ -99,9 +99,9 @@       noprog_init_state <- liftIO $ newFutharkiState 0 noLoadedProg Nothing       case noprog_init_state of         Left err ->-          error $ "Failed to initialise interpreter state: " ++ err+          error $ "Failed to initialise interpreter state: " <> T.unpack (docText err)         Right s -> do-          liftIO $ putStrLn prog_err+          liftIO $ putDoc prog_err           pure s {futharkiLoaded = maybe_prog}     Right s ->       pure s@@ -148,7 +148,7 @@     t_imports = filter ((`elem` opens) . fst) $ lpImports prog     i_envs = map snd $ filter ((`elem` opens) . fst) $ M.toList $ I.ctxImports ictx -newFutharkiState :: Int -> LoadedProg -> Maybe FilePath -> IO (Either String FutharkiState)+newFutharkiState :: Int -> LoadedProg -> Maybe FilePath -> IO (Either (Doc AnsiStyle) FutharkiState) newFutharkiState count prev_prog maybe_file = runExceptT $ do   (prog, tenv, ienv) <- case maybe_file of     Nothing -> do@@ -158,7 +158,7 @@       -- Then into the interpreter.       ienv <-         foldM-          (\ctx -> badOnLeft show <=< runInterpreter' . I.interpretImport ctx)+          (\ctx -> badOnLeft (pretty . show) <=< runInterpreter' . I.interpretImport ctx)           I.initialCtx           $ map (fmap fileProg) (lpImports prog) @@ -168,11 +168,11 @@       pure (prog, tenv, ienv')     Just file -> do       prog <- badOnLeft prettyProgErrors =<< liftIO (reloadProg prev_prog [file] M.empty)-      liftIO $ putStrLn $ pretty $ lpWarnings prog+      liftIO $ putDoc $ prettyWarnings $ lpWarnings prog        ienv <-         foldM-          (\ctx -> badOnLeft show <=< runInterpreter' . I.interpretImport ctx)+          (\ctx -> badOnLeft (pretty . show) <=< runInterpreter' . I.interpretImport ctx)           I.initialCtx           $ map (fmap fileProg) (lpImports prog) @@ -192,16 +192,14 @@         futharkiLoaded = maybe_file       }   where-    badOnLeft :: (err -> String) -> Either err a -> ExceptT String IO a+    badOnLeft :: (err -> err') -> Either err a -> ExceptT err' IO a     badOnLeft _ (Right x) = pure x     badOnLeft p (Left err) = throwError $ p err -    prettyProgErrors = pretty . pprProgErrors- getPrompt :: FutharkiM String getPrompt = do   i <- gets futharkiCount-  pure $ "[" ++ show i ++ "]> "+  fmap T.unpack $ liftIO $ docTextForHandle stdout $ annotate bold $ brackets (pretty i) <> "> "  -- The ExceptT part is more of a continuation, really. newtype FutharkiM a = FutharkiM {runFutharkiM :: ExceptT StopReason (StateT FutharkiState (Haskeline.InputT IO)) a}@@ -238,7 +236,7 @@       maybe_dec_or_e <- parseDecOrExpIncrM (inputLine "  ") prompt line        case maybe_dec_or_e of-        Left (SyntaxError _ err) -> liftIO $ putStrLn err+        Left (SyntaxError _ err) -> liftIO $ T.putStrLn err         Right (Left d) -> onDec d         Right (Right e) -> onExp e   modify $ \s -> s {futharkiCount = futharkiCount s + 1}@@ -266,14 +264,14 @@   cur_prog <- gets futharkiProg   imp_r <- liftIO $ extendProg cur_prog files M.empty   case imp_r of-    Left e -> liftIO $ T.putStrLn $ prettyText $ pprProgErrors e+    Left e -> liftIO $ putDoc $ prettyProgErrors e     Right prog -> do       env <- gets futharkiEnv       let (tenv, ienv) = extendEnvs prog env (map fst $ decImports d)           imports = lpImports prog           src = lpNameSource prog       case T.checkDec imports src tenv cur_import d of-        (_, Left e) -> liftIO $ putStrLn $ pretty e+        (_, Left e) -> liftIO $ putDoc $ T.prettyTypeErrorNoLoc e         (_, Right (tenv', d', src')) -> do           let new_imports = filter ((`notElem` map fst old_imports) . fst) imports           int_r <- runInterpreter $ do@@ -293,22 +291,22 @@ onExp e = do   (imports, src, tenv, ienv) <- getIt   case T.checkExp imports src tenv e of-    (_, Left err) -> liftIO $ putStrLn $ pretty err+    (_, Left err) -> liftIO $ putDoc $ T.prettyTypeErrorNoLoc err     (_, Right (tparams, e'))       | null tparams -> do           r <- runInterpreter $ I.interpretExp ienv e'           case r of             Left err -> liftIO $ print err-            Right v -> liftIO $ putStrLn $ pretty v+            Right v -> liftIO $ putDoc $ I.prettyValue v <> hardline       | otherwise -> liftIO $ do-          putStrLn $ "Inferred type of expression: " ++ pretty (typeOf e')-          putStrLn $+          T.putStrLn $ "Inferred type of expression: " <> prettyText (typeOf e')+          T.putStrLn $             "The following types are ambiguous: "-              ++ intercalate ", " (map (prettyName . typeParamName) tparams)+              <> T.intercalate ", " (map (nameToText . toName . typeParamName) tparams) -prettyBreaking :: Breaking -> String+prettyBreaking :: Breaking -> T.Text prettyBreaking b =-  prettyStacktrace (breakingAt b) $ map locStr $ NE.toList $ breakingStack b+  prettyStacktrace (breakingAt b) $ map locText $ NE.toList $ breakingStack b  -- Are we currently willing to break for this reason?  Among othe -- things, we do not want recursive breakpoints.  It could work fine@@ -341,9 +339,9 @@        -- Are we supposed to respect this breakpoint?       when (breakForReason s top why) $ do-        liftIO $ putStrLn $ why' <> " at " ++ locStr w-        liftIO $ putStrLn $ prettyBreaking breaking-        liftIO $ putStrLn "<Enter> to continue."+        liftIO $ T.putStrLn $ why' <> " at " <> locText w+        liftIO $ T.putStrLn $ prettyBreaking breaking+        liftIO $ T.putStrLn "<Enter> to continue."          -- Note the cleverness to preserve the Haskeline session (for         -- line history and such).@@ -400,22 +398,22 @@ genTypeCommand f g h e = do   prompt <- getPrompt   case f prompt e of-    Left (SyntaxError _ err) -> liftIO $ putStrLn err+    Left (SyntaxError _ err) -> liftIO $ T.putStrLn err     Right e' -> do       (imports, src, tenv, _) <- getIt       case snd $ g imports src tenv e' of-        Left err -> liftIO $ putStrLn $ pretty err+        Left err -> liftIO $ putDoc $ T.prettyTypeErrorNoLoc err         Right x -> liftIO $ putStrLn $ h x  typeCommand :: Command typeCommand = genTypeCommand parseExp T.checkExp $ \(ps, e) ->-  pretty e-    <> concatMap ((" " <>) . pretty) ps+  prettyString e+    <> concatMap ((" " <>) . prettyString) ps     <> " : "-    <> pretty (typeOf e)+    <> prettyString (typeOf e)  mtypeCommand :: Command-mtypeCommand = genTypeCommand parseModExp T.checkModExp $ pretty . fst+mtypeCommand = genTypeCommand parseModExp T.checkModExp $ prettyString . fst  unbreakCommand :: Command unbreakCommand _ = do@@ -450,7 +448,7 @@               { futharkiEnv = (tenv, ctx),                 futharkiBreaking = Just breaking               }-          liftIO $ putStrLn $ prettyBreaking breaking+          liftIO $ T.putStrLn $ prettyBreaking breaking     (Just _, _) ->       liftIO $ putStrLn $ "Invalid stack index: " ++ T.unpack which     (Nothing, _) ->@@ -470,8 +468,8 @@ helpCommand :: Command helpCommand _ = liftIO $   forM_ commands $ \(cmd, (_, desc)) -> do-    T.putStrLn $ ":" <> cmd-    T.putStrLn $ T.replicate (1 + T.length cmd) "-"+    putDoc $ annotate bold $ ":" <> pretty cmd <> hardline+    T.putStrLn $ T.replicate (1 + T.length cmd) "─"     T.putStr desc     T.putStrLn ""     T.putStrLn ""

@@ -1,7 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}- -- | @futhark run@ module Futhark.CLI.Run (main) where @@ -9,18 +5,20 @@ import Control.Monad import Control.Monad.Except import Control.Monad.Free.Church-import qualified Data.Map as M+import Data.ByteString.Lazy qualified as BS+import Data.Map qualified as M import Data.Maybe-import qualified Data.Text.IO as T+import Data.Text.IO qualified as T import Futhark.Compiler+import Futhark.Data.Reader (readValues) import Futhark.Pipeline import Futhark.Util (toPOSIX) import Futhark.Util.Options+import Futhark.Util.Pretty (AnsiStyle, Doc, hPutDoc) import Language.Futhark-import qualified Language.Futhark.Interpreter as I-import Language.Futhark.Parser-import qualified Language.Futhark.Semantic as T-import qualified Language.Futhark.TypeChecker as T+import Language.Futhark.Interpreter qualified as I+import Language.Futhark.Semantic qualified as T+import Language.Futhark.TypeChecker qualified as T import System.Exit import System.FilePath import System.IO@@ -38,19 +36,19 @@   pr <- newFutharkiState config fp   (tenv, ienv) <- case pr of     Left err -> do-      hPutStrLn stderr err+      hPutDoc stderr err       exitFailure     Right env -> pure env    let entry = interpreterEntryPoint config-  vr <- parseValues "stdin" <$> T.getContents+  vr <- readValues <$> BS.getContents    inps <-     case vr of-      Left (SyntaxError loc err) -> do-        hPutStrLn stderr $ "Input syntax error at " <> locStr loc <> ":\n" <> err+      Nothing -> do+        T.hPutStrLn stderr "Incorrectly formatted input data."         exitFailure-      Right vs ->+      Just vs ->         pure vs    (fname, ret) <-@@ -59,12 +57,12 @@         | Just (T.BoundV _ t) <- M.lookup (qualLeaf fname) $ T.envVtable tenv ->             pure (fname, toStructural $ snd $ unfoldFunType t)       _ -> do-        hPutStrLn stderr $ "Invalid entry point: " ++ pretty entry+        T.hPutStrLn stderr $ "Invalid entry point: " <> prettyText entry         exitFailure    case I.interpretFunction ienv (qualLeaf fname) inps of     Left err -> do-      hPutStrLn stderr err+      T.hPutStrLn stderr err       exitFailure     Right run -> do       run' <- runInterpreter' run@@ -79,8 +77,8 @@  putValue :: I.Value -> TypeBase () () -> IO () putValue v t-  | I.isEmptyArray v = putStrLn $ I.prettyEmptyArray t v-  | otherwise = putStrLn $ pretty v+  | I.isEmptyArray v = T.putStrLn $ I.prettyEmptyArray t v+  | otherwise = T.putStrLn $ I.valueText v  data InterpreterConfig = InterpreterConfig   { interpreterEntryPoint :: Name,@@ -112,10 +110,10 @@ newFutharkiState ::   InterpreterConfig ->   FilePath ->-  IO (Either String (T.Env, I.Ctx))+  IO (Either (Doc AnsiStyle) (T.Env, I.Ctx)) newFutharkiState cfg file = runExceptT $ do   (ws, imports, src) <--    badOnLeft show+    badOnLeft prettyCompilerError       =<< liftIO         ( runExceptT (readProgramFile [] file)             `catch` \(err :: IOException) ->@@ -123,30 +121,28 @@         )   when (interpreterPrintWarnings cfg) $     liftIO $-      hPutStr stderr $-        pretty ws+      hPutDoc stderr $+        prettyWarnings ws    let imp = T.mkInitialImport "."   ienv1 <--    foldM (\ctx -> badOnLeft show <=< runInterpreter' . I.interpretImport ctx) I.initialCtx $+    foldM (\ctx -> badOnLeft I.prettyInterpreterError <=< runInterpreter' . I.interpretImport ctx) I.initialCtx $       map (fmap fileProg) imports   (tenv1, d1, src') <--    badOnLeft pretty $-      snd $-        T.checkDec imports src T.initialEnv imp $-          mkOpen "/prelude/prelude"+    badOnLeft T.prettyTypeError . snd $+      T.checkDec imports src T.initialEnv imp $+        mkOpen "/prelude/prelude"   (tenv2, d2, _) <--    badOnLeft pretty $-      snd $-        T.checkDec imports src' tenv1 imp $-          mkOpen $-            toPOSIX $-              dropExtension file-  ienv2 <- badOnLeft show =<< runInterpreter' (I.interpretDec ienv1 d1)-  ienv3 <- badOnLeft show =<< runInterpreter' (I.interpretDec ienv2 d2)+    badOnLeft T.prettyTypeError . snd $+      T.checkDec imports src' tenv1 imp $+        mkOpen $+          toPOSIX $+            dropExtension file+  ienv2 <- badOnLeft I.prettyInterpreterError =<< runInterpreter' (I.interpretDec ienv1 d1)+  ienv3 <- badOnLeft I.prettyInterpreterError =<< runInterpreter' (I.interpretDec ienv2 d2)   pure (tenv2, ienv3)   where-    badOnLeft :: (err -> String) -> Either err a -> ExceptT String IO a+    badOnLeft :: (err -> err') -> Either err a -> ExceptT err' IO a     badOnLeft _ (Right x) = pure x     badOnLeft p (Left err) = throwError $ p err 

@@ -1,6 +1,4 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}  -- | @futhark test@ module Futhark.CLI.Test (main) where@@ -10,22 +8,22 @@ import Control.Exception import Control.Monad import Control.Monad.Except hiding (throwError)-import qualified Control.Monad.Except as E-import qualified Data.ByteString as SBS-import qualified Data.ByteString.Lazy as LBS+import Control.Monad.Except qualified as E+import Data.ByteString qualified as SBS+import Data.ByteString.Lazy qualified as LBS import Data.List (delete, partition)-import qualified Data.Map.Strict as M-import qualified Data.Text as T-import qualified Data.Text.Encoding as T+import Data.Map.Strict qualified as M+import Data.Text qualified as T+import Data.Text.Encoding qualified as T import Futhark.Analysis.Metrics.Type import Futhark.Server import Futhark.Test import Futhark.Util (atMostChars, fancyTerminal)-import Futhark.Util.Console import Futhark.Util.Options+import Futhark.Util.Pretty (annotate, bold, hardline, pretty, putDoc, vsep) import Futhark.Util.Table-import System.Console.ANSI-import qualified System.Console.Terminal.Size as Terminal+import System.Console.ANSI (clearFromCursorToScreenEnd, clearLine, cursorUpLine)+import System.Console.Terminal.Size qualified as Terminal import System.Environment import System.Exit import System.FilePath@@ -454,16 +452,16 @@       InputOutputs entry $ filter (not . any excluded . runTags) runs     excluded = (`elem` configExclude config) . T.pack -statusTable :: TestStatus -> String-statusTable ts = buildTable rows 1+putStatusTable :: TestStatus -> IO ()+putStatusTable ts = hPutTable stdout rows 1   where     rows =-      [ [mkEntry "", passed, failed, mkEntry "remaining"],-        map mkEntry ["programs", passedProgs, failedProgs, remainProgs'],-        map mkEntry ["runs", passedRuns, failedRuns, remainRuns']+      [ [mkEntry "" mempty, passed, failed, mkEntry "remaining" mempty],+        map (`mkEntry` mempty) ["programs", passedProgs, failedProgs, remainProgs'],+        map (`mkEntry` mempty) ["runs", passedRuns, failedRuns, remainRuns']       ]-    passed = ("passed", [SetColor Foreground Vivid Green])-    failed = ("failed", [SetColor Foreground Vivid Red])+    passed = mkEntry "passed" $ color Green+    failed = mkEntry "failed" $ color Red     passedProgs = show $ testStatusPass ts     failedProgs = show $ testStatusFail ts     totalProgs = show $ testStatusTotal ts@@ -476,9 +474,7 @@     remainRuns' = remainRuns ++ "/" ++ totalRuns  tableLines :: Int-tableLines = 1 + (length . lines $ blankTable)-  where-    blankTable = statusTable $ TestStatus [] [] 0 0 0 0 0 0 0+tableLines = 8  spaceTable :: IO () spaceTable = putStr $ replicate tableLines '\n'@@ -486,7 +482,7 @@ reportTable :: TestStatus -> IO () reportTable ts = do   moveCursorToTableTop-  putStrLn $ statusTable ts+  putStatusTable ts   clearLine   w <- maybe 80 Terminal.width <$> Terminal.size   putStrLn $ atMostChars (w - length labelstr) running@@ -561,7 +557,11 @@                   Failure s -> do                     when fancy moveCursorToTableTop                     clear-                    putStr $ inBold (testCaseProgram test <> ":\n") <> T.unpack (T.unlines s)+                    putDoc $+                      annotate bold (pretty (testCaseProgram test) <> ":")+                        <> hardline+                        <> vsep (map pretty s)+                        <> hardline                     when fancy spaceTable                     getResults $                       ts'@@ -592,7 +592,9 @@         }    -- Removes "Now testing" output.-  when fancy $ cursorUpLine 1 >> clearLine+  if fancy+    then cursorUpLine 1 >> clearLine+    else putStrLn $ show (testStatusPass ts) <> "/" <> show (testStatusTotal ts) <> " passed."    unless (null excluded) . putStrLn $     show (length excluded) ++ " program(s) excluded."

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}- -- | @futhark wasm@ module Futhark.CLI.WASM (main) where 

@@ -1,6 +1,4 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TupleSections #-}  -- | Code generation for CUDA. module Futhark.CodeGen.Backends.CCUDA@@ -14,22 +12,22 @@  import Control.Monad import Data.Maybe (catMaybes)-import qualified Data.Text as T+import Data.Text qualified as T import Futhark.CodeGen.Backends.CCUDA.Boilerplate import Futhark.CodeGen.Backends.COpenCL.Boilerplate (commonOptions, sizeLoggingCode)-import qualified Futhark.CodeGen.Backends.GenericC as GC+import Futhark.CodeGen.Backends.GenericC qualified as GC import Futhark.CodeGen.Backends.GenericC.Options import Futhark.CodeGen.Backends.SimpleRep (primStorageType, toStorage) import Futhark.CodeGen.ImpCode.OpenCL-import qualified Futhark.CodeGen.ImpGen.CUDA as ImpGen+import Futhark.CodeGen.ImpGen.CUDA qualified as ImpGen import Futhark.IR.GPUMem hiding   ( CmpSizeLe,     GetSize,     GetSizeMax,   ) import Futhark.MonadFreshNames-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C import NeatInterpolation (untrimming)  -- | Compile the program to C with calls to CUDA.@@ -298,7 +296,7 @@     cudaSizeClass SizeTile = "tile_size"     cudaSizeClass SizeRegTile = "reg_tile_size"     cudaSizeClass SizeLocalMemory = "shared_memory"-    cudaSizeClass (SizeBespoke x _) = pretty x+    cudaSizeClass (SizeBespoke x _) = prettyString x callKernel (LaunchKernel safety kernel_name args num_blocks block_size) = do   args_arr <- newVName "kernel_args"   time_start <- newVName "time_start"@@ -359,7 +357,7 @@       typename int64_t $id:time_start = 0, $id:time_end = 0;       if (ctx->debugging) {         fprintf(ctx->log, "Launching %s with grid size [%ld, %ld, %ld] and block size [%ld, %ld, %ld]; shared memory: %d bytes.\n",-                $string:(pretty kernel_name),+                $string:(prettyString kernel_name),                 (long int)$exp:grid_x, (long int)$exp:grid_y, (long int)$exp:grid_z,                 (long int)$exp:block_x, (long int)$exp:block_y, (long int)$exp:block_z,                 (int)$exp:shared_tot);@@ -377,7 +375,7 @@         CUDA_SUCCEED_FATAL(cuCtxSynchronize());         $id:time_end = get_wall_time();         fprintf(ctx->log, "Kernel %s runtime: %ldus\n",-                $string:(pretty kernel_name), $id:time_end - $id:time_start);+                $string:(prettyString kernel_name), $id:time_end - $id:time_start);       }     }|] 

@@ -8,9 +8,9 @@   ) where -import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe-import qualified Data.Text as T+import Data.Text qualified as T import Futhark.CodeGen.Backends.COpenCL.Boilerplate   ( copyDevToDev,     copyDevToHost,@@ -22,12 +22,13 @@     kernelRuns,     kernelRuntime,   )-import qualified Futhark.CodeGen.Backends.GenericC as GC+import Futhark.CodeGen.Backends.GenericC qualified as GC+import Futhark.CodeGen.Backends.GenericC.Pretty import Futhark.CodeGen.ImpCode.OpenCL import Futhark.CodeGen.RTS.C (cudaH, freeListH) import Futhark.Util (chunk, zEncodeString)-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C  errorMsgNumArgs :: ErrorMsg a -> Int errorMsgNumArgs = length . errorMsgArgTypes@@ -87,9 +88,9 @@  generateSizeFuns :: M.Map Name SizeClass -> GC.CompilerM OpenCL () () generateSizeFuns sizes = do-  let size_name_inits = map (\k -> [C.cinit|$string:(pretty k)|]) $ M.keys sizes-      size_var_inits = map (\k -> [C.cinit|$string:(zEncodeString (pretty k))|]) $ M.keys sizes-      size_class_inits = map (\c -> [C.cinit|$string:(pretty c)|]) $ M.elems sizes+  let size_name_inits = map (\k -> [C.cinit|$string:(prettyString k)|]) $ M.keys sizes+      size_var_inits = map (\k -> [C.cinit|$string:(zEncodeString (prettyString k))|]) $ M.keys sizes+      size_class_inits = map (\c -> [C.cinit|$string:(prettyString c)|]) $ M.elems sizes    GC.earlyDecl [C.cedecl|static const char *tuning_param_names[] = { $inits:size_name_inits };|]   GC.earlyDecl [C.cedecl|static const char *tuning_param_vars[] = { $inits:size_var_inits };|]@@ -316,7 +317,7 @@           [C.cstm|CUDA_SUCCEED_FATAL(cuModuleGetFunction(                                      &ctx->$id:name,                                      ctx->cuda.module,-                                     $string:(pretty (C.toIdent name mempty))));|]+                                     $string:(T.unpack (idText (C.toIdent name mempty)))));|]         )           : forCostCentre name 

@@ -1,7 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TupleSections #-}  -- | Code generation for C with OpenCL. module Futhark.CodeGen.Backends.COpenCL@@ -15,21 +12,21 @@  import Control.Monad hiding (mapM) import Data.List (intercalate)-import qualified Data.Text as T+import Data.Text qualified as T import Futhark.CodeGen.Backends.COpenCL.Boilerplate-import qualified Futhark.CodeGen.Backends.GenericC as GC+import Futhark.CodeGen.Backends.GenericC qualified as GC import Futhark.CodeGen.Backends.GenericC.Options import Futhark.CodeGen.Backends.SimpleRep (primStorageType, toStorage) import Futhark.CodeGen.ImpCode.OpenCL-import qualified Futhark.CodeGen.ImpGen.OpenCL as ImpGen+import Futhark.CodeGen.ImpGen.OpenCL qualified as ImpGen import Futhark.IR.GPUMem hiding   ( CmpSizeLe,     GetSize,     GetSizeMax,   ) import Futhark.MonadFreshNames-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C import NeatInterpolation (untrimming)  -- | Compile the program to C with calls to OpenCL.@@ -337,7 +334,7 @@   GC.stm [C.cstm|$id:v = *ctx->tuning_params.$id:key <= $exp:x';|]   sizeLoggingCode v key x' callKernel (GetSizeMax v size_class) =-  let field = "max_" ++ pretty size_class+  let field = "max_" ++ prettyString size_class    in GC.stm [C.cstm|$id:v = ctx->opencl.$id:field;|] callKernel (LaunchKernel safety name args num_workgroups workgroup_size) = do   -- The other failure args are set automatically when the kernel is@@ -428,7 +425,7 @@         $id:time_end = get_wall_time();         long int $id:time_diff = $id:time_end - $id:time_start;         fprintf(ctx->log, "kernel %s runtime: %ldus\n",-                $string:(pretty kernel_name), $id:time_diff);+                $string:(prettyString kernel_name), $id:time_diff);       }     }|]   where@@ -449,7 +446,7 @@           ++ " and local work size "           ++ dims           ++ "; local memory: %d bytes.\n",-        [C.cexp|$string:(pretty kernel_name)|]+        [C.cexp|$string:(prettyString kernel_name)|]           : map (kernelDim global_work_size) [0 .. kernel_rank - 1]           ++ map (kernelDim local_work_size) [0 .. kernel_rank - 1]           ++ [[C.cexp|(int)$exp:local_bytes|]]

@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}  module Futhark.CodeGen.Backends.COpenCL.Boilerplate@@ -20,18 +18,19 @@ where  import Control.Monad.State-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe-import qualified Data.Text as T-import qualified Futhark.CodeGen.Backends.GenericC as GC+import Data.Text qualified as T+import Futhark.CodeGen.Backends.GenericC qualified as GC import Futhark.CodeGen.Backends.GenericC.Options+import Futhark.CodeGen.Backends.GenericC.Pretty import Futhark.CodeGen.ImpCode.OpenCL import Futhark.CodeGen.OpenCL.Heuristics import Futhark.CodeGen.RTS.C (freeListH, openclH) import Futhark.Util (chunk, zEncodeString)-import Futhark.Util.Pretty (prettyOneLine)-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Futhark.Util.Pretty (prettyTextOneLine)+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C  errorMsgNumArgs :: ErrorMsg a -> Int errorMsgNumArgs = length . errorMsgArgTypes@@ -42,7 +41,7 @@         let escapeChar '%' = "%%"             escapeChar c = [c]          in concatMap escapeChar-      onPart (ErrorString s) = printfEscape s+      onPart (ErrorString s) = printfEscape $ T.unpack s       -- FIXME: bogus for non-ints.       onPart ErrorVal {} = "%lld"       onFailure i (FailureMsg emsg@(ErrorMsg parts) backtrace) =@@ -86,9 +85,9 @@    mapM_ GC.earlyDecl top_decls -  let size_name_inits = map (\k -> [C.cinit|$string:(pretty k)|]) $ M.keys sizes-      size_var_inits = map (\k -> [C.cinit|$string:(zEncodeString (pretty k))|]) $ M.keys sizes-      size_class_inits = map (\c -> [C.cinit|$string:(pretty c)|]) $ M.elems sizes+  let size_name_inits = map (\k -> [C.cinit|$string:(prettyString k)|]) $ M.keys sizes+      size_var_inits = map (\k -> [C.cinit|$string:(zEncodeString (prettyString k))|]) $ M.keys sizes+      size_class_inits = map (\c -> [C.cinit|$string:(prettyString c)|]) $ M.elems sizes       num_sizes = M.size sizes    GC.earlyDecl [C.cedecl|static const char *tuning_param_names[] = { $inits:size_name_inits };|]@@ -583,11 +582,11 @@ loadKernel :: (KernelName, KernelSafety) -> C.Stm loadKernel (name, safety) =   [C.cstm|{-  ctx->$id:name = clCreateKernel(prog, $string:(pretty (C.toIdent name mempty)), &error);+  ctx->$id:name = clCreateKernel(prog, $string:(T.unpack (idText (C.toIdent name mempty))), &error);   OPENCL_SUCCEED_FATAL(error);   $items:set_args   if (ctx->debugging) {-    fprintf(ctx->log, "Created kernel %s.\n", $string:(pretty name));+    fprintf(ctx->log, "Created kernel %s.\n", $string:(prettyString name));   }   }|]   where@@ -616,7 +615,7 @@ costCentreReport :: [Name] -> [C.BlockItem] costCentreReport names = report_kernels ++ [report_total]   where-    longest_name = foldl max 0 $ map (length . pretty) names+    longest_name = foldl max 0 $ map (length . prettyString) names     report_kernels = concatMap reportKernel names     format_string name =       let padding = replicate (longest_name - length name) ' '@@ -629,7 +628,7 @@           total_runtime = kernelRuntime name        in [ [C.citem|                str_builder(&builder,-                           $string:(format_string (pretty name)),+                           $string:(format_string (prettyString name)),                            ctx->$id:runs,                            (long int) ctx->$id:total_runtime / (ctx->$id:runs != 0 ? ctx->$id:runs : 1),                            (long int) ctx->$id:total_runtime);@@ -697,7 +696,7 @@ sizeLoggingCode v key x' = do   GC.stm     [C.cstm|if (ctx->logging) {-    fprintf(ctx->log, "Compared %s <= %ld: %s.\n", $string:(prettyOneLine key), (long)$exp:x', $id:v ? "true" : "false");+    fprintf(ctx->log, "Compared %s <= %ld: %s.\n", $string:(T.unpack (prettyTextOneLine key)), (long)$exp:x', $id:v ? "true" : "false");     }|]  -- Options that are common to multiple GPU-like backends.

@@ -1,9 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TupleSections #-}  -- | C code generation for whole programs, built on -- "Futhark.CodeGen.Backends.GenericC.Monad".  Most of this module is@@ -11,7 +6,6 @@ module Futhark.CodeGen.Backends.GenericC   ( compileProg,     compileProg',-    compileFun,     defaultOperations,     CParts (..),     asLibrary,@@ -24,25 +18,26 @@  import Control.Monad.Reader import Control.Monad.State-import qualified Data.DList as DL+import Data.DList qualified as DL import Data.Loc-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Data.Maybe-import qualified Data.Text as T+import Data.Text qualified as T import Futhark.CodeGen.Backends.GenericC.CLI (cliDefs) import Futhark.CodeGen.Backends.GenericC.Code import Futhark.CodeGen.Backends.GenericC.EntryPoints+import Futhark.CodeGen.Backends.GenericC.Fun import Futhark.CodeGen.Backends.GenericC.Monad import Futhark.CodeGen.Backends.GenericC.Options+import Futhark.CodeGen.Backends.GenericC.Pretty import Futhark.CodeGen.Backends.GenericC.Server (serverDefs) import Futhark.CodeGen.Backends.GenericC.Types import Futhark.CodeGen.ImpCode import Futhark.CodeGen.RTS.C (cacheH, contextH, contextPrototypesH, errorsH, halfH, lockH, timingH, utilH)-import qualified Futhark.Manifest as Manifest+import Futhark.Manifest qualified as Manifest import Futhark.MonadFreshNames-import Futhark.Util.Pretty (prettyText)-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C import NeatInterpolation (untrimming)  defCall :: CallCompiler op s@@ -99,76 +94,9 @@     defCompiler _ =       error "The default compiler cannot compile extended operations" -compileFunBody :: [C.Exp] -> [Param] -> Code op -> CompilerM op s ()-compileFunBody output_ptrs outputs code = do-  mapM_ declareOutput outputs-  compileCode code-  zipWithM_ setRetVal' output_ptrs outputs-  where-    declareOutput (MemParam name space) =-      declMem name space-    declareOutput (ScalarParam name pt) = do-      let ctp = primTypeToCType pt-      decl [C.cdecl|$ty:ctp $id:name;|]--    setRetVal' p (MemParam name space) = do-      resetMem [C.cexp|*$exp:p|] space-      setMem [C.cexp|*$exp:p|] name space-    setRetVal' p (ScalarParam name _) =-      stm [C.cstm|*$exp:p = $id:name;|]--compileFun :: [C.BlockItem] -> [C.Param] -> (Name, Function op) -> CompilerM op s (C.Definition, C.Func)-compileFun get_constants extra (fname, func@(Function _ outputs inputs body)) = inNewFunction $ do-  (outparams, out_ptrs) <- unzip <$> mapM compileOutput outputs-  inparams <- mapM compileInput inputs--  cachingMemory (lexicalMemoryUsage func) $ \decl_cached free_cached -> do-    body' <- collect $ compileFunBody out_ptrs outputs body-    decl_mem <- declAllocatedMem-    free_mem <- freeAllocatedMem--    pure-      ( [C.cedecl|static int $id:(funName fname)($params:extra, $params:outparams, $params:inparams);|],-        [C.cfun|static int $id:(funName fname)($params:extra, $params:outparams, $params:inparams) {-               $stms:ignores-               int err = 0;-               $items:decl_cached-               $items:decl_mem-               $items:get_constants-               $items:body'-              cleanup:-               {-               $stms:free_cached-               $items:free_mem-               }-               return err;-  }|]-      )-  where-    -- Ignore all the boilerplate parameters, just in case we don't-    -- actually need to use them.-    ignores = [[C.cstm|(void)$id:p;|] | C.Param (Just p) _ _ _ <- extra]--    compileInput (ScalarParam name bt) = do-      let ctp = primTypeToCType bt-      pure [C.cparam|$ty:ctp $id:name|]-    compileInput (MemParam name space) = do-      ty <- memToCType name space-      pure [C.cparam|$ty:ty $id:name|]--    compileOutput (ScalarParam name bt) = do-      let ctp = primTypeToCType bt-      p_name <- newVName $ "out_" ++ baseString name-      pure ([C.cparam|$ty:ctp *$id:p_name|], [C.cexp|$id:p_name|])-    compileOutput (MemParam name space) = do-      ty <- memToCType name space-      p_name <- newVName $ baseString name ++ "_p"-      pure ([C.cparam|$ty:ty *$id:p_name|], [C.cexp|$id:p_name|])- declsCode :: (HeaderSection -> Bool) -> CompilerState s -> T.Text declsCode p =-  T.unlines-    . map prettyText+  definitionsText     . concatMap (DL.toList . snd)     . filter (p . fst)     . M.toList@@ -477,8 +405,8 @@ $timingH |] -  let early_decls = T.unlines $ map prettyText $ DL.toList $ compEarlyDecls endstate-      lib_decls = T.unlines $ map prettyText $ DL.toList $ compLibDecls endstate+  let early_decls = definitionsText $ DL.toList $ compEarlyDecls endstate+      lib_decls = definitionsText $ DL.toList $ compLibDecls endstate       clidefs = cliDefs options manifest       serverdefs = serverDefs options manifest       libdefs =@@ -551,18 +479,12 @@       generateCommonLibFuns memreport        pure-        ( T.unlines $ map prettyText prototypes,-          T.unlines $ map (prettyText . funcToDef) functions,-          T.unlines $ map prettyText entry_points,+        ( definitionsText prototypes,+          funcsText functions,+          definitionsText entry_points,           Manifest.Manifest (M.fromList entry_points_manifest) type_funs backend version         ) -    funcToDef func = C.FuncDef func loc-      where-        loc = case func of-          C.OldFunc _ _ _ _ _ _ l -> l-          C.Func _ _ _ _ _ l -> l- -- | Compile imperative program to a C program.  Always uses the -- function named "main" as entry point, so make sure it is defined. compileProg ::@@ -727,7 +649,7 @@      constMacro p = ([C.citem|$escstm:def|], [C.citem|$escstm:undef|])       where-        p' = pretty (C.toIdent (paramName p) mempty)+        p' = T.unpack $ idText (C.toIdent (paramName p) mempty)         def = "#define " ++ p' ++ " (" ++ "ctx->constants." ++ p' ++ ")"         undef = "#undef " ++ p' 

@@ -1,9 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TupleSections #-}  -- | Code generation for standalone executables. module Futhark.CodeGen.Backends.GenericC.CLI@@ -12,9 +7,10 @@ where  import Data.List (unzip5)-import qualified Data.Map as M-import qualified Data.Text as T+import Data.Map qualified as M+import Data.Text qualified as T import Futhark.CodeGen.Backends.GenericC.Options+import Futhark.CodeGen.Backends.GenericC.Pretty import Futhark.CodeGen.Backends.SimpleRep   ( cproduct,     primAPIType,@@ -23,9 +19,9 @@   ) import Futhark.CodeGen.RTS.C (tuningH, valuesH) import Futhark.Manifest-import Futhark.Util.Pretty (pretty, prettyText)-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Futhark.Util.Pretty (prettyString)+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C  genericOptions :: [Option] genericOptions =@@ -270,7 +266,11 @@       let info = tname <> "_info"        in [C.cstm|write_scalar(stdout, binary_output, &$id:info, &$exp:e);|]     Just (TypeOpaque desc _ _) ->-      [C.cstm|printf("#<opaque %s>", $string:(T.unpack desc));|]+      [C.cstm|{+         fprintf(stderr, "Values of type \"%s\" have no external representation.\n", $string:(T.unpack desc));+         retval = 1;+         goto print_end;+       }|]     Just (TypeArray _ et rank ops) ->       let et' = uncurry primAPIType $ scalarToPrim et           values_array = arrayValues ops@@ -349,9 +349,10 @@                 $stms:free_input               |]    in ( [C.cedecl|-   static void $id:cli_entry_point_function_name($ty:ctx_ty *ctx) {+   static int $id:cli_entry_point_function_name($ty:ctx_ty *ctx) {      typename int64_t t_start, t_end;      int time_runs = 0, profile_run = 0;+     int retval = 0;       // We do not want to profile all the initialisation.      $id:pause_profiling(ctx);@@ -361,7 +362,7 @@      $items:(mconcat input_items)       if (end_of_input(stdin) != 0) {-       futhark_panic(1, "Expected EOF on stdin after reading input for \"%s\".\n", $string:(pretty entry_point_name));+       futhark_panic(1, "Expected EOF on stdin after reading input for \"%s\".\n", $string:(prettyString entry_point_name));      }       $items:output_decls@@ -392,11 +393,12 @@        }        $stms:printstms      }-+     print_end: {}      $stms:free_outputs+     return retval;    }|],         [C.cinit|{ .name = $string:(T.unpack entry_point_name),-                       .fun = $id:cli_entry_point_function_name }|]+                   .fun = $id:cli_entry_point_function_name }|]       )  {-# NOINLINE cliDefs #-}@@ -411,7 +413,7 @@           map (uncurry (cliEntryPoint manifest)) $             M.toList $               manifestEntryPoints manifest-   in prettyText+   in definitionsText         [C.cunit| $esc:("#include <getopt.h>") $esc:("#include <ctype.h>")@@ -435,7 +437,7 @@  $edecls:cli_entry_point_decls -typedef void entry_point_fun(struct futhark_context*);+typedef int entry_point_fun(struct futhark_context*);  struct entry_point_entry {   const char *name;@@ -443,6 +445,7 @@ };  int main(int argc, char** argv) {+  int retval = 0;   fut_progname = argv[0];    struct futhark_context_config *cfg = futhark_context_config_new();@@ -492,7 +495,7 @@       fprintf(stderr, "Send EOF (CTRL-d) after typing all input values.\n");     } -    entry_point_fun(ctx);+    retval = entry_point_fun(ctx);      if (runtime_file != NULL) {       fclose(runtime_file);@@ -507,5 +510,5 @@    futhark_context_free(ctx);   futhark_context_config_free(cfg);-  return 0;+  return retval; }|]

@@ -1,9 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TupleSections #-}  -- | Translation of ImpCode Exp and Code to C. module Futhark.CodeGen.Backends.GenericC.Code@@ -19,19 +14,20 @@ import Control.Monad.Reader import Data.Loc import Data.Maybe+import Data.Text qualified as T import Futhark.CodeGen.Backends.GenericC.Monad import Futhark.CodeGen.ImpCode import Futhark.IR.Prop (isBuiltInFunction) import Futhark.MonadFreshNames-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C  errorMsgString :: ErrorMsg Exp -> CompilerM op s (String, [C.Exp]) errorMsgString (ErrorMsg parts) = do   let boolStr e = [C.cexp|($exp:e) ? "true" : "false"|]       asLongLong e = [C.cexp|(long long int)$exp:e|]       asDouble e = [C.cexp|(double)$exp:e|]-      onPart (ErrorString s) = pure ("%s", [C.cexp|$string:s|])+      onPart (ErrorString s) = pure ("%s", [C.cexp|$string:(T.unpack s)|])       onPart (ErrorVal Bool x) = ("%s",) . boolStr <$> compileExp x       onPart (ErrorVal Unit _) = pure ("%s", [C.cexp|"()"|])       onPart (ErrorVal (IntType Int8) x) = ("%hhd",) <$> compileExp x@@ -82,7 +78,7 @@   pure [C.cexp|($exp:x' > 0 ? 1 : 0) - ($exp:x' < 0 ? 1 : 0) != 0|] compilePrimExp f (UnOpExp op x) = do   x' <- compilePrimExp f x-  pure [C.cexp|$id:(pretty op)($exp:x')|]+  pure [C.cexp|$id:(prettyString op)($exp:x')|] compilePrimExp f (CmpOpExp cmp x y) = do   x' <- compilePrimExp f x   y' <- compilePrimExp f y@@ -92,10 +88,10 @@     FCmpLe {} -> [C.cexp|$exp:x' <= $exp:y'|]     CmpLlt {} -> [C.cexp|$exp:x' < $exp:y'|]     CmpLle {} -> [C.cexp|$exp:x' <= $exp:y'|]-    _ -> [C.cexp|$id:(pretty cmp)($exp:x', $exp:y')|]+    _ -> [C.cexp|$id:(prettyString cmp)($exp:x', $exp:y')|] compilePrimExp f (ConvOpExp conv x) = do   x' <- compilePrimExp f x-  pure [C.cexp|$id:(pretty conv)($exp:x')|]+  pure [C.cexp|$id:(prettyString conv)($exp:x')|] compilePrimExp f (BinOpExp bop x y) = do   x' <- compilePrimExp f x   y' <- compilePrimExp f y@@ -117,7 +113,7 @@     Or {} -> [C.cexp|$exp:x' | $exp:y'|]     LogAnd {} -> [C.cexp|$exp:x' && $exp:y'|]     LogOr {} -> [C.cexp|$exp:x' || $exp:y'|]-    _ -> [C.cexp|$id:(pretty bop)($exp:x', $exp:y')|]+    _ -> [C.cexp|$id:(prettyString bop)($exp:x', $exp:y')|] compilePrimExp f (FunExp h args _) = do   args' <- mapM (compilePrimExp f) args   pure [C.cexp|$id:(funName (nameFromString h))($args:args')|]@@ -172,7 +168,7 @@ compileCode Skip = pure () compileCode (Comment s code) = do   xs <- collect $ compileCode code-  let comment = "// " ++ s+  let comment = "// " ++ T.unpack s   stm     [C.cstm|$comment:comment               { $items:xs }@@ -229,7 +225,7 @@       asks (opsError . envOperations) <*> pure msg <*> pure stacktrace   stm [C.cstm|if (!$exp:e') { $items:err }|]   where-    stacktrace = prettyStacktrace 0 $ map locStr $ loc : locs+    stacktrace = T.unpack $ prettyStacktrace 0 $ map locText $ loc : locs compileCode (Allocate _ _ ScalarSpace {}) =   -- Handled by the declaration of the memory block, which is   -- translated to an actual array.@@ -330,7 +326,7 @@   let ct = primTypeToCType t   decl [C.cdecl|$tyquals:(volQuals vol) $ty:ct $id:name;|] compileCode (DeclareArray name ScalarSpace {} _ _) =-  error $ "Cannot declare array " ++ pretty name ++ " in scalar space."+  error $ "Cannot declare array " ++ prettyString name ++ " in scalar space." compileCode (DeclareArray name DefaultSpace t vs) = do   name_realtype <- newVName $ baseString name ++ "_realtype"   let ct = primTypeToCType t@@ -348,7 +344,7 @@       [C.cexp|(struct memblock){NULL,                                 (unsigned char*)$id:name_realtype,                                 0,-                                $string:(pretty name)}|]+                                $string:(prettyString name)}|]   item [C.citem|struct memblock $id:name = ctx->$id:name;|] compileCode (DeclareArray name (Space space) t vs) =   join $

@@ -1,9 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TupleSections #-}  -- | Generate the entry point packing/unpacking code. module Futhark.CodeGen.Backends.GenericC.EntryPoints@@ -14,14 +9,14 @@ import Control.Monad.Reader import Data.Char (isAlpha, isAlphaNum) import Data.Maybe-import qualified Data.Text as T+import Data.Text qualified as T import Futhark.CodeGen.Backends.GenericC.Monad import Futhark.CodeGen.Backends.GenericC.Types (opaqueToCType, valueTypeToCType) import Futhark.CodeGen.ImpCode-import qualified Futhark.Manifest as Manifest+import Futhark.Manifest qualified as Manifest import Futhark.Util (zEncodeString)-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C  valueDescToType :: ValueDesc -> ValueType valueDescToType (ScalarValue pt signed _) =

@@ -0,0 +1,83 @@+{-# LANGUAGE QuasiQuotes #-}++-- | C code generation for functions.+module Futhark.CodeGen.Backends.GenericC.Fun+  ( compileFun,+    module Futhark.CodeGen.Backends.GenericC.Monad,+    module Futhark.CodeGen.Backends.GenericC.Code,+  )+where++import Control.Monad.Reader+import Futhark.CodeGen.Backends.GenericC.Code+import Futhark.CodeGen.Backends.GenericC.Monad+import Futhark.CodeGen.ImpCode+import Futhark.MonadFreshNames+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C++compileFunBody :: [C.Exp] -> [Param] -> Code op -> CompilerM op s ()+compileFunBody output_ptrs outputs code = do+  mapM_ declareOutput outputs+  compileCode code+  zipWithM_ setRetVal' output_ptrs outputs+  where+    declareOutput (MemParam name space) =+      declMem name space+    declareOutput (ScalarParam name pt) = do+      let ctp = primTypeToCType pt+      decl [C.cdecl|$ty:ctp $id:name;|]++    setRetVal' p (MemParam name space) = do+      resetMem [C.cexp|*$exp:p|] space+      setMem [C.cexp|*$exp:p|] name space+    setRetVal' p (ScalarParam name _) =+      stm [C.cstm|*$exp:p = $id:name;|]++compileFun :: [C.BlockItem] -> [C.Param] -> (Name, Function op) -> CompilerM op s (C.Definition, C.Func)+compileFun get_constants extra (fname, func@(Function _ outputs inputs body)) = inNewFunction $ do+  (outparams, out_ptrs) <- unzip <$> mapM compileOutput outputs+  inparams <- mapM compileInput inputs++  cachingMemory (lexicalMemoryUsage func) $ \decl_cached free_cached -> do+    body' <- collect $ compileFunBody out_ptrs outputs body+    decl_mem <- declAllocatedMem+    free_mem <- freeAllocatedMem++    pure+      ( [C.cedecl|static int $id:(funName fname)($params:extra, $params:outparams, $params:inparams);|],+        [C.cfun|static int $id:(funName fname)($params:extra, $params:outparams, $params:inparams) {+               $stms:ignores+               int err = 0;+               $items:decl_cached+               $items:decl_mem+               $items:get_constants+               $items:body'+              cleanup:+               {+               $stms:free_cached+               $items:free_mem+               }+               return err;+  }|]+      )+  where+    -- Ignore all the boilerplate parameters, just in case we don't+    -- actually need to use them.+    ignores = [[C.cstm|(void)$id:p;|] | C.Param (Just p) _ _ _ <- extra]++    compileInput (ScalarParam name bt) = do+      let ctp = primTypeToCType bt+      pure [C.cparam|$ty:ctp $id:name|]+    compileInput (MemParam name space) = do+      ty <- memToCType name space+      pure [C.cparam|$ty:ty $id:name|]++    compileOutput (ScalarParam name bt) = do+      let ctp = primTypeToCType bt+      p_name <- newVName $ "out_" ++ baseString name+      pure ([C.cparam|$ty:ctp *$id:p_name|], [C.cexp|$id:p_name|])+    compileOutput (MemParam name space) = do+      ty <- memToCType name space+      p_name <- newVName $ baseString name ++ "_p"+      pure ([C.cparam|$ty:ty *$id:p_name|], [C.cexp|$id:p_name|])

@@ -1,9 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TupleSections #-}  -- | C code generator framework. module Futhark.CodeGen.Backends.GenericC.Monad@@ -89,16 +84,18 @@ import Control.Monad.Reader import Control.Monad.State import Data.Bifunctor (first)-import qualified Data.DList as DL+import Data.DList qualified as DL import Data.List (unzip4) import Data.Loc-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Data.Maybe+import Data.Text qualified as T+import Futhark.CodeGen.Backends.GenericC.Pretty import Futhark.CodeGen.Backends.SimpleRep import Futhark.CodeGen.ImpCode import Futhark.MonadFreshNames-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C  -- How public an array type definition sould be.  Public types show up -- in the generated API, while private types are used only to@@ -522,7 +519,7 @@ setMem :: (C.ToExp a, C.ToExp b) => a -> b -> Space -> CompilerM op s () setMem dest src space = do   refcount <- fatMemory space-  let src_s = pretty $ C.toExp src noLoc+  let src_s = T.unpack $ expText $ C.toExp src noLoc   if refcount     then       stm@@ -547,7 +544,7 @@ unRefMem mem space = do   refcount <- fatMemory space   cached <- isJust <$> cacheMem mem-  let mem_s = pretty $ C.toExp mem noLoc+  let mem_s = T.unpack $ expText $ C.toExp mem noLoc   when (refcount && not cached) $     stm       [C.cstm|if ($id:(fatMemUnRef space)(ctx, &$exp:mem, $string:mem_s) != 0) {@@ -563,7 +560,7 @@   CompilerM op s () allocMem mem size space on_failure = do   refcount <- fatMemory space-  let mem_s = pretty $ C.toExp mem noLoc+  let mem_s = T.unpack $ expText $ C.toExp mem noLoc   if refcount     then       stm@@ -603,7 +600,7 @@   let cached = M.keys $ M.filter (== DefaultSpace) lexical    cached' <- forM cached $ \mem -> do-    size <- newVName $ pretty mem <> "_cached_size"+    size <- newVName $ prettyString mem <> "_cached_size"     pure (mem, size)    let lexMem env =

@@ -15,8 +15,8 @@ import Data.Function ((&)) import Data.List (intercalate) import Data.Maybe-import qualified Language.C.Quote.C as C-import qualified Language.C.Syntax as C+import Language.C.Quote.C qualified as C+import Language.C.Syntax qualified as C  -- | Specification if a single command line option.  The option must -- have a long name, and may also have a short name.@@ -34,7 +34,7 @@ -- | Whether an option accepts an argument. data OptionArgument   = NoArgument-  | -- | The 'String' becomes part of the help text.+  | -- | The 'String' becomes part of the help pretty.     RequiredArgument String   | OptionalArgument @@ -114,7 +114,7 @@       [C.cinit| { $string:(optionLongName option), $id:arg, NULL, $int:i } |]       where         arg = case optionArgument option of-          NoArgument -> "no_argument"+          NoArgument -> "no_argument" :: String           RequiredArgument _ -> "required_argument"           OptionalArgument -> "optional_argument" 

@@ -0,0 +1,33 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | Compatibility shims for mainland-pretty; the prettyprinting+-- library used by language-c-quote.+module Futhark.CodeGen.Backends.GenericC.Pretty+  ( expText,+    definitionsText,+    typeText,+    idText,+    funcsText,+  )+where++import Data.Text qualified as T+import Language.C.Pretty ()+import Language.C.Syntax qualified as C+import Text.PrettyPrint.Mainland qualified as MPP+import Text.PrettyPrint.Mainland.Class qualified as MPP++expText :: C.Exp -> T.Text+expText = T.pack . MPP.pretty 8000 . MPP.ppr++definitionsText :: [C.Definition] -> T.Text+definitionsText = T.unlines . map (T.pack . MPP.pretty 8000 . MPP.ppr)++typeText :: C.Type -> T.Text+typeText = T.pack . MPP.pretty 8000 . MPP.ppr++idText :: C.Id -> T.Text+idText = T.pack . MPP.pretty 8000 . MPP.ppr++funcsText :: [C.Func] -> T.Text+funcsText = T.unlines . map (T.pack . MPP.pretty 8000 . MPP.ppr)

@@ -1,9 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TupleSections #-}  -- | Code generation for server executables. module Futhark.CodeGen.Backends.GenericC.Server@@ -12,16 +7,16 @@ where  import Data.Bifunctor (first, second)-import qualified Data.Map as M-import qualified Data.Text as T+import Data.Map qualified as M+import Data.Text qualified as T import Futhark.CodeGen.Backends.GenericC.Options+import Futhark.CodeGen.Backends.GenericC.Pretty import Futhark.CodeGen.Backends.SimpleRep import Futhark.CodeGen.RTS.C (serverH, tuningH, valuesH) import Futhark.Manifest import Futhark.Util (zEncodeString)-import Futhark.Util.Pretty (prettyText)-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C import Language.Futhark.Core (nameFromText)  genericOptions :: [Option]@@ -321,7 +316,7 @@         generateOptionParser "parse_options" $ genericOptions ++ options       (boilerplate_defs, type_inits, entry_point_inits) =         mkBoilerplate manifest-   in prettyText+   in definitionsText         [C.cunit| $esc:("#include <getopt.h>") $esc:("#include <ctype.h>")

@@ -1,9 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TupleSections #-}  -- | Code generation for public API types. module Futhark.CodeGen.Backends.GenericC.Types@@ -16,16 +11,16 @@ import Control.Monad.Reader import Control.Monad.State import Data.Char (isDigit)-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Data.Maybe-import qualified Data.Text as T+import Data.Text qualified as T import Futhark.CodeGen.Backends.GenericC.Monad+import Futhark.CodeGen.Backends.GenericC.Pretty import Futhark.CodeGen.ImpCode-import qualified Futhark.Manifest as Manifest+import Futhark.Manifest qualified as Manifest import Futhark.Util (chunks, mapAccumLM)-import Futhark.Util.Pretty (prettyText)-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C  opaqueToCType :: String -> CompilerM op s C.Type opaqueToCType desc = do@@ -545,7 +540,7 @@       pure $         Just           ( pretty_name,-            Manifest.TypeArray (prettyText arr_type) pt_name rank ops+            Manifest.TypeArray (typeText arr_type) pt_name rank ops           )     Private ->       pure Nothing@@ -560,7 +555,7 @@   libDecl [C.cedecl|struct $id:name { $sdecls:members };|]   (ops, record) <- opaqueLibraryFunctions types desc ot   let opaque_type = [C.cty|struct $id:name*|]-  pure (T.pack desc, Manifest.TypeOpaque (prettyText opaque_type) ops record)+  pure (T.pack desc, Manifest.TypeOpaque (typeText opaque_type) ops record)   where     field vt@(ValueType _ (Rank r) _) i = do       ct <- valueTypeToCType Private vt

@@ -1,7 +1,3 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}- -- | A generic Python code generator which is polymorphic in the type -- of the operations.  Concretely, we use this to handle both -- sequential and PyOpenCL Python code.@@ -48,19 +44,19 @@  import Control.Monad.Identity import Control.Monad.RWS-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe-import qualified Data.Text as T+import Data.Text qualified as T import Futhark.CodeGen.Backends.GenericPython.AST import Futhark.CodeGen.Backends.GenericPython.Options-import qualified Futhark.CodeGen.ImpCode as Imp+import Futhark.CodeGen.ImpCode qualified as Imp import Futhark.CodeGen.RTS.Python import Futhark.Compiler.Config (CompilerMode (..)) import Futhark.IR.Prop (isBuiltInFunction, subExpVars) import Futhark.IR.Syntax.Core (Space (..)) import Futhark.MonadFreshNames import Futhark.Util (zEncodeString)-import Futhark.Util.Pretty (pretty, prettyText)+import Futhark.Util.Pretty (prettyString, prettyText) import Language.Futhark.Primitive hiding (Bool)  -- | A substitute expression compiler, tried before the main@@ -498,7 +494,7 @@         Index (Var "self.constants") $           IdxExp $             String $-              pretty $+              prettyString $                 Imp.paramName p  compileConstants :: Imp.Constants op -> CompilerM op s ()@@ -525,7 +521,7 @@ simpleCall fname = Call (Var fname) . map Arg  compileName :: VName -> String-compileName = zEncodeString . pretty+compileName = zEncodeString . prettyString  compileDim :: Imp.DimSize -> CompilerM op s PyExp compileDim (Imp.Constant v) = pure $ compilePrimValue v@@ -553,7 +549,7 @@  entryPointOutput :: Imp.ExternalValue -> CompilerM op s PyExp entryPointOutput (Imp.OpaqueValue desc vs) =-  simpleCall "opaque" . (String (pretty desc) :)+  simpleCall "opaque" . (String (prettyString desc) :)     <$> mapM (entryPointOutput . Imp.TransparentValue) vs entryPointOutput (Imp.TransparentValue (Imp.ScalarValue bt ept name)) = do   name' <- compileVar name@@ -721,7 +717,7 @@ extValueDescName (Imp.TransparentValue v) = extName $ valueDescName v extValueDescName (Imp.OpaqueValue desc []) = extName $ zEncodeString desc extValueDescName (Imp.OpaqueValue desc (v : _)) =-  extName $ zEncodeString desc ++ "_" ++ pretty (baseTag (valueDescVName v))+  extName $ zEncodeString desc ++ "_" ++ prettyString (baseTag (valueDescVName v))  extName :: String -> String extName = (++ "_ext")@@ -782,7 +778,7 @@         ]     printValue' (Imp.TransparentValue (Imp.ArrayValue mem (Space _) bt ept shape)) e =       printValue' (Imp.TransparentValue (Imp.ArrayValue mem DefaultSpace bt ept shape)) $-        simpleCall (pretty e ++ ".get") []+        simpleCall (prettyString e ++ ".get") []     printValue' (Imp.TransparentValue _) e =       pure         [ Exp $@@ -907,10 +903,10 @@   (map descArg args, map desc res)   where     descArg ((_, u), d) = desc (u, d)-    desc (u, Imp.OpaqueValue d _) = pretty u <> d-    desc (u, Imp.TransparentValue (Imp.ScalarValue pt s _)) = pretty u <> readTypeEnum pt s+    desc (u, Imp.OpaqueValue d _) = prettyString u <> d+    desc (u, Imp.TransparentValue (Imp.ScalarValue pt s _)) = prettyString u <> readTypeEnum pt s     desc (u, Imp.TransparentValue (Imp.ArrayValue _ _ pt s dims)) =-      pretty u <> concat (replicate (length dims) "[]") <> readTypeEnum pt s+      prettyString u <> concat (replicate (length dims) "[]") <> readTypeEnum pt s  callEntryFun ::   [PyStmt] ->@@ -922,7 +918,7 @@   (_, prepare_in, body_bin, _, res) <- prepareEntry entry fun    let str_input = map (readInput . snd) decl_args-      end_of_input = [Exp $ simpleCall "end_of_input" [String $ pretty fname]]+      end_of_input = [Exp $ simpleCall "end_of_input" [String $ prettyString fname]]        exitcall = [Exp $ simpleCall "sys.exit" [Field (String "Assertion.{} failed") "format(e)"]]       except' = Catch (Var "AssertionError") exitcall@@ -1139,10 +1135,10 @@     Shl {} -> simple "<<"     LogAnd {} -> simple "and"     LogOr {} -> simple "or"-    _ -> pure $ simpleCall (pretty op) [x', y']+    _ -> pure $ simpleCall (prettyString op) [x', y'] compilePrimExp f (Imp.ConvOpExp conv x) = do   x' <- compilePrimExp f x-  pure $ simpleCall (pretty conv) [x']+  pure $ simpleCall (prettyString conv) [x'] compilePrimExp f (Imp.CmpOpExp cmp x y) = do   (x', y', simple) <- compileBinOpLike f x y   case cmp of@@ -1151,18 +1147,18 @@     FCmpLe {} -> simple "<="     CmpLlt -> simple "<"     CmpLle -> simple "<="-    _ -> pure $ simpleCall (pretty cmp) [x', y']+    _ -> pure $ simpleCall (prettyString cmp) [x', y'] compilePrimExp f (Imp.UnOpExp op exp1) =   UnOp (compileUnOp op) <$> compilePrimExp f exp1 compilePrimExp f (Imp.FunExp h args _) =-  simpleCall (futharkFun (pretty h)) <$> mapM (compilePrimExp f) args+  simpleCall (futharkFun (prettyString h)) <$> mapM (compilePrimExp f) args  compileExp :: Imp.Exp -> CompilerM op s PyExp compileExp = compilePrimExp compileVar  errorMsgString :: Imp.ErrorMsg Imp.Exp -> CompilerM op s (String, [PyExp]) errorMsgString (Imp.ErrorMsg parts) = do-  let onPart (Imp.ErrorString s) = pure ("%s", String s)+  let onPart (Imp.ErrorString s) = pure ("%s", String $ T.unpack s)       onPart (Imp.ErrorVal IntType {} x) = ("%d",) <$> compileExp x       onPart (Imp.ErrorVal FloatType {} x) = ("%f",) <$> compileExp x       onPart (Imp.ErrorVal Imp.Bool x) = ("%r",) <$> compileExp x@@ -1193,8 +1189,8 @@   bound' <- compileExp bound   let i' = compileName i   body' <- collect $ compileCode body-  counter <- pretty <$> newVName "counter"-  one <- pretty <$> newVName "one"+  counter <- prettyString <$> newVName "counter"+  one <- prettyString <$> newVName "one"   stm $ Assign (Var i') $ simpleCall (compilePrimToNp (Imp.primExpType bound)) [Integer 0]   stm $ Assign (Var one) $ simpleCall (compilePrimToNp (Imp.primExpType bound)) [Integer 1]   stm $@@ -1241,7 +1237,7 @@   stm $ Assign name' $ Field (Var "self") (compileName name) compileCode (Imp.Comment s code) = do   code' <- collect $ compileCode code-  stm $ Comment s code'+  stm $ Comment (T.unpack s) code' compileCode (Imp.Assert e msg (loc, locs)) = do   e' <- compileExp e   (formatstr, formatargs) <- errorMsgString msg@@ -1254,13 +1250,13 @@           (Tuple formatargs)       )   where-    stacktrace = prettyStacktrace 0 $ map locStr $ loc : locs+    stacktrace = T.unpack $ prettyStacktrace 0 $ map locText $ loc : locs compileCode (Imp.Call dests fname args) = do   args' <- mapM compileArg args   dests' <- tupleOrSingle <$> mapM compileVar dests   let fname'-        | isBuiltInFunction fname = futharkFun (pretty fname)-        | otherwise = "self." ++ futharkFun (pretty fname)+        | isBuiltInFunction fname = futharkFun (prettyString fname)+        | otherwise = "self." ++ futharkFun (prettyString fname)       call' = simpleCall fname' args'   -- If the function returns nothing (is called only for side   -- effects), take care not to assign to an empty tuple.

@@ -11,7 +11,7 @@   ) where -import qualified Data.Text as T+import Data.Text qualified as T import Futhark.Util.Pretty import Language.Futhark.Core @@ -92,116 +92,116 @@   deriving (Eq, Show)  instance Pretty PyIdx where-  ppr (IdxExp e) = ppr e-  ppr (IdxRange from to) = ppr from <> text ":" <> ppr to+  pretty (IdxExp e) = pretty e+  pretty (IdxRange from to) = pretty from <> ":" <> pretty to  instance Pretty PyArg where-  ppr (ArgKeyword k e) = text k <> equals <> ppr e-  ppr (Arg e) = ppr e+  pretty (ArgKeyword k e) = pretty k <> equals <> pretty e+  pretty (Arg e) = pretty e  instance Pretty PyExp where-  ppr (Integer x) = ppr x-  ppr (Bool x) = ppr x-  ppr (Float x)-    | isInfinite x = text $ if x > 0 then "float('inf')" else "float('-inf')"-    | otherwise = ppr x-  ppr (String x) = text $ show x-  ppr (RawStringLiteral s) = text "\"\"\"" <> strictText s <> text "\"\"\""-  ppr (Var n) = text $ map (\x -> if x == '\'' then 'm' else x) n-  ppr (Field e s) = ppr e <> text "." <> text s-  ppr (BinOp s e1 e2) = parens (ppr e1 <+> text s <+> ppr e2)-  ppr (UnOp s e) = text s <> parens (ppr e)-  ppr (Cond e1 e2 e3) = ppr e2 <+> text "if" <+> ppr e1 <+> text "else" <+> ppr e3-  ppr (Cast src bt) =-    text "ct.cast"+  pretty (Integer x) = pretty x+  pretty (Bool x) = pretty x+  pretty (Float x)+    | isInfinite x = if x > 0 then "float('inf')" else "float('-inf')"+    | otherwise = pretty x+  pretty (String x) = pretty $ show x+  pretty (RawStringLiteral s) = "\"\"\"" <> pretty s <> "\"\"\""+  pretty (Var n) = pretty $ map (\x -> if x == '\'' then 'm' else x) n+  pretty (Field e s) = pretty e <> "." <> pretty s+  pretty (BinOp s e1 e2) = parens (pretty e1 <+> pretty s <+> pretty e2)+  pretty (UnOp s e) = pretty s <> parens (pretty e)+  pretty (Cond e1 e2 e3) = pretty e2 <+> "if" <+> pretty e1 <+> "else" <+> pretty e3+  pretty (Cast src bt) =+    "ct.cast"       <> parens-        ( ppr src <> text ","-            <+> text "ct.POINTER" <> parens (text bt)+        ( pretty src <> ","+            <+> "ct.POINTER" <> parens (pretty bt)         )-  ppr (Index src idx) = ppr src <> brackets (ppr idx)-  ppr (Call fun exps) = ppr fun <> parens (commasep $ map ppr exps)-  ppr (Tuple [dim]) = parens (ppr dim <> text ",")-  ppr (Tuple dims) = parens (commasep $ map ppr dims)-  ppr (List es) = brackets $ commasep $ map ppr es-  ppr (Dict kvs) = braces $ commasep $ map ppElem kvs+  pretty (Index src idx) = pretty src <> brackets (pretty idx)+  pretty (Call fun exps) = pretty fun <> parens (commasep $ map pretty exps)+  pretty (Tuple [dim]) = parens (pretty dim <> ",")+  pretty (Tuple dims) = parens (commasep $ map pretty dims)+  pretty (List es) = brackets $ commasep $ map pretty es+  pretty (Dict kvs) = braces $ commasep $ map ppElem kvs     where-      ppElem (k, v) = ppr k <> colon <+> ppr v-  ppr (Lambda p e) = text "lambda" <+> text p <> text ":" <+> ppr e-  ppr None = text "None"+      ppElem (k, v) = pretty k <> colon <+> pretty v+  pretty (Lambda p e) = "lambda" <+> pretty p <> ":" <+> pretty e+  pretty None = "None"  instance Pretty PyStmt where-  ppr (If cond [] []) =-    text "if"-      <+> ppr cond <> text ":"-      </> indent 2 (text "pass")-  ppr (If cond [] fbranch) =-    text "if"-      <+> ppr cond <> text ":"-      </> indent 2 (text "pass")-      </> text "else:"-      </> indent 2 (stack $ map ppr fbranch)-  ppr (If cond tbranch []) =-    text "if"-      <+> ppr cond <> text ":"-      </> indent 2 (stack $ map ppr tbranch)-  ppr (If cond tbranch fbranch) =-    text "if"-      <+> ppr cond <> text ":"-      </> indent 2 (stack $ map ppr tbranch)-      </> text "else:"-      </> indent 2 (stack $ map ppr fbranch)-  ppr (Try pystms pyexcepts) =-    text "try:"-      </> indent 2 (stack $ map ppr pystms)-      </> stack (map ppr pyexcepts)-  ppr (While cond body) =-    text "while"-      <+> ppr cond <> text ":"-      </> indent 2 (stack $ map ppr body)-  ppr (For i what body) =-    text "for"-      <+> ppr i-      <+> text "in"-      <+> ppr what <> text ":"-      </> indent 2 (stack $ map ppr body)-  ppr (With what body) =-    text "with"-      <+> ppr what <> text ":"-      </> indent 2 (stack $ map ppr body)-  ppr (Assign e1 e2) = ppr e1 <+> text "=" <+> ppr e2-  ppr (AssignOp op e1 e2) = ppr e1 <+> text (op ++ "=") <+> ppr e2-  ppr (Comment s body) = text "#" <> text s </> stack (map ppr body)-  ppr (Assert e1 e2) = text "assert" <+> ppr e1 <> text "," <+> ppr e2-  ppr (Raise e) = text "raise" <+> ppr e-  ppr (Exp c) = ppr c-  ppr (Return e) = text "return" <+> ppr e-  ppr Pass = text "pass"-  ppr (Import from (Just as)) =-    text "import" <+> text from <+> text "as" <+> text as-  ppr (Import from Nothing) =-    text "import" <+> text from-  ppr (FunDef d) = ppr d-  ppr (ClassDef d) = ppr d-  ppr (Escape s) = stack $ map strictText $ T.lines s+  pretty (If cond [] []) =+    "if"+      <+> pretty cond <> ":"+      </> indent 2 "pass"+  pretty (If cond [] fbranch) =+    "if"+      <+> pretty cond <> ":"+      </> indent 2 "pass"+      </> "else:"+      </> indent 2 (stack $ map pretty fbranch)+  pretty (If cond tbranch []) =+    "if"+      <+> pretty cond <> ":"+      </> indent 2 (stack $ map pretty tbranch)+  pretty (If cond tbranch fbranch) =+    "if"+      <+> pretty cond <> ":"+      </> indent 2 (stack $ map pretty tbranch)+      </> "else:"+      </> indent 2 (stack $ map pretty fbranch)+  pretty (Try pystms pyexcepts) =+    "try:"+      </> indent 2 (stack $ map pretty pystms)+      </> stack (map pretty pyexcepts)+  pretty (While cond body) =+    "while"+      <+> pretty cond <> ":"+      </> indent 2 (stack $ map pretty body)+  pretty (For i what body) =+    "for"+      <+> pretty i+      <+> "in"+      <+> pretty what <> ":"+      </> indent 2 (stack $ map pretty body)+  pretty (With what body) =+    "with"+      <+> pretty what <> ":"+      </> indent 2 (stack $ map pretty body)+  pretty (Assign e1 e2) = pretty e1 <+> "=" <+> pretty e2+  pretty (AssignOp op e1 e2) = pretty e1 <+> pretty (op ++ "=") <+> pretty e2+  pretty (Comment s body) = "#" <> pretty s </> stack (map pretty body)+  pretty (Assert e1 e2) = "assert" <+> pretty e1 <> "," <+> pretty e2+  pretty (Raise e) = "raise" <+> pretty e+  pretty (Exp c) = pretty c+  pretty (Return e) = "return" <+> pretty e+  pretty Pass = "pass"+  pretty (Import from (Just as)) =+    "import" <+> pretty from <+> "as" <+> pretty as+  pretty (Import from Nothing) =+    "import" <+> pretty from+  pretty (FunDef d) = pretty d+  pretty (ClassDef d) = pretty d+  pretty (Escape s) = stack $ map pretty $ T.lines s  instance Pretty PyFunDef where-  ppr (Def fname params body) =-    text "def"-      <+> text fname <> parens (commasep $ map ppr params) <> text ":"-      </> indent 2 (stack (map ppr body))+  pretty (Def fname params body) =+    "def"+      <+> pretty fname <> parens (commasep $ map pretty params) <> ":"+      </> indent 2 (stack (map pretty body))  instance Pretty PyClassDef where-  ppr (Class cname body) =-    text "class"-      <+> text cname <> text ":"-      </> indent 2 (stack (map ppr body))+  pretty (Class cname body) =+    "class"+      <+> pretty cname <> ":"+      </> indent 2 (stack (map pretty body))  instance Pretty PyExcept where-  ppr (Catch pyexp stms) =-    text "except"-      <+> ppr pyexp-      <+> text "as e:"-      </> indent 2 (stack $ map ppr stms)+  pretty (Catch pyexp stms) =+    "except"+      <+> pretty pyexp+      <+> "as e:"+      </> indent 2 (vsep $ map pretty stms)  instance Pretty PyProg where-  ppr (PyProg stms) = stack (map ppr stms)+  pretty (PyProg stms) = vsep (map pretty stms)

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}  module Futhark.CodeGen.Backends.GenericWASM@@ -17,10 +16,10 @@ where  import Data.List (intercalate, nub)-import qualified Data.Text as T-import qualified Futhark.CodeGen.Backends.GenericC as GC+import Data.Text qualified as T+import Futhark.CodeGen.Backends.GenericC qualified as GC import Futhark.CodeGen.Backends.SimpleRep (opaqueName)-import qualified Futhark.CodeGen.ImpCode.Sequential as Imp+import Futhark.CodeGen.ImpCode.Sequential qualified as Imp import Futhark.CodeGen.RTS.JavaScript import Language.Futhark.Primitive import NeatInterpolation (text)

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}  -- | C code generator.  This module can convert a correct ImpCode@@ -31,19 +30,19 @@  import Control.Monad import Data.Loc-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe-import qualified Data.Text as T-import qualified Futhark.CodeGen.Backends.GenericC as GC+import Data.Text qualified as T+import Futhark.CodeGen.Backends.GenericC qualified as GC import Futhark.CodeGen.Backends.GenericC.Options import Futhark.CodeGen.Backends.SimpleRep import Futhark.CodeGen.ImpCode.Multicore hiding (ValueType)-import qualified Futhark.CodeGen.ImpGen.Multicore as ImpGen+import Futhark.CodeGen.ImpGen.Multicore qualified as ImpGen import Futhark.CodeGen.RTS.C (schedulerH) import Futhark.IR.MCMem (MCMem, Prog) import Futhark.MonadFreshNames-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C  -- | Compile the program to ImpCode with multicore operations. compileProg ::@@ -272,11 +271,11 @@  closureFreeStructField :: VName -> Name closureFreeStructField v =-  nameFromString "free_" <> nameFromString (pretty v)+  nameFromString "free_" <> nameFromString (prettyString v)  closureRetvalStructField :: VName -> Name closureRetvalStructField v =-  nameFromString "retval_" <> nameFromString (pretty v)+  nameFromString "retval_" <> nameFromString (prettyString v)  data ValueType = Prim PrimType | MemBlock | RawMem @@ -337,7 +336,7 @@        in [C.cdecl|$ty:ty $id:name = $exp:(fromStorage pt inner);|]     field name (ty, _) =       [C.cdecl|$ty:ty $id:name =-                 {.desc = $string:(pretty name),+                 {.desc = $string:(prettyString name),                  .mem = $id:struct->$id:(closureRetvalStructField name),                  .size = 0, .references = NULL};|] @@ -354,7 +353,7 @@        in [C.cdecl|$ty:ty $id:name = $exp:(fromStorage pt inner);|]     field name (ty, _) =       [C.cdecl|$ty:ty $id:name =-                 {.desc = $string:(pretty name),+                 {.desc = $string:(prettyString name),                   .mem = $id:struct->$id:(closureFreeStructField name),                   .size = 0, .references = NULL};|] 

@@ -1,5 +1,3 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}  -- | C code generator.  This module can convert a correct ImpCode@@ -20,24 +18,24 @@ import Control.Monad.Reader import Control.Monad.State import Data.Bifunctor-import qualified Data.DList as DL+import Data.DList qualified as DL import Data.List (unzip4) import Data.Loc (noLoc)-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe-import qualified Data.Text as T-import qualified Futhark.CodeGen.Backends.GenericC as GC-import qualified Futhark.CodeGen.Backends.MulticoreC as MC+import Data.Text qualified as T+import Futhark.CodeGen.Backends.GenericC qualified as GC+import Futhark.CodeGen.Backends.GenericC.Pretty+import Futhark.CodeGen.Backends.MulticoreC qualified as MC import Futhark.CodeGen.Backends.SimpleRep import Futhark.CodeGen.ImpCode.Multicore-import qualified Futhark.CodeGen.ImpGen.Multicore as ImpGen+import Futhark.CodeGen.ImpGen.Multicore qualified as ImpGen import Futhark.CodeGen.RTS.C (errorsH, ispcUtilH, uniformH) import Futhark.IR.MCMem (MCMem, Prog) import Futhark.IR.Prop (isBuiltInFunction) import Futhark.MonadFreshNames-import Futhark.Util.Pretty (prettyText)-import qualified Language.C.Quote.OpenCL as C-import qualified Language.C.Syntax as C+import Language.C.Quote.OpenCL qualified as C+import Language.C.Syntax qualified as C import NeatInterpolation (untrimming)  type ISPCCompilerM a = GC.CompilerM Multicore ISPCState a@@ -85,7 +83,7 @@       )       (ws, defs) -  let ispc_decls = T.unlines $ map prettyText $ DL.toList $ sDefs $ GC.compUserState endstate+  let ispc_decls = definitionsText $ DL.toList $ sDefs $ GC.compUserState endstate    -- The bool #define is a workaround around an ISPC bug, stdbool doesn't get included.   let ispcdefs =@@ -180,7 +178,7 @@ -- | Set memory in ISPC setMem :: (C.ToExp a, C.ToExp b) => a -> b -> Space -> ISPCCompilerM () setMem dest src space = do-  let src_s = pretty $ C.toExp src noLoc+  let src_s = T.unpack $ expText $ C.toExp src noLoc   strlit <- makeStringLiteral src_s   GC.stm     [C.cstm|if ($id:(GC.fatMemSet space)(ctx, &$exp:dest, &$exp:src,@@ -192,7 +190,7 @@ unRefMem :: C.ToExp a => a -> Space -> ISPCCompilerM () unRefMem mem space = do   cached <- isJust <$> GC.cacheMem mem-  let mem_s = pretty $ C.toExp mem noLoc+  let mem_s = T.unpack $ expText $ C.toExp mem noLoc   strlit <- makeStringLiteral mem_s   unless cached $     GC.stm@@ -209,13 +207,12 @@   C.Stm ->   ISPCCompilerM () allocMem mem size space on_failure = do-  let mem_s = pretty $ C.toExp mem noLoc+  let mem_s = T.unpack $ expText $ C.toExp mem noLoc   strlit <- makeStringLiteral mem_s   GC.stm-    [C.cstm|if ($id:(GC.fatMemAlloc space)(ctx, &$exp:mem, $exp:size,-                                              $id:strlit())) {+    [C.cstm|if ($id:(GC.fatMemAlloc space)(ctx, &$exp:mem, $exp:size, $id:strlit())) {                     $stm:on_failure-                  }|]+            }|]  -- | Free memory in ISPC freeAllocatedMem :: ISPCCompilerM [C.BlockItem]@@ -388,7 +385,7 @@   let args' = map (\x -> [C.cexp|extract($exp:x, $id:uni)|]) args   GC.items     [C.citems|-      $escstm:("foreach_active(" <> pretty uni <> ")")+      $escstm:("foreach_active(" <> prettyString uni <> ")")       {         $id:shim(ctx, $args:args');         err = FUTHARK_PROGRAM_ERROR;@@ -422,11 +419,11 @@ compileExp e@(ValueExp (FloatValue (Float64Value v))) =   if isInfinite v || isNaN v     then GC.compileExp e-    else pure [C.cexp|$esc:(pretty v <> "d")|]+    else pure [C.cexp|$esc:(prettyString v <> "d")|] compileExp e@(ValueExp (FloatValue (Float16Value v))) =   if isInfinite v || isNaN v     then GC.compileExp e-    else pure [C.cexp|$esc:(pretty v <> "f16")|]+    else pure [C.cexp|$esc:(prettyString v <> "f16")|] compileExp (ValueExp val) =   pure $ C.toExp val mempty compileExp (LeafExp v _) =@@ -451,7 +448,7 @@   pure [C.cexp|($exp:x' > 0 ? 1 : 0) - ($exp:x' < 0 ? 1 : 0) != 0|] compileExp (UnOpExp op x) = do   x' <- compileExp x-  pure [C.cexp|$id:(pretty op)($exp:x')|]+  pure [C.cexp|$id:(prettyString op)($exp:x')|] compileExp (CmpOpExp cmp x y) = do   x' <- compileExp x   y' <- compileExp y@@ -461,10 +458,10 @@     FCmpLe {} -> [C.cexp|$exp:x' <= $exp:y'|]     CmpLlt {} -> [C.cexp|$exp:x' < $exp:y'|]     CmpLle {} -> [C.cexp|$exp:x' <= $exp:y'|]-    _ -> [C.cexp|$id:(pretty cmp)($exp:x', $exp:y')|]+    _ -> [C.cexp|$id:(prettyString cmp)($exp:x', $exp:y')|] compileExp (ConvOpExp conv x) = do   x' <- compileExp x-  pure [C.cexp|$id:(pretty conv)($exp:x')|]+  pure [C.cexp|$id:(prettyString conv)($exp:x')|] compileExp (BinOpExp bop x y) = do   x' <- compileExp x   y' <- compileExp y@@ -481,7 +478,7 @@     Or {} -> [C.cexp|$exp:x' | $exp:y'|]     LogAnd {} -> [C.cexp|$exp:x' && $exp:y'|]     LogOr {} -> [C.cexp|$exp:x' || $exp:y'|]-    _ -> [C.cexp|$id:(pretty bop)($exp:x', $exp:y')|]+    _ -> [C.cexp|$id:(prettyString bop)($exp:x', $exp:y')|] compileExp (FunExp h args _) = do   args' <- mapM compileExp args   pure [C.cexp|$id:(funName (nameFromString h))($args:args')|]@@ -493,7 +490,7 @@ compileCode :: MCCode -> ISPCCompilerM () compileCode (Comment s code) = do   xs <- GC.collect $ compileCode code-  let comment = "// " ++ s+  let comment = "// " ++ T.unpack s   GC.stm     [C.cstm|$comment:comment               { $items:xs }@@ -654,7 +651,7 @@   err <- GC.collect $ handleError msg stacktrace   GC.stm [C.cstm|if (!$exp:e') { $items:err }|]   where-    stacktrace = prettyStacktrace 0 $ map locStr $ loc : locs+    stacktrace = T.unpack $ prettyStacktrace 0 $ map locText $ loc : locs compileCode code =   GC.compileCode code @@ -724,7 +721,7 @@       let inner = [C.cexp|$id:struct'->$id:(MC.closureFreeStructField name)|]       pure [C.citems|$tyqual:uniform $ty:ty $id:name = $exp:(fromStorage pt inner);|]     field name (_, _) = do-      strlit <- makeStringLiteral $ pretty name+      strlit <- makeStringLiteral $ prettyString name       pure         [C.citems|$tyqual:uniform struct memblock $id:name;                      $id:name.desc = $id:strlit();@@ -928,7 +925,7 @@     else       GC.stms         [C.cstms|-      $escstm:("foreach (" <> pretty i <> " = " <> pretty from' <> " ... " <> pretty bound' <> ")") {+      $escstm:(T.unpack ("foreach (" <> prettyText i <> " = " <> expText from' <> " ... " <> expText bound' <> ")")) {         $items:body'       }|] compileOp (ForEachActive name body) = do@@ -961,7 +958,7 @@   let cached = M.keys $ M.filter (== DefaultSpace) lexical    cached' <- forM cached $ \mem -> do-    size <- newVName $ pretty mem <> "_cached_size"+    size <- newVName $ prettyString mem <> "_cached_size"     pure (mem, size)    let lexMem env =

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- -- | C code generator.  This module can convert a correct ImpCode -- program to an equivalent C program.  This C program is expected to -- be converted to WebAssembly, so we also produce the intended@@ -16,12 +14,12 @@ where  import Data.Maybe-import qualified Data.Text as T-import qualified Futhark.CodeGen.Backends.GenericC as GC+import Data.Text qualified as T+import Futhark.CodeGen.Backends.GenericC qualified as GC import Futhark.CodeGen.Backends.GenericWASM-import qualified Futhark.CodeGen.Backends.MulticoreC as MC-import qualified Futhark.CodeGen.ImpCode.Multicore as Imp-import qualified Futhark.CodeGen.ImpGen.Multicore as ImpGen+import Futhark.CodeGen.Backends.MulticoreC qualified as MC+import Futhark.CodeGen.ImpCode.Multicore qualified as Imp+import Futhark.CodeGen.ImpGen.Multicore qualified as ImpGen import Futhark.IR.MCMem import Futhark.MonadFreshNames 

@@ -1,6 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TupleSections #-}- -- | Code generation for Python with OpenCL. module Futhark.CodeGen.Backends.PyOpenCL   ( compileProg,@@ -8,19 +5,19 @@ where  import Control.Monad-import qualified Data.Map as M-import qualified Data.Text as T-import qualified Futhark.CodeGen.Backends.GenericPython as Py+import Data.Map qualified as M+import Data.Text qualified as T+import Futhark.CodeGen.Backends.GenericPython qualified as Py import Futhark.CodeGen.Backends.GenericPython.AST import Futhark.CodeGen.Backends.GenericPython.Options import Futhark.CodeGen.Backends.PyOpenCL.Boilerplate-import qualified Futhark.CodeGen.ImpCode.OpenCL as Imp-import qualified Futhark.CodeGen.ImpGen.OpenCL as ImpGen+import Futhark.CodeGen.ImpCode.OpenCL qualified as Imp+import Futhark.CodeGen.ImpGen.OpenCL qualified as ImpGen import Futhark.CodeGen.RTS.Python (openclPy) import Futhark.IR.GPUMem (GPUMem, Prog) import Futhark.MonadFreshNames import Futhark.Util (zEncodeString)-import Futhark.Util.Pretty (pretty)+import Futhark.Util.Pretty (prettyString)  -- | Compile the program to Python with calls to OpenCL. compileProg ::@@ -46,7 +43,7 @@         unlines           $ map             ( \x ->-                pretty $+                prettyString $                   Assign                     (Var ("self." ++ zEncodeString (nameToString x) ++ "_var"))                     (Var $ "program." ++ zEncodeString (nameToString x))@@ -56,6 +53,7 @@   let defines =         [ Assign (Var "synchronous") $ Bool False,           Assign (Var "preferred_platform") None,+          Assign (Var "build_options") $ List [],           Assign (Var "preferred_device") None,           Assign (Var "default_threshold") None,           Assign (Var "default_group_size") None,@@ -77,6 +75,7 @@   let constructor =         Py.Constructor           [ "self",+            "build_options=build_options",             "command_queue=None",             "interactive=False",             "platform_pref=preferred_platform",@@ -105,6 +104,16 @@                 [Assign (Var "preferred_device") $ Var "optarg"]             },           Option+            { optionLongName = "build-option",+              optionShortName = Nothing,+              optionArgument = RequiredArgument "str",+              optionAction =+                [ Assign (Var "build_options") $+                    BinOp "+" (Var "build_options") $+                      List [Var "optarg"]+                ]+            },+          Option             { optionLongName = "default-threshold",               optionShortName = Nothing,               optionArgument = RequiredArgument "int",@@ -195,19 +204,19 @@   v' <- Py.compileVar v   Py.stm $     Assign v' $-      Index (Var "self.sizes") (IdxExp $ String $ pretty key)+      Index (Var "self.sizes") (IdxExp $ String $ prettyString key) callKernel (Imp.CmpSizeLe v key x) = do   v' <- Py.compileVar v   x' <- Py.compileExp x   Py.stm $     Assign v' $-      BinOp "<=" (Index (Var "self.sizes") (IdxExp $ String $ pretty key)) x'+      BinOp "<=" (Index (Var "self.sizes") (IdxExp $ String $ prettyString key)) x' callKernel (Imp.GetSizeMax v size_class) = do   v' <- Py.compileVar v   Py.stm $     Assign v' $       Var $-        "self.max_" ++ pretty size_class+        "self.max_" ++ prettyString size_class callKernel (Imp.LaunchKernel safety name args num_workgroups workgroup_size) = do   num_workgroups' <- mapM (fmap asLong . Py.compileExp) num_workgroups   workgroup_size' <- mapM (fmap asLong . Py.compileExp) workgroup_size@@ -285,7 +294,7 @@ readOpenCLScalar :: Py.ReadScalar Imp.OpenCL () readOpenCLScalar mem i bt "device" = do   val <- newVName "read_res"-  let val' = Var $ pretty val+  let val' = Var $ prettyString val   let nparr =         Call           (Var "np.empty")@@ -312,7 +321,7 @@ allocateOpenCLBuffer mem size "device" =   Py.stm $     Assign mem $-      Py.simpleCall "opencl_alloc" [Var "self", size, String $ pretty mem]+      Py.simpleCall "opencl_alloc" [Var "self", size, String $ prettyString mem] allocateOpenCLBuffer _ _ space =   error $ "Cannot allocate in '" ++ space ++ "' space" 

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}  -- | Various boilerplate definitions for the PyOpenCL backend.@@ -8,9 +7,9 @@ where  import Control.Monad.Identity-import qualified Data.Map as M-import qualified Data.Text as T-import qualified Futhark.CodeGen.Backends.GenericPython as Py+import Data.Map qualified as M+import Data.Text qualified as T+import Futhark.CodeGen.Backends.GenericPython qualified as Py import Futhark.CodeGen.Backends.GenericPython.AST import Futhark.CodeGen.ImpCode.OpenCL   ( ErrorMsg (..),@@ -23,7 +22,7 @@     untyped,   ) import Futhark.CodeGen.OpenCL.Heuristics-import Futhark.Util.Pretty (pretty, prettyText)+import Futhark.Util.Pretty (prettyString, prettyText) import NeatInterpolation (text)  errorMsgNumArgs :: ErrorMsg a -> Int@@ -40,6 +39,7 @@ self.failure_msgs=$failure_msgs program = initialise_opencl_object(self,                                    program_src=fut_opencl_src,+                                   build_options=build_options,                                    command_queue=command_queue,                                    interactive=interactive,                                    platform_pref=platform_pref,@@ -58,7 +58,7 @@   where     assign' = T.pack assign     size_heuristics = prettyText $ sizeHeuristicsToPython sizeHeuristicsTable-    types' = prettyText $ map (show . pretty) types -- Looks enough like Python.+    types' = prettyText $ map (show . prettyString) types -- Looks enough like Python.     sizes' = prettyText $ sizeClassesToPython sizes     max_num_args = prettyText $ foldl max 0 $ map (errorMsgNumArgs . failureError) failures     failure_msgs = prettyText $ List $ map formatFailure failures@@ -73,16 +73,16 @@           escapeChar c = [c]        in concatMap escapeChar -    onPart (ErrorString s) = formatEscape s+    onPart (ErrorString s) = formatEscape $ T.unpack s     onPart ErrorVal {} = "{}"  sizeClassesToPython :: M.Map Name SizeClass -> PyExp sizeClassesToPython = Dict . map f . M.toList   where     f (size_name, size_class) =-      ( String $ pretty size_name,+      ( String $ prettyString size_name,         Dict-          [ (String "class", String $ pretty size_class),+          [ (String "class", String $ prettyString size_class),             ( String "value",               maybe None (Integer . fromIntegral) $                 sizeDefault size_class

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- -- | C code generator.  This module can convert a correct ImpCode -- program to an equivalent C program. The C code is strictly -- sequential, but can handle the full Futhark language.@@ -13,11 +11,11 @@ where  import Control.Monad-import qualified Data.Text as T-import qualified Futhark.CodeGen.Backends.GenericC as GC+import Data.Text qualified as T+import Futhark.CodeGen.Backends.GenericC qualified as GC import Futhark.CodeGen.Backends.SequentialC.Boilerplate-import qualified Futhark.CodeGen.ImpCode.Sequential as Imp-import qualified Futhark.CodeGen.ImpGen.Sequential as ImpGen+import Futhark.CodeGen.ImpCode.Sequential qualified as Imp+import Futhark.CodeGen.ImpGen.Sequential qualified as ImpGen import Futhark.IR.SeqMem import Futhark.MonadFreshNames 

@@ -3,8 +3,8 @@ -- | Boilerplate for sequential C code. module Futhark.CodeGen.Backends.SequentialC.Boilerplate (generateBoilerplate) where -import qualified Futhark.CodeGen.Backends.GenericC as GC-import qualified Language.C.Quote.OpenCL as C+import Futhark.CodeGen.Backends.GenericC qualified as GC+import Language.C.Quote.OpenCL qualified as C  -- | Generate the necessary boilerplate. generateBoilerplate :: GC.CompilerM op s ()

@@ -5,11 +5,11 @@ where  import Control.Monad-import qualified Data.Text as T-import qualified Futhark.CodeGen.Backends.GenericPython as GenericPython+import Data.Text qualified as T+import Futhark.CodeGen.Backends.GenericPython qualified as GenericPython import Futhark.CodeGen.Backends.GenericPython.AST-import qualified Futhark.CodeGen.ImpCode.Sequential as Imp-import qualified Futhark.CodeGen.ImpGen.Sequential as ImpGen+import Futhark.CodeGen.ImpCode.Sequential qualified as Imp+import Futhark.CodeGen.ImpGen.Sequential qualified as ImpGen import Futhark.IR.SeqMem import Futhark.MonadFreshNames 

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- -- | C code generator.  This module can convert a correct ImpCode -- program to an equivalent C program.  This C program is expected to -- be converted to WebAssembly, so we also produce the intended@@ -16,12 +14,12 @@ where  import Data.Maybe-import qualified Data.Text as T-import qualified Futhark.CodeGen.Backends.GenericC as GC+import Data.Text qualified as T+import Futhark.CodeGen.Backends.GenericC qualified as GC import Futhark.CodeGen.Backends.GenericWASM import Futhark.CodeGen.Backends.SequentialC.Boilerplate-import qualified Futhark.CodeGen.ImpCode.Sequential as Imp-import qualified Futhark.CodeGen.ImpGen.Sequential as ImpGen+import Futhark.CodeGen.ImpCode.Sequential qualified as Imp+import Futhark.CodeGen.ImpGen.Sequential qualified as ImpGen import Futhark.IR.SeqMem import Futhark.MonadFreshNames 

@@ -1,6 +1,4 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE Trustworthy #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  -- | Simple C runtime representation.@@ -38,12 +36,12 @@  import Data.Bits (shiftR, xor) import Data.Char (isAlphaNum, isDigit, ord)-import qualified Data.Text as T+import Data.Text qualified as T import Futhark.CodeGen.ImpCode import Futhark.CodeGen.RTS.C (scalarF16H, scalarH) import Futhark.Util (zEncodeString)-import qualified Language.C.Quote.C as C-import qualified Language.C.Syntax as C+import Language.C.Quote.C qualified as C+import Language.C.Syntax qualified as C import Text.Printf  -- | The C type corresponding to a signed integer type.@@ -178,7 +176,7 @@   toIdent = C.toIdent . T.unpack  instance C.ToIdent VName where-  toIdent = C.toIdent . zEncodeString . pretty+  toIdent = C.toIdent . zEncodeString . prettyString  instance C.ToExp VName where   toExp v _ = [C.cexp|$id:v|]

@@ -1,7 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Strict #-}-{-# LANGUAGE TupleSections #-}  -- | ImpCode is an imperative intermediate language used as a stepping -- stone in code generation.  The functional core IR@@ -86,7 +83,8 @@     withElemType,      -- * Re-exports from other modules.-    pretty,+    prettyText,+    prettyString,     module Futhark.IR.Syntax.Core,     module Language.Futhark.Core,     module Language.Futhark.Primitive,@@ -98,8 +96,9 @@ where  import Data.List (intersperse)-import qualified Data.Map as M-import qualified Data.Set as S+import Data.Map qualified as M+import Data.Set qualified as S+import Data.Text qualified as T import Data.Traversable import Futhark.Analysis.PrimExp import Futhark.Analysis.PrimExp.Convert@@ -307,7 +306,7 @@   | -- | Has the same semantics as the contained code, but     -- the comment should show up in generated code for ease     -- of inspection.-    Comment String (Code a)+    Comment T.Text (Code a)   | -- | Print the given value to the screen, somehow     -- annotated with the given string as a description.  If     -- no type/value pair, just print the string.  This has@@ -425,174 +424,174 @@ -- Prettyprinting definitions.  instance Pretty op => Pretty (Definitions op) where-  ppr (Definitions types consts funs) =-    ppr types </> ppr consts </> ppr funs+  pretty (Definitions types consts funs) =+    pretty types </> pretty consts </> pretty funs  instance Pretty op => Pretty (Functions op) where-  ppr (Functions funs) = stack $ intersperse mempty $ map ppFun funs+  pretty (Functions funs) = stack $ intersperse mempty $ map ppFun funs     where       ppFun (name, fun) =-        "Function " <> ppr name <> colon </> indent 2 (ppr fun)+        "Function " <> pretty name <> colon </> indent 2 (pretty fun)  instance Pretty op => Pretty (Constants op) where-  ppr (Constants decls code) =+  pretty (Constants decls code) =     "Constants:"-      </> indent 2 (stack $ map ppr decls)+      </> indent 2 (stack $ map pretty decls)       </> mempty       </> "Initialisation:"-      </> indent 2 (ppr code)+      </> indent 2 (pretty code)  instance Pretty EntryPoint where-  ppr (EntryPoint name results args) =+  pretty (EntryPoint name results args) =     "Name:"-      </> indent 2 (pquote (ppr name))+      </> indent 2 (dquotes (pretty name))       </> "Arguments:"       </> indent 2 (stack $ map ppArg args)       </> "Results:"       </> indent 2 (stack $ map ppRes results)     where-      ppArg ((p, u), t) = ppr p <+> ":" <+> ppRes (u, t)-      ppRes (u, t) = ppr u <> ppr t+      ppArg ((p, u), t) = pretty p <+> ":" <+> ppRes (u, t)+      ppRes (u, t) = pretty u <> pretty t  instance Pretty op => Pretty (FunctionT op) where-  ppr (Function entry outs ins body) =+  pretty (Function entry outs ins body) =     "Inputs:"-      </> indent 2 (stack $ map ppr ins)+      </> indent 2 (stack $ map pretty ins)       </> "Outputs:"-      </> indent 2 (stack $ map ppr outs)+      </> indent 2 (stack $ map pretty outs)       </> "Entry:"-      </> indent 2 (ppr entry)+      </> indent 2 (pretty entry)       </> "Body:"-      </> indent 2 (ppr body)+      </> indent 2 (pretty body)  instance Pretty Param where-  ppr (ScalarParam name ptype) = ppr ptype <+> ppr name-  ppr (MemParam name space) = "mem" <> ppr space <> " " <> ppr name+  pretty (ScalarParam name ptype) = pretty ptype <+> pretty name+  pretty (MemParam name space) = "mem" <> pretty space <> " " <> pretty name  instance Pretty ValueDesc where-  ppr (ScalarValue t ept name) =-    ppr t <+> ppr name <> ept'+  pretty (ScalarValue t ept name) =+    pretty t <+> pretty name <> ept'     where       ept' = case ept of         Unsigned -> " (unsigned)"         Signed -> mempty-  ppr (ArrayValue mem space et ept shape) =-    foldr f (ppr et) shape <+> "at" <+> ppr mem <> ppr space <+> ept'+  pretty (ArrayValue mem space et ept shape) =+    foldr f (pretty et) shape <+> "at" <+> pretty mem <> pretty space <+> ept'     where-      f e s = brackets $ s <> comma <> ppr e+      f e s = brackets $ s <> comma <> pretty e       ept' = case ept of         Unsigned -> " (unsigned)"         Signed -> mempty  instance Pretty ExternalValue where-  ppr (TransparentValue v) = ppr v-  ppr (OpaqueValue desc vs) =+  pretty (TransparentValue v) = pretty v+  pretty (OpaqueValue desc vs) =     "opaque"-      <+> pquote (ppr desc)-      <+> nestedBlock "{" "}" (stack $ map ppr vs)+      <+> dquotes (pretty desc)+      <+> nestedBlock "{" "}" (stack $ map pretty vs)  instance Pretty ArrayContents where-  ppr (ArrayValues vs) = braces (commasep $ map ppr vs)-  ppr (ArrayZeros n) = braces "0" <+> "*" <+> ppr n+  pretty (ArrayValues vs) = braces (commasep $ map pretty vs)+  pretty (ArrayZeros n) = braces "0" <+> "*" <+> pretty n  instance Pretty op => Pretty (Code op) where-  ppr (Op op) = ppr op-  ppr Skip = "skip"-  ppr (c1 :>>: c2) = ppr c1 </> ppr c2-  ppr (For i limit body) =+  pretty (Op op) = pretty op+  pretty Skip = "skip"+  pretty (c1 :>>: c2) = pretty c1 </> pretty c2+  pretty (For i limit body) =     "for"-      <+> ppr i+      <+> pretty i       <+> langle-      <+> ppr limit+      <+> pretty limit       <+> "{"-      </> indent 2 (ppr body)+      </> indent 2 (pretty body)       </> "}"-  ppr (While cond body) =+  pretty (While cond body) =     "while"-      <+> ppr cond+      <+> pretty cond       <+> "{"-      </> indent 2 (ppr body)+      </> indent 2 (pretty body)       </> "}"-  ppr (DeclareMem name space) =-    "var" <+> ppr name <> ": mem" <> ppr space-  ppr (DeclareScalar name vol t) =-    "var" <+> ppr name <> ":" <+> vol' <> ppr t+  pretty (DeclareMem name space) =+    "var" <+> pretty name <> ": mem" <> pretty space+  pretty (DeclareScalar name vol t) =+    "var" <+> pretty name <> ":" <+> vol' <> pretty t     where       vol' = case vol of         Volatile -> "volatile "         Nonvolatile -> mempty-  ppr (DeclareArray name space t vs) =+  pretty (DeclareArray name space t vs) =     "array"-      <+> ppr name <> "@" <> ppr space+      <+> pretty name <> "@" <> pretty space       <+> ":"-      <+> ppr t+      <+> pretty t       <+> equals-      <+> ppr vs-  ppr (Allocate name e space) =-    ppr name <+> "<-" <+> "malloc" <> parens (ppr e) <> ppr space-  ppr (Free name space) =-    "free" <> parens (ppr name) <> ppr space-  ppr (Write name i bt space vol val) =-    ppr name <> langle <> vol' <> ppr bt <> ppr space <> rangle <> brackets (ppr i)+      <+> pretty vs+  pretty (Allocate name e space) =+    pretty name <+> "<-" <+> "malloc" <> parens (pretty e) <> pretty space+  pretty (Free name space) =+    "free" <> parens (pretty name) <> pretty space+  pretty (Write name i bt space vol val) =+    pretty name <> langle <> vol' <> pretty bt <> pretty space <> rangle <> brackets (pretty i)       <+> "<-"-      <+> ppr val+      <+> pretty val     where       vol' = case vol of         Volatile -> "volatile "         Nonvolatile -> mempty-  ppr (Read name v is bt space vol) =-    ppr name+  pretty (Read name v is bt space vol) =+    pretty name       <+> "<-"-      <+> ppr v <> langle <> vol' <> ppr bt <> ppr space <> rangle <> brackets (ppr is)+      <+> pretty v <> langle <> vol' <> pretty bt <> pretty space <> rangle <> brackets (pretty is)     where       vol' = case vol of         Volatile -> "volatile "         Nonvolatile -> mempty-  ppr (SetScalar name val) =-    ppr name <+> "<-" <+> ppr val-  ppr (SetMem dest from DefaultSpace) =-    ppr dest <+> "<-" <+> ppr from-  ppr (SetMem dest from space) =-    ppr dest <+> "<-" <+> ppr from <+> "@" <> ppr space-  ppr (Assert e msg _) =-    "assert" <> parens (commasep [ppr msg, ppr e])-  ppr (Copy t dest destoffset destspace src srcoffset srcspace size) =+  pretty (SetScalar name val) =+    pretty name <+> "<-" <+> pretty val+  pretty (SetMem dest from DefaultSpace) =+    pretty dest <+> "<-" <+> pretty from+  pretty (SetMem dest from space) =+    pretty dest <+> "<-" <+> pretty from <+> "@" <> pretty space+  pretty (Assert e msg _) =+    "assert" <> parens (commasep [pretty msg, pretty e])+  pretty (Copy t dest destoffset destspace src srcoffset srcspace size) =     "copy"       <> parens-        ( ppr t <> comma-            </> ppMemLoc dest destoffset <> ppr destspace <> comma-            </> ppMemLoc src srcoffset <> ppr srcspace <> comma-            </> ppr size+        ( pretty t <> comma+            </> ppMemLoc dest destoffset <> pretty destspace <> comma+            </> ppMemLoc src srcoffset <> pretty srcspace <> comma+            </> pretty size         )     where       ppMemLoc base offset =-        ppr base <+> "+" <+> ppr offset-  ppr (If cond tbranch fbranch) =+        pretty base <+> "+" <+> pretty offset+  pretty (If cond tbranch fbranch) =     "if"-      <+> ppr cond+      <+> pretty cond       <+> "then {"-      </> indent 2 (ppr tbranch)+      </> indent 2 (pretty tbranch)       </> "} else"       <+> case fbranch of-        If {} -> ppr fbranch+        If {} -> pretty fbranch         _ ->-          "{" </> indent 2 (ppr fbranch) </> "}"-  ppr (Call dests fname args) =-    commasep (map ppr dests)+          "{" </> indent 2 (pretty fbranch) </> "}"+  pretty (Call dests fname args) =+    commasep (map pretty dests)       <+> "<-"-      <+> ppr fname <> parens (commasep $ map ppr args)-  ppr (Comment s code) =-    "--" <+> text s </> ppr code-  ppr (DebugPrint desc (Just e)) =-    "debug" <+> parens (commasep [text (show desc), ppr e])-  ppr (DebugPrint desc Nothing) =-    "debug" <+> parens (text (show desc))-  ppr (TracePrint msg) =-    "trace" <+> parens (ppr msg)+      <+> pretty fname <> parens (commasep $ map pretty args)+  pretty (Comment s code) =+    "--" <+> pretty s </> pretty code+  pretty (DebugPrint desc (Just e)) =+    "debug" <+> parens (commasep [pretty (show desc), pretty e])+  pretty (DebugPrint desc Nothing) =+    "debug" <+> parens (pretty (show desc))+  pretty (TracePrint msg) =+    "trace" <+> parens (pretty msg)  instance Pretty Arg where-  ppr (MemArg m) = ppr m-  ppr (ExpArg e) = ppr e+  pretty (MemArg m) = pretty m+  pretty (ExpArg e) = pretty e  instance Functor Functions where   fmap = fmapDefault

@@ -1,6 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}- -- | Variation of "Futhark.CodeGen.ImpCode" that contains the notion -- of a kernel invocation. module Futhark.CodeGen.ImpCode.GPU@@ -83,31 +80,31 @@   deriving (Eq, Ord, Show)  instance Pretty KernelConst where-  ppr (SizeConst key) = text "get_size" <> parens (ppr key)+  pretty (SizeConst key) = "get_size" <> parens (pretty key)  instance Pretty KernelUse where-  ppr (ScalarUse name t) =-    oneLine $ text "scalar_copy" <> parens (commasep [ppr name, ppr t])-  ppr (MemoryUse name) =-    oneLine $ text "mem_copy" <> parens (commasep [ppr name])-  ppr (ConstUse name e) =-    oneLine $ text "const" <> parens (commasep [ppr name, ppr e])+  pretty (ScalarUse name t) =+    oneLine $ "scalar_copy" <> parens (commasep [pretty name, pretty t])+  pretty (MemoryUse name) =+    oneLine $ "mem_copy" <> parens (commasep [pretty name])+  pretty (ConstUse name e) =+    oneLine $ "const" <> parens (commasep [pretty name, pretty e])  instance Pretty HostOp where-  ppr (GetSize dest key size_class) =-    ppr dest-      <+> text "<-"-      <+> text "get_size" <> parens (commasep [ppr key, ppr size_class])-  ppr (GetSizeMax dest size_class) =-    ppr dest <+> text "<-" <+> text "get_size_max" <> parens (ppr size_class)-  ppr (CmpSizeLe dest name size_class x) =-    ppr dest-      <+> text "<-"-      <+> text "get_size" <> parens (commasep [ppr name, ppr size_class])-      <+> text "<"-      <+> ppr x-  ppr (CallKernel c) =-    ppr c+  pretty (GetSize dest key size_class) =+    pretty dest+      <+> "<-"+      <+> "get_size" <> parens (commasep [pretty key, pretty size_class])+  pretty (GetSizeMax dest size_class) =+    pretty dest <+> "<-" <+> "get_size_max" <> parens (pretty size_class)+  pretty (CmpSizeLe dest name size_class x) =+    pretty dest+      <+> "<-"+      <+> "get_size" <> parens (commasep [pretty name, pretty size_class])+      <+> "<"+      <+> pretty x+  pretty (CallKernel c) =+    pretty c  instance FreeIn HostOp where   freeIn' (CallKernel c) =@@ -125,21 +122,21 @@       <> freeIn' [kernelNumGroups kernel, kernelGroupSize kernel]  instance Pretty Kernel where-  ppr kernel =-    text "kernel"+  pretty kernel =+    "kernel"       <+> brace-        ( text "groups"-            <+> brace (ppr $ kernelNumGroups kernel)-            </> text "group_size"-            <+> brace (ppr $ kernelGroupSize kernel)-            </> text "uses"-            <+> brace (commasep $ map ppr $ kernelUses kernel)-            </> text "failure_tolerant"-            <+> brace (ppr $ kernelFailureTolerant kernel)-            </> text "check_local_memory"-            <+> brace (ppr $ kernelCheckLocalMemory kernel)-            </> text "body"-            <+> brace (ppr $ kernelBody kernel)+        ( "groups"+            <+> brace (pretty $ kernelNumGroups kernel)+            </> "group_size"+            <+> brace (pretty $ kernelGroupSize kernel)+            </> "uses"+            <+> brace (commasep $ map pretty $ kernelUses kernel)+            </> "failure_tolerant"+            <+> brace (pretty $ kernelFailureTolerant kernel)+            </> "check_local_memory"+            <+> brace (pretty $ kernelCheckLocalMemory kernel)+            </> "body"+            <+> brace (pretty $ kernelBody kernel)         )  -- | When we do a barrier or fence, is it at the local or global@@ -197,106 +194,106 @@   freeIn' (AtomicXchg _ _ arr i x) = freeIn' arr <> freeIn' i <> freeIn' x  instance Pretty KernelOp where-  ppr (GetGroupId dest i) =-    ppr dest+  pretty (GetGroupId dest i) =+    pretty dest       <+> "<-"-      <+> "get_group_id" <> parens (ppr i)-  ppr (GetLocalId dest i) =-    ppr dest+      <+> "get_group_id" <> parens (pretty i)+  pretty (GetLocalId dest i) =+    pretty dest       <+> "<-"-      <+> "get_local_id" <> parens (ppr i)-  ppr (GetLocalSize dest i) =-    ppr dest+      <+> "get_local_id" <> parens (pretty i)+  pretty (GetLocalSize dest i) =+    pretty dest       <+> "<-"-      <+> "get_local_size" <> parens (ppr i)-  ppr (GetLockstepWidth dest) =-    ppr dest+      <+> "get_local_size" <> parens (pretty i)+  pretty (GetLockstepWidth dest) =+    pretty dest       <+> "<-"       <+> "get_lockstep_width()"-  ppr (Barrier FenceLocal) =+  pretty (Barrier FenceLocal) =     "local_barrier()"-  ppr (Barrier FenceGlobal) =+  pretty (Barrier FenceGlobal) =     "global_barrier()"-  ppr (MemFence FenceLocal) =+  pretty (MemFence FenceLocal) =     "mem_fence_local()"-  ppr (MemFence FenceGlobal) =+  pretty (MemFence FenceGlobal) =     "mem_fence_global()"-  ppr (LocalAlloc name size) =-    ppr name <+> equals <+> "local_alloc" <> parens (ppr size)-  ppr (ErrorSync FenceLocal) =+  pretty (LocalAlloc name size) =+    pretty name <+> equals <+> "local_alloc" <> parens (pretty size)+  pretty (ErrorSync FenceLocal) =     "error_sync_local()"-  ppr (ErrorSync FenceGlobal) =+  pretty (ErrorSync FenceGlobal) =     "error_sync_global()"-  ppr (Atomic _ (AtomicAdd t old arr ind x)) =-    ppr old+  pretty (Atomic _ (AtomicAdd t old arr ind x)) =+    pretty old       <+> "<-"       <+> "atomic_add_"-        <> ppr t-        <> parens (commasep [ppr arr <> brackets (ppr ind), ppr x])-  ppr (Atomic _ (AtomicFAdd t old arr ind x)) =-    ppr old+        <> pretty t+        <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x])+  pretty (Atomic _ (AtomicFAdd t old arr ind x)) =+    pretty old       <+> "<-"       <+> "atomic_fadd_"-        <> ppr t-        <> parens (commasep [ppr arr <> brackets (ppr ind), ppr x])-  ppr (Atomic _ (AtomicSMax t old arr ind x)) =-    ppr old+        <> pretty t+        <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x])+  pretty (Atomic _ (AtomicSMax t old arr ind x)) =+    pretty old       <+> "<-"       <+> "atomic_smax"-        <> ppr t-        <> parens (commasep [ppr arr <> brackets (ppr ind), ppr x])-  ppr (Atomic _ (AtomicSMin t old arr ind x)) =-    ppr old+        <> pretty t+        <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x])+  pretty (Atomic _ (AtomicSMin t old arr ind x)) =+    pretty old       <+> "<-"       <+> "atomic_smin"-        <> ppr t-        <> parens (commasep [ppr arr <> brackets (ppr ind), ppr x])-  ppr (Atomic _ (AtomicUMax t old arr ind x)) =-    ppr old+        <> pretty t+        <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x])+  pretty (Atomic _ (AtomicUMax t old arr ind x)) =+    pretty old       <+> "<-"       <+> "atomic_umax"-        <> ppr t-        <> parens (commasep [ppr arr <> brackets (ppr ind), ppr x])-  ppr (Atomic _ (AtomicUMin t old arr ind x)) =-    ppr old+        <> pretty t+        <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x])+  pretty (Atomic _ (AtomicUMin t old arr ind x)) =+    pretty old       <+> "<-"       <+> "atomic_umin"-        <> ppr t-        <> parens (commasep [ppr arr <> brackets (ppr ind), ppr x])-  ppr (Atomic _ (AtomicAnd t old arr ind x)) =-    ppr old+        <> pretty t+        <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x])+  pretty (Atomic _ (AtomicAnd t old arr ind x)) =+    pretty old       <+> "<-"       <+> "atomic_and"-        <> ppr t-        <> parens (commasep [ppr arr <> brackets (ppr ind), ppr x])-  ppr (Atomic _ (AtomicOr t old arr ind x)) =-    ppr old+        <> pretty t+        <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x])+  pretty (Atomic _ (AtomicOr t old arr ind x)) =+    pretty old       <+> "<-"       <+> "atomic_or"-        <> ppr t-        <> parens (commasep [ppr arr <> brackets (ppr ind), ppr x])-  ppr (Atomic _ (AtomicXor t old arr ind x)) =-    ppr old+        <> pretty t+        <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x])+  pretty (Atomic _ (AtomicXor t old arr ind x)) =+    pretty old       <+> "<-"       <+> "atomic_xor"-        <> ppr t-        <> parens (commasep [ppr arr <> brackets (ppr ind), ppr x])-  ppr (Atomic _ (AtomicCmpXchg t old arr ind x y)) =-    ppr old+        <> pretty t+        <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x])+  pretty (Atomic _ (AtomicCmpXchg t old arr ind x y)) =+    pretty old       <+> "<-"       <+> "atomic_cmp_xchg"-        <> ppr t-        <> parens (commasep [ppr arr <> brackets (ppr ind), ppr x, ppr y])-  ppr (Atomic _ (AtomicXchg t old arr ind x)) =-    ppr old+        <> pretty t+        <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x, pretty y])+  pretty (Atomic _ (AtomicXchg t old arr ind x)) =+    pretty old       <+> "<-"       <+> "atomic_xchg"-        <> ppr t-        <> parens (commasep [ppr arr <> brackets (ppr ind), ppr x])+        <> pretty t+        <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x])  instance FreeIn KernelOp where   freeIn' (Atomic _ op) = freeIn' op   freeIn' _ = mempty -brace :: Doc -> Doc+brace :: Doc a -> Doc a brace body = " {" </> indent 2 body </> "}"

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- -- | Multicore imperative code. module Futhark.CodeGen.ImpCode.Multicore   ( Program,@@ -15,7 +13,7 @@   ) where -import qualified Data.Map as M+import Data.Map qualified as M import Futhark.CodeGen.ImpCode import Futhark.Util.Pretty @@ -91,63 +89,63 @@   | Static  instance Pretty Scheduling where-  ppr Dynamic = "Dynamic"-  ppr Static = "Static"+  pretty Dynamic = "Dynamic"+  pretty Static = "Static"  instance Pretty SchedulerInfo where-  ppr (SchedulerInfo i sched) =+  pretty (SchedulerInfo i sched) =     stack-      [ nestedBlock "scheduling {" "}" (ppr sched),-        nestedBlock "iter {" "}" (ppr i)+      [ nestedBlock "scheduling {" "}" (pretty sched),+        nestedBlock "iter {" "}" (pretty i)       ]  instance Pretty ParallelTask where-  ppr (ParallelTask code) = ppr code+  pretty (ParallelTask code) = pretty code  instance Pretty Multicore where-  ppr (GetLoopBounds start end) =-    ppr (start, end) <+> "<-" <+> "get_loop_bounds()"-  ppr (GetTaskId v) =-    ppr v <+> "<-" <+> "get_task_id()"-  ppr (GetNumTasks v) =-    ppr v <+> "<-" <+> "get_num_tasks()"-  ppr (SegOp s free seq_code par_code retval scheduler) =-    "SegOp" <+> text s <+> nestedBlock "{" "}" ppbody+  pretty (GetLoopBounds start end) =+    pretty (start, end) <+> "<-" <+> "get_loop_bounds()"+  pretty (GetTaskId v) =+    pretty v <+> "<-" <+> "get_task_id()"+  pretty (GetNumTasks v) =+    pretty v <+> "<-" <+> "get_num_tasks()"+  pretty (SegOp s free seq_code par_code retval scheduler) =+    "SegOp" <+> pretty s <+> nestedBlock "{" "}" ppbody     where       ppbody =         stack-          [ ppr scheduler,-            nestedBlock "free {" "}" (ppr free),-            nestedBlock "seq {" "}" (ppr seq_code),-            maybe mempty (nestedBlock "par {" "}" . ppr) par_code,-            nestedBlock "retvals {" "}" (ppr retval)+          [ pretty scheduler,+            nestedBlock "free {" "}" (pretty free),+            nestedBlock "seq {" "}" (pretty seq_code),+            maybe mempty (nestedBlock "par {" "}" . pretty) par_code,+            nestedBlock "retvals {" "}" (pretty retval)           ]-  ppr (ParLoop s body params) =-    "parloop" <+> ppr s </> nestedBlock "{" "}" ppbody+  pretty (ParLoop s body params) =+    "parloop" <+> pretty s </> nestedBlock "{" "}" ppbody     where       ppbody =         stack-          [ nestedBlock "params {" "}" (ppr params),-            nestedBlock "body {" "}" (ppr body)+          [ nestedBlock "params {" "}" (pretty params),+            nestedBlock "body {" "}" (pretty body)           ]-  ppr (Atomic _) =+  pretty (Atomic _) =     "AtomicOp"-  ppr (ISPCKernel body _) =-    "ispc" <+> nestedBlock "{" "}" (ppr body)-  ppr (ForEach i from to body) =+  pretty (ISPCKernel body _) =+    "ispc" <+> nestedBlock "{" "}" (pretty body)+  pretty (ForEach i from to body) =     "foreach"-      <+> ppr i+      <+> pretty i       <+> "="-      <+> ppr from+      <+> pretty from       <+> "to"-      <+> ppr to-      <+> nestedBlock "{" "}" (ppr body)-  ppr (ForEachActive i body) =+      <+> pretty to+      <+> nestedBlock "{" "}" (pretty body)+  pretty (ForEachActive i body) =     "foreach_active"-      <+> ppr i-      <+> nestedBlock "{" "}" (ppr body)-  ppr (ExtractLane dest tar lane) =-    ppr dest <+> "<-" <+> "extract" <+> parens (commasep $ map ppr [tar, lane])+      <+> pretty i+      <+> nestedBlock "{" "}" (pretty body)+  pretty (ExtractLane dest tar lane) =+    pretty dest <+> "<-" <+> "extract" <+> parens (commasep $ map pretty [tar, lane])  instance FreeIn SchedulerInfo where   freeIn' (SchedulerInfo iter _) = freeIn' iter

@@ -21,8 +21,8 @@   ) where -import qualified Data.Map as M-import qualified Data.Text as T+import Data.Map qualified as M+import Data.Text qualified as T import Futhark.CodeGen.ImpCode import Futhark.IR.GPU.Sizes import Futhark.Util.Pretty@@ -105,4 +105,4 @@   deriving (Eq)  instance Pretty OpenCL where-  ppr = text . show+  pretty = pretty . show

@@ -16,7 +16,7 @@ data Sequential  instance Pretty Sequential where-  ppr _ = empty+  pretty _ = mempty  instance FreeIn Sequential where   freeIn' _ = mempty

@@ -1,13 +1,5 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Strict #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}  module Futhark.CodeGen.ImpGen@@ -131,14 +123,15 @@ import Control.Monad.Writer import Control.Parallel.Strategies import Data.Bifunctor (first)-import qualified Data.DList as DL+import Data.DList qualified as DL import Data.Either import Data.List (find) import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.Map.Strict as M+import Data.Map.Strict qualified as M import Data.Maybe-import qualified Data.Set as S+import Data.Set qualified as S import Data.String+import Data.Text qualified as T import Futhark.CodeGen.ImpCode   ( Bytes,     Count,@@ -147,15 +140,16 @@     elements,     withElemType,   )-import qualified Futhark.CodeGen.ImpCode as Imp+import Futhark.CodeGen.ImpCode qualified as Imp import Futhark.CodeGen.ImpGen.Transpose import Futhark.Construct hiding (ToExp (..)) import Futhark.IR.Mem-import qualified Futhark.IR.Mem.IxFun as IxFun+import Futhark.IR.Mem.IxFun qualified as IxFun import Futhark.IR.SOACS (SOACS) import Futhark.Util import Futhark.Util.IntegralExp import Futhark.Util.Loc (noLoc)+import Futhark.Util.Pretty hiding (nest, space) import Language.Futhark.Warnings import Prelude hiding (mod, quot) @@ -400,7 +394,7 @@  -- | Execute a code generation action, wrapping the generated code -- within a 'Imp.Comment' with the given description.-comment :: String -> ImpM rep r op () -> ImpM rep r op ()+comment :: T.Text -> ImpM rep r op () -> ImpM rep r op () comment desc m = do   code <- collect m   emit $ Imp.Comment desc code@@ -413,9 +407,9 @@ warnings ws = modify $ \s -> s {stateWarnings = ws <> stateWarnings s}  -- | Emit a warning about something the user should be aware of.-warn :: Located loc => loc -> [loc] -> String -> ImpM rep r op ()+warn :: Located loc => loc -> [loc] -> T.Text -> ImpM rep r op () warn loc locs problem =-  warnings $ singleWarning' (srclocOf loc) (map srclocOf locs) (fromString problem)+  warnings $ singleWarning' (srclocOf loc) (map srclocOf locs) (pretty problem)  -- | Emit a function in the generated code. emitFunction :: Name -> Imp.Function op -> ImpM rep r op ()@@ -875,12 +869,12 @@   opc <- asks envOpCompiler   opc pat op -tracePrim :: String -> PrimType -> SubExp -> ImpM rep r op ()+tracePrim :: T.Text -> PrimType -> SubExp -> ImpM rep r op () tracePrim s t se =   emit . Imp.TracePrint $     ErrorMsg [ErrorString (s <> ": "), ErrorVal t (toExp' t se), ErrorString "\n"] -traceArray :: String -> PrimType -> Shape -> SubExp -> ImpM rep r op ()+traceArray :: T.Text -> PrimType -> Shape -> SubExp -> ImpM rep r op () traceArray s t shape se = do   emit . Imp.TracePrint $ ErrorMsg [ErrorString (s <> ": ")]   sLoopNest shape $ \is -> do@@ -907,7 +901,7 @@         Array t shape _ -> traceArray s t shape se         _ ->           warn [mempty :: SrcLoc] mempty $-            s ++ ": cannot trace value of this (core) type: " <> pretty se_t+            s <> ": cannot trace value of this (core) type: " <> prettyText se_t defCompileBasicOp (Pat [pe]) (UnOp op e) = do   e' <- toExp e   patElemName pe <~~ Imp.UnOpExp op e'@@ -980,7 +974,7 @@   forM_ (x : ys) $ \y -> do     y_dims <- arrayDims <$> lookupType y     let rows = case drop i y_dims of-          [] -> error $ "defCompileBasicOp Concat: empty array shape for " ++ pretty y+          [] -> error $ "defCompileBasicOp Concat: empty array shape for " ++ prettyString y           r : _ -> pe64 r         skip_dims = take i y_dims         sliceAllDim d = DimSlice 0 d 1@@ -1054,9 +1048,9 @@ defCompileBasicOp pat e =   error $     "ImpGen.defCompileBasicOp: Invalid pattern\n  "-      ++ pretty pat+      ++ prettyString pat       ++ "\nfor expression\n  "-      ++ pretty e+      ++ prettyString e  -- | Note: a hack to be used only for functions. addArrays :: [ArrayDecl] -> ImpM rep r op ()@@ -1258,7 +1252,7 @@     lookupVar v >>= \case       ScalarVar _ (ScalarEntry pt) ->         pure $ Imp.var v pt-      _ -> error $ "toExp SubExp: SubExp is not a primitive type: " ++ pretty v+      _ -> error $ "toExp SubExp: SubExp is not a primitive type: " ++ prettyString v    toExp' _ (Constant v) = Imp.ValueExp v   toExp' t (Var v) = Imp.var v t@@ -1336,21 +1330,21 @@   res <- gets $ M.lookup name . stateVTable   case res of     Just entry -> pure entry-    _ -> error $ "Unknown variable: " ++ pretty name+    _ -> error $ "Unknown variable: " ++ prettyString name  lookupArray :: VName -> ImpM rep r op ArrayEntry lookupArray name = do   res <- lookupVar name   case res of     ArrayVar _ entry -> pure entry-    _ -> error $ "ImpGen.lookupArray: not an array: " ++ pretty name+    _ -> error $ "ImpGen.lookupArray: not an array: " ++ prettyString name  lookupMemory :: VName -> ImpM rep r op MemEntry lookupMemory name = do   res <- lookupVar name   case res of     MemVar _ entry -> pure entry-    _ -> error $ "Unknown memory block: " ++ pretty name+    _ -> error $ "Unknown memory block: " ++ prettyString name  lookupArraySpace :: VName -> ImpM rep r op Space lookupArraySpace =@@ -1370,7 +1364,7 @@       acc' <- gets $ M.lookup acc . stateAccs       case acc' of         Just ([], _) ->-          error $ "Accumulator with no arrays: " ++ pretty name+          error $ "Accumulator with no arrays: " ++ prettyString name         Just (arrs@(arr : _), Just (op, _)) -> do           space <- lookupArraySpace arr           let (i_params, ps) = splitAt (length is) $ lambdaParams op@@ -1386,8 +1380,8 @@           space <- lookupArraySpace arr           pure (acc, space, arrs, map pe64 (shapeDims ispace), Nothing)         Nothing ->-          error $ "ImpGen.lookupAcc: unlisted accumulator: " ++ pretty name-    _ -> error $ "ImpGen.lookupAcc: not an accumulator: " ++ pretty name+          error $ "ImpGen.lookupAcc: unlisted accumulator: " ++ prettyString name+    _ -> error $ "ImpGen.lookupAcc: not an accumulator: " ++ prettyString name  destinationFromPat :: Pat (LetDec rep) -> ImpM rep r op [ValueDestination] destinationFromPat = mapM inspect . patElems@@ -1492,7 +1486,7 @@        in (product mapped, product pretrans, product posttrans)  mapTransposeName :: PrimType -> String-mapTransposeName bt = "map_transpose_" ++ pretty bt+mapTransposeName bt = "map_transpose_" ++ prettyString bt  mapTransposeForType :: PrimType -> ImpM rep r op Name mapTransposeForType bt = do@@ -1609,13 +1603,13 @@           then             error $               "copyArrayDWIM: cannot copy to "-                ++ pretty (memLocName destlocation)+                ++ prettyString (memLocName destlocation)                 ++ " from "-                ++ pretty (memLocName srclocation)+                ++ prettyString (memLocName srclocation)                 ++ " because ranks do not match ("-                ++ pretty destrank+                ++ prettyString destrank                 ++ " vs "-                ++ pretty srcrank+                ++ prettyString srcrank                 ++ ")"           else             if destlocation' == srclocation'@@ -1632,19 +1626,19 @@   ImpM rep r op () copyDWIMDest _ _ (Constant v) (_ : _) =   error $-    unwords ["copyDWIMDest: constant source", pretty v, "cannot be indexed."]+    unwords ["copyDWIMDest: constant source", prettyString v, "cannot be indexed."] copyDWIMDest pat dest_slice (Constant v) [] =   case mapM dimFix dest_slice of     Nothing ->       error $-        unwords ["copyDWIMDest: constant source", pretty v, "with slice destination."]+        unwords ["copyDWIMDest: constant source", prettyString v, "with slice destination."]     Just dest_is ->       case pat of         ScalarDestination name ->           emit $ Imp.SetScalar name $ Imp.ValueExp v         MemoryDestination {} ->           error $-            unwords ["copyDWIMDest: constant source", pretty v, "cannot be written to memory destination."]+            unwords ["copyDWIMDest: constant source", prettyString v, "cannot be written to memory destination."]         ArrayDestination (Just dest_loc) -> do           (dest_mem, dest_space, dest_i) <-             fullyIndexArray' dest_loc dest_is@@ -1661,18 +1655,18 @@       emit $ Imp.SetMem mem src space     (MemoryDestination {}, _) ->       error $-        unwords ["copyDWIMDest: cannot write", pretty src, "to memory destination."]+        unwords ["copyDWIMDest: cannot write", prettyString src, "to memory destination."]     (_, MemVar {}) ->       error $-        unwords ["copyDWIMDest: source", pretty src, "is a memory block."]+        unwords ["copyDWIMDest: source", prettyString src, "is a memory block."]     (_, ScalarVar _ (ScalarEntry _))       | not $ null src_slice ->           error $-            unwords ["copyDWIMDest: prim-typed source", pretty src, "with slice", pretty src_slice]+            unwords ["copyDWIMDest: prim-typed source", prettyString src, "with slice", prettyString src_slice]     (ScalarDestination name, _)       | not $ null dest_slice ->           error $-            unwords ["copyDWIMDest: prim-typed target", pretty name, "with slice", pretty dest_slice]+            unwords ["copyDWIMDest: prim-typed target", prettyString name, "with slice", prettyString dest_slice]     (ScalarDestination name, ScalarVar _ (ScalarEntry pt)) ->       emit $ Imp.SetScalar name $ Imp.var src pt     (ScalarDestination name, ArrayVar _ arr)@@ -1687,13 +1681,13 @@           error $             unwords               [ "copyDWIMDest: prim-typed target",-                pretty name,+                prettyString name,                 "and array-typed source",-                pretty src,+                prettyString src,                 "of shape",-                pretty (entryArrayShape arr),+                prettyString (entryArrayShape arr),                 "sliced with",-                pretty src_slice+                prettyString src_slice               ]     (ArrayDestination (Just dest_loc), ArrayVar _ src_arr) -> do       let src_loc = entryArrayLoc src_arr@@ -1709,9 +1703,9 @@           error $             unwords               [ "copyDWIMDest: array-typed target and prim-typed source",-                pretty src,+                prettyString src,                 "with slice",-                pretty dest_slice+                prettyString dest_slice               ]     (ArrayDestination Nothing, _) ->       pure () -- Nothing to do; something else set some memory@@ -1766,7 +1760,7 @@     Nothing -> emit $ Imp.Allocate (patElemName mem) e' space     Just allocator' -> allocator' (patElemName mem) e' compileAlloc pat _ _ =-  error $ "compileAlloc: Invalid pattern: " ++ pretty pat+  error $ "compileAlloc: Invalid pattern: " ++ prettyString pat  -- | The number of bytes needed to represent the array in a -- straightforward contiguous format, as an t'Int64' expression.@@ -1798,7 +1792,7 @@ sFor' i bound body = do   let it = case primExpType bound of         IntType bound_t -> bound_t-        t -> error $ "sFor': bound " ++ pretty bound ++ " is of type " ++ pretty t+        t -> error $ "sFor': bound " ++ prettyString bound ++ " is of type " ++ prettyString t   addLoopVar i it   body' <- collect body   emit $ Imp.For i bound body'@@ -1818,7 +1812,7 @@   body' <- collect body   emit $ Imp.While cond body' -sComment :: String -> ImpM rep r op () -> ImpM rep r op ()+sComment :: T.Text -> ImpM rep r op () -> ImpM rep r op () sComment s code = do   code' <- collect code   emit $ Imp.Comment s code'