diff --git a/docs/language-reference.rst b/docs/language-reference.rst --- a/docs/language-reference.rst +++ b/docs/language-reference.rst @@ -190,12 +190,14 @@ first class. See :ref:`hofs` for the details. .. productionlist:: - stringlit: '"' `stringchar` '"' + stringlit: '"' `stringchar`* '"' + charlit: "'" `stringchar` "'" stringchar: String literals are supported, but only as syntactic sugar for UTF-8 encoded arrays of ``u8`` values. There is no character type in -Futhark. +Futhark, but character literals are interpreted as integers of the +corresponding Unicode code point. Declarations ------------ @@ -407,6 +409,7 @@ atom: `literal` : | `qualid` ("." `fieldid`)* : | `stringlit` + : | `charlit` : | "(" ")" : | "(" `exp` ")" ("." `fieldid`)* : | "(" `exp` ("," `exp`)* ")" diff --git a/docs/server-protocol.rst b/docs/server-protocol.rst --- a/docs/server-protocol.rst +++ b/docs/server-protocol.rst @@ -21,16 +21,20 @@ Basics ------ -Each command is sent as a *single line* on standard input. The -response is sent on standard output. The server will print ``%%% OK`` -on a line by itself to indicate that a command has finished. It will -also print ``%%% OK`` at startup once initialisation has finished. If -initialisation fails, the process will terminate. If a command fails, -the server will print ``%%% FAILURE`` followed by the error message, -and then ``%%% OK`` when it is ready for more input. Some output may -also precede ``%%% FAILURE``, e.g. logging statements that occured -before failure was detected. Fatal errors (that lead to server -shutdown) may be printed to stderr. +Each command is sent as a *single line* on standard input. A command +consists of space-separated *words*. A word is either a sequence of +non-space characters (``foo``), *or* double quotes surrounding a +sequence of non-newline and non-quote characters (``"foo bar"``). + +The response is sent on standard output. The server will print ``%%% +OK`` on a line by itself to indicate that a command has finished. It +will also print ``%%% OK`` at startup once initialisation has +finished. If initialisation fails, the process will terminate. If a +command fails, the server will print ``%%% FAILURE`` followed by the +error message, and then ``%%% OK`` when it is ready for more input. +Some output may also precede ``%%% FAILURE``, e.g. logging statements +that occured before failure was detected. Fatal errors (that lead to +server shutdown) may be printed to stderr. Variables --------- diff --git a/futhark.cabal b/futhark.cabal --- a/futhark.cabal +++ b/futhark.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 -- Run 'cabal2nix . >futhark.nix' after adding deps. name: futhark -version: 0.19.3 +version: 0.19.4 synopsis: An optimising compiler for a functional, array-oriented language. description: Futhark is a small programming language designed to be compiled to diff --git a/rts/c/server.h b/rts/c/server.h --- a/rts/c/server.h +++ b/rts/c/server.h @@ -488,19 +488,61 @@ free(report); } +char *next_word(char **line) { + char *p = *line; + + while (isspace(*p)) { + p++; + } + + if (*p == 0) { + return NULL; + } + + if (*p == '"') { + char *save = p+1; + // Skip ahead till closing quote. + p++; + + while (*p && *p != '"') { + p++; + } + + if (*p == '"') { + *p = 0; + *line = p+1; + return save; + } else { + return NULL; + } + } else { + char *save = p; + // Skip ahead till next whitespace. + + while (*p && !isspace(*p)) { + p++; + } + + if (*p) { + *p = 0; + *line = p+1; + } else { + *line = p; + } + return save; + } +} + void process_line(struct server_state *s, char *line) { - int max_num_tokens = 100; + int max_num_tokens = 1000; const char* tokens[max_num_tokens]; int num_tokens = 0; - char *saveptr; - char *tmp = line; - while ((tokens[num_tokens] = strtok_r(tmp, " \n", &saveptr)) != NULL) { + while ((tokens[num_tokens] = next_word(&line)) != NULL) { num_tokens++; if (num_tokens == max_num_tokens) { futhark_panic(1, "Line too long.\n"); } - tmp = NULL; } const char *command = tokens[0]; diff --git a/rts/python/server.py b/rts/python/server.py --- a/rts/python/server.py +++ b/rts/python/server.py @@ -2,6 +2,7 @@ import sys import time +import shlex # For string splitting class Server: def __init__(self, ctx): @@ -81,23 +82,36 @@ for (out_vname, val) in zip(out_vnames, vals): self._vars[out_vname] = val + def _store_val(self, f, value): + # In case we are using the PyOpenCL backend, we first + # need to convert OpenCL arrays to ordinary NumPy + # arrays. We do this in a nasty way. + if isinstance(value, opaque): + for component in value.data: + self._store_val(f, component) + elif isinstance(value, np.number) or isinstance(value, bool) or isinstance(value, np.bool_) or isinstance(value, np.ndarray): + # Ordinary NumPy value. + f.write(construct_binary_value(value)) + else: + # Assuming PyOpenCL array. + f.write(construct_binary_value(value.get())) + def _cmd_store(self, args): fname = self._get_arg(args, 0) with open(fname, 'wb') as f: for i in range(1, len(args)): - vname = args[i] - value = self._get_var(vname) - # In case we are using the PyOpenCL backend, we first - # need to convert OpenCL arrays to ordinary NumPy - # arrays. We do this in a nasty way. - if isinstance(value, np.number) or isinstance(value, bool) or isinstance(value, np.bool_) or isinstance(value, np.ndarray): - # Ordinary NumPy value. - f.write(construct_binary_value(self._vars[vname])) - else: - # Assuming PyOpenCL array. - f.write(construct_binary_value(self._vars[vname].get())) + self._store_val(f, self._get_var(args[i])) + def _restore_val(self, reader, typename): + if typename in self._ctx.opaques: + vs = [] + for t in self._ctx.opaques[typename]: + vs += [read_value(t, reader)] + return opaque(typename, *vs) + else: + return read_value(typename, reader) + def _cmd_restore(self, args): if len(args) % 2 == 0: raise self.Failure('Invalid argument count') @@ -116,7 +130,7 @@ raise self.Failure('Variable already exists: %s' % vname) try: - self._vars[vname] = read_value(typename, reader) + self._vars[vname] = self._restore_val(reader, typename) except ValueError: raise self.Failure('Failed to restore variable %s.\n' 'Possibly malformed data in %s.\n' @@ -139,7 +153,7 @@ } def _process_line(self, line): - words = line.split() + words = shlex.split(line) if words == []: raise self.Failure('Empty line') else: diff --git a/rts/python/values.py b/rts/python/values.py --- a/rts/python/values.py +++ b/rts/python/values.py @@ -371,7 +371,8 @@ def bin_reader(f): fmt = FUTHARK_PRIMTYPES[t]['bin_format'] size = FUTHARK_PRIMTYPES[t]['size'] - return struct.unpack('<' + fmt, f.get_chars(size))[0] + tf = FUTHARK_PRIMTYPES[t]['numpy_type'] + return tf(struct.unpack('<' + fmt, f.get_chars(size))[0]) return bin_reader read_bin_i8 = mk_bin_scalar_reader('i8') @@ -536,18 +537,18 @@ shape = [] elem_count = 1 for i in range(rank): - bin_size = read_bin_u64(f) + bin_size = read_bin_i64(f) elem_count *= bin_size shape.append(bin_size) bin_fmt = FUTHARK_PRIMTYPES[bin_type_enum]['bin_format'] # We first read the expected number of types into a bytestring, - # then use np.fromstring. This is because np.fromfile does not + # then use np.frombuffer. This is because np.fromfile does not # work on things that are insufficiently file-like, like a network # stream. bytes = f.get_chars(elem_count * FUTHARK_PRIMTYPES[expected_type]['size']) - arr = np.fromstring(bytes, dtype=FUTHARK_PRIMTYPES[bin_type_enum]['numpy_type']) + arr = np.frombuffer(bytes, dtype=FUTHARK_PRIMTYPES[bin_type_enum]['numpy_type']) arr.shape = shape return arr @@ -664,9 +665,9 @@ bytes[3:7] = type_strs[t] for i in range(len(shape)): - bytes[7+i*8:7+(i+1)*8] = np.int64(shape[i]).tostring() + bytes[7+i*8:7+(i+1)*8] = np.int64(shape[i]).tobytes() - bytes[7+len(shape)*8:] = np.ascontiguousarray(v).tostring() + bytes[7+len(shape)*8:] = np.ascontiguousarray(v).tobytes() return bytes diff --git a/src/Futhark/Analysis/SymbolTable.hs b/src/Futhark/Analysis/SymbolTable.hs --- a/src/Futhark/Analysis/SymbolTable.hs +++ b/src/Futhark/Analysis/SymbolTable.hs @@ -14,6 +14,7 @@ entryDepth, entryLetBoundDec, entryIsSize, + entryStm, -- * Lookup elem, diff --git a/src/Futhark/CLI/Dev.hs b/src/Futhark/CLI/Dev.hs --- a/src/Futhark/CLI/Dev.hs +++ b/src/Futhark/CLI/Dev.hs @@ -646,6 +646,8 @@ runPolyPasses config base (SOACS prog) ), (".fut_soacs", readCore parseSOACS SOACS), + (".fut_seq", readCore parseSeq Seq), + (".fut_seq_mem", readCore parseSeqMem SeqMem), (".fut_kernels", readCore parseKernels Kernels), (".fut_kernels_mem", readCore parseKernelsMem KernelsMem), (".fut_mc", readCore parseMC MC), diff --git a/src/Futhark/CodeGen/Backends/GenericC.hs b/src/Futhark/CodeGen/Backends/GenericC.hs --- a/src/Futhark/CodeGen/Backends/GenericC.hs +++ b/src/Futhark/CodeGen/Backends/GenericC.hs @@ -1337,7 +1337,9 @@ // _any_ headers files are imported to get // the usage statistics of a thread (i.e. have RUSAGE_THREAD) on GNU/Linux // https://manpages.courier-mta.org/htmlman2/getrusage.2.html +$esc:("#ifndef _GNU_SOURCE") // Avoid possible double-definition warning. $esc:("#define _GNU_SOURCE") +$esc:("#endif") |] -- We may generate variables that are never used (e.g. for @@ -1354,6 +1356,7 @@ $esc:("#pragma GCC diagnostic ignored \"-Wunused-variable\"") $esc:("#pragma GCC diagnostic ignored \"-Wparentheses\"") $esc:("#pragma GCC diagnostic ignored \"-Wunused-label\"") +$esc:("#pragma GCC diagnostic ignored \"-Wunused-but-set-variable\"") $esc:("#endif") $esc:("#ifdef __clang__") diff --git a/src/Futhark/CodeGen/Backends/GenericPython.hs b/src/Futhark/CodeGen/Backends/GenericPython.hs --- a/src/Futhark/CodeGen/Backends/GenericPython.hs +++ b/src/Futhark/CodeGen/Backends/GenericPython.hs @@ -321,6 +321,22 @@ } ] +functionExternalValues :: Imp.Function a -> [Imp.ExternalValue] +functionExternalValues fun = Imp.functionResult fun ++ Imp.functionArgs fun + +opaqueDefs :: Imp.Functions a -> M.Map String [PyExp] +opaqueDefs (Imp.Functions funs) = + mconcat . map evd . concatMap (functionExternalValues . snd) $ + filter (Imp.functionEntry . snd) funs + where + evd Imp.TransparentValue {} = mempty + evd (Imp.OpaqueValue name vds) = + M.singleton name $ map (String . vd) vds + vd (Imp.ScalarValue pt s _) = + readTypeEnum pt s + vd (Imp.ArrayValue _ _ pt s dims) = + concat (replicate (length dims) "[]") ++ readTypeEnum pt s + -- | The class generated by the code generator must have a -- constructor, although it can be vacuous. data Constructor = Constructor [String] [PyStmt] @@ -392,6 +408,9 @@ [ ClassDef $ Class class_name $ Assign (Var "entry_points") (Dict entry_point_types) : + Assign + (Var "opaques") + (Dict $ zip (map String opaque_names) (map Tuple opaque_payloads)) : map FunDef (constructor' : definitions ++ entry_points) ] ToServer -> do @@ -405,6 +424,9 @@ ++ [ ClassDef ( Class class_name $ Assign (Var "entry_points") (Dict entry_point_types) : + Assign + (Var "opaques") + (Dict $ zip (map String opaque_names) (map Tuple opaque_payloads)) : map FunDef (constructor' : definitions ++ entry_points) ), Assign @@ -440,6 +462,9 @@ parse_options_server = generateOptionParser (standardOptions ++ options) + + (opaque_names, opaque_payloads) = + unzip $ M.toList $ opaqueDefs $ Imp.defFuns prog selectEntryPoint entry_point_names entry_points = [ Assign (Var "entry_points") $ diff --git a/src/Futhark/IR/Parse.hs b/src/Futhark/IR/Parse.hs --- a/src/Futhark/IR/Parse.hs +++ b/src/Futhark/IR/Parse.hs @@ -9,6 +9,8 @@ parseKernelsMem, parseMC, parseMCMem, + parseSeq, + parseSeqMem, ) where @@ -33,6 +35,8 @@ import Futhark.IR.SOACS (SOACS) import qualified Futhark.IR.SOACS.SOAC as SOAC import qualified Futhark.IR.SegOp as SegOp +import Futhark.IR.Seq (Seq) +import Futhark.IR.SeqMem (SeqMem) import Futhark.Util.Pretty (prettyText) import Text.Megaparsec import Text.Megaparsec.Char hiding (space) @@ -881,6 +885,16 @@ prSOACS = PR pDeclExtType pExtType pDeclType pType pType (pSOAC prSOACS) () () +prSeq :: PR Seq +prSeq = + PR pDeclExtType pExtType pDeclType pType pType empty () () + +prSeqMem :: PR SeqMem +prSeqMem = + PR pRetTypeMem pBranchTypeMem pFParamMem pLParamMem pLetDecMem op () () + where + op = pMemOp empty + prKernels :: PR Kernels prKernels = PR pDeclExtType pExtType pDeclType pType pType op () () @@ -912,6 +926,12 @@ parseSOACS :: FilePath -> T.Text -> Either T.Text (Prog SOACS) parseSOACS = parseLore prSOACS + +parseSeq :: FilePath -> T.Text -> Either T.Text (Prog Seq) +parseSeq = parseLore prSeq + +parseSeqMem :: FilePath -> T.Text -> Either T.Text (Prog SeqMem) +parseSeqMem = parseLore prSeqMem parseKernels :: FilePath -> T.Text -> Either T.Text (Prog Kernels) parseKernels = parseLore prKernels diff --git a/src/Futhark/IR/SegOp.hs b/src/Futhark/IR/SegOp.hs --- a/src/Futhark/IR/SegOp.hs +++ b/src/Futhark/IR/SegOp.hs @@ -336,6 +336,10 @@ TC.TypeM lore () checkKernelBody ts (KernelBody (_, dec) stms kres) = do TC.checkBodyLore dec + -- We consume the kernel results (when applicable) before + -- type-checking the stms, so we will get an error if a statement + -- uses an array that is written to in a result. + mapM_ consumeKernelResult kres TC.checkStms stms $ do unless (length ts == length kres) $ TC.bad $ @@ -346,6 +350,11 @@ ++ " values." zipWithM_ checkKernelResult kres ts where + consumeKernelResult (WriteReturns _ arr _) = + TC.consume =<< TC.lookupAliases arr + consumeKernelResult _ = + pure () + checkKernelResult (Returns _ what) t = TC.require [t] what checkKernelResult (WriteReturns shape arr res) t = do @@ -365,7 +374,6 @@ ++ pretty shape ++ ", but destination array has type " ++ pretty arr_t - TC.consume =<< TC.lookupAliases arr checkKernelResult (ConcatReturns o w per_thread_elems v) t = do case o of SplitContiguous -> return () @@ -1048,26 +1056,34 @@ simplifyKernelBody space (KernelBody _ stms res) = do par_blocker <- Engine.asksEngineEnv $ Engine.blockHoistPar . Engine.envHoistBlockers + -- Ensure we do not try to use anything that is consumed in the result. ((body_stms, body_res), hoisted) <- - Engine.localVtable (<> scope_vtable) $ - Engine.localVtable (\vtable -> vtable {ST.simplifyMemory = True}) $ - Engine.blockIf - ( Engine.hasFree bound_here - `Engine.orIf` Engine.isOp - `Engine.orIf` par_blocker - `Engine.orIf` Engine.isConsumed - ) - $ Engine.simplifyStms stms $ do - res' <- - Engine.localVtable (ST.hideCertified $ namesFromList $ M.keys $ scopeOf stms) $ - mapM Engine.simplify res - return ((res', UT.usages $ freeIn res'), mempty) + Engine.localVtable (flip (foldl' (flip ST.consume)) (foldMap consumedInResult res)) + . Engine.localVtable (<> scope_vtable) + . Engine.localVtable (\vtable -> vtable {ST.simplifyMemory = True}) + . Engine.enterLoop + $ Engine.blockIf + ( Engine.hasFree bound_here + `Engine.orIf` Engine.isOp + `Engine.orIf` par_blocker + `Engine.orIf` Engine.isConsumed + ) + $ Engine.simplifyStms stms $ do + res' <- + Engine.localVtable (ST.hideCertified $ namesFromList $ M.keys $ scopeOf stms) $ + mapM Engine.simplify res + return ((res', UT.usages $ freeIn res'), mempty) return (mkWiseKernelBody () body_stms body_res, hoisted) where scope_vtable = segSpaceSymbolTable space bound_here = namesFromList $ M.keys $ scopeOfSegSpace space + consumedInResult (WriteReturns _ arr _) = + [arr] + consumedInResult _ = + [] + segSpaceSymbolTable :: ASTLore lore => SegSpace -> ST.SymbolTable lore segSpaceSymbolTable (SegSpace flat gtids_and_dims) = foldl' f (ST.fromScope $ M.singleton flat $ IndexName Int64) gtids_and_dims @@ -1362,15 +1378,13 @@ ) $ segSpaceDims space index kpe' = - letBind (Pattern [] [kpe']) $ - BasicOp $ - Index arr $ - outer_slice <> remaining_slice + letBindNames [patElemName kpe'] . BasicOp . Index arr $ + outer_slice <> remaining_slice if patElemName kpe `UT.isConsumed` used then do precopy <- newVName $ baseString (patElemName kpe) <> "_precopy" index kpe {patElemName = precopy} - letBind (Pattern [] [kpe]) $ BasicOp $ Copy precopy + letBindNames [patElemName kpe] $ BasicOp $ Copy precopy else index kpe return ( kpes'', diff --git a/src/Futhark/Internalise/Defunctionalise.hs b/src/Futhark/Internalise/Defunctionalise.hs --- a/src/Futhark/Internalise/Defunctionalise.hs +++ b/src/Futhark/Internalise/Defunctionalise.hs @@ -251,8 +251,8 @@ return ((x, decs), const mempty) -- | Looks up the associated static value for a given name in the environment. -lookupVar :: StructType -> SrcLoc -> VName -> DefM StaticVal -lookupVar t loc x = do +lookupVar :: StructType -> VName -> DefM StaticVal +lookupVar t x = do env <- askEnv case M.lookup x env of Just (Binding (Just (dims, sv_t)) sv) -> do @@ -263,14 +263,9 @@ Nothing -- If the variable is unknown, it may refer to the 'intrinsics' -- module, which we will have to treat specially. | baseTag x <= maxIntrinsicTag -> return IntrinsicSV - | otherwise -> -- Anything not in scope is going to be an - -- existential size. - return $ Dynamic $ Scalar $ Prim $ Signed Int64 | otherwise -> - error $ - "Variable " ++ pretty x ++ " at " - ++ locStr loc - ++ " is out of scope." + -- Anything not in scope is going to be an existential size. + return $ Dynamic $ Scalar $ Prim $ Signed Int64 -- Like patternDimNames, but ignores sizes that are only found in -- funtion types. @@ -461,7 +456,7 @@ (e', sv) <- defuncExp e return (RecordFieldExplicit vn e' loc', (vn, sv)) defuncField (RecordFieldImplicit vn (Info t) loc') = do - sv <- lookupVar (toStruct t) loc' vn + sv <- lookupVar (toStruct t) vn case sv of -- If the implicit field refers to a dynamic function, we -- convert it to an explicit field with a record closing over @@ -486,7 +481,7 @@ incl' <- mapM defuncExp' incl return (Range e1' me' incl' t loc, Dynamic t') defuncExp e@(Var qn (Info t) loc) = do - sv <- lookupVar (toStruct t) loc (qualLeaf qn) + sv <- lookupVar (toStruct t) (qualLeaf qn) case sv of -- If the variable refers to a dynamic function, we return its closure -- representation (i.e., a record expression capturing the free variables @@ -931,7 +926,7 @@ ++ show sv1 defuncApply depth e@(Var qn (Info t) loc) = do let (argtypes, _) = unfoldFunType t - sv <- lookupVar (toStruct t) loc (qualLeaf qn) + sv <- lookupVar (toStruct t) (qualLeaf qn) case sv of DynamicFun _ _ diff --git a/src/Futhark/Optimise/Fusion.hs b/src/Futhark/Optimise/Fusion.hs --- a/src/Futhark/Optimise/Fusion.hs +++ b/src/Futhark/Optimise/Fusion.hs @@ -140,14 +140,20 @@ varsAliases :: Names -> FusionGM Names varsAliases = fmap mconcat . mapM varAliases . namesToList -checkForUpdates :: FusedRes -> Exp -> FusionGM FusedRes -checkForUpdates res (BasicOp (Update src is _)) = do - res' <- - foldM addVarToInfusible res $ - src : namesToList (mconcat $ map freeIn is) - aliases <- varAliases src +updateKerInPlaces :: FusedRes -> ([VName], [VName]) -> FusionGM FusedRes +updateKerInPlaces res (ip_vs, other_infuse_vs) = do + res' <- foldM addVarToInfusible res (ip_vs ++ other_infuse_vs) + aliases <- mconcat <$> mapM varAliases ip_vs let inspectKer k = k {inplace = aliases <> inplace k} return res' {kernels = M.map inspectKer $ kernels res'} + +checkForUpdates :: FusedRes -> Exp -> FusionGM FusedRes +checkForUpdates res (BasicOp (Update src is _)) = do + let ifvs = namesToList $ mconcat $ map freeIn is + updateKerInPlaces res ([src], ifvs) +checkForUpdates res (Op (Futhark.Scatter _ _ _ written_info)) = do + let updt_arrs = map (\(_, _, x) -> x) written_info + updateKerInPlaces res (updt_arrs, []) checkForUpdates res _ = return res -- | Updates the environment: (i) the @soacs@ (map) by binding each pattern @@ -747,7 +753,8 @@ -- set to force horizontal fusion. It is not possible to -- producer/consumer-fuse Scatter anyway. fres' <- addNamesToInfusible fres $ namesFromList $ patternNames pat - mapLike fres' soac lam + fres'' <- mapLike fres' soac lam + checkForUpdates fres'' e Right soac@(SOAC.Hist _ _ lam _) -> do -- We put the variables produced by Hist into the infusible -- set to force horizontal fusion. It is not possible to diff --git a/src/Futhark/Optimise/InPlaceLowering/LowerIntoStm.hs b/src/Futhark/Optimise/InPlaceLowering/LowerIntoStm.hs --- a/src/Futhark/Optimise/InPlaceLowering/LowerIntoStm.hs +++ b/src/Futhark/Optimise/InPlaceLowering/LowerIntoStm.hs @@ -81,7 +81,8 @@ scope (Let pat aux (Op (SegOp (SegMap lvl space ts kbody)))) updates - | all ((`elem` patternNames pat) . updateValue) updates = do + | all ((`elem` patternNames pat) . updateValue) updates, + not source_used_in_kbody = do mk <- lowerUpdatesIntoSegMap scope pat updates space kbody Just $ do (pat', kbody', poststms) <- mk @@ -89,6 +90,15 @@ return $ certify cs (Let pat' aux $ Op $ SegOp $ SegMap lvl space ts kbody') : stmsToList poststms + where + -- This check is a bit more conservative than ideal. In a perfect + -- world, we would allow indexing a[i,j] if the update is also + -- to exactly a[i,j], as that will not create cross-iteration + -- dependencies. (Although the type checker wouldn't be able to + -- permit this anyway.) + source_used_in_kbody = + mconcat (map (`lookupAliases` scope) (namesToList (freeIn kbody))) + `namesIntersect` mconcat (map ((`lookupAliases` scope) . updateSource) updates) lowerUpdateKernels scope stm updates = lowerUpdate scope stm updates lowerUpdatesIntoSegMap :: diff --git a/src/Futhark/Optimise/Simplify/Engine.hs b/src/Futhark/Optimise/Simplify/Engine.hs --- a/src/Futhark/Optimise/Simplify/Engine.hs +++ b/src/Futhark/Optimise/Simplify/Engine.hs @@ -59,6 +59,7 @@ ST.SymbolTable, hoistStms, blockIf, + enterLoop, module Futhark.Optimise.Simplify.Lore, ) where @@ -220,6 +221,7 @@ usedCerts :: Certificates -> SimpleM lore () usedCerts cs = modify $ \(a, b, c) -> (a, b, cs <> c) +-- | Indicate in the symbol table that we have descended into a loop. enterLoop :: SimpleM lore a -> SimpleM lore a enterLoop = localVtable ST.deepen diff --git a/src/Futhark/Optimise/Simplify/Rules.hs b/src/Futhark/Optimise/Simplify/Rules.hs --- a/src/Futhark/Optimise/Simplify/Rules.hs +++ b/src/Futhark/Optimise/Simplify/Rules.hs @@ -22,6 +22,7 @@ import Control.Monad import Data.Either +import Data.List (find) import qualified Data.Map.Strict as M import Data.Maybe import Futhark.Analysis.PrimExp.Convert @@ -59,19 +60,25 @@ -- statement and it can be consumed. -- -- This simplistic rule is only valid before we introduce memory. -removeUnnecessaryCopy :: BinderOps lore => BottomUpRuleBasicOp lore +removeUnnecessaryCopy :: (BinderOps lore, Aliased lore) => BottomUpRuleBasicOp lore removeUnnecessaryCopy (vtable, used) (Pattern [] [d]) _ (Copy v) | not (v `UT.isConsumed` used), (not (v `UT.used` used) && consumable) || not (patElemName d `UT.isConsumed` used) = Simplify $ letBindNames [patElemName d] $ BasicOp $ SubExp $ Var v where - -- We need to make sure we can even consume the original. - -- This is currently a hacky check, much too conservative, - -- because we don't have the information conveniently - -- available. + -- We need to make sure we can even consume the original. The big + -- missing piece here is that we cannot do copy removal inside of + -- 'map' and other SOACs, but those cases tend to be handled in + -- later representations anyway. consumable = case M.lookup v $ ST.toScope vtable of Just (FParamName info) -> unique $ declTypeOf info - _ -> False + _ -> fromMaybe False $ do + e <- ST.lookup v vtable + pat <- stmPattern <$> ST.entryStm e + guard $ ST.entryDepth e == ST.loopDepth vtable + pe <- find ((== v) . patElemName) (patternElements pat) + guard $ aliasesOf pe == mempty + pure True removeUnnecessaryCopy _ _ _ _ = Skip constantFoldPrimFun :: BinderOps lore => TopDownRuleGeneric lore diff --git a/src/Futhark/Optimise/Simplify/Rules/BasicOp.hs b/src/Futhark/Optimise/Simplify/Rules/BasicOp.hs --- a/src/Futhark/Optimise/Simplify/Rules/BasicOp.hs +++ b/src/Futhark/Optimise/Simplify/Rules/BasicOp.hs @@ -124,15 +124,22 @@ | -- We produce the to-be-concatenated arrays in reverse order, so -- reverse them back. y : ys <- - reverse $ - foldl' fuseConcatArg mempty $ - map (toConcatArg vtable) $ x : xs, + forSingleArray $ + reverse $ + foldl' fuseConcatArg mempty $ + map (toConcatArg vtable) $ x : xs, length xs /= length ys = Simplify $ do elem_type <- lookupType x y' <- fromConcatArg elem_type y ys' <- mapM (fromConcatArg elem_type) ys auxing aux $ letBind pat $ BasicOp $ Concat 0 y' ys' outer_w + where + -- If we fuse so much that there is only a single input left, then + -- it must have the right size. + forSingleArray [(ArgReplicate _ v, cs)] = + [(ArgReplicate [outer_w] v, cs)] + forSingleArray ys = ys simplifyConcat _ _ _ _ = Skip ruleBasicOp :: BinderOps lore => TopDownRuleBasicOp lore diff --git a/src/Futhark/Pass/ExtractKernels.hs b/src/Futhark/Pass/ExtractKernels.hs --- a/src/Futhark/Pass/ExtractKernels.hs +++ b/src/Futhark/Pass/ExtractKernels.hs @@ -384,26 +384,6 @@ lvl <- segThreadCapped [w] "segscan" $ NoRecommendation SegNoVirt addStms . fmap (certify cs) =<< segScan lvl res_pat w scan_ops map_lam_sequential arrs [] [] - - -- We are only willing to generate code for scanomaps that do not - -- involve array accumulators, and do not have parallelism in their - -- 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). However, if the map - -- lambda is already identity, let's just go ahead here. - | Just (scans, map_lam) <- isScanomapSOAC form, - ( all primType (concatMap (lambdaReturnType . scanLambda) scans) - && not (lambdaContainsParallelism map_lam) - ) - || isIdentityLambda map_lam = runBinder_ $ do - scan_ops <- forM scans $ \(Scan scan_lam nes) -> do - let scan_lam' = soacsLambdaToKernels scan_lam - return $ SegBinOp Noncommutative scan_lam' nes mempty - - let map_lam' = soacsLambdaToKernels map_lam - lvl <- segThreadCapped [w] "segscan" $ NoRecommendation SegNoVirt - addStms =<< segScan lvl res_pat w scan_ops map_lam' arrs [] [] transformStm path (Let res_pat aux (Op (Screma w arrs form))) | Just [Reduce comm red_fun nes] <- isReduceSOAC form, let comm' diff --git a/src/Futhark/Pass/ExtractKernels/DistributeNests.hs b/src/Futhark/Pass/ExtractKernels/DistributeNests.hs --- a/src/Futhark/Pass/ExtractKernels/DistributeNests.hs +++ b/src/Futhark/Pass/ExtractKernels/DistributeNests.hs @@ -802,8 +802,12 @@ groupScatterResults (zip3 as_ws as_ns as_inps) (is' ++ vs) & map (inPlaceReturn ispace) & KernelBody () k_body_stms + -- Remove unused kernel inputs, since some of these might + -- reference the array we are scattering into. + kernel_inps' = + filter ((`nameIn` freeIn k_body) . kernelInputName) kernel_inps - (k, k_bnds) <- mapKernel mk_lvl ispace kernel_inps rts k_body + (k, k_bnds) <- mapKernel mk_lvl ispace kernel_inps' rts k_body traverse renameStm <=< runBinder_ $ do addStms k_bnds @@ -863,9 +867,14 @@ WriteReturns (arrayShape arr_t) arr' [(map DimFix write_is, v')] ) + -- Remove unused kernel inputs, since some of these might + -- reference the array we are scattering into. + let kernel_inps' = + filter ((`nameIn` freeIn kstms) . kernelInputName) kernel_inps + mk_lvl <- mkSegLevel (k, prestms) <- - mapKernel mk_lvl ispace kernel_inps [res_t] $ + mapKernel mk_lvl ispace kernel_inps' [res_t] $ KernelBody () kstms [res] traverse renameStm <=< runBinder_ $ do diff --git a/src/Futhark/Server.hs b/src/Futhark/Server.hs --- a/src/Futhark/Server.hs +++ b/src/Futhark/Server.hs @@ -118,9 +118,16 @@ Left (CmdFailure xs ys) -> Left $ CmdFailure (l : xs) ys Right ls' -> Right $ l : ls' +-- Words with spaces in them must be quoted. +quoteWord :: Text -> Text +quoteWord t + | Just _ <- T.find (== ' ') t = + "\"" <> t <> "\"" + | otherwise = t + sendCommand :: Server -> [Text] -> IO (Either CmdFailure [Text]) sendCommand s command = do - let command' = T.unwords command + let command' = T.unwords $ map quoteWord command when (serverDebug s) $ T.hPutStrLn stderr $ ">>> " <> command' diff --git a/src/Futhark/Version.hs b/src/Futhark/Version.hs --- a/src/Futhark/Version.hs +++ b/src/Futhark/Version.hs @@ -41,6 +41,4 @@ branch | $(gitBranch) == "master" = "" | otherwise = $(gitBranch) ++ " @ " - dirty - | $(gitDirtyTracked) = " [modified]" - | otherwise = "" + dirty = if $(gitDirtyTracked) then " [modified]" else "" diff --git a/src/Language/Futhark/TypeChecker/Terms.hs b/src/Language/Futhark/TypeChecker/Terms.hs --- a/src/Language/Futhark/TypeChecker/Terms.hs +++ b/src/Language/Futhark/TypeChecker/Terms.hs @@ -3151,7 +3151,7 @@ Uniqueness -> TermTypeM (TypeBase dim as) arrayOfM loc t shape u = do - zeroOrderType (mkUsage loc "use as array element") "type used in array" t + arrayElemType (mkUsage loc "use as array element") "type used in array" t return $ arrayOf t shape u updateTypes :: ASTMappable e => e -> TermTypeM e diff --git a/src/Language/Futhark/TypeChecker/Unify.hs b/src/Language/Futhark/TypeChecker/Unify.hs --- a/src/Language/Futhark/TypeChecker/Unify.hs +++ b/src/Language/Futhark/TypeChecker/Unify.hs @@ -22,6 +22,7 @@ dimNotes, mkTypeVarName, zeroOrderType, + arrayElemType, mustHaveConstr, mustHaveField, mustBeOneOf, @@ -647,23 +648,26 @@ let tp' = removeUniqueness tp modifyConstraints $ M.insert vn (lvl, Constraint tp' usage) case snd <$> M.lookup vn constraints of - Just (NoConstraint Unlifted unlift_usage) -> do - let bcs' = - breadCrumb - ( Matching $ - "When verifying that" <+> pquote (pprName vn) - <+> textwrap "is not instantiated with a function type, due to" - <+> ppr unlift_usage - ) - bcs - zeroOrderTypeWith usage bcs' tp' + Just (NoConstraint l unlift_usage) + | l < Lifted -> do + let bcs' = + breadCrumb + ( Matching $ + "When verifying that" <+> pquote (pprName vn) + <+> textwrap "is not instantiated with a function type, due to" + <+> ppr unlift_usage + ) + bcs - when (hasEmptyDims tp') $ - unifyError usage mempty bcs $ - "Type variable" <+> pprName vn - <+> "cannot be instantiated with type containing anonymous sizes:" - indent 2 (ppr tp) - textwrap "This is usually because the size of an array returned by a higher-order function argument cannot be determined statically. This can also be due to the return size being a value parameter. Add type annotation to clarify." + arrayElemTypeWith usage bcs' tp' + + when (l == Unlifted) $ do + when (hasEmptyDims tp') $ + unifyError usage mempty bcs $ + "Type variable" <+> pprName vn + <+> "cannot be instantiated with type containing anonymous sizes:" + indent 2 (ppr tp) + textwrap "This is usually because the size of an array returned by a higher-order function argument cannot be determined statically. This can also be due to the return size being a value parameter. Add type annotation to clarify." Just (Equality _) -> equalityType usage tp' Just (Overloaded ts old_usage) @@ -901,6 +905,45 @@ m () zeroOrderType usage desc = zeroOrderTypeWith usage $ breadCrumb bc noBreadCrumbs + where + bc = Matching $ "When checking" <+> textwrap desc + +arrayElemTypeWith :: + (MonadUnify m, Pretty (ShapeDecl dim), Monoid as) => + Usage -> + BreadCrumbs -> + TypeBase dim as -> + m () +arrayElemTypeWith usage bcs t = do + unless (orderZero t) $ + unifyError usage mempty bcs $ + "Type" indent 2 (ppr t) "found to be functional." + mapM_ mustBeZeroOrder . S.toList . typeVars $ t + where + mustBeZeroOrder vn = do + constraints <- getConstraints + case M.lookup vn constraints of + Just (lvl, NoConstraint _ _) -> + modifyConstraints $ M.insert vn (lvl, NoConstraint SizeLifted usage) + Just (_, ParamType l ploc) + | l `elem` [Lifted, SizeLifted] -> + unifyError usage mempty bcs $ + "Type parameter" + <+> pquote (pprName vn) + <+> "bound at" + <+> text (locStr ploc) + <+> "is lifted and cannot be an array element." + _ -> return () + +-- | Assert that this type must be valid as an array element. +arrayElemType :: + (MonadUnify m, Pretty (ShapeDecl dim), Monoid as) => + Usage -> + String -> + TypeBase dim as -> + m () +arrayElemType usage desc = + arrayElemTypeWith usage $ breadCrumb bc noBreadCrumbs where bc = Matching $ "When checking" <+> textwrap desc