futhark 0.20.3 → 0.20.4
raw patch · 36 files changed
+376/−201 lines, 36 filesdep ~aesondep ~futhark-serverPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson, futhark-server
API changes (from Hackage documentation)
+ Futhark.IR.Pretty: prettyTupleLines :: Pretty a => [a] -> String
+ Futhark.Util.Pretty: prettyTupleLines :: Pretty a => [a] -> String
+ Language.Futhark.TypeChecker.Monad: atTopLevel :: TypeM Bool
+ Language.Futhark.TypeChecker.Monad: enteringModule :: TypeM a -> TypeM a
+ Language.Futhark.TypeChecker.Monad: withIndexLink :: Doc -> Doc -> Doc
Files
- docs/c-api.rst +29/−1
- docs/error-index.rst +25/−0
- docs/language-reference.rst +6/−1
- docs/man/futhark-bench.rst +2/−1
- docs/man/futhark-cuda.rst +6/−6
- docs/man/futhark-opencl.rst +7/−2
- docs/man/futhark-test.rst +2/−1
- docs/server-protocol.rst +5/−0
- futhark.cabal +2/−2
- rts/c/server.h +27/−2
- rts/c/tuning.h +2/−2
- rts/python/opencl.py +1/−1
- src/Futhark/CLI/Autotune.hs +53/−36
- src/Futhark/CLI/Bench.hs +5/−1
- src/Futhark/CLI/Test.hs +9/−1
- src/Futhark/CodeGen/Backends/CCUDA.hs +2/−2
- src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs +28/−28
- src/Futhark/CodeGen/Backends/COpenCL.hs +2/−2
- src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs +28/−28
- src/Futhark/CodeGen/Backends/GenericC.hs +6/−6
- src/Futhark/CodeGen/Backends/GenericC/CLI.hs +9/−9
- src/Futhark/CodeGen/Backends/GenericC/Server.hs +10/−10
- src/Futhark/CodeGen/Backends/MulticoreC.hs +7/−7
- src/Futhark/CodeGen/Backends/PyOpenCL.hs +3/−3
- src/Futhark/CodeGen/Backends/SequentialC/Boilerplate.hs +14/−7
- src/Futhark/Compiler/Program.hs +1/−1
- src/Futhark/IR/Pretty.hs +6/−1
- src/Futhark/IR/Primitive.hs +1/−1
- src/Futhark/Optimise/InPlaceLowering/LowerIntoStm.hs +1/−1
- src/Futhark/Pass/ExtractKernels/Interchange.hs +1/−2
- src/Futhark/TypeCheck.hs +1/−1
- src/Futhark/Util/Pretty.hs +7/−0
- src/Language/Futhark/Parser/Parser.y +20/−8
- src/Language/Futhark/TypeChecker.hs +6/−1
- src/Language/Futhark/TypeChecker/Monad.hs +42/−7
- src/Language/Futhark/TypeChecker/Terms.hs +0/−19
docs/c-api.rst view
@@ -31,7 +31,7 @@ changes to the configuration must be made *before* calling :c:func:`futhark_context_new`. A configuration object must not be freed before any context objects for which it is used. The same-configuration may be used for multiple concurrent contexts.+configuration may *not* be used for multiple concurrent contexts. .. c:struct:: futhark_context_config @@ -65,6 +65,34 @@ With a nonzero flag, print a running log to standard error of what the program is doing.++.. c:function:: int futhark_context_config_set_tuning_param(struct futhark_context_config *cfg, const char *param_name, size_t new_value)++ Set the value of a tuning parameter. Returns zero on success, and+ non-zero if the parameter cannot be set. This is usually because a+ parameter of the given name does not exist. See+ :c:func:`futhark_get_tuning_param_count` and+ :c:func:`futhark_get_tuning_param_name` for how to query which+ parameters are available. Most of the tuning parameters are+ applied only when the context is created, but some may be changed+ even after the context is active. At the moment, only parameters+ of class "threshold" may change after the context has been created.+ Use :c:func:`futhark_get_tuning_param_class` to determine the class+ of a tuning parameter.++.. c:function:: int futhark_get_tuning_param_count(void)++ Return the number of available tuning parameters. Useful for+ knowing how to call :c:func:`futhark_get_tuning_param_name` and+ :c:func:`futhark_get_tuning_param_class`.++.. c:function:: const char* futhark_get_tuning_param_name(int i)++ Return the name of tuning parameter *i*, counting from zero.++.. c:function:: const char* futhark_get_tuning_param_class(int i)++ Return the class of tuning parameter *i*, counting from zero. Context -------
docs/error-index.rst view
@@ -169,3 +169,28 @@ first, meaning that the size is available by the time ``a`` is bound. In many other cases, we can lift out the "size-producing" expressions into a separate ``let``-binding preceding the problematic expressions.++Other errors+------------++.. _nested-entry:++"Entry points may not be declared inside modules."+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++This occurs when the program uses the ``entry`` keyword inside a+module::++ module m = {+ entry f x = x + 1+ }++Entry points can only be declared at the top level of a file. When we+wish to make a function from inside a module available as an entry+point, we must define a wrapper function::++ module m = {+ let f x = x + 1+ }++ entry f = m.f
docs/language-reference.rst view
@@ -453,7 +453,7 @@ : | `id` size : "[" `id` "]" pat: `id`- : | `literal`+ : | `pat_literal` : | "_" : | "(" ")" : | "(" `pat` ")"@@ -462,6 +462,11 @@ : | "{" `fieldid` ["=" `pat`] ("," `fieldid` ["=" `pat`])* "}" : | `constructor` `pat`* : | `pat` ":" `type`+ pat_literal: [ "-" ] `intnumber`+ | [ "-" ] `floatnumber`+ | `charlit`+ | "true"+ | "false" loopform : "for" `id` "<" `exp` : | "for" `pat` "in" `exp` : | "while" `exp`
docs/man/futhark-bench.rst view
@@ -50,7 +50,8 @@ --exclude-case=TAG Do not run test cases that contain the given tag. Cases marked with- "nobench" or "disable" are ignored by default.+ "nobench", "disable", or "no_foo" (where *foo* is the backend used)+ are ignored by default. --futhark=program
docs/man/futhark-cuda.rst view
@@ -144,15 +144,15 @@ to the CUDA documentation for which options are supported. Be careful - some options can easily result in invalid results. ---print-sizes-- Print all sizes that can be set with ``-size`` or ``--tuning``.----size=ASSIGNMENT+--param=ASSIGNMENT - Set a configurable run-time parameter to the given+ Set a tuning parameter to the given value. ``ASSIGNMENT`` must be of the form ``NAME=INT`` Use ``--print-sizes`` to see which names are available.++--print-params++ Print all tuning parameters that can be set with ``--param`` or ``--tuning``. --tuning=FILE
docs/man/futhark-opencl.rst view
@@ -170,11 +170,16 @@ end. When ``-r`` is used, only the last run will be profiled. Implied by ``-D``. ---size=ASSIGNMENT+--param=ASSIGNMENT - Set a configurable run-time parameter to the given+ Set a tuning parameter to the given value. ``ASSIGNMENT`` must be of the form ``NAME=INT`` Use ``--print-sizes`` to see which names are available.++--print-params++ Print all tuning parameters that can be set with ``--param`` or+ ``--tuning``. --tuning=FILE
docs/man/futhark-test.rst view
@@ -144,7 +144,8 @@ --exclude=tag Do not run test cases that contain the given tag. Cases marked with- "disable" are ignored by default.+ "disable" are ignored by default, as are cases marked "no_foo",+ where *foo* is the backend used. -i Only interpret - do not run any compilers.
docs/server-protocol.rst view
@@ -133,6 +133,11 @@ Corresponds to :c:func:`futhark_context_report`. +``set_tuning_param``+....................++Corresponds to :c:func:`futhark_context_config_set_tuning_param`.+ Environment Variables ---------------------
futhark.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: futhark-version: 0.20.3+version: 0.20.4 synopsis: An optimising compiler for a functional, array-oriented language. description: Futhark is a small programming language designed to be compiled to@@ -327,7 +327,7 @@ , filepath >=1.4.1.1 , free >=4.12.4 , futhark-data >= 1.0.2.0- , futhark-server >= 1.1.0.0+ , futhark-server >= 1.1.1.0 , githash >=0.1.6.1 , half >= 0.3 , haskeline
rts/c/server.h view
@@ -2,10 +2,14 @@ // Forward declarations of things that we technically don't know until // the application header file is included, but which we need.+struct futhark_context_config; struct futhark_context; char *futhark_context_get_error(struct futhark_context *ctx); int futhark_context_sync(struct futhark_context *ctx); int futhark_context_clear_caches(struct futhark_context *ctx);+int futhark_context_config_set_tuning_param(struct futhark_context_config *cfg,+ const char *param_name,+ size_t new_value); typedef int (*restore_fn)(const void*, FILE *, struct futhark_context*, void*); typedef void (*store_fn)(const void*, FILE *, struct futhark_context*, void*);@@ -166,6 +170,7 @@ struct server_state { struct futhark_prog prog;+ struct futhark_context *cfg; struct futhark_context *ctx; int variables_capacity; struct variable *variables;@@ -273,7 +278,9 @@ if (err != 0) { failure(); char *error = futhark_context_get_error(s->ctx);- puts(error);+ if (error != NULL) {+ puts(error);+ } free(error); } }@@ -524,6 +531,19 @@ free(report); } +void cmd_set_tuning_param(struct server_state *s, const char *args[]) {+ const char *param = get_arg(args, 0);+ const char *val_s = get_arg(args, 1);+ size_t val = atol(val_s);+ int err = futhark_context_config_set_tuning_param(s->cfg, param, val);++ error_check(s, err);++ if (err != 0) {+ printf("Failed to set tuning parameter %s to %ld\n", param, (long)val);+ }+}+ char *next_word(char **line) { char *p = *line; @@ -608,17 +628,22 @@ cmd_unpause_profiling(s, tokens+1); } else if (strcmp(command, "report") == 0) { cmd_report(s, tokens+1);+ } else if (strcmp(command, "set_tuning_param") == 0) {+ cmd_set_tuning_param(s, tokens+1); } else { futhark_panic(1, "Unknown command: %s\n", command); } } -void run_server(struct futhark_prog *prog, struct futhark_context *ctx) {+void run_server(struct futhark_prog *prog,+ struct futhark_context_config *cfg,+ struct futhark_context *ctx) { char *line = NULL; size_t buflen = 0; ssize_t linelen; struct server_state s = {+ .cfg = cfg, .ctx = ctx, .variables_capacity = 100, .prog = *prog
rts/c/tuning.h view
@@ -2,7 +2,7 @@ static char* load_tuning_file(const char *fname, void *cfg,- int (*set_size)(void*, const char*, size_t)) {+ int (*set_tuning_param)(void*, const char*, size_t)) { const int max_line_len = 1024; char* line = (char*) malloc(max_line_len); @@ -20,7 +20,7 @@ if (eql) { *eql = 0; int value = atoi(eql+1);- if (set_size(cfg, line, (size_t)value) != 0) {+ if (set_tuning_param(cfg, line, (size_t)value) != 0) { char* err = (char*) malloc(max_line_len + 50); snprintf(err, max_line_len + 50, "Unknown name '%s' on line %d.", line, lineno); free(line);
rts/python/opencl.py view
@@ -55,7 +55,7 @@ device_matches += 1 raise Exception('No OpenCL platform and device matching constraints found.') -def size_assignment(s):+def param_assignment(s): name, value = s.split('=') return (name, int(value))
src/Futhark/CLI/Autotune.hs view
@@ -75,19 +75,29 @@ val' <- readMaybe val return (thresh, val') -type RunDataset = Int -> Path -> IO (Either String ([(String, Int)], Int))+type RunDataset = Server -> Int -> Path -> IO (Either String ([(String, Int)], Int)) type DatasetName = String -serverOptions :: Path -> AutotuneOptions -> [String]-serverOptions path opts =+serverOptions :: AutotuneOptions -> [String]+serverOptions opts = "--default-threshold" : show (optDefaultThreshold opts) : "-L" :- map opt path- ++ optExtraOptions opts+ optExtraOptions opts++setTuningParam :: Server -> String -> Int -> IO ()+setTuningParam server name val =+ either (error . T.unpack . T.unlines . failureMsg) (const $ pure ())+ =<< cmdSetTuningParam server (T.pack name) (T.pack (show val))++setTuningParams :: Server -> Path -> IO ()+setTuningParams server = mapM_ (uncurry $ setTuningParam server)++restoreTuningParams :: AutotuneOptions -> Server -> Path -> IO ()+restoreTuningParams opts server = mapM_ opt where- opt (name, val) = "--size=" ++ name ++ "=" ++ show val+ opt (name, _) = setTuningParam server name (optDefaultThreshold opts) prepare :: AutotuneOptions -> FutharkExe -> FilePath -> IO [(DatasetName, RunDataset, T.Text)] prepare opts futhark prog = do@@ -116,7 +126,10 @@ case runExpectedResult trun of Succeeds expected | null (runTags trun `intersect` ["notune", "disable"]) ->- Just (runDescription trun, run entry_point trun expected)+ Just+ ( runDescription trun,+ \server -> run server entry_point trun expected+ ) _ -> Nothing fmap concat . forM truns $ \ios -> do@@ -125,7 +138,7 @@ forM cases $ \(dataset, do_run) -> return (dataset, do_run, iosEntryPoint ios) where- run entry_point trun expected timeout path = do+ run server entry_point trun expected timeout path = do let bestRuntime :: ([RunResult], T.Text) -> ([(String, Int)], Int) bestRuntime (runres, errout) = ( comparisons (T.unpack errout),@@ -135,24 +148,26 @@ ropts = runOptions timeout opts when (optVerbose opts > 1) $- putStrLn $ "Running with options: " ++ unwords (serverOptions path opts)+ putStrLn $ "Trying path: " ++ show path - -- XXX: it is really inefficient to start a new server for every- -- run, but unfortunately we can only set threshold parameters- -- on startup.- let progbin = "." </> dropExtension prog- withServer (futharkServerCfg progbin (serverOptions path opts)) $ \server ->- either (Left . T.unpack) (Right . bestRuntime)- <$> benchmarkDataset- server- ropts- futhark- prog- entry_point- (runInput trun)- expected- (testRunReferenceOutput prog entry_point trun)+ -- Setting the tuning parameters is a stateful action, so we+ -- must be careful to restore the defaults below. This is+ -- because we rely on parameters not in 'path' to have their+ -- default value.+ setTuningParams server path + either (Left . T.unpack) (Right . bestRuntime)+ <$> benchmarkDataset+ server+ ropts+ futhark+ prog+ entry_point+ (runInput trun)+ expected+ (testRunReferenceOutput prog entry_point trun)+ <* restoreTuningParams opts server path+ --- Benchmarking a program data DatasetResult = DatasetResult [(String, Int)] Double@@ -187,7 +202,7 @@ thresholdForest prog = do thresholds <- getThresholds- <$> readProcess ("." </> dropExtension prog) ["--print-sizes"] ""+ <$> readProcess ("." </> dropExtension prog) ["--print-params"] "" let root (v, _) = ((v, False), []) return $ unfoldForest (unfold thresholds) $@@ -226,11 +241,12 @@ tuneThreshold :: AutotuneOptions ->+ Server -> [(DatasetName, RunDataset, T.Text)] -> Path -> (String, Path) -> IO Path-tuneThreshold opts datasets already_tuned (v, _v_path) = do+tuneThreshold opts server datasets already_tuned (v, _v_path) = do tune_result <- foldM tuneDataset Nothing datasets case tune_result of@@ -259,6 +275,7 @@ sample_run <- run+ server (optTimeout opts) ((v, maybe thresholdMax snd thresholds) : already_tuned) @@ -281,7 +298,7 @@ runner :: Int -> Int -> IO (Maybe Int) runner timeout' threshold = do- res <- run timeout' ((v, threshold) : already_tuned)+ res <- run server timeout' ((v, threshold) : already_tuned) case res of Right (_, runTime) -> return $ Just runTime@@ -365,8 +382,12 @@ when (optVerbose opts > 0) $ putStrLn $ ("Threshold forest:\n" ++) $ drawForest $ map (fmap show) forest - foldM (tuneThreshold opts datasets) [] $ tuningPaths forest+ let progbin = "." </> dropExtension prog+ putStrLn $ "Running with options: " ++ unwords (serverOptions opts) + withServer (futharkServerCfg progbin (serverOptions opts)) $ \server ->+ foldM (tuneThreshold opts server datasets) [] $ tuningPaths forest+ runAutotuner :: AutotuneOptions -> FilePath -> IO () runAutotuner opts prog = do best <- tune opts prog@@ -460,11 +481,7 @@ -- | Run @futhark autotune@ main :: String -> [String] -> IO ()-main = mainWithOptions- initialAutotuneOptions- commandLineOptions- "options... program"- $ \progs config ->- case progs of- [prog] -> Just $ runAutotuner config prog- _ -> Nothing+main = mainWithOptions initialAutotuneOptions commandLineOptions "options... program" $ \progs config ->+ case progs of+ [prog] -> Just $ runAutotuner config prog+ _ -> Nothing
src/Futhark/CLI/Bench.hs view
@@ -506,12 +506,16 @@ max_timeout :: Int max_timeout = maxBound `div` 1000000 +excludeBackend :: BenchOptions -> BenchOptions+excludeBackend config =+ config {optExcludeCase = "no_" <> optBackend config : optExcludeCase config}+ -- | Run @futhark bench@. main :: String -> [String] -> IO () main = mainWithOptions initialBenchOptions commandLineOptions "options... programs..." $ \progs config -> case progs of [] -> Nothing- _ -> Just $ runBenchmarks config progs+ _ -> Just $ runBenchmarks (excludeBackend config) progs --- The following extracted from hstats package by Marshall Beddoe: --- https://hackage.haskell.org/package/hstats-0.3
src/Futhark/CLI/Test.hs view
@@ -739,9 +739,17 @@ "Number of tests to run concurrently." ] +excludeBackend :: TestConfig -> TestConfig+excludeBackend config =+ config+ { configExclude =+ "no_" <> T.pack (configBackend (configPrograms config)) :+ configExclude config+ }+ -- | Run @futhark test@. main :: String -> [String] -> IO () main = mainWithOptions defaultConfig commandLineOptions "options... programs..." $ \progs config -> case progs of [] -> Nothing- _ -> Just $ runTests config progs+ _ -> Just $ runTests (excludeBackend config) progs
src/Futhark/CodeGen/Backends/CCUDA.hs view
@@ -248,10 +248,10 @@ callKernel :: GC.OpCompiler OpenCL () callKernel (GetSize v key) =- GC.stm [C.cstm|$id:v = ctx->sizes.$id:key;|]+ GC.stm [C.cstm|$id:v = *ctx->tuning_params.$id:key;|] callKernel (CmpSizeLe v key x) = do x' <- GC.compileExp x- GC.stm [C.cstm|$id:v = ctx->sizes.$id:key <= $exp:x';|]+ GC.stm [C.cstm|$id:v = *ctx->tuning_params.$id:key <= $exp:x';|] sizeLoggingCode v key x' callKernel (GetSizeMax v size_class) = let field = "max_" ++ cudaSizeClass size_class
src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs view
@@ -92,27 +92,27 @@ size_var_inits = map (\k -> [C.cinit|$string:(zEncodeString (pretty k))|]) $ M.keys sizes size_class_inits = map (\c -> [C.cinit|$string:(pretty c)|]) $ M.elems sizes - GC.earlyDecl [C.cedecl|static const char *size_names[] = { $inits:size_name_inits };|]- GC.earlyDecl [C.cedecl|static const char *size_vars[] = { $inits:size_var_inits };|]- GC.earlyDecl [C.cedecl|static const char *size_classes[] = { $inits:size_class_inits };|]+ GC.earlyDecl [C.cedecl|static const char *tuning_param_names[] = { $inits:size_name_inits };|]+ GC.earlyDecl [C.cedecl|static const char *tuning_param_vars[] = { $inits:size_var_inits };|]+ GC.earlyDecl [C.cedecl|static const char *tuning_param_classes[] = { $inits:size_class_inits };|] generateConfigFuns :: M.Map Name SizeClass -> GC.CompilerM OpenCL () String generateConfigFuns sizes = do- let size_decls = map (\k -> [C.csdecl|typename int64_t $id:k;|]) $ M.keys sizes+ let size_decls = map (\k -> [C.csdecl|typename int64_t *$id:k;|]) $ M.keys sizes num_sizes = M.size sizes- GC.earlyDecl [C.cedecl|struct sizes { $sdecls:size_decls };|]+ GC.earlyDecl [C.cedecl|struct tuning_params { $sdecls:size_decls };|] cfg <- GC.publicDef "context_config" GC.InitDecl $ \s -> ( [C.cedecl|struct $id:s;|], [C.cedecl|struct $id:s { struct cuda_config cu_cfg; int profiling;- typename int64_t sizes[$int:num_sizes];+ typename int64_t tuning_params[$int:num_sizes]; int num_nvrtc_opts; const char **nvrtc_opts; };|] ) let size_value_inits = zipWith sizeInit [0 .. M.size sizes -1] (M.elems sizes)- sizeInit i size = [C.cstm|cfg->sizes[$int:i] = $int:val;|]+ sizeInit i size = [C.cstm|cfg->tuning_params[$int:i] = $int:val;|] where val = fromMaybe 0 $ sizeDefault size GC.publicDef_ "context_config_new" GC.InitDecl $ \s ->@@ -129,8 +129,8 @@ cfg->nvrtc_opts[0] = NULL; $stms:size_value_inits cuda_config_init(&cfg->cu_cfg, $int:num_sizes,- size_names, size_vars,- cfg->sizes, size_classes);+ tuning_param_names, tuning_param_vars,+ cfg->tuning_params, tuning_param_classes); return cfg; }|] )@@ -247,39 +247,39 @@ }|] ) - GC.publicDef_ "context_config_set_size" GC.InitDecl $ \s ->- ( [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *size_name, size_t size_value);|],- [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *size_name, size_t size_value) {+ GC.publicDef_ "context_config_set_tuning_param" GC.InitDecl $ \s ->+ ( [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *param_name, size_t new_value);|],+ [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *param_name, size_t new_value) { for (int i = 0; i < $int:num_sizes; i++) {- if (strcmp(size_name, size_names[i]) == 0) {- cfg->sizes[i] = size_value;+ if (strcmp(param_name, tuning_param_names[i]) == 0) {+ cfg->tuning_params[i] = new_value; return 0; } } - if (strcmp(size_name, "default_group_size") == 0) {- cfg->cu_cfg.default_block_size = size_value;+ if (strcmp(param_name, "default_group_size") == 0) {+ cfg->cu_cfg.default_block_size = new_value; return 0; } - if (strcmp(size_name, "default_num_groups") == 0) {- cfg->cu_cfg.default_grid_size = size_value;+ if (strcmp(param_name, "default_num_groups") == 0) {+ cfg->cu_cfg.default_grid_size = new_value; return 0; } - if (strcmp(size_name, "default_threshold") == 0) {- cfg->cu_cfg.default_threshold = size_value;+ if (strcmp(param_name, "default_threshold") == 0) {+ cfg->cu_cfg.default_threshold = new_value; return 0; } - if (strcmp(size_name, "default_tile_size") == 0) {- cfg->cu_cfg.default_tile_size = size_value;+ if (strcmp(param_name, "default_tile_size") == 0) {+ cfg->cu_cfg.default_tile_size = new_value; return 0; } - if (strcmp(size_name, "default_reg_tile_size") == 0) {- cfg->cu_cfg.default_reg_tile_size = size_value;+ if (strcmp(param_name, "default_reg_tile_size") == 0) {+ cfg->cu_cfg.default_reg_tile_size = new_value; return 0; } @@ -337,7 +337,7 @@ typename CUdeviceptr global_failure; typename CUdeviceptr global_failure_args; struct cuda_context cuda;- struct sizes sizes;+ struct tuning_params tuning_params; // True if a potentially failing kernel has been enqueued. typename int32_t failure_is_an_option; @@ -346,9 +346,9 @@ };|] ) - let set_sizes =+ let set_tuning_params = zipWith- (\i k -> [C.cstm|ctx->sizes.$id:k = cfg->sizes[$int:i];|])+ (\i k -> [C.cstm|ctx->tuning_params.$id:k = &cfg->tuning_params[$int:i];|]) [(0 :: Int) ..] $ M.keys sizes max_failure_args =@@ -396,7 +396,7 @@ $stms:init_kernel_fields $stms:final_inits- $stms:set_sizes+ $stms:set_tuning_params init_constants(ctx); // Clear the free list of any deallocations that occurred while initialising constants.
src/Futhark/CodeGen/Backends/COpenCL.hs view
@@ -315,10 +315,10 @@ callKernel :: GC.OpCompiler OpenCL () callKernel (GetSize v key) =- GC.stm [C.cstm|$id:v = ctx->sizes.$id:key;|]+ GC.stm [C.cstm|$id:v = *ctx->tuning_params.$id:key;|] callKernel (CmpSizeLe v key x) = do x' <- GC.compileExp x- GC.stm [C.cstm|$id:v = ctx->sizes.$id:key <= $exp:x';|]+ GC.stm [C.cstm|$id:v = *ctx->tuning_params.$id:key <= $exp:x';|] sizeLoggingCode v key x' callKernel (GetSizeMax v size_class) = let field = "max_" ++ pretty size_class
src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs view
@@ -92,23 +92,23 @@ size_class_inits = map (\c -> [C.cinit|$string:(pretty c)|]) $ M.elems sizes num_sizes = M.size sizes - GC.earlyDecl [C.cedecl|static const char *size_names[] = { $inits:size_name_inits };|]- GC.earlyDecl [C.cedecl|static const char *size_vars[] = { $inits:size_var_inits };|]- GC.earlyDecl [C.cedecl|static const char *size_classes[] = { $inits:size_class_inits };|]+ GC.earlyDecl [C.cedecl|static const char *tuning_param_names[] = { $inits:size_name_inits };|]+ GC.earlyDecl [C.cedecl|static const char *tuning_param_vars[] = { $inits:size_var_inits };|]+ GC.earlyDecl [C.cedecl|static const char *tuning_param_classes[] = { $inits:size_class_inits };|] - let size_decls = map (\k -> [C.csdecl|typename int64_t $id:k;|]) $ M.keys sizes- GC.earlyDecl [C.cedecl|struct sizes { $sdecls:size_decls };|]+ let size_decls = map (\k -> [C.csdecl|typename int64_t *$id:k;|]) $ M.keys sizes+ GC.earlyDecl [C.cedecl|struct tuning_params { $sdecls:size_decls };|] cfg <- GC.publicDef "context_config" GC.InitDecl $ \s -> ( [C.cedecl|struct $id:s;|], [C.cedecl|struct $id:s { struct opencl_config opencl;- typename int64_t sizes[$int:num_sizes];+ typename int64_t tuning_params[$int:num_sizes]; int num_build_opts; const char **build_opts; };|] ) let size_value_inits = zipWith sizeInit [0 .. M.size sizes -1] (M.elems sizes)- sizeInit i size = [C.cstm|cfg->sizes[$int:i] = $int:val;|]+ sizeInit i size = [C.cstm|cfg->tuning_params[$int:i] = $int:val;|] where val = fromMaybe 0 $ sizeDefault size GC.publicDef_ "context_config_new" GC.InitDecl $ \s ->@@ -124,8 +124,8 @@ cfg->build_opts[0] = NULL; $stms:size_value_inits opencl_config_init(&cfg->opencl, $int:num_sizes,- size_names, size_vars,- cfg->sizes, size_classes);+ tuning_param_names, tuning_param_vars,+ cfg->tuning_params, tuning_param_classes); return cfg; }|] )@@ -263,39 +263,39 @@ }|] ) - GC.publicDef_ "context_config_set_size" GC.InitDecl $ \s ->- ( [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *size_name, size_t size_value);|],- [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *size_name, size_t size_value) {+ GC.publicDef_ "context_config_set_tuning_param" GC.InitDecl $ \s ->+ ( [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *param_name, size_t new_value);|],+ [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *param_name, size_t new_value) { for (int i = 0; i < $int:num_sizes; i++) {- if (strcmp(size_name, size_names[i]) == 0) {- cfg->sizes[i] = size_value;+ if (strcmp(param_name, tuning_param_names[i]) == 0) {+ cfg->tuning_params[i] = new_value; return 0; } } - if (strcmp(size_name, "default_group_size") == 0) {- cfg->opencl.default_group_size = size_value;+ if (strcmp(param_name, "default_group_size") == 0) {+ cfg->opencl.default_group_size = new_value; return 0; } - if (strcmp(size_name, "default_num_groups") == 0) {- cfg->opencl.default_num_groups = size_value;+ if (strcmp(param_name, "default_num_groups") == 0) {+ cfg->opencl.default_num_groups = new_value; return 0; } - if (strcmp(size_name, "default_threshold") == 0) {- cfg->opencl.default_threshold = size_value;+ if (strcmp(param_name, "default_threshold") == 0) {+ cfg->opencl.default_threshold = new_value; return 0; } - if (strcmp(size_name, "default_tile_size") == 0) {- cfg->opencl.default_tile_size = size_value;+ if (strcmp(param_name, "default_tile_size") == 0) {+ cfg->opencl.default_tile_size = new_value; return 0; } - if (strcmp(size_name, "default_reg_tile_size") == 0) {- cfg->opencl.default_reg_tile_size = size_value;+ if (strcmp(param_name, "default_reg_tile_size") == 0) {+ cfg->opencl.default_reg_tile_size = new_value; return 0; } @@ -320,7 +320,7 @@ typename cl_mem global_failure; typename cl_mem global_failure_args; struct opencl_context opencl;- struct sizes sizes;+ struct tuning_params tuning_params; // True if a potentially failing kernel has been enqueued. typename cl_int failure_is_an_option; };|]@@ -350,9 +350,9 @@ $stms:ctx_opencl_inits }|] - let set_sizes =+ let set_tuning_params = zipWith- (\i k -> [C.cstm|ctx->sizes.$id:k = cfg->sizes[$int:i];|])+ (\i k -> [C.cstm|ctx->tuning_params.$id:k = &cfg->tuning_params[$int:i];|]) [(0 :: Int) ..] $ M.keys sizes max_failure_args =@@ -380,7 +380,7 @@ $stms:(map loadKernel (M.toList kernels)) $stms:final_inits- $stms:set_sizes+ $stms:set_tuning_params init_constants(ctx); // Clear the free list of any deallocations that occurred while initialising constants.
src/Futhark/CodeGen/Backends/GenericC.hs view
@@ -1639,24 +1639,24 @@ ops <- asks envOperations profilereport <- gets $ DL.toList . compProfileItems - publicDef_ "get_num_sizes" InitDecl $ \s ->+ publicDef_ "get_tuning_param_count" InitDecl $ \s -> ( [C.cedecl|int $id:s(void);|], [C.cedecl|int $id:s(void) {- return sizeof(size_names)/sizeof(size_names[0]);+ return sizeof(tuning_param_names)/sizeof(tuning_param_names[0]); }|] ) - publicDef_ "get_size_name" InitDecl $ \s ->+ publicDef_ "get_tuning_param_name" InitDecl $ \s -> ( [C.cedecl|const char* $id:s(int);|], [C.cedecl|const char* $id:s(int i) {- return size_names[i];+ return tuning_param_names[i]; }|] ) - publicDef_ "get_size_class" InitDecl $ \s ->+ publicDef_ "get_tuning_param_class" InitDecl $ \s -> ( [C.cedecl|const char* $id:s(int);|], [C.cedecl|const char* $id:s(int i) {- return size_classes[i];+ return tuning_param_classes[i]; }|] )
src/Futhark/CodeGen/Backends/GenericC/CLI.hs view
@@ -93,25 +93,25 @@ }|] }, Option- { optionLongName = "print-sizes",+ { optionLongName = "print-params", optionShortName = Nothing, optionArgument = NoArgument,- optionDescription = "Print all sizes that can be set with --size or --tuning.",+ optionDescription = "Print all tuning parameters that can be set with --param or --tuning.", optionAction = [C.cstm|{- int n = futhark_get_num_sizes();+ int n = futhark_get_tuning_param_count(); for (int i = 0; i < n; i++) {- printf("%s (%s)\n", futhark_get_size_name(i),- futhark_get_size_class(i));+ printf("%s (%s)\n", futhark_get_tuning_param_name(i),+ futhark_get_tuning_param_class(i)); } exit(0); }|] }, Option- { optionLongName = "size",+ { optionLongName = "param", optionShortName = Nothing, optionArgument = RequiredArgument "ASSIGNMENT",- optionDescription = "Set a configurable run-time parameter to the given value.",+ optionDescription = "Set a tuning parameter to the given value.", optionAction = [C.cstm|{ char *name = optarg;@@ -120,7 +120,7 @@ int value = atoi(value_str); if (equals != NULL) { *equals = 0;- if (futhark_context_config_set_size(cfg, name, (size_t)value) != 0) {+ if (futhark_context_config_set_tuning_param(cfg, name, (size_t)value) != 0) { futhark_panic(1, "Unknown size: %s\n", name); } } else {@@ -135,7 +135,7 @@ optionAction = [C.cstm|{ char *ret = load_tuning_file(optarg, cfg, (int(*)(void*, const char*, size_t))- futhark_context_config_set_size);+ futhark_context_config_set_tuning_param); if (ret != NULL) { futhark_panic(1, "When loading tuning from '%s': %s\n", optarg, ret); }}|]
src/Futhark/CodeGen/Backends/GenericC/Server.hs view
@@ -53,25 +53,25 @@ }|] }, Option- { optionLongName = "print-sizes",+ { optionLongName = "print-params", optionShortName = Nothing, optionArgument = NoArgument,- optionDescription = "Print all sizes that can be set with --size or --tuning.",+ optionDescription = "Print all tuning parameters that can be set with --param or --tuning.", optionAction = [C.cstm|{- int n = futhark_get_num_sizes();+ int n = futhark_get_tuning_param_count(); for (int i = 0; i < n; i++) {- printf("%s (%s)\n", futhark_get_size_name(i),- futhark_get_size_class(i));+ printf("%s (%s)\n", futhark_get_tuning_param_name(i),+ futhark_get_tuning_param_class(i)); } exit(0); }|] }, Option- { optionLongName = "size",+ { optionLongName = "param", optionShortName = Nothing, optionArgument = RequiredArgument "ASSIGNMENT",- optionDescription = "Set a configurable run-time parameter to the given value.",+ optionDescription = "Set a tuning parameter to the given value.", optionAction = [C.cstm|{ char *name = optarg;@@ -80,7 +80,7 @@ int value = atoi(value_str); if (equals != NULL) { *equals = 0;- if (futhark_context_config_set_size(cfg, name, value) != 0) {+ if (futhark_context_config_set_tuning_param(cfg, name, value) != 0) { futhark_panic(1, "Unknown size: %s\n", name); } } else {@@ -95,7 +95,7 @@ optionAction = [C.cstm|{ char *ret = load_tuning_file(optarg, cfg, (int(*)(void*, const char*, size_t))- futhark_context_config_set_size);+ futhark_context_config_set_tuning_param); if (ret != NULL) { futhark_panic(1, "When loading tuning from '%s': %s\n", optarg, ret); }}|]@@ -326,7 +326,7 @@ } if (entry_point != NULL) {- run_server(&prog, ctx);+ run_server(&prog, cfg, ctx); } futhark_context_free(ctx);
src/Futhark/CodeGen/Backends/MulticoreC.hs view
@@ -195,14 +195,14 @@ }|] ) - GC.earlyDecl [C.cedecl|static const char *size_names[0];|]- GC.earlyDecl [C.cedecl|static const char *size_vars[0];|]- GC.earlyDecl [C.cedecl|static const char *size_classes[0];|]+ GC.earlyDecl [C.cedecl|static const char *tuning_param_names[0];|]+ GC.earlyDecl [C.cedecl|static const char *tuning_param_vars[0];|]+ GC.earlyDecl [C.cedecl|static const char *tuning_param_classes[0];|] - GC.publicDef_ "context_config_set_size" GC.InitDecl $ \s ->- ( [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *size_name, size_t size_value);|],- [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *size_name, size_t size_value) {- (void)cfg; (void)size_name; (void)size_value;+ GC.publicDef_ "context_config_set_tuning_param" GC.InitDecl $ \s ->+ ( [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *param_name, size_t param_value);|],+ [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *param_name, size_t param_value) {+ (void)cfg; (void)param_name; (void)param_value; return 1; }|] )
src/Futhark/CodeGen/Backends/PyOpenCL.hs view
@@ -140,13 +140,13 @@ [Assign (Var "default_reg_tile_size") $ Var "optarg"] }, Option- { optionLongName = "size",+ { optionLongName = "param", optionShortName = Nothing,- optionArgument = RequiredArgument "size_assignment",+ optionArgument = RequiredArgument "param_assignment", optionAction = [ Assign ( Index- (Var "sizes")+ (Var "params") ( IdxExp ( Index (Var "optarg")
src/Futhark/CodeGen/Backends/SequentialC/Boilerplate.hs view
@@ -38,6 +38,13 @@ }|] ) + GC.publicDef_ "context_config_set_profiling" GC.InitDecl $ \s ->+ ( [C.cedecl|void $id:s(struct $id:cfg* cfg, int flag);|],+ [C.cedecl|void $id:s(struct $id:cfg* cfg, int flag) {+ (void)cfg; (void)flag;+ }|]+ )+ GC.publicDef_ "context_config_set_logging" GC.InitDecl $ \s -> ( [C.cedecl|void $id:s(struct $id:cfg* cfg, int flag);|], [C.cedecl|void $id:s(struct $id:cfg* cfg, int detail) {@@ -100,14 +107,14 @@ }|] ) - GC.earlyDecl [C.cedecl|static const char *size_names[0];|]- GC.earlyDecl [C.cedecl|static const char *size_vars[0];|]- GC.earlyDecl [C.cedecl|static const char *size_classes[0];|]+ GC.earlyDecl [C.cedecl|static const char *tuning_param_names[0];|]+ GC.earlyDecl [C.cedecl|static const char *tuning_param_vars[0];|]+ GC.earlyDecl [C.cedecl|static const char *tuning_param_classes[0];|] - GC.publicDef_ "context_config_set_size" GC.InitDecl $ \s ->- ( [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *size_name, size_t size_value);|],- [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *size_name, size_t size_value) {- (void)cfg; (void)size_name; (void)size_value;+ GC.publicDef_ "context_config_set_tuning_param" GC.InitDecl $ \s ->+ ( [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *param_name, size_t param_value);|],+ [C.cedecl|int $id:s(struct $id:cfg* cfg, const char *param_name, size_t param_value) {+ (void)cfg; (void)param_name; (void)param_value; return 1; }|] )
src/Futhark/Compiler/Program.hs view
@@ -204,7 +204,7 @@ [FilePath] -> m (E.Warnings, Imports, VNameSource) readLibrary extra_eps fps =- typeCheckProgram emptyBasis . setEntryPoints extra_eps fps+ typeCheckProgram emptyBasis . setEntryPoints (E.defaultEntryPoint : extra_eps) fps =<< readUntypedLibrary fps -- | Read and type-check Futhark imports (no @.fut@ extension; may
src/Futhark/IR/Pretty.hs view
@@ -10,6 +10,7 @@ -- the interface from 'Pretty'. module Futhark.IR.Pretty ( prettyTuple,+ prettyTupleLines, pretty, PrettyRep (..), ppTuple',@@ -305,7 +306,7 @@ ppr (Lambda [] (Body _ stms []) []) | stms == mempty = text "nilFn" ppr (Lambda params body rettype) = text "\\" <+> ppTuple' params- <+/> colon <+> ppTuple' rettype <+> text "->"+ <+/> colon <+> ppTupleLines' rettype <+> text "->" </> indent 2 (ppr body) instance Pretty EntryPointType where@@ -351,3 +352,7 @@ -- | Like 'prettyTuple', but produces a 'Doc'. ppTuple' :: Pretty a => [a] -> Doc ppTuple' ets = braces $ commasep $ map (align . ppr) ets++-- | Like 'prettyTupleLines', but produces a 'Doc'.+ppTupleLines' :: Pretty a => [a] -> Doc+ppTupleLines' ets = braces $ stack $ punctuate comma $ map (align . ppr) ets
src/Futhark/IR/Primitive.hs view
@@ -178,7 +178,7 @@ = IntType IntType | FloatType FloatType | Bool- | -- | An informationless type - still takes up space!+ | -- | An informationless type - An array of this type takes up no space. Unit deriving (Eq, Ord, Show)
src/Futhark/Optimise/InPlaceLowering/LowerIntoStm.hs view
@@ -150,7 +150,7 @@ traverse (toSubExp "index") $ fixSlice (fmap pe64 slice) $ map (pe64 . Var) gtids - let res_dims = arrayDims $ snd bindee_dec+ let res_dims = take (length slice') $ arrayDims $ snd bindee_dec ret' = WriteReturns cs (Shape res_dims) src [(Slice $ map DimFix slice', se)] v_aliased <- newName v
src/Futhark/Pass/ExtractKernels/Interchange.hs view
@@ -205,8 +205,7 @@ auxing map_aux . fmap subExpsRes . letTupExp' "withacc_inter" $ Op $ Screma w (iota_w : map paramName acc_params ++ arrs) (mapSOAC maplam) let pat = Pat $ rearrangeShape perm $ patElems map_pat- perm' = [0 .. patSize pat -1]- pure $ WithAccStm perm' pat inputs' acc_lam'+ pure $ WithAccStm perm pat inputs' acc_lam' where newAccLamParams ps = do let (cert_ps, acc_ps) = splitAt (length ps `div` 2) ps
src/Futhark/TypeCheck.hs view
@@ -122,7 +122,7 @@ show (InvalidPatError pat t desc) = "Pat\n" ++ pretty pat ++ "\ncannot match value of type\n"- ++ prettyTuple t+ ++ prettyTupleLines t ++ end where end = case desc of
src/Futhark/Util/Pretty.hs view
@@ -7,6 +7,7 @@ pretty, prettyDoc, prettyTuple,+ prettyTupleLines, prettyText, prettyTextOneLine, prettyOneLine,@@ -53,6 +54,12 @@ -- | Prettyprint a list enclosed in curly braces. prettyTuple :: Pretty a => [a] -> String prettyTuple = PP.pretty 80 . ppTuple'++-- | Like 'prettyTuple', but put a linebreak after every element.+prettyTupleLines :: Pretty a => [a] -> String+prettyTupleLines = PP.pretty 80 . ppTupleLines'+ where+ ppTupleLines' ets = braces $ stack $ punctuate comma $ map (align . ppr) ets -- | The document @'apply' ds@ separates @ds@ with commas and encloses them with -- parentheses.
src/Language/Futhark/Parser/Parser.y view
@@ -389,7 +389,7 @@ Val :: { ValBindBase NoInfo Name } Val : let BindingId TypeParams FunParams maybeAscription(TypeExpDecl) '=' Exp { let (name, _) = $2- in ValBind (if name==defaultEntryPoint then Just NoInfo else Nothing) name (fmap declaredType $5) NoInfo+ in ValBind Nothing name (fmap declaredType $5) NoInfo $3 $4 $7 Nothing mempty (srcspan $1 $>) } @@ -661,11 +661,8 @@ { IndexSection $4 NoInfo (srcspan $1 $>) } -PrimLit :: { (PrimValue, SrcLoc) }- : true { (BoolValue True, $1) }- | false { (BoolValue False, $1) }-- | i8lit { let L loc (I8LIT num) = $1 in (SignedValue $ Int8Value num, loc) }+NumLit :: { (PrimValue, SrcLoc) }+ : i8lit { let L loc (I8LIT num) = $1 in (SignedValue $ Int8Value num, loc) } | i16lit { let L loc (I16LIT num) = $1 in (SignedValue $ Int16Value num, loc) } | i32lit { let L loc (I32LIT num) = $1 in (SignedValue $ Int32Value num, loc) } | i64lit { let L loc (I64LIT num) = $1 in (SignedValue $ Int64Value num, loc) }@@ -679,6 +676,12 @@ | f32lit { let L loc (F32LIT num) = $1 in (FloatValue $ Float32Value num, loc) } | f64lit { let L loc (F64LIT num) = $1 in (FloatValue $ Float64Value num, loc) } ++PrimLit :: { (PrimValue, SrcLoc) }+ : true { (BoolValue True, $1) }+ | false { (BoolValue False, $1) }+ | NumLit { $1 }+ Exps1 :: { (UncheckedExp, [UncheckedExp]) } : Exps1_ { case reverse (snd $1 : fst $1) of [] -> (snd $1, [])@@ -789,11 +792,14 @@ | CFieldPat { [$1] } CaseLiteral :: { (PatLit, SrcLoc) }- : PrimLit { (PatLitPrim (fst $1), snd $1) }- | charlit { let L loc (CHARLIT x) = $1+ : charlit { let L loc (CHARLIT x) = $1 in (PatLitInt (toInteger (ord x)), loc) }+ | PrimLit { (PatLitPrim (fst $1), snd $1) } | intlit { let L loc (INTLIT x) = $1 in (PatLitInt x, loc) } | floatlit { let L loc (FLOATLIT x) = $1 in (PatLitFloat x, loc) }+ | '-' NumLit { (PatLitPrim (primNegate (fst $2)), snd $2) }+ | '-' intlit { let L loc (INTLIT x) = $2 in (PatLitInt (negate x), loc) }+ | '-' floatlit { let L loc (FLOATLIT x) = $2 in (PatLitFloat (negate x), loc) } LoopForm :: { LoopFormBase NoInfo Name } LoopForm : for VarId '<' Exp@@ -1130,6 +1136,12 @@ floatNegate (Float16Value v) = Float16Value (-v) floatNegate (Float32Value v) = Float32Value (-v) floatNegate (Float64Value v) = Float64Value (-v)++primNegate :: PrimValue -> PrimValue+primNegate (FloatValue v) = FloatValue $ floatNegate v+primNegate (SignedValue v) = SignedValue $ intNegate v+primNegate (UnsignedValue v) = UnsignedValue $ intNegate v+primNegate (BoolValue v) = BoolValue $ not v readLine :: ParserMonad (Maybe T.Text) readLine = lift $ lift $ lift readLineFromMonad
src/Language/Futhark/TypeChecker.hs view
@@ -460,7 +460,7 @@ ModExp, MTy )-checkModBody maybe_fsig_e body_e loc = do+checkModBody maybe_fsig_e body_e loc = enteringModule $ do (body_e_abs, body_mty, body_e') <- checkOneModExp body_e case maybe_fsig_e of Nothing ->@@ -627,6 +627,11 @@ checkValBind :: ValBindBase NoInfo Name -> TypeM (Env, ValBind) checkValBind (ValBind entry fname maybe_tdecl NoInfo tparams params body doc attrs loc) = do+ top_level <- atTopLevel+ when (not top_level && isJust entry) $+ typeError loc mempty $+ withIndexLink "nested-entry" "Entry points may not be declared inside modules."+ (fname', tparams', params', maybe_tdecl', rettype, retext, body') <- checkFunDef (fname, maybe_tdecl, tparams, params, body, loc)
src/Language/Futhark/TypeChecker/Monad.hs view
@@ -13,12 +13,15 @@ runTypeM, askEnv, askImportName,+ atTopLevel,+ enteringModule, bindSpaced, qualifyTypeVars, lookupMTy, lookupImport, localEnv, TypeError (..),+ withIndexLink, unappliedFunctor, unknownVariable, unknownType,@@ -58,6 +61,7 @@ import qualified Data.Map.Strict as M import Data.Maybe import qualified Data.Set as S+import qualified Data.Version as Version import Futhark.FreshNames hiding (newName) import qualified Futhark.FreshNames import Futhark.Util.Console@@ -65,6 +69,7 @@ import Language.Futhark import Language.Futhark.Semantic import Language.Futhark.Warnings+import qualified Paths_futhark import Prelude hiding (mapM, mod) -- | A note with extra information regarding a type error.@@ -92,6 +97,24 @@ text (inRed $ "Error at " <> locStr loc <> ":") </> msg <> ppr notes +errorIndexUrl :: Doc+errorIndexUrl = version_url <> "error-index.html"+ where+ version = Paths_futhark.version+ base_url = "https://futhark.readthedocs.io/en/"+ version_url+ | last (Version.versionBranch version) == 0 = base_url <> "latest/"+ | otherwise = base_url <> "v" <> text (Version.showVersion version) <> "/"++-- | Attach a reference to documentation explaining the error in more detail.+withIndexLink :: Doc -> Doc -> Doc+withIndexLink href msg =+ stack+ [ msg,+ "\nFor more information, see:",+ indent 2 (ppr errorIndexUrl <> "#" <> href)+ ]+ -- | An unexpected functor appeared! unappliedFunctor :: MonadTypeChecker m => SrcLoc -> m a unappliedFunctor loc =@@ -131,7 +154,10 @@ data Context = Context { contextEnv :: Env, contextImportTable :: ImportTable,- contextImportName :: ImportName+ contextImportName :: ImportName,+ -- | Currently type-checking at the top level? If false, we are+ -- inside a module.+ contextAtTopLevel :: Bool } data TypeState = TypeState@@ -176,7 +202,7 @@ TypeM a -> (Warnings, Either TypeError (a, VNameSource)) runTypeM env imports fpath src (TypeM m) = do- let ctx = Context env imports fpath+ let ctx = Context env imports fpath True s = TypeState src mempty case runExcept $ runStateT (runReaderT m ctx) s of Left (ws, e) -> (ws, Left e)@@ -190,6 +216,15 @@ askImportName :: TypeM ImportName askImportName = asks contextImportName +-- | Are we type-checking at the top level, or are we inside a nested+-- module?+atTopLevel :: TypeM Bool+atTopLevel = asks contextAtTopLevel++-- | We are now going to type-check the body of a module.+enteringModule :: TypeM a -> TypeM a+enteringModule = local $ \ctx -> ctx {contextAtTopLevel = False}+ -- | Look up a module type. lookupMTy :: SrcLoc -> QualName Name -> TypeM (QualName VName, MTy) lookupMTy loc qn = do@@ -463,11 +498,11 @@ -- | The names that are available in the initial environment. topLevelNameMap :: NameMap-topLevelNameMap = M.filterWithKey (\k _ -> atTopLevel k) intrinsicsNameMap+topLevelNameMap = M.filterWithKey (\k _ -> available k) intrinsicsNameMap where- atTopLevel :: (Namespace, Name) -> Bool- atTopLevel (Type, _) = True- atTopLevel (Term, v) = v `S.member` (type_names <> binop_names <> fun_names)+ available :: (Namespace, Name) -> Bool+ available (Type, _) = True+ available (Term, v) = v `S.member` (type_names <> binop_names <> fun_names) where type_names = S.fromList $ map (nameFromString . pretty) anyPrimType binop_names =@@ -476,4 +511,4 @@ (nameFromString . pretty) [minBound .. (maxBound :: BinOp)] fun_names = S.fromList $ map nameFromString ["shape"]- atTopLevel _ = False+ available _ = False
src/Language/Futhark/TypeChecker/Terms.hs view
@@ -32,7 +32,6 @@ import qualified Data.Map.Strict as M import Data.Maybe import qualified Data.Set as S-import qualified Data.Version as Version import Futhark.IR.Primitive (intByteSize) import Futhark.Util (nubOrd) import Futhark.Util.Pretty hiding (bool, group, space)@@ -45,7 +44,6 @@ import Language.Futhark.TypeChecker.Types hiding (checkTypeDecl) import qualified Language.Futhark.TypeChecker.Types as Types import Language.Futhark.TypeChecker.Unify hiding (Usage)-import qualified Paths_futhark import Prelude hiding (mod) --- Uniqueness@@ -693,23 +691,6 @@ ) --- Errors--errorIndexUrl :: Doc-errorIndexUrl = version_url <> "error-index.html"- where- version = Paths_futhark.version- base_url = "https://futhark.readthedocs.io/en/"- version_url- | last (Version.versionBranch version) == 0 = base_url <> "latest/"- | otherwise = base_url <> "v" <> text (Version.showVersion version) <> "/"--withIndexLink :: Doc -> Doc -> Doc-withIndexLink href msg =- stack- [ msg,- "\nFor more information, see:",- indent 2 (ppr errorIndexUrl <> "#" <> href)- ] useAfterConsume :: VName -> SrcLoc -> SrcLoc -> TermTypeM a useAfterConsume name rloc wloc = do