diff --git a/futhark.cabal b/futhark.cabal --- a/futhark.cabal +++ b/futhark.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: futhark -version: 0.18.2 +version: 0.18.3 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/prelude/functional.fut b/prelude/functional.fut --- a/prelude/functional.fut +++ b/prelude/functional.fut @@ -9,13 +9,40 @@ let (|>) '^a '^b (x: a) (f: a -> b): b = f x -- | Right to left application. +-- +-- Due to the causality restriction (see the language reference) this +-- is less useful than `|>`@term. For example, the following is +-- a type error: +-- +-- ``` +-- length <| filter (>0) [-1,0,1] +-- ``` +-- +-- But this works: +-- +-- ``` +-- filter (>0) [-1,0,1] |> length +-- ``` + let (<|) '^a '^b (f: a -> b) (x: a) = f x -- | Function composition, with values flowing from left to right. +-- +-- Note that functions with anonymous return sizes cannot be composed. +-- For example, the following is a type error: +-- +-- ``` +-- filter (>0) >-> length +-- ``` +-- +-- In such cases you can use the pipe operator `|>`@term instead. let (>->) '^a '^b '^c (f: a -> b) (g: b -> c) (x: a): c = g (f x) -- | Function composition, with values flowing from right to left. -- This is the same as the `∘` operator known from mathematics. +-- +-- Has the same restrictions with respect to anonymous sizes as +-- `>->`@term. let (<-<) '^a '^b '^c (g: b -> c) (f: a -> b) (x: a): c = g (f x) -- | Flip the arguments passed to a function. diff --git a/prelude/math.fut b/prelude/math.fut --- a/prelude/math.fut +++ b/prelude/math.fut @@ -50,12 +50,15 @@ val abs: t -> t + -- | Sign function. Produces -1, 0, or 1 if the argument is + -- respectively less than, equal to, or greater than zero. val sgn: t -> t - -- | The highest representable number. + -- | The most positive representable number. val highest: t - -- | The lowest representable number. + -- | The least positive representable number (most negative for + -- signed types). val lowest: t -- | Returns zero on empty input. diff --git a/src/Futhark/CLI/Datacmp.hs b/src/Futhark/CLI/Datacmp.hs --- a/src/Futhark/CLI/Datacmp.hs +++ b/src/Futhark/CLI/Datacmp.hs @@ -3,28 +3,48 @@ -- | @futhark datacmp@ module Futhark.CLI.Datacmp (main) where +import Control.Exception import qualified Data.ByteString.Lazy.Char8 as BS import Futhark.Test.Values import Futhark.Util.Options import System.Exit +import System.IO +readFileSafely :: String -> IO (Either String BS.ByteString) +readFileSafely filepath = + (Right <$> BS.readFile filepath) `catch` couldNotRead + where + couldNotRead e = return $ Left $ show (e :: IOError) + -- | Run @futhark datacmp@ main :: String -> [String] -> IO () main = mainWithOptions () [] " " f where f [file_a, file_b] () = Just $ do - vs_a_maybe <- readValues <$> BS.readFile file_a - vs_b_maybe <- readValues <$> BS.readFile file_b - case (vs_a_maybe, vs_b_maybe) of - (Nothing, _) -> - error $ "Error reading values from " ++ file_a - (_, Nothing) -> - error $ "Error reading values from " ++ file_b - (Just vs_a, Just vs_b) -> - case compareValues vs_a vs_b of - [] -> return () - es -> do - mapM_ print es - exitWith $ ExitFailure 2 + file_contents_a_maybe <- readFileSafely file_a + file_contents_b_maybe <- readFileSafely file_b + case (file_contents_a_maybe, file_contents_b_maybe) of + (Left err_msg, _) -> do + hPutStrLn stderr err_msg + exitFailure + (_, Left err_msg) -> do + hPutStrLn stderr err_msg + exitFailure + (Right contents_a, Right contents_b) -> do + let vs_a_maybe = readValues contents_a + let vs_b_maybe = readValues contents_b + case (vs_a_maybe, vs_b_maybe) of + (Nothing, _) -> do + hPutStrLn stderr $ "Error reading values from " ++ file_a + exitFailure + (_, Nothing) -> do + hPutStrLn stderr $ "Error reading values from " ++ file_b + exitFailure + (Just vs_a, Just vs_b) -> + case compareValues vs_a vs_b of + [] -> return () + es -> do + mapM_ print es + exitWith $ ExitFailure 2 f _ _ = Nothing 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 @@ -1053,13 +1053,14 @@ (OpaqueDecl desc) [C.cedecl|int $id:free_opaque($ty:ctx_ty *ctx, $ty:opaque_type *obj);|] - ops <- asks envOperations - + -- We do not need to enclose the body in a critical section, because + -- when we free the components of the opaque, we are calling public + -- API functions that do their own locking. return [C.cunit| int $id:free_opaque($ty:ctx_ty *ctx, $ty:opaque_type *obj) { int ret = 0, tmp; - $items:(criticalSection ops free_body) + $items:free_body free(obj); return ret; } 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 @@ -760,15 +760,24 @@ let argexps_lib = map (compileName . Imp.paramName) inputs argexps_bin = zipWith fromMaybe argexps_lib argexps_mem_copies fname' = "self." ++ futharkFun (nameToString fname) - call_lib = [Assign funTuple $ simpleCall fname' (fmap Var argexps_lib)] - call_bin = [Assign funTuple $ simpleCall fname' (fmap Var argexps_bin)] + -- We ignore overflow errors and the like for executable entry + -- points. These are (somewhat) well-defined in Futhark. + ignore s = ArgKeyword s $ String "ignore" + errstate = Call (Var "np.errstate") $ map ignore ["divide", "over", "under", "invalid"] + + call argexps = + [ With + errstate + [Assign funTuple $ simpleCall fname' (fmap Var argexps)] + ] + return ( nameToString fname, map extValueDescName args, prepareIn, - call_lib, - call_bin, + call argexps_lib, + call argexps_bin, prepareOut, zip results res, prepare_run @@ -832,11 +841,6 @@ do_run = body_bin ++ pre_timing (do_run_with_timing, close_runtime_file) = addTiming do_run - -- We ignore overflow errors and the like for executable entry - -- points. These are (somewhat) well-defined in Futhark. - ignore s = ArgKeyword s $ String "ignore" - errstate = Call (Var "np.errstate") $ map ignore ["divide", "over", "under", "invalid"] - do_warmup_run = If (Var "do_warmup_run") (prepare_run ++ do_run) [] @@ -853,7 +857,7 @@ return ( Def fname' [] $ str_input ++ end_of_input ++ prepare_in - ++ [Try [With errstate [do_warmup_run, do_num_runs]] [except']] + ++ [Try [do_warmup_run, do_num_runs] [except']] ++ [close_runtime_file] ++ str_output, nameToString fname,