packages feed

futhark 0.15.1 → 0.15.2

raw patch · 61 files changed

+140/−658 lines, 61 files

Files

docs/language-reference.rst view
@@ -992,15 +992,14 @@ accepted or produced by the function.  For example::    let f [n] (a: [n]i32) (b: [n]i32): [n]i32 =-    map (+) a b+    map2 (+) a b -We use a *size parameter*, ``[n]``, to explicitly quantify the names-of shapes.  The ``[n]`` parameter is not explicitly passed when-calling ``f``.  Rather, its value is implicitly deduced from the-arguments passed for the value parameters.  An array can contain-*anonymous dimensions*, e.g. ``[]i32``, for which the type checker-will invent fresh size parameters, which ensures that all sizes have a-(symbolic) size.+We use a *size parameter*, ``[n]``, to explicitly quantify sizes.  The+``[n]`` parameter is not explicitly passed when calling ``f``.+Rather, its value is implicitly deduced from the arguments passed for+the value parameters.  An array can contain *anonymous dimensions*,+e.g. ``[]i32``, for which the type checker will invent fresh size+parameters, which ensures that all arrays have a (symbolic) size.  A size annotation can also be an integer constant (with no suffix). Size parameters can be used as ordinary variables within the scope of@@ -1434,9 +1433,9 @@ modules.  For example::    module Times = \(M: Addable) -> {-    let times (x: M.t) (k: int): M.t =-      loop (x' = x) for i < k do-        T.add x' x+    let times (x: M.t) (k: i32): M.t =+      loop x' = x for i < k do+        M.add x' x   }  We can instantiate ``Times`` with any module that fulfils the module
docs/man/futhark-cuda.rst view
@@ -19,7 +19,7 @@ kernels, and either compiles that C code with gcc(1) to an executable binary program, or produces a ``.h`` and ``.c`` file that can be linked with other code. The standard Futhark optimisation pipeline is-used, and GCC is invoked with ``-O3``, ``-lm``, and ``-std=c99``. The+used, and GCC is invoked with ``-O``, ``-lm``, and ``-std=c99``. The resulting program will otherwise behave exactly as one compiled with ``futhark c``. 
docs/man/futhark-opencl.rst view
@@ -19,7 +19,7 @@ OpenCL kernels, and either compiles that C code with gcc(1) to an executable binary program, or produces a ``.h`` and ``.c`` file that can be linked with other code. The standard Futhark optimisation-pipeline is used, and GCC is invoked with ``-O3``, ``-lm``, and+pipeline is used, and GCC is invoked with ``-O``, ``-lm``, and ``-std=c99``. The resulting program will otherwise behave exactly as one compiled with ``futhark c``. 
futhark.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.4  name:           futhark-version:        0.15.1+version:        0.15.2 synopsis:       An optimising compiler for a functional, array-oriented language. description:    Futhark is a small programming language designed to be compiled to                 efficient parallel code. It is a statically typed, data-parallel,
prelude/array.fut view
@@ -46,7 +46,7 @@ -- | Concatenation where the result has a predetermined size.  If the -- provided size is wrong, the function will fail with a run-time -- error.-let concat_to 't (n: i32) (xs: []t) (ys: []t): *[]t = xs ++ ys :> [n]t+let concat_to [n] [m] 't (k: i32) (xs: [n]t) (ys: [m]t): *[k]t = xs ++ ys :> [k]t  -- | Rotate an array some number of elements to the left.  A negative -- rotation amount is also supported.
rts/c/values.h view
@@ -651,6 +651,17 @@   } } +static int end_of_input() {+  skipspaces();+  char token[2];+  next_token(token, sizeof(token));+  if (strcmp(token, "") == 0) {+    return 0;+  } else {+    return 1;+  }+}+ static int write_str_array(FILE *out, const struct primtype_info_t *elem_type, unsigned char *data, int64_t *shape, int8_t rank) {   if (rank==0) {     elem_type->write_str(out, (void*)data);
− rts/csharp/functions.cs
rts/csharp/reader.cs view
@@ -852,6 +852,18 @@     return ReadStrF64(); } +private void EndOfInput(string entry)+{+    try {+        SkipSpaces();+        var c = GetChar();+        if (c.HasValue) {+            throw new Exception(String.Format("Expected EOF on stdin after reading input for \"{0}\".", entry));+        }+    } catch (System.IO.EndOfStreamException e) {+    }+}+ private void WriteValue(bool x){Console.Write(x ? "true" : "false", x);} private void WriteValue(sbyte x){Console.Write("{0}i8", x);} private void WriteValue(short x){Console.Write("{0}i16", x);}
rts/python/panic.py view
@@ -3,6 +3,7 @@ def panic(exitcode, fmt, *args):     sys.stderr.write('%s: ' % sys.argv[0])     sys.stderr.write(fmt % args)+    sys.stderr.write('\n')     sys.exit(exitcode)  # End of panic.py.
rts/python/values.py view
@@ -573,6 +573,11 @@             return read_scalar(reader, basetype)         return (dims, basetype) +def end_of_input(entry, f=input_reader):+    skip_spaces(f)+    if f.get_char() != b'':+        panic(1, "Expected EOF on stdin after reading input for \"%s\".", entry)+ def write_value_text(v, out=sys.stdout):     if type(v) == np.uint8:         out.write("%uu8" % v)
src/Futhark/Analysis/HORepresentation/SOAC.hs view
@@ -43,7 +43,6 @@   , isVarInput   , isVarishInput   , addTransform-  , addTransforms   , addInitialTransforms   , inputArray   , inputRank@@ -54,7 +53,6 @@   -- ** Input transformations   , ArrayTransforms   , noTransforms-  , singleTransform   , nullTransforms   , (|>)   , (<|)@@ -144,10 +142,6 @@ nullTransforms :: ArrayTransforms -> Bool nullTransforms (ArrayTransforms s) = Seq.null s --- | A transformation list containing just a single transformation.-singleTransform :: ArrayTransform -> ArrayTransforms-singleTransform = ArrayTransforms . Seq.singleton- -- | Decompose the input-end of the transformation sequence. viewf :: ArrayTransforms -> ViewF viewf (ArrayTransforms s) = case Seq.viewl s of@@ -260,11 +254,6 @@ addTransform :: ArrayTransform -> Input -> Input addTransform tr (Input trs a t) =   Input (trs |> tr) a t---- | Add several transformations to the end of the transformation--- list.-addTransforms :: ArrayTransforms -> Input -> Input-addTransforms ts (Input ots a t) = Input (ots <> ts) a t  -- | Add several transformations to the start of the transformation -- list.
src/Futhark/Analysis/Rephrase.hs view
@@ -11,8 +11,6 @@        , rephrasePattern        , rephrasePatElem        , Rephraser (..)--       , castStm        ) where @@ -87,21 +85,3 @@   , mapOnLParam = rephraseParam (rephraseLParamLore rephraser)   , mapOnOp = rephraseOp rephraser   }---- | Convert a binding from one lore to another, if possible.-castStm :: (SameScope from to,-            ExpAttr from ~ ExpAttr to,-            BodyAttr from ~ BodyAttr to,-            RetType from ~ RetType to,-            BranchType from ~ BranchType to) =>-           Stm from -> Maybe (Stm to)-castStm = rephraseStm caster-  where caster = Rephraser { rephraseExpLore = Just-                           , rephraseBodyLore = Just-                           , rephraseLetBoundLore = Just-                           , rephraseFParamLore = Just-                           , rephraseLParamLore = Just-                           , rephraseOp = const Nothing-                           , rephraseRetType = Just-                           , rephraseBranchType = Just-                           }
src/Futhark/Analysis/SymbolTable.hs view
@@ -7,16 +7,13 @@   , empty   , fromScope   , toScope-  , castSymbolTable     -- * Entries   , Entry   , deepen   , bindingDepth   , valueRange-  , loopVariable   , entryStm   , entryLetBoundAttr-  , entryFParamLore   , entryType   , asScalExp     -- * Lookup@@ -28,8 +25,6 @@   , lookupType   , lookupSubExp   , lookupScalExp-  , lookupValue-  , lookupVar   , lookupAliases   , available   , consume@@ -43,7 +38,6 @@   , insertFParams   , insertLParam   , insertArrayLParam-  , insertChunkLParam   , insertLoopVar     -- * Bounds   , updateBounds@@ -51,7 +45,6 @@   , setLowerBound   , isAtLeast     -- * Misc-  , enclosingLoopVars   , rangesRep   , hideIf   , hideCertified@@ -75,7 +68,6 @@ import qualified Futhark.Representation.AST as AST import Futhark.Analysis.ScalExp -import Futhark.Analysis.Rephrase import qualified Futhark.Analysis.AlgSimplify as AS import Futhark.Representation.AST.Attributes.Ranges   (Range, ScalExpRange, Ranged)@@ -116,51 +108,6 @@ toScope :: SymbolTable lore -> Scope lore toScope = M.map entryInfo . bindings --- | Try to convert a symbol table for one representation into a--- symbol table for another.  The two symbol tables will have the same--- keys, but some entries may be diferent (i.e. some expression--- entries will have been turned into free variable entries).-castSymbolTable :: (SameScope from to,-                    ExpAttr from ~ ExpAttr to,-                    BodyAttr from ~ BodyAttr to,-                    RetType from ~ RetType to,-                    BranchType from ~ BranchType to) =>-                   SymbolTable from -> SymbolTable to-castSymbolTable table = genCastSymbolTable loopVar letBound fParam lParam freeVar table-  where loopVar (LoopVarEntry r d it) = LoopVar $ LoopVarEntry r d it-        letBound e-          | Just e' <- castStm $ letBoundStm e =-              LetBound e { letBoundStm = e'-                         , letBoundAttr = letBoundAttr e-                         }-          | otherwise =-              FreeVar FreeVarEntry-              { freeVarAttr = LetInfo $ letBoundAttr e-              , freeVarStmDepth = letBoundStmDepth e-              , freeVarRange = letBoundRange e-              , freeVarIndex = \name is -> index' name is table-              , freeVarConsumed = letBoundConsumed e-              }--        fParam e = FParam e { fparamAttr = fparamAttr e }-        lParam e = LParam e { lparamAttr = lparamAttr e }-        freeVar e = FreeVar e { freeVarAttr = castNameInfo $ freeVarAttr e }--genCastSymbolTable :: (LoopVarEntry fromlore -> Entry tolore)-                   -> (LetBoundEntry fromlore -> Entry tolore)-                   -> (FParamEntry fromlore -> Entry tolore)-                   -> (LParamEntry fromlore -> Entry tolore)-                   -> (FreeVarEntry fromlore -> Entry tolore)-                   -> SymbolTable fromlore-                   -> SymbolTable tolore-genCastSymbolTable loopVar letBound fParam lParam freeVar vtable =-  vtable { bindings = M.map onEntry $ bindings vtable }-  where onEntry (LoopVar entry) = loopVar entry-        onEntry (LetBound entry) = letBound entry-        onEntry (FParam entry) = fParam entry-        onEntry (LParam entry) = lParam entry-        onEntry (FreeVar entry) = freeVar entry- deepen :: SymbolTable lore -> SymbolTable lore deepen vtable = vtable { loopDepth = loopDepth vtable + 1,                          availableAtClosestLoop = namesFromList $ M.keys $ bindings vtable@@ -306,14 +253,6 @@ entryLetBoundAttr (LetBound entry) = Just $ letBoundAttr entry entryLetBoundAttr _                = Nothing -entryFParamLore :: Entry lore -> Maybe (FParamAttr lore)-entryFParamLore (FParam entry) = Just $ fparamAttr entry-entryFParamLore _              = Nothing--loopVariable :: Entry lore -> Bool-loopVariable (LoopVar _) = True-loopVariable _           = False- asStm :: Entry lore -> Maybe (Stm lore) asStm = fmap letBoundStm . isVarBound @@ -361,16 +300,6 @@     (Just entry, _) -> asScalExp entry     _ -> Nothing -lookupValue :: VName -> SymbolTable lore -> Maybe (PrimValue, Certificates)-lookupValue name vtable = case lookupSubExp name vtable of-                            Just (Constant val, cs) -> Just (val, cs)-                            _                       -> Nothing--lookupVar :: VName -> SymbolTable lore -> Maybe (VName, Certificates)-lookupVar name vtable = case lookupSubExp name vtable of-                          Just (Var v, cs) -> Just (v, cs)-                          _                -> Nothing- lookupAliases :: VName -> SymbolTable lore -> Names lookupAliases name vtable = case M.lookup name $ bindings vtable of                               Just (LetBound e) -> letBoundAliases e@@ -408,14 +337,6 @@ lookupRange name vtable =   maybe (Nothing, Nothing) valueRange $ lookup name vtable -enclosingLoopVars :: [VName] -> SymbolTable lore -> [VName]-enclosingLoopVars free vtable =-  map fst $-  sortOn (Down . bindingDepth . snd) $-  filter (loopVariable . snd) $ mapMaybe fetch free-  where fetch name = do e <- lookup name vtable-                        return (name, e)- rangesRep :: SymbolTable lore -> AS.RangesRep rangesRep = M.filter knownRange . M.map toRep . bindings   where toRep entry = (bindingDepth entry, lower, upper)@@ -473,12 +394,6 @@  indexExp _ _ _ _ = Nothing -indexChunk :: SymbolTable lore -> VName -> VName -> IndexArray-indexChunk table offset array (i:is) =-  index' array (offset'+i:is) table-  where offset' = primExpFromSubExp (IntType Int32) (Var offset)-indexChunk _ _ _ _ = Nothing- defBndEntry :: (Attributes lore, IndexOp (Op lore)) =>                SymbolTable lore             -> PatElem lore@@ -643,19 +558,6 @@ insertArrayLParam param Nothing vtable =   -- Well, we still know that it's a param...   insertLParam param vtable--insertChunkLParam :: Attributes lore =>-                     VName -> LParam lore -> VName -> SymbolTable lore-                  -> SymbolTable lore-insertChunkLParam offset param array vtable =-  -- We now know that the outer size of 'array' is at least one, and-  -- that the inner sizes are at least zero, since they are array-  -- sizes.-  let vtable' = insertLParamWithRange param-                (lookupRange array vtable) (indexChunk vtable offset array) vtable-  in case arrayDims <$> lookupType array vtable of-    Just (Var v:_) -> (v `isAtLeast` 1) vtable'-    _              -> vtable'  insertLoopVar :: Attributes lore => VName -> IntType -> SubExp -> SymbolTable lore -> SymbolTable lore insertLoopVar name it bound = insertEntry name bind
src/Futhark/Analysis/UsageTable.hs view
@@ -4,16 +4,13 @@ module Futhark.Analysis.UsageTable   ( UsageTable   , empty-  , contains   , without   , lookup-  , keys   , used   , expand   , isConsumed   , isInResult   , isUsedDirectly-  , allConsumed   , usages   , usage   , consumedUsage@@ -53,8 +50,6 @@ empty :: UsageTable empty = UsageTable M.empty -contains :: UsageTable -> [VName] -> Bool-contains (UsageTable table) = Foldable.any (`M.member` table)  without :: UsageTable -> [VName] -> UsageTable without (UsageTable table) = UsageTable . Foldable.foldl (flip M.delete) table@@ -75,9 +70,6 @@                          namesToList $ look k         grow'' v m'' k = M.insertWith (<>) k v m'' -keys :: UsageTable -> [VName]-keys (UsageTable table) = M.keys table- is :: Usages -> VName -> UsageTable -> Bool is = lookupPred . matches @@ -91,10 +83,6 @@ -- remove it without anyone noticing?) isUsedDirectly :: VName -> UsageTable -> Bool isUsedDirectly = is presentU--allConsumed :: UsageTable -> Names-allConsumed (UsageTable m) =-  namesFromList . map fst . filter (matches consumedU . snd) $ M.toList m  usages :: Names -> UsageTable usages names = UsageTable $ M.fromList [ (name, presentU) | name <- namesToList names ]
src/Futhark/CodeGen/Backends/CSOpenCL.hs view
@@ -17,7 +17,7 @@ import Futhark.CodeGen.Backends.GenericCSharp.Options import Futhark.CodeGen.Backends.GenericCSharp.Definitions import Futhark.Util (zEncodeString)-import Futhark.MonadFreshNames hiding (newVName')+import Futhark.MonadFreshNames   compileProg :: MonadFreshNames m => Maybe String
src/Futhark/CodeGen/Backends/GenericC.hs view
@@ -30,7 +30,6 @@   , CompilerM   , CompilerState (compUserState)   , getUserState-  , putUserState   , modifyUserState   , contextContents   , contextFinalInits@@ -341,9 +340,6 @@ getUserState :: CompilerM op s s getUserState = gets compUserState -putUserState :: s -> CompilerM op s ()-putUserState s = modify $ \compstate -> compstate { compUserState = s }- modifyUserState :: (s -> s) -> CompilerM op s () modifyUserState f = modify $ \compstate ->   compstate { compUserState = f $ compUserState compstate }@@ -1231,6 +1227,11 @@     /* Declare and read input. */     set_binary_mode(stdin);     $items:input_items++    if (end_of_input() != 0) {+      panic(1, "Expected EOF on stdin after reading input for %s.\n", $string:(quote (pretty fname)));+    }+     $items:output_decls      /* Warmup run */
src/Futhark/CodeGen/Backends/GenericCSharp.hs view
@@ -52,18 +52,14 @@   , simpleCall   , callMethod   , simpleInitClass-  , parametrizedCall    , copyMemoryDefaultSpace   , consoleErrorWrite   , consoleErrorWriteLine-  , consoleWrite-  , consoleWriteLine    , publicName   , sizeOf   , privateFunDef-  , publicFunDef   , getDefaultDecl   ) where @@ -561,12 +557,6 @@ simpleCall :: String -> [CSExp] -> CSExp simpleCall fname = Call (Var fname) . map simpleArg --- | A 'Call' where the function is a variable and every argument is a--- simple 'Arg'.-parametrizedCall :: String -> String -> [CSExp] -> CSExp-parametrizedCall fname primtype = Call (Var fname') . map simpleArg-  where fname' = concat [fname, "<", primtype, ">"]- simpleArg :: CSExp -> CSArg simpleArg = Arg Nothing @@ -683,9 +673,6 @@ sizeOf :: CSType -> CSExp sizeOf t = simpleCall "sizeof" [(Var . pretty) t] -publicFunDef :: String -> CSType -> [(CSType, String)] -> [CSStmt] -> CSStmt-publicFunDef s t args stmts = PublicFunDef $ Def s t args stmts- privateFunDef :: String -> CSType -> [(CSType, String)] -> [CSStmt] -> CSStmt privateFunDef s t args stmts = PrivateFunDef $ Def s t args stmts @@ -696,12 +683,6 @@ valueDescVName (Imp.ScalarValue _ _ vname) = vname valueDescVName (Imp.ArrayValue vname _ _ _ _) = vname -consoleWrite :: String -> [CSExp] -> CSExp-consoleWrite str exps = simpleCall "Console.Write" $ String str:exps--consoleWriteLine :: String -> [CSExp] -> CSExp-consoleWriteLine str exps = simpleCall "Console.WriteLine" $ String str:exps- consoleErrorWrite :: String -> [CSExp] -> CSExp consoleErrorWrite str exps = simpleCall "Console.Error.Write" $ String str:exps @@ -969,8 +950,9 @@   if any isOpaque decl_args then     return (Def fname' VoidT [] [exitException], nameToString fname, Var fname')   else do-    (_, _, _, prepareIn, _, body_bin, prepare_out, res, prepare_run) <- prepareEntry entry+    (_, _, _, prepare_in, _, body_bin, prepare_out, res, prepare_run) <- prepareEntry entry     let str_input = map readInput decl_args+        end_of_input = [Exp $ simpleCall "EndOfInput" [String $ pretty fname]]      let outputDecls = map getDefaultDecl outputs         exitcall = [@@ -997,7 +979,7 @@     str_output <- printValue res      return (Def fname' VoidT [] $-             str_input ++ prepareIn ++ outputDecls +++             str_input ++ end_of_input ++ prepare_in ++ outputDecls ++              [Try [do_warmup_run, do_num_runs] [except']] ++              [close_runtime_file] ++              str_output,
src/Futhark/CodeGen/Backends/GenericCSharp/Definitions.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} module Futhark.CodeGen.Backends.GenericCSharp.Definitions-  ( csFunctions-  , csReader+  ( csReader   , csMemory   , csMemoryOpenCL   , csScalar@@ -11,9 +10,6 @@   ) where  import Data.FileEmbed--csFunctions :: String-csFunctions = $(embedStringFile "rts/csharp/functions.cs")  csMemory :: String csMemory = $(embedStringFile "rts/csharp/memory.cs")
src/Futhark/CodeGen/Backends/GenericPython.hs view
@@ -36,7 +36,6 @@   , CompilerEnv(..)   , CompilerState(..)   , stm-  , stms   , atInit   , collect'   , collect@@ -221,9 +220,6 @@ stm :: PyStmt -> CompilerM op s () stm x = tell [x] -stms :: [PyStmt] -> CompilerM op s ()-stms = mapM_ stm- futharkFun :: String -> String futharkFun s = "futhark_" ++ zEncodeString s @@ -614,9 +610,10 @@ callEntryFun :: [PyStmt] -> (Name, Imp.Function op)              -> CompilerM op s (PyFunDef, String, PyExp) callEntryFun pre_timing entry@(fname, Imp.Function _ _ _ _ _ decl_args) = do-  (_, _, prepareIn, _, body_bin, _, res, prepare_run) <- prepareEntry entry+  (_, _, prepare_in, _, body_bin, _, res, prepare_run) <- prepareEntry entry    let str_input = map readInput decl_args+      end_of_input = [Exp $ simpleCall "end_of_input" [String $ pretty fname]]        exitcall = [Exp $ simpleCall "sys.exit" [Field (String "Assertion.{} failed") "format(e)"]]       except' = Catch (Var "AssertionError") exitcall@@ -640,7 +637,7 @@   let fname' = "entry_" ++ nameToString fname    return (Def fname' [] $-           str_input ++ prepareIn +++           str_input ++ end_of_input ++ prepare_in ++            [Try [With errstate [do_warmup_run, do_num_runs]] [except']] ++            [close_runtime_file] ++            str_output,
src/Futhark/CodeGen/Backends/SimpleRepresentation.hs view
@@ -2,7 +2,6 @@ -- | Simple C runtime representation. module Futhark.CodeGen.Backends.SimpleRepresentation   ( tupleField-  , tupleFieldExp   , funName   , defaultMemBlockType   , primTypeToCType@@ -60,12 +59,6 @@ -- | @tupleField i@ is the name of field number @i@ in a tuple. tupleField :: Int -> String tupleField i = "v" ++ show i---- | @tupleFieldExp e i@ is the expression for accesing field @i@ of--- tuple @e@.  If @e@ is an lvalue, so will the resulting expression--- be.-tupleFieldExp :: C.ToExp a => a -> Int -> C.Exp-tupleFieldExp e i = [C.cexp|$exp:e.$id:(tupleField i)|]  -- | @funName f@ is the name of the C function corresponding to -- the Futhark function @f@.
src/Futhark/CodeGen/ImpGen.hs view
@@ -62,7 +62,6 @@   , dLParams   , dFParams   , dScope-  , dScopes   , dArray   , dPrim, dPrimVol_, dPrim_, dPrimV_, dPrimV, dPrimVE @@ -813,9 +812,6 @@  dScope :: Maybe (Exp lore) -> Scope ExplicitMemory -> ImpM lore op () dScope e = mapM_ (uncurry $ dInfo e) . M.toList--dScopes :: [(Maybe (Exp lore), Scope ExplicitMemory)] -> ImpM lore op ()-dScopes = mapM_ $ uncurry dScope  dArray :: VName -> PrimType -> ShapeBase SubExp -> MemBind -> ImpM lore op () dArray name bt shape membind = do
src/Futhark/CodeGen/ImpGen/Kernels/Base.hs view
@@ -47,7 +47,6 @@ import Futhark.Representation.ExplicitMemory import qualified Futhark.Representation.ExplicitMemory.IndexFunction as IxFun import qualified Futhark.CodeGen.ImpCode.Kernels as Imp-import Futhark.CodeGen.ImpCode.Kernels (elements) import Futhark.CodeGen.ImpGen import Futhark.Util.IntegralExp (quotRoundingUp, quot, rem) import Futhark.Util (chunks, maybeNth, mapAccumLM, takeLast, dropLast)@@ -713,27 +712,15 @@         globalMemory entry =           entry -writeParamToLocalMemory :: Typed (MemBound u) =>-                           Imp.Exp -> (VName, t) -> Param (MemBound u)+writeParamToLocalMemory :: Imp.Exp -> VName -> LParam ExplicitMemory                         -> ImpM lore op ()-writeParamToLocalMemory i (mem, _) param-  | Prim t <- paramType param =-      emit $-      Imp.Write mem (elements i) bt (Space "local") Imp.Volatile $-      Imp.var (paramName param) t-  | otherwise =-      return ()-  where bt = elemType $ paramType param+writeParamToLocalMemory i arr param =+  everythingVolatile $ copyDWIM arr [DimFix i] (Var $ paramName param) [] -readParamFromLocalMemory :: Typed (MemBound u) =>-                            Imp.Exp -> Param (MemBound u) -> (VName, t)+readParamFromLocalMemory :: Imp.Exp -> LParam ExplicitMemory -> VName                          -> ImpM lore op ()-readParamFromLocalMemory i param (l_mem, _)-  | Prim _ <- paramType param =-      paramName param <---      Imp.index l_mem (elements i) bt (Space "local") Imp.Volatile-  | otherwise = return ()-  where bt = elemType $ paramType param+readParamFromLocalMemory i param arr =+  everythingVolatile $ copyDWIM (paramName param) [] (Var arr) [DimFix i]  groupReduce :: ExplicitMemorish lore =>                KernelConstants@@ -842,10 +829,6 @@    renamed_lam <- renameLambda lam -  acc_local_mem <- flip zip (repeat ()) <$>-                   mapM (fmap (memLocationName . entryArrayLocation) .-                         lookupArray) arrs-   let ltid = kernelLocalThreadId constants       (x_params, y_params) = splitAt (length arrs) $ lambdaParams lam @@ -865,7 +848,7 @@       simd_width = kernelWaveSize constants       block_id = ltid `quot` block_size       in_block_id = ltid - block_id * block_size-      doInBlockScan seg_flag' active = inBlockScan seg_flag' simd_width block_size active ltid acc_local_mem+      doInBlockScan seg_flag' active = inBlockScan seg_flag' simd_width block_size active ltid arrs       ltid_in_bounds = ltid .<. w    doInBlockScan seg_flag ltid_in_bounds lam@@ -874,7 +857,7 @@   let last_in_block = in_block_id .==. block_size - 1   sComment "last thread of block 'i' writes its result to offset 'i'" $     sWhen (last_in_block .&&. ltid_in_bounds) $-    zipWithM_ (writeParamToLocalMemory block_id) acc_local_mem y_params+    zipWithM_ (writeParamToLocalMemory block_id) arrs y_params    sOp Imp.LocalBarrier @@ -891,7 +874,7 @@    let read_carry_in =         zipWithM_ (readParamFromLocalMemory (block_id - 1))-        x_params acc_local_mem+        x_params arrs    let op_to_y         | Nothing <- seg_flag =@@ -900,7 +883,7 @@             sUnless (flag_true (block_id*block_size-1) ltid) $               compileBody' y_params $ lambdaBody lam       write_final_result =-        zipWithM_ (writeParamToLocalMemory ltid) acc_local_mem y_params+        zipWithM_ (writeParamToLocalMemory ltid) arrs y_params    sComment "carry-in for every block except the first" $     sUnless (is_first_block .||. Imp.UnOpExp Not ltid_in_bounds) $ do@@ -920,10 +903,10 @@             -> Imp.Exp             -> Imp.Exp             -> Imp.Exp-            -> [(VName, t)]+            -> [VName]             -> Lambda ExplicitMemory             -> InKernelGen ()-inBlockScan seg_flag lockstep_width block_size active ltid acc_local_mem scan_lam = everythingVolatile $ do+inBlockScan seg_flag lockstep_width block_size active ltid arrs scan_lam = everythingVolatile $ do   skip_threads <- dPrim "skip_threads" int32   let in_block_thread_active =         Imp.var skip_threads int32 .<=. in_block_id@@ -932,11 +915,11 @@         splitAt (length actual_params `div` 2) actual_params       read_operands =         zipWithM_ (readParamFromLocalMemory $ ltid - Imp.var skip_threads int32)-        x_params acc_local_mem+        x_params arrs    -- Set initial y values   sWhen active $-    zipWithM_ (readParamFromLocalMemory ltid) y_params acc_local_mem+    zipWithM_ (readParamFromLocalMemory ltid) y_params arrs    let op_to_y         | Nothing <- seg_flag =@@ -945,7 +928,7 @@             sUnless (flag_true (ltid-Imp.var skip_threads int32) ltid) $               compileBody' y_params $ lambdaBody scan_lam       write_operation_result =-        zipWithM_ (writeParamToLocalMemory ltid) acc_local_mem y_params+        zipWithM_ (writeParamToLocalMemory ltid) arrs y_params       maybeLocalBarrier = sWhen (lockstep_width .<=. Imp.var skip_threads int32) $                           sOp Imp.LocalBarrier 
src/Futhark/CodeGen/ImpGen/Kernels/SegMap.hs view
@@ -29,11 +29,11 @@   group_size' <- traverse toExp $ segGroupSize lvl    case lvl of--    SegThread{} ->-      sKernelThread "segmap" num_groups' group_size' (segFlat space) $ \constants -> do+    SegThread{} -> do+      emit $ Imp.DebugPrint "\n# SegMap" Nothing       let virt_num_groups = product dims' `quotRoundingUp` unCount group_size'-      virtualiseGroups constants (segVirt lvl) virt_num_groups $ \group_id -> do+      sKernelThread "segmap" num_groups' group_size' (segFlat space) $ \constants ->+        virtualiseGroups constants (segVirt lvl) virt_num_groups $ \group_id -> do         let global_tid = Imp.vi32 group_id * unCount group_size' +                          kernelLocalThreadId constants 
src/Futhark/CodeGen/ImpGen/Kernels/SegRed.hs view
@@ -176,6 +176,8 @@    num_threads <- dPrimV "num_threads" $ unCount num_groups' * unCount group_size' +  emit $ Imp.DebugPrint "\n# SegRed" Nothing+   sKernelThread "segred_nonseg" num_groups' group_size' (segFlat space) $ \constants -> do     sync_arr <- sAllocArray "sync_arr" Bool (Shape [intConst Int32 1]) $ Space "local"     reds_arrs <- mapM (intermediateArrays group_size (Var num_threads)) reds
src/Futhark/CodeGen/ImpGen/Kernels/SegScan.hs view
@@ -243,10 +243,11 @@                -> KernelBody ExplicitMemory                -> CallKernelGen () compileSegScan pat lvl space scan_op nes kbody = do+  emit $ Imp.DebugPrint "\n# SegScan" Nothing+   (elems_per_group, crossesSegment) <-     scanStage1 pat (segNumGroups lvl) (segGroupSize lvl) space scan_op nes kbody -  emit $ Imp.DebugPrint "\n# SegScan" Nothing   emit $ Imp.DebugPrint "elems_per_group" $ Just elems_per_group    scan_op' <- renameLambda scan_op
src/Futhark/Construct.hs view
@@ -5,7 +5,6 @@   ( letSubExp   , letSubExps   , letExp-  , letExps   , letTupExp   , letTupExp'   , letInPlace@@ -16,9 +15,7 @@   , eBinOp   , eCmpOp   , eConvOp-  , eNegate   , eNot-  , eAbs   , eSignum   , eCopy   , eAssert@@ -102,10 +99,6 @@               String -> [Exp (Lore m)] -> m [SubExp] letSubExps desc = mapM $ letSubExp desc -letExps :: MonadBinder m =>-           String -> [Exp (Lore m)] -> m [VName]-letExps desc = mapM $ letExp desc- letTupExp :: (MonadBinder m) =>              String -> Exp (Lore m)           -> m [VName]@@ -175,39 +168,9 @@   x' <- letSubExp "x" =<< x   return $ BasicOp $ ConvOp op x' -eNegate :: MonadBinder m =>-           m (Exp (Lore m)) -> m (Exp (Lore m))-eNegate em = do-  e <- em-  e' <- letSubExp "negate_arg" e-  t <- subExpType e'-  case t of-    Prim (IntType int_t) ->-      return $ BasicOp $-      BinOp (Sub int_t) (intConst int_t 0) e'-    Prim (FloatType float_t) ->-      return $ BasicOp $-      BinOp (FSub float_t) (floatConst float_t 0) e'-    _ ->-      error $ "eNegate: operand " ++ pretty e ++ " has invalid type."- eNot :: MonadBinder m =>         m (Exp (Lore m)) -> m (Exp (Lore m)) eNot e = BasicOp . UnOp Not <$> (letSubExp "not_arg" =<< e)--eAbs :: MonadBinder m =>-        m (Exp (Lore m)) -> m (Exp (Lore m))-eAbs em = do-  e <- em-  e' <- letSubExp "abs_arg" e-  t <- subExpType e'-  case t of-    Prim (IntType int_t) ->-      return $ BasicOp $ UnOp (Abs int_t) e'-    Prim (FloatType float_t) ->-      return $ BasicOp $ UnOp (FAbs float_t) e'-    _ ->-      error $ "eAbs: operand " ++ pretty e ++ " has invalid type."  eSignum :: MonadBinder m =>         m (Exp (Lore m)) -> m (Exp (Lore m))
src/Futhark/Doc/Html.hs view
@@ -1,6 +1,5 @@ module Futhark.Doc.Html   ( primTypeHtml-  , prettyTypeName   , prettyU   , renderName   , joinBy@@ -23,9 +22,6 @@  primTypeHtml :: PrimType -> Html primTypeHtml = docToHtml . ppr--prettyTypeName :: TypeName -> Html-prettyTypeName et = (docToHtml . ppr) (baseName <$> qualNameFromTypeName et)  prettyU :: Uniqueness -> Html prettyU = docToHtml . ppr
src/Futhark/FreshNames.hs view
@@ -5,8 +5,6 @@   , blankNameSource   , newNameSource   , newName-  , newVName-  , newVNameFromName   ) where  import Language.Haskell.TH.Syntax (Lift)@@ -41,11 +39,3 @@ -- | A new name source that starts counting from the given number. newNameSource :: Int -> VNameSource newNameSource = VNameSource---- | Produce a fresh 'VName', using the given base name as a template.-newVName :: VNameSource -> String -> (VName, VNameSource)-newVName src = newVNameFromName src . nameFromString---- | Produce a fresh 'VName', using the given base name as a template.-newVNameFromName :: VNameSource -> Name -> (VName, VNameSource)-newVNameFromName src s = newName src $ VName s 0
src/Futhark/Internalise.hs view
@@ -583,14 +583,14 @@   -- information.  For a type-correct source program, these reshapes   -- should simplify away.   let merge = ctxmerge ++ valmerge-      merge_names = map (I.paramName . fst) merge-      merge_ts = existentialiseExtTypes merge_names $-                 staticShapes $ map (I.paramType . fst) merge+      merge_ts = map (I.paramType . fst) merge   loopbody'' <- localScope (scopeOfFParams $ map fst merge) $-                inScopeOf form' $-                ensureResultExtShapeNoCtx asserting-                "shape of loop result does not match shapes in loop parameter"-                loc merge_ts loopbody'+                inScopeOf form' $ insertStmsM $+    resultBodyM+    =<< ensureArgShapes asserting+        "shape of loop result does not match shapes in loop parameter"+        loc (map (I.paramName . fst) ctxmerge) merge_ts+    =<< bodyBind loopbody'    loop_res <- map I.Var . dropCond <$>               letTupExp desc (I.DoLoop ctxmerge valmerge form' loopbody'')
src/Futhark/Internalise/AccurateSizes.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} module Futhark.Internalise.AccurateSizes   ( shapeBody-  , annotateArrayShape   , argShapes   , ensureResultShape   , ensureResultExtShape@@ -28,12 +27,6 @@     ses <- bodyBind body     sets <- mapM subExpType ses     resultBodyM $ argShapes shapenames ts sets--annotateArrayShape :: ArrayShape shape =>-                      TypeBase shape u -> [Int] -> TypeBase Shape u-annotateArrayShape t newshape =-  t `setArrayShape` Shape (take (arrayRank t) $-                           map (intConst Int32 . toInteger) $ newshape ++ repeat 0)  argShapes :: [VName] -> [TypeBase Shape u0] -> [TypeBase Shape u1] -> [SubExp] argShapes shapes valts valargts =
src/Futhark/Internalise/Defunctionalise.hs view
@@ -758,6 +758,8 @@         problematic v = (v `member` bound) && not (boundAsUnique v)         comb (Scalar (Record fs_annot)) (Scalar (Record fs_got)) =           Scalar $ Record $ M.intersectionWith comb fs_annot fs_got+        comb (Scalar (Sum cs_annot)) (Scalar (Sum cs_got)) =+          Scalar $ Sum $ M.intersectionWith (zipWith comb) cs_annot cs_got         comb (Scalar Arrow{}) t =           descend t         comb got et =
src/Futhark/MonadFreshNames.hs view
@@ -11,12 +11,9 @@   , newName   , newNameFromString   , newVName-  , newVName'   , newIdent   , newIdent'-  , newIdents   , newParam-  , newParam'   , module Futhark.FreshNames   ) where @@ -32,7 +29,7 @@  import Futhark.Representation.AST.Syntax import qualified Futhark.FreshNames as FreshNames-import Futhark.FreshNames hiding (newName, newVName)+import Futhark.FreshNames hiding (newName)  -- | A monad that stores a name source.  The following is a good -- instance for a monad in which the only state is a @NameSource vn@:@@ -89,11 +86,6 @@ newVName :: MonadFreshNames m => String -> m VName newVName = newID . nameFromString --- | Produce a fresh 'VName', using the given name as a template, but--- possibly appending something more..-newVName' :: MonadFreshNames m => (String -> String) -> String -> m VName-newVName' f = newID . nameFromString . f- -- | Produce a fresh 'Ident', using the given name as a template. newIdent :: MonadFreshNames m =>             String -> Type -> m Ident@@ -110,27 +102,12 @@   newIdent (f $ nameToString $ baseName $ identName ident)            (identType ident) --- | Produce several 'Ident's, using the given name as a template,--- based on a list of types.-newIdents :: MonadFreshNames m =>-             String -> [Type] -> m [Ident]-newIdents = mapM . newIdent- -- | Produce a fresh 'Param', using the given name as a template. newParam :: MonadFreshNames m =>             String -> attr -> m (Param attr) newParam s t = do   s' <- newID $ nameFromString s   return $ Param s' t---- | Produce a fresh 'Param', using the given 'Param' as a template,--- but possibly modifying the name.-newParam' :: MonadFreshNames m =>-             (String -> String)-          -> Param attr -> m (Param attr)-newParam' f param =-  newParam (f $ nameToString $ baseName $ paramName param)-           (paramAttr param)  -- Utility instance defintions for MTL classes.  This requires -- UndecidableInstances, but saves on typing elsewhere.
src/Futhark/Optimise/Fusion/LoopKernel.hs view
@@ -6,7 +6,6 @@   , inputs   , setInputs   , arrInputs-  , kernelType   , transformOutput   , attemptFusion   , SOAC@@ -126,9 +125,6 @@  setInputs :: [SOAC.Input] -> FusedKer -> FusedKer setInputs inps ker = ker { fsoac = inps `SOAC.setInputs` fsoac ker }--kernelType :: FusedKer -> [Type]-kernelType = SOAC.typeOf . fsoac  tryOptimizeSOAC :: Names -> [VName] -> SOAC -> Names -> FusedKer                 -> TryFusion FusedKer
src/Futhark/Optimise/Simplify/Engine.hs view
@@ -22,7 +22,6 @@        ( -- * Monadic interface          SimpleM        , runSimpleM-       , subSimpleM        , SimpleOps (..)        , SimplifyOp        , bindableSimpleOps@@ -49,7 +48,6 @@        , simplifyStms        , simplifyFun        , simplifyLambda-       , simplifyLambdaSeq        , simplifyLambdaNoHoisting        , simplifyParam        , bindLParams@@ -167,16 +165,6 @@   let (x, (src', b, _)) = runState (runReaderT m (simpl, env)) (src, False, mempty)   in ((x, b), src') -subSimpleM :: RuleBook (Wise lore)-           -> HoistBlockers lore-           -> SimpleM lore a-           -> SimpleM lore a-subSimpleM rules blockers =-  local $ \(ops, env) -> (ops,-                          env { envRules = rules-                              , envHoistBlockers = blockers-                              })- askEngineEnv :: SimpleM lore (Env lore) askEngineEnv = asks snd @@ -829,12 +817,6 @@ simplifyLambda lam arrs = do   par_blocker <- asksEngineEnv $ blockHoistPar . envHoistBlockers   simplifyLambdaMaybeHoist par_blocker lam arrs--simplifyLambdaSeq :: SimplifiableLore lore =>-                     Lambda lore-                  -> [Maybe VName]-                  -> SimpleM lore (Lambda (Wise lore), Stms (Wise lore))-simplifyLambdaSeq = simplifyLambdaMaybeHoist neverBlocks  simplifyLambdaNoHoisting :: SimplifiableLore lore =>                             Lambda lore
src/Futhark/Optimise/Simplify/Lore.hs view
@@ -10,11 +10,9 @@        , ExpWisdom        , removeStmWisdom        , removeLambdaWisdom-       , removeProgWisdom        , removeFunDefWisdom        , removeExpWisdom        , removePatternWisdom-       , removePatElemWisdom        , removeBodyWisdom        , removeScopeWisdom        , addScopeWisdom@@ -175,9 +173,6 @@         alias (LParamInfo attr) = LParamInfo attr         alias (IndexInfo it) = IndexInfo it -removeProgWisdom :: CanBeWise (Op lore) => Prog (Wise lore) -> Prog lore-removeProgWisdom = runIdentity . rephraseProg removeWisdom- removeFunDefWisdom :: CanBeWise (Op lore) => FunDef (Wise lore) -> FunDef lore removeFunDefWisdom = runIdentity . rephraseFunDef removeWisdom @@ -195,9 +190,6 @@  removePatternWisdom :: PatternT (VarWisdom, a) -> PatternT a removePatternWisdom = runIdentity . rephrasePattern (return . snd)--removePatElemWisdom :: PatElemT (VarWisdom, a) -> PatElemT a-removePatElemWisdom = runIdentity . rephrasePatElem (return . snd)  addWisdomToPattern :: (Attributes lore, CanBeWise (Op lore)) =>                       Pattern lore
src/Futhark/Pass/ExpandAllocations.hs view
@@ -403,7 +403,7 @@           return patElem { patElemAttr = new_attr }         inspectCtx patElem           | Mem space <- patElemType patElem,-            space /= Space "local" =+            space `notElem` [Space "local", Space "private"] =               throwError $ unwords ["Cannot deal with existential memory block",                                     pretty (patElemName patElem),                                     "when expanding inside kernels."]
src/Futhark/Pass/ExtractKernels.hs view
@@ -351,10 +351,11 @@   -- map function.  Such cases will fall through to the   -- screma-splitting case, and produce an ordinary map and scan.   -- Hopefully, the scan then triggers the ISWIM case above (otherwise-  -- we will still crash in code generation).+  -- we will still crash in code generation).  However, if the map+  -- lambda is already identity, let's just go ahead here.   | Just (scan_lam, nes, map_lam) <- isScanomapSOAC form,-    all primType $ lambdaReturnType scan_lam,-    not $ lambdaContainsParallelism map_lam = runBinder_ $ do+    (all primType (lambdaReturnType scan_lam) &&+     not (lambdaContainsParallelism map_lam)) || isIdentityLambda map_lam = runBinder_ $ do       let scan_lam' = soacsLambdaToKernels scan_lam           map_lam' = soacsLambdaToKernels map_lam       lvl <- segThreadCapped [w] "segscan" $ NoRecommendation SegNoVirt
src/Futhark/Pass/ExtractKernels/Distribution.hs view
@@ -31,7 +31,6 @@        , newKernel        , pushKernelNesting        , pushInnerKernelNesting-       , removeArraysFromNest        , kernelNestLoops        , kernelNestWidths        , boundInKernelNest@@ -208,18 +207,6 @@         fixed_target = sortOn posInInnerPat $ zip (patternValueIdents pat) res         posInInnerPat (_, Var v) = fromMaybe 0 $ elemIndex v $ patternNames inner_pat         posInInnerPat _          = 0---- | Remove these arrays from the outermost nesting, and all--- uses of corresponding parameters from innermost nesting.-removeArraysFromNest :: [VName] -> KernelNest -> KernelNest-removeArraysFromNest orig_arrs (outer, inners) =-  let (arrs, outer') = remove (namesFromList orig_arrs) outer-      (_, inners') = mapAccumL remove arrs inners-  in (outer', inners')-  where remove arrs nest =-          let (discard, keep) = partition ((`nameIn` arrs) . snd) $ loopNestingParamsAndArrs nest-          in (namesFromList (map (paramName . fst) discard) <> arrs,-              nest { loopNestingParamsAndArrs = keep })  newKernel :: LoopNesting -> KernelNest newKernel nest = (nest, [])
src/Futhark/Pipeline.hs view
@@ -15,7 +15,6 @@        , onePass        , passes        , runPasses-       , runPipeline        )        where @@ -108,17 +107,6 @@           -> Prog fromlore           -> FutharkM (Prog tolore) runPasses = unPipeline--runPipeline :: Pipeline fromlore tolore-            -> PipelineConfig-            -> Prog fromlore-            -> Action tolore-            -> FutharkM ()-runPipeline p cfg prog a = do-  prog' <- runPasses p cfg prog-  when (pipelineVerbose cfg) $ logMsg $-    "Running action " <> T.pack (actionName a)-  actionProcedure a prog'  onePass :: (Checkable fromlore, Checkable tolore) =>            Pass fromlore tolore -> Pipeline fromlore tolore
src/Futhark/Representation/AST/Attributes.hs view
@@ -30,7 +30,6 @@   , stmCerts   , certify   , expExtTypesFromPattern-  , patternFromParams    , IsOp (..)   , Attributes (..)@@ -218,8 +217,3 @@ expExtTypesFromPattern pat =   existentialiseExtTypes (patternContextNames pat) $   staticShapes $ map patElemType $ patternValueElements pat---- | Create a pattern corresponding to some parameters.-patternFromParams :: [Param attr] -> PatternT attr-patternFromParams = Pattern [] . map toPatElem-  where toPatElem p = PatElem (paramName p) $ paramAttr p
src/Futhark/Representation/AST/Attributes/Patterns.hs view
@@ -21,7 +21,6 @@        , patternContextNames        , patternTypes        , patternValueTypes-       , patternExtTypes        , patternSize        -- * Pattern construction        , basicPattern@@ -29,8 +28,7 @@        where  import Futhark.Representation.AST.Syntax-import Futhark.Representation.AST.Attributes.Types-  (existentialiseExtTypes, staticShapes, Typed(..), DeclTyped(..))+import Futhark.Representation.AST.Attributes.Types (Typed(..), DeclTyped(..))  -- | The 'Type' of a parameter. paramType :: Typed attr => Param attr -> Type@@ -91,14 +89,6 @@ -- | Return a list of the 'Types's bound by the value part of the 'Pattern'. patternValueTypes :: Typed attr => PatternT attr -> [Type] patternValueTypes = map identType . patternValueIdents---- | Return a list of the 'ExtTypes's bound by the value part of the--- 'Pattern', with existentials where the sizes are part of the--- context part of the 'Pattern'.-patternExtTypes :: Typed attr => PatternT attr -> [ExtType]-patternExtTypes pat =-  existentialiseExtTypes (patternContextNames pat)-  (staticShapes (patternValueTypes pat))  -- | Return the number of names bound by the 'Pattern'. patternSize :: PatternT attr -> Int
src/Futhark/Representation/AST/Attributes/Reshape.hs view
@@ -19,7 +19,6 @@           -- * Simplification        , fuseReshape-       , fuseReshapes        , informReshape           -- * Shape calculations@@ -118,13 +117,6 @@           d2 -- TODO: intelligently handle case where s1 is a prefix of s2. fuseReshape _ s2 = s2---- | @fuseReshapes s ss@ creates a fused 'ShapeChange' that is--- logically the same as first applying @s@ and then the changes in--- @ss@ from left to right.-fuseReshapes :: (Eq d, Data.Foldable.Foldable t) =>-                ShapeChange d -> t (ShapeChange d) -> ShapeChange d-fuseReshapes = Data.Foldable.foldl fuseReshape  -- | Given concrete information about the shape of the source array, -- convert some 'DimNew's into 'DimCoercion's.
src/Futhark/Representation/AST/Attributes/Types.hs view
@@ -9,7 +9,6 @@        , setArrayShape        , existential        , uniqueness-       , setUniqueness        , unique        , staticShapes        , staticShapes1@@ -23,7 +22,6 @@        , setOuterDim        , setDim        , setArrayDims-       , setArrayExtDims        , peelArray        , stripArray        , arrayDims@@ -130,13 +128,6 @@ unique :: TypeBase shape Uniqueness -> Bool unique = (==Unique) . uniqueness --- | Set the uniqueness attribute of a type.-setUniqueness :: TypeBase shape Uniqueness-              -> Uniqueness-              -> TypeBase shape Uniqueness-setUniqueness (Array et dims _) u = Array et dims u-setUniqueness t _ = t- -- | Convert types with non-existential shapes to types with -- non-existential shapes.  Only the representation is changed, so all -- the shapes will be 'Free'.@@ -190,11 +181,6 @@ -- array, return the type unchanged. setArrayDims :: TypeBase oldshape u -> [SubExp] -> TypeBase Shape u setArrayDims t dims = t `setArrayShape` Shape dims---- | Set the existential dimensions of an array.  If the given type is--- not an array, return the type unchanged.-setArrayExtDims :: TypeBase oldshape u -> [ExtSize] -> TypeBase ExtShape u-setArrayExtDims t dims = t `setArrayShape` Shape dims  -- | Replace the size of the outermost dimension of an array.  If the -- given type is not an array, it is returned unchanged.
src/Futhark/Representation/AST/Traversals.hs view
@@ -30,7 +30,6 @@   , mapExp   , mapOnType   , mapOnLoopForm-  , mapOnExtType    -- * Walking   , Walker(..)@@ -153,16 +152,6 @@  mapOnShape :: Monad m => Mapper flore tlore m -> Shape -> m Shape mapOnShape tv (Shape ds) = Shape <$> mapM (mapOnSubExp tv) ds--mapOnExtType :: Monad m =>-                Mapper flore tlore m -> TypeBase ExtShape u -> m (TypeBase ExtShape u)-mapOnExtType tv (Array bt (Shape shape) u) =-  Array bt <$> (Shape <$> mapM mapOnExtSize shape) <*>-  return u-  where mapOnExtSize (Ext x)   = return $ Ext x-        mapOnExtSize (Free se) = Free <$> mapOnSubExp tv se-mapOnExtType _ (Prim bt) = return $ Prim bt-mapOnExtType _ (Mem space) = pure $ Mem space  mapOnLoopForm :: Monad m =>                  Mapper flore tlore m -> LoopForm flore -> m (LoopForm tlore)
src/Futhark/Representation/ExplicitMemory/IndexFunction.hs view
@@ -6,14 +6,12 @@        , index        , iota        , offsetIndex-       , strideIndex        , permute        , rotate        , reshape        , slice        , rebase        , repeat-       , isContiguous        , shape        , rank        , linearWithOffset@@ -225,10 +223,6 @@      (zip4 dims [0..length dims - 1] oshp strides_expected) isDirect _ = False --- | Does the index function have contiguous memory support?-isContiguous :: (Eq num, IntegralExp num) => IxFun num -> Bool-isContiguous ixfun = ixfunContig ixfun && hasContiguousPerm ixfun- -- | Does the index function have an ascending permutation? hasContiguousPerm :: IxFun num -> Bool hasContiguousPerm (IxFun (lmad :| []) _ _) =@@ -701,15 +695,6 @@ offsetIndex ixfun i =   case shape ixfun of     d : ds -> slice ixfun (DimSlice i (d - i) 1 : map (unitSlice 0) ds)-    [] -> error "offsetIndex: underlying index function has rank zero"---- | Stride index.  Results in the index function corresponding to making the--- outermost dimension strided by @s@.-strideIndex :: (Eq num, IntegralExp num) =>-               IxFun num -> num -> IxFun num-strideIndex ixfun s =-  case shape ixfun of-    d : ds -> slice ixfun (DimSlice 0 d s : map (unitSlice 0) ds)     [] -> error "offsetIndex: underlying index function has rank zero"  -- | If the memory support of the index function is contiguous and row-major
src/Futhark/Representation/Kernels/Kernel.hs view
@@ -35,9 +35,6 @@        , SegOpMapper(..)        , identitySegOpMapper        , mapSegOpM-       , SegOpWalker(..)-       , identitySegOpWalker-       , walkSegOpM         -- * Size operations        , SizeOp(..)@@ -651,39 +648,6 @@ mapOnSegOpType tv (Array pt shape u) = Array pt <$> f shape <*> pure u   where f (Shape dims) = Shape <$> mapM (mapOnSegOpSubExp tv) dims mapOnSegOpType _tv (Mem s) = pure $ Mem s---- | Like 'Walker', but just for 'SegOp's.-data SegOpWalker lore m = SegOpWalker {-    walkOnSegOpSubExp :: SubExp -> m ()-  , walkOnSegOpLambda :: Lambda lore -> m ()-  , walkOnSegOpBody :: KernelBody lore -> m ()-  , walkOnSegOpVName :: VName -> m ()-  }---- | A no-op traversal.-identitySegOpWalker :: Monad m => SegOpWalker lore m-identitySegOpWalker = SegOpWalker {-    walkOnSegOpSubExp = const $ return ()-  , walkOnSegOpLambda = const $ return ()-  , walkOnSegOpBody = const $ return ()-  , walkOnSegOpVName = const $ return ()-  }--walkSegOpMapper :: forall lore m. Monad m =>-                   SegOpWalker lore m -> SegOpMapper lore lore m-walkSegOpMapper f = SegOpMapper {-    mapOnSegOpSubExp = wrap walkOnSegOpSubExp-  , mapOnSegOpLambda = wrap walkOnSegOpLambda-  , mapOnSegOpBody = wrap walkOnSegOpBody-  , mapOnSegOpVName = wrap walkOnSegOpVName-  }-  where wrap :: (SegOpWalker lore m -> a -> m ()) -> a -> m a-        wrap op k = op f k >> return k---- | As 'mapSegOpM', but ignoring the results.-walkSegOpM :: Monad m => SegOpWalker lore m -> SegOp lore -> m ()-walkSegOpM f = void . mapSegOpM m-  where m = walkSegOpMapper f  instance Attributes lore => Substitute (SegOp lore) where   substituteNames subst = runIdentity . mapSegOpM substitute
src/Futhark/Representation/Kernels/Simplify.hs view
@@ -67,6 +67,7 @@   (reds', reds_hoisted) <- fmap unzip $ forM reds $ \(SegRedOp comm lam nes shape) -> do     (lam', hoisted) <-       Engine.localVtable (<>scope_vtable) $+      Engine.localVtable (\vtable -> vtable { ST.simplifyMemory = True }) $       Engine.simplifyLambda lam $ replicate (length nes * 2) Nothing     shape' <- Engine.simplify shape     nes' <- mapM Engine.simplify nes@@ -99,6 +100,7 @@       dims' <- Engine.simplify dims       (lam', op_hoisted) <-         Engine.localVtable (<>scope_vtable) $+        Engine.localVtable (\vtable -> vtable { ST.simplifyMemory = True }) $         Engine.simplifyLambda lam $         replicate (length nes * 2) Nothing       return (HistOp w' rf' arrs' nes' dims' lam',@@ -142,6 +144,7 @@    (scan_op', scan_op_hoisted) <-     Engine.localVtable (<>scope_vtable) $+    Engine.localVtable (\vtable -> vtable { ST.simplifyMemory = True }) $     Engine.simplifyLambda scan_op $ replicate (length nes * 2) Nothing    (kbody', body_hoisted) <- simplifyKernelBody space kbody
src/Futhark/Representation/Primitive.hs view
@@ -696,7 +696,7 @@ doSIToFP v t = floatValue t $ intToInt64 v  doCmpOp :: CmpOp -> PrimValue -> PrimValue -> Maybe Bool-doCmpOp CmpEq{} v1 v2                            = Just $ v1 == v2+doCmpOp CmpEq{} v1 v2                            = Just $ doCmpEq v1 v2 doCmpOp CmpUlt{} (IntValue v1) (IntValue v2)     = Just $ doCmpUlt v1 v2 doCmpOp CmpUle{} (IntValue v1) (IntValue v2)     = Just $ doCmpUle v1 v2 doCmpOp CmpSlt{} (IntValue v1) (IntValue v2)     = Just $ doCmpSlt v1 v2
src/Futhark/Representation/Ranges.hs view
@@ -17,13 +17,10 @@        , module Futhark.Representation.AST.Syntax          -- * Adding ranges        , addRangesToPattern-       , mkRangedLetStm        , mkRangedBody        , mkPatternRanges        , mkBodyRanges          -- * Removing ranges-       , removeProgRanges-       , removeFunDefRanges        , removeExpRanges        , removeBodyRanges        , removeStmRanges@@ -110,14 +107,6 @@                          , rephraseOp = return . removeOpRanges                          } -removeProgRanges :: CanBeRanged (Op lore) =>-                    Prog (Ranges lore) -> Prog lore-removeProgRanges = runIdentity . rephraseProg removeRanges--removeFunDefRanges :: CanBeRanged (Op lore) =>-                      FunDef (Ranges lore) -> FunDef lore-removeFunDefRanges = runIdentity . rephraseFunDef removeRanges- removeExpRanges :: CanBeRanged (Op lore) =>                    Exp (Ranges lore) -> Exp lore removeExpRanges = runIdentity . rephraseExp removeRanges@@ -174,14 +163,6 @@           | otherwise                                 = Just bound         removeUnknownBound Nothing =           Nothing--mkRangedLetStm :: (Attributes lore, CanBeRanged (Op lore)) =>-                  Pattern lore-               -> ExpAttr lore-               -> Exp (Ranges lore)-               -> Stm (Ranges lore)-mkRangedLetStm pat explore e =-  Let (addRangesToPattern pat e) (StmAux mempty explore) e  -- It is convenient for a wrapped aliased lore to also be aliased. 
src/Futhark/Representation/SOACS/SOAC.hs view
@@ -24,7 +24,6 @@         , mkIdentityLambda        , isIdentityLambda-       , composeLambda        , nilFn        , scanomapSOAC        , redomapSOAC@@ -71,7 +70,7 @@ import Futhark.Analysis.Metrics import qualified Futhark.Analysis.Range as Range import Futhark.Construct-import Futhark.Util (maybeNth, chunks, splitAt3)+import Futhark.Util (maybeNth, chunks)  data SOAC lore =     Stream SubExp (StreamForm lore) (Lambda lore) [VName]@@ -175,37 +174,6 @@ isIdentityLambda :: Lambda lore -> Bool isIdentityLambda lam = bodyResult (lambdaBody lam) ==                        map (Var . paramName) (lambdaParams lam)--composeLambda :: (Bindable lore, BinderOps lore, MonadFreshNames m,-                  HasScope somelore m, SameScope somelore lore) =>-                 Lambda lore-              -> Lambda lore-              -> Lambda lore-              -> m (Lambda lore)-composeLambda scan_fun red_fun map_fun = do-  body <- runBodyBinder $ inScopeOf scan_fun $ inScopeOf red_fun $ inScopeOf map_fun $ do-    mapM_ addStm $ bodyStms $ lambdaBody map_fun-    let (scan_res, red_res, map_res) = splitAt3 n m $ bodyResult $ lambdaBody map_fun--    forM_ (zip scan_y_params scan_res) $ \(p,se) ->-      letBindNames_ [paramName p] $ BasicOp $ SubExp se-    forM_ (zip red_y_params red_res) $ \(p,se) ->-      letBindNames_ [paramName p] $ BasicOp $ SubExp se-    mapM_ addStm $ bodyStms $ lambdaBody scan_fun-    mapM_ addStm $ bodyStms $ lambdaBody red_fun--    resultBodyM $-      bodyResult (lambdaBody scan_fun) ++-      bodyResult (lambdaBody red_fun) ++-      map_res--  return Lambda { lambdaParams = scan_x_params ++ red_x_params ++ lambdaParams map_fun-                , lambdaBody = body-                , lambdaReturnType = lambdaReturnType map_fun }-  where n = length $ lambdaReturnType scan_fun-        m = length $ lambdaReturnType red_fun-        (scan_x_params, scan_y_params) = splitAt n $ lambdaParams scan_fun-        (red_x_params, red_y_params) = splitAt m $ lambdaParams red_fun  -- | A lambda with no parameters that returns no values. nilFn :: Bindable lore => Lambda lore
src/Futhark/Representation/SOACS/Simplify.hs view
@@ -8,7 +8,6 @@        ( simplifySOACS        , simplifyLambda        , simplifyFun-       , simplifyFun'        , simplifyStms         , simpleSOACS@@ -66,10 +65,6 @@ simplifyFun :: MonadFreshNames m => FunDef SOACS -> m (FunDef SOACS) simplifyFun =   Simplify.simplifyFun simpleSOACS soacRules Engine.noExtraHoistBlockers--simplifyFun' :: MonadFreshNames m => FunDef SOACS -> m (FunDef SOACS)-simplifyFun' =-  Simplify.simplifyFun simpleSOACS mempty Engine.noExtraHoistBlockers  simplifyLambda :: (HasScope SOACS m, MonadFreshNames m) =>                   Lambda -> [Maybe VName] -> m Lambda
src/Futhark/Tools.hs view
@@ -6,12 +6,10 @@    , nonuniqueParams   , redomapToMapAndReduce-  , scanomapToMapAndScan   , dissectScrema   , sequentialStreamWholeArray    , partitionChunkedFoldParameters-  , partitionChunkedKernelLambdaParameters   , partitionChunkedKernelFoldParameters    -- * Primitive expressions@@ -67,25 +65,6 @@ redomapToMapAndReduce _ _ =   error "redomapToMapAndReduce does not handle a non-empty 'patternContextElements'" --- | Like 'redomapToMapAndReduce', but for 'Scanomap'.-scanomapToMapAndScan :: (MonadFreshNames m, Bindable lore,-                          ExpAttr lore ~ (), Op lore ~ SOAC lore) =>-                        Pattern lore-                     -> ( SubExp-                        , LambdaT lore, LambdaT lore, [SubExp]-                        , [VName])-                     -> m (Stm lore, Stm lore)-scanomapToMapAndScan (Pattern [] patelems) (w, scanlam, map_lam, accs, arrs) = do-  (map_pat, scan_pat, scan_args) <--    splitScanOrRedomap patelems w map_lam accs-  let map_bnd = mkLet [] map_pat $ Op $ Screma w (mapSOAC map_lam) arrs-      (nes, scan_arrs) = unzip scan_args-  scan_bnd <- Let scan_pat (defAux ()) . Op <$>-              (Screma w <$> scanSOAC scanlam nes <*> pure scan_arrs)-  return (map_bnd, scan_bnd)-scanomapToMapAndScan _ _ =-  error "scanomapToMapAndScan does not handle a non-empty 'patternContextElements'"- splitScanOrRedomap :: (Typed attr, MonadFreshNames m) =>                       [PatElemT attr]                    -> SubExp -> LambdaT lore -> [SubExp]@@ -180,10 +159,3 @@   in (paramName i_param, chunk_param, acc_params, arr_params) partitionChunkedKernelFoldParameters _ _ =   error "partitionChunkedKernelFoldParameters: lambda takes too few parameters"--partitionChunkedKernelLambdaParameters :: [Param attr]-                                       -> (VName, Param attr, [Param attr])-partitionChunkedKernelLambdaParameters (i_param : chunk_param : params) =-  (paramName i_param, chunk_param, params)-partitionChunkedKernelLambdaParameters _ =-  error "partitionChunkedKernelLambdaParameters: lambda takes too few parameters"
src/Futhark/Transform/Rename.hs view
@@ -27,7 +27,6 @@   -- * Renaming annotations   , RenameM   , substituteRename-  , bindingForRename   , renamingStms   , Rename (..)   , Renameable@@ -163,10 +162,6 @@     name' <- rename name     tp' <- rename tp     return $ Ident name' tp'---- | Create a bunch of new names and bind them for substitution.-bindingForRename :: [VName] -> RenameM a -> RenameM a-bindingForRename = bind  bind :: [VName] -> RenameM a -> RenameM a bind vars body = do
src/Futhark/Util.hs view
@@ -18,7 +18,6 @@         maybeHead,         splitFromEnd,         splitAt3,-        splitAt4,         focusNth,         unixEnvironment,         isEnvVarSet,@@ -121,14 +120,6 @@   let (xs, l') = splitAt n l       (ys, zs) = splitAt m l'   in (xs, ys, zs)---- | Like 'splitAt', but produces four lists.-splitAt4 :: Int -> Int -> Int -> [a] -> ([a], [a], [a], [a])-splitAt4 n m k l =-  let (xs, l') = splitAt n l-      (ys, l'') = splitAt m l'-      (zs, vs) = splitAt k l''-  in (xs, ys, zs, vs)  -- | Return the list element at the given index, if the index is -- valid, along with the elements before and after.
src/Language/Futhark/Attributes.hs view
@@ -22,7 +22,6 @@   , decImports   , progModuleTypes   , identifierReference-  , identifierReferences   , prettyStacktrace    -- * Queries on expressions@@ -240,7 +239,8 @@ uniqueness :: TypeBase shape as -> Uniqueness uniqueness (Array _ u _ _) = u uniqueness (Scalar (TypeVar _ u _ _)) = u-uniqueness (Scalar (Sum ts)) = mconcat $ map (mconcat . map uniqueness) $ M.elems ts+uniqueness (Scalar (Sum ts)) = foldMap (foldMap uniqueness) $ M.elems ts+uniqueness (Scalar (Record fs)) = foldMap uniqueness $ M.elems fs uniqueness _ = Nonunique  -- | @unique t@ is 'True' if the type of the argument is unique.@@ -994,15 +994,6 @@         _ -> Just ((identifier, namespace, Nothing), s'')  identifierReference _ = Nothing---- | Find all the identifier references in a string.-identifierReferences :: String -> [(String, String, Maybe FilePath)]-identifierReferences [] = []-identifierReferences s-  | Just (ref, s') <- identifierReference s =-      ref : identifierReferences s'-identifierReferences (_:s') =-  identifierReferences s'  -- | Given an operator name, return the operator that determines its -- syntactical properties.
src/Language/Futhark/Interpreter.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE OverloadedStrings #-} module Language.Futhark.Interpreter   ( Ctx(..)   , Env@@ -39,7 +40,7 @@ import qualified Futhark.Representation.Primitive as P import qualified Language.Futhark.Semantic as T -import Futhark.Util.Pretty hiding (apply, bool, stack)+import Futhark.Util.Pretty hiding (apply, bool) import Futhark.Util (chunk, splitFromEnd, maybeHead)  import Prelude hiding (mod, break)@@ -57,7 +58,7 @@  instance Functor ExtOp where   fmap f (ExtOpTrace w s x) = ExtOpTrace w s $ f x-  fmap f (ExtOpBreak stack x) = ExtOpBreak stack $ f x+  fmap f (ExtOpBreak backtrace x) = ExtOpBreak backtrace $ f x   fmap _ (ExtOpError err) = ExtOpError err  type Stack = [StackFrame]@@ -403,10 +404,10 @@   -- intrinsics.break, since that is just going to be the boring   -- wrapper function (intrinsics are never called directly).   -- This is why we go a step up the stack.-  stack <- asks $ drop 1 . fst-  case NE.nonEmpty stack of+  backtrace <- asks $ drop 1 . fst+  case NE.nonEmpty backtrace of     Nothing -> return ()-    Just stack' -> liftF $ ExtOpBreak stack' ()+    Just backtrace' -> liftF $ ExtOpBreak backtrace' ()  fromArray :: Value -> (ValueShape, [Value]) fromArray (ValueArray shape as) = (shape, elems as)@@ -1444,7 +1445,24 @@   env <- runEvalM (ctxImports ctx) $ foldM evalDec (ctxEnv ctx) $ progDecs prog   return ctx { ctxImports = M.insert fp env $ ctxImports ctx } --- | Execute the named function on the given arguments; will fail+checkEntryArgs :: VName -> [F.Value] -> StructType -> Either String ()+checkEntryArgs entry args entry_t+  | args_ts == param_ts =+      return ()+  | otherwise =+      Left $ pretty $ expected </>+      "Got input of types" </>+      indent 2 (stack (map ppr args_ts))+  where (param_ts, _) = unfoldFunType entry_t+        args_ts = map (valueStructType . valueType) args+        expected+          | null param_ts =+              "Entry point " <> pquote (pprName entry) <> " is not a function."+          | otherwise =+              "Entry point " <> pquote (pprName entry) <> " expects input of type(s)" </>+              indent 2 (stack (map ppr param_ts))++-- | Execute the named function on the given arguments; may fail -- horribly if these are ill-typed. interpretFunction :: Ctx -> VName -> [F.Value] -> Either String (F ExtOp Value) interpretFunction ctx fname vs = do@@ -1459,6 +1477,8 @@   vs' <- case mapM convertValue vs of            Just vs' -> Right vs'            Nothing -> Left "Invalid input: irregular array."++  checkEntryArgs fname vs ft    Right $ runEvalM (ctxImports ctx) $ do     f <- evalTermVar (ctxEnv ctx) (qualName fname) ft
src/Language/Futhark/Traversals.hs view
@@ -296,7 +296,7 @@  instance ASTMappable (CaseBase Info VName) where   astMap tv (CasePat pat e loc) =-    CasePat <$> astMap tv pat <*> astMap tv e <*> pure loc+    CasePat <$> astMap tv pat <*> mapOnExp tv e <*> pure loc  instance ASTMappable a => ASTMappable (Info a) where   astMap tv = traverse $ astMap tv
src/Language/Futhark/TypeChecker/Monad.hs view
@@ -22,7 +22,6 @@   , unappliedFunctor   , unknownVariableError   , underscoreUse-  , functionIsNotValue   , Notes   , aNote @@ -115,12 +114,6 @@ undefinedType :: MonadTypeChecker m => SrcLoc -> QualName Name -> m a undefinedType loc name =   typeError loc mempty $ "Unknown type" <+> ppr name <> "."--functionIsNotValue :: MonadTypeChecker m => SrcLoc -> QualName Name -> m a-functionIsNotValue loc name =-  typeError loc mempty $-  "Attempt to use function" <+> ppr name <+> "as value at" <+>-  text (locStr loc) <> "."  unappliedFunctor :: MonadTypeChecker m => SrcLoc -> m a unappliedFunctor loc =
src/Language/Futhark/TypeChecker/Terms.hs view
@@ -651,7 +651,7 @@ returnAliased fname name loc =   typeError loc mempty $   "Unique return value of" <+> pquote (pprName fname) <+>-  "is aliased to" <+> pquote (pprName name) <+> ", which is not consumed."+  "is aliased to" <+> pquote (pprName name) <> ", which is not consumed."  uniqueReturnAliased :: Name -> SrcLoc -> TermTypeM a uniqueReturnAliased fname loc =@@ -1390,14 +1390,14 @@    unless (unique src_t) $     typeError loc mempty $ "Source" <+> pquote (pprName (identName src)) <+>-    "has type" <+> ppr src_t <+> ", which is not unique."+    "has type" <+> ppr src_t <> ", which is not unique."   vtable <- asks $ scopeVtable . termScope   forM_ (aliases src_t) $ \v ->     case aliasVar v `M.lookup` vtable of       Just (BoundV Local _ v_t)         | not $ unique v_t ->             typeError loc mempty $ "Source" <+> pquote (pprName (identName src)) <+>-            "aliases" <+> pquote (pprName (aliasVar v)) <+> ", which is not consumable."+            "aliases" <+> pquote (pprName (aliasVar v)) <> ", which is not consumable."       _ -> return ()    sequentially (unifies "type of target array" (toStruct elemt) =<< checkExp ve) $ \ve' _ -> do@@ -1423,7 +1423,7 @@     src_t <- expTypeFully src'     unless (unique src_t) $       typeError loc mempty $ "Source" <+> pquote (ppr src) <+>-      "has type" <+> ppr src_t <+> ", which is not unique."+      "has type" <+> ppr src_t <> ", which is not unique."      let src_als = aliases src_t     ve_t <- expTypeFully ve'@@ -1601,8 +1601,8 @@    (merge_t, new_dims) <-     instantiateEmptyArrayDims loc "loop" Nonrigid . -- dim handling (1)-    anySizes .-    (`setAliases` mempty) =<< expTypeFully mergeexp'+    anySizes+    =<< expTypeFully mergeexp'    -- dim handling (2)   let checkLoopReturnSize mergepat' loopbody' = do@@ -1716,8 +1716,8 @@                   loopbody')    mergepat'' <- do-    loop_t <- expTypeFully loopbody'-    convergePattern mergepat' (allConsumed bodyflow) loop_t $+    loopbody_t <- expTypeFully loopbody'+    convergePattern mergepat' (allConsumed bodyflow) loopbody_t $       mkUsage (srclocOf loopbody') "being (part of) the result of the loop body"    let consumeMerge (Id _ (Info pt) ploc) mt@@ -1777,8 +1777,7 @@                 let t' = t `setUniqueness` Unique `setAliases` mempty                 in Id name (Info t') iloc             | otherwise =-                let t' = case t of Scalar Record{} -> t-                                   _               -> t `setUniqueness` Nonunique+                let t' = t `setUniqueness` Nonunique                 in Id name (Info t') iloc           uniquePat (TuplePattern pats ploc) =             TuplePattern (map uniquePat pats) ploc@@ -2319,8 +2318,8 @@   let t = toStruct $ typeOf e'   (tparams, _, _, _) <-     letGeneralise (nameFromString "<exp>") (srclocOf e) [] [] t-  e'' <- updateTypes e'   fixOverloadedTypes+  e'' <- updateTypes e'   checkUnmatched e''   causalityCheck e''   return (tparams, e'')@@ -2876,6 +2875,7 @@   let consumable v = case M.lookup v vtable of                        Just (BoundV Local _ t)                          | arrayRank t > 0 -> unique t+                         | Scalar TypeVar{} <- t -> unique t                          | otherwise -> True                        _ -> False   case filter (not . consumable) $ map aliasVar $ S.toList als of
unittests/Futhark/Representation/ExplicitMemory/IndexFunction/Alg.hs view
@@ -4,7 +4,6 @@   ( IxFun(..)   , iota   , offsetIndex-  , strideIndex   , permute   , rotate   , reshape@@ -12,7 +11,6 @@   , rebase   , repeat   , shape-  , rank   , index   ) where@@ -39,7 +37,6 @@                | Reshape (IxFun num) (ShapeChange num)                | Repeat (IxFun num) [Shape num] (Shape num)                | OffsetIndex (IxFun num) num-               | StrideIndex (IxFun num) num                | Rebase (IxFun num) (IxFun num)                deriving (Eq, Show) @@ -56,8 +53,6 @@     ppr fun <> text "->repeat" <> parens (commasep (map ppr $ outer_shapes++ [inner_shape]))   ppr (OffsetIndex fun i) =     ppr fun <> text "->offset_index" <> parens (ppr i)-  ppr (StrideIndex fun s) =-    ppr fun <> text "->stride_index" <> parens (ppr s)   ppr (Rebase new_base fun) =     text "rebase(" <> ppr new_base <> text ", " <> ppr fun <> text ")" @@ -68,9 +63,6 @@ offsetIndex :: IxFun num -> num -> IxFun num offsetIndex = OffsetIndex -strideIndex :: IxFun num -> num -> IxFun num-strideIndex = StrideIndex- permute :: IxFun num -> Permutation -> IxFun num permute = Permute @@ -106,16 +98,9 @@   where repeated outer_ds d = outer_ds ++ [d] shape (OffsetIndex ixfun _) =   shape ixfun-shape (StrideIndex ixfun _) =-  shape ixfun shape (Rebase _ ixfun) =   shape ixfun -rank :: IntegralExp num =>-        IxFun num -> Int-rank = length . shape-- index :: (IntegralExp num, Eq num) =>          IxFun num -> Indices num -> num index (Direct dims) is =@@ -147,11 +132,6 @@     d : ds ->       index (Index fun (DimSlice i (d-i) 1 : map (unitSlice 0) ds)) is     [] -> error "index: OffsetIndex: underlying index function has rank zero"-index (StrideIndex fun s) is =-  case shape fun of-    d : ds ->-      index (Index fun (DimSlice 0 d s : map (unitSlice 0) ds)) is-    [] -> error "index: StrideIndex: underlying index function has rank zero" index (Rebase new_base fun) is =   let fun' = case fun of                Direct old_shape ->@@ -168,8 +148,6 @@                  reshape (rebase new_base ixfun) new_shape                Repeat ixfun outer_shapes inner_shape ->                  repeat (rebase new_base ixfun) outer_shapes inner_shape-               StrideIndex ixfun i ->-                 strideIndex (rebase new_base ixfun) i                OffsetIndex ixfun s ->                  offsetIndex (rebase new_base ixfun) s                r@Rebase{} ->
unittests/Futhark/Representation/ExplicitMemory/IndexFunctionWrapper.hs view
@@ -3,8 +3,6 @@ module Futhark.Representation.ExplicitMemory.IndexFunctionWrapper   ( IxFun   , iota-  , offsetIndex-  , strideIndex   , permute   , rotate   , reshape@@ -31,14 +29,6 @@ iota :: IntegralExp num =>         Shape num -> IxFun num iota x = (I.iota x, IA.iota x)--offsetIndex :: (Eq num, IntegralExp num) =>-               IxFun num -> num -> IxFun num-offsetIndex (l, a) x = (I.offsetIndex l x, IA.offsetIndex a x)--strideIndex :: (Eq num, IntegralExp num) =>-               IxFun num -> num -> IxFun num-strideIndex (l, a) x = (I.strideIndex l x, IA.strideIndex a x)  permute :: IntegralExp num =>            IxFun num -> Permutation -> IxFun num