Merge branch 'master' into automap

.github/actions/benchmark/action.yml

@@ -25,7 +25,7 @@ runs:
           module load perl
           cd futhark-benchmarks
           ./get-data.sh external-data.txt
-        slurm-options: --time=30:00 -c 1
+        slurm-options: --time=30:00
 
     - uses: ./.github/actions/futhark-slurm
       with:

.github/workflows/main.yml

@@ -362,7 +362,7 @@ jobs:
         make -C futhark-nightly-linux-x86_64/ install PREFIX=$HOME/.local
         echo "$HOME/.local/bin" >> $GITHUB_PATH
     - run: |
-        futhark test tests -c --no-terminal --backend=opencl --exclude=compiled --cache-extension=cache --pass-option=--build-option=-O0 --runner=tools/oclgrindrunner.sh
+        futhark test tests -c --no-terminal --backend=opencl --exclude=compiled --exclude=no_oclgrind --cache-extension=cache --pass-option=--build-option=-O0 --runner=tools/oclgrindrunner.sh
 
   test-pyoclgrind:
     runs-on: ubuntu-22.04
@@ -386,7 +386,7 @@ jobs:
         python -m venv virtualenv
         source virtualenv/bin/activate
         pip install 'numpy<2.0.0' pyopencl jsonschema
-        futhark test tests -c --no-terminal --backend=pyopencl --exclude=compiled --cache-extension=cache --pass-option=--build-option=-O0 --runner=tools/oclgrindrunner.sh
+        futhark test tests -c --no-terminal --backend=pyopencl --exclude=compiled --exclude=no_oclgrind --cache-extension=cache --pass-option=--build-option=-O0 --runner=tools/oclgrindrunner.sh
 
   test-opencl:
     runs-on: hendrix

CHANGELOG.md

@@ -9,15 +9,26 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.
 
 ### Added
 
+### Removed
+
+### Changed
+
+### Fixed
+
+* Negation of floating-point positive zero now produces a negative
+  zero.
+
+## [0.25.23]
+
+### Added
+
 * Trailing commas are now allowed for arrays, records, and tuples in
   the textual value format and in FutharkScript.
 
 * Faster floating-point atomics with OpenCL backend on AMD and NVIDIA
   GPUs. This affects histogram workloads.
 
-### Removed
-
-### Changed
+* AD is now supported by the interpreter (thanks to Marcus Jensen).
 
 ### Fixed
 

futhark.cabal

@@ -402,6 +402,7 @@ library
       Language.Futhark
       Language.Futhark.Core
       Language.Futhark.Interpreter
+      Language.Futhark.Interpreter.AD
       Language.Futhark.Interpreter.Values
       Language.Futhark.FreeVars
       Language.Futhark.Parser

shell.nix

@@ -16,6 +16,7 @@ let
     )
     ps.mypy
     black
+    cycler
     numpy
     pyopencl
     matplotlib
@@ -51,7 +52,6 @@ pkgs.stdenv.mkDerivation {
       ghcid
       niv
       ispc
-      python
       imagemagick # needed for literate tests
       glpk
     ]

src/Futhark/AD/Derivatives.hs

@@ -26,7 +26,10 @@ untyped2 = bimap untyped untyped
 pdUnOp :: UnOp -> PrimExp VName -> PrimExp VName
 pdUnOp (Abs it) a = UnOpExp (SSignum it) a
 pdUnOp (FAbs ft) a = UnOpExp (FSignum ft) a
-pdUnOp Not x = x
+pdUnOp (Neg Bool) x = x
+pdUnOp (Neg Unit) x = x
+pdUnOp (Neg (IntType it)) _ = iConst it (-1)
+pdUnOp (Neg (FloatType ft)) _ = fConst ft (-1)
 pdUnOp (Complement it) x = UnOpExp (Complement it) x
 pdUnOp (SSignum it) _ = iConst it 0
 pdUnOp (USignum it) _ = iConst it 0

src/Futhark/Analysis/PrimExp.hs

@@ -230,7 +230,7 @@ constFoldPrimExp (BinOpExp LogOr x y)
   | zeroIshExp y = x
 constFoldPrimExp (UnOpExp Abs {} x)
   | not $ negativeIshExp x = x
-constFoldPrimExp (UnOpExp Not {} (ValueExp (BoolValue x))) =
+constFoldPrimExp (UnOpExp (Neg _) (ValueExp (BoolValue x))) =
   ValueExp $ BoolValue $ not x
 constFoldPrimExp (BinOpExp UMod {} x y)
   | sameIshExp x y,
@@ -642,7 +642,7 @@ fromBool b = if b then true else false
 
 -- | Boolean negation smart constructor.
 bNot :: TPrimExp Bool v -> TPrimExp Bool v
-bNot = TPrimExp . UnOpExp Not . untyped
+bNot = TPrimExp . UnOpExp (Neg Bool) . untyped
 
 -- | SMax on 32-bit integers.
 sMax32 :: TPrimExp Int32 v -> TPrimExp Int32 v -> TPrimExp Int32 v

src/Futhark/CodeGen/Backends/GenericC/Code.hs

@@ -56,15 +56,18 @@ compilePrimExp f (LeafExp v _) =
 compilePrimExp f (UnOpExp Complement {} x) = do
   x' <- compilePrimExp f x
   pure [C.cexp|~$exp:x'|]
-compilePrimExp f (UnOpExp Not {} x) = do
-  x' <- compilePrimExp f x
-  pure [C.cexp|!$exp:x'|]
 compilePrimExp f (UnOpExp SSignum {} x) = do
   x' <- compilePrimExp f x
   pure [C.cexp|($exp:x' > 0 ? 1 : 0) - ($exp:x' < 0 ? 1 : 0)|]
 compilePrimExp f (UnOpExp USignum {} x) = do
   x' <- compilePrimExp f x
   pure [C.cexp|($exp:x' > 0 ? 1 : 0) - ($exp:x' < 0 ? 1 : 0) != 0|]
+compilePrimExp f (UnOpExp (Neg Bool) x) = do
+  x' <- compilePrimExp f x
+  pure [C.cexp|!$exp:x'|]
+compilePrimExp f (UnOpExp Neg {} x) = do
+  x' <- compilePrimExp f x
+  pure [C.cexp|-$exp:x'|]
 compilePrimExp f (UnOpExp op x) = do
   x' <- compilePrimExp f x
   pure [C.cexp|$id:(prettyString op)($exp:x')|]

src/Futhark/CodeGen/Backends/GenericPython.hs

@@ -992,7 +992,8 @@ toMicroseconds x =
 compileUnOp :: Imp.UnOp -> String
 compileUnOp op =
   case op of
-    Not -> "not"
+    Neg Imp.Bool -> "not"
+    Neg _ -> "-"
     Complement {} -> "~"
     Abs {} -> "abs"
     FAbs {} -> "abs"

src/Futhark/CodeGen/Backends/MulticoreISPC.hs

@@ -415,9 +415,12 @@ compileExp (LeafExp v _) =
 compileExp (UnOpExp Complement {} x) = do
   x' <- compileExp x
   pure [C.cexp|~$exp:x'|]
-compileExp (UnOpExp Not {} x) = do
+compileExp (UnOpExp (Neg Bool) x) = do
   x' <- compileExp x
   pure [C.cexp|!$exp:x'|]
+compileExp (UnOpExp Neg {} x) = do
+  x' <- compileExp x
+  pure [C.cexp|-$exp:x'|]
 compileExp (UnOpExp (FAbs Float32) x) = do
   x' <- compileExp x
   pure [C.cexp|(float)fabs($exp:x')|]

src/Futhark/Internalise/Exps.hs

@@ -316,7 +316,7 @@ internaliseAppExp desc _ (E.Range start maybe_second end loc) = do
     letSubExp "range_invalid" $
       I.BasicOp $
         I.BinOp I.LogOr step_invalid bounds_invalid
-  valid <- letSubExp "valid" $ I.BasicOp $ I.UnOp I.Not invalid
+  valid <- letSubExp "valid" $ I.BasicOp $ I.UnOp (I.Neg I.Bool) invalid
   cs <- assert "range_valid_c" valid errmsg loc
 
   step_i64 <- asIntS Int64 step
@@ -705,19 +705,17 @@ internaliseExp desc (E.Negate e _) = do
   e' <- internaliseExp1 "negate_arg" e
   et <- subExpType e'
   case et of
-    I.Prim (I.IntType t) ->
-      letTupExp' desc $ I.BasicOp $ I.BinOp (I.Sub t I.OverflowWrap) (I.intConst t 0) e'
-    I.Prim (I.FloatType t) ->
-      letTupExp' desc $ I.BasicOp $ I.BinOp (I.FSub t) (I.floatConst t 0) e'
-    _ -> error "Futhark.Internalise.internaliseExp: non-numeric type in Negate"
+    I.Prim pt ->
+      letTupExp' desc $ I.BasicOp $ I.UnOp (I.Neg pt) e'
+    _ -> error "Futhark.Internalise.internaliseExp: non-primitive type in Negate"
 internaliseExp desc (E.Not e _) = do
   e' <- internaliseExp1 "not_arg" e
   et <- subExpType e'
   case et of
     I.Prim (I.IntType t) ->
       letTupExp' desc $ I.BasicOp $ I.UnOp (I.Complement t) e'
     I.Prim I.Bool ->
-      letTupExp' desc $ I.BasicOp $ I.UnOp I.Not e'
+      letTupExp' desc $ I.BasicOp $ I.UnOp (I.Neg I.Bool) e'
     _ ->
       error "Futhark.Internalise.internaliseExp: non-int/bool type in Not"
 internaliseExp desc (E.Update src slice ve loc) = do
@@ -1068,7 +1066,7 @@ internaliseDimIndex w (E.DimSlice i j s) = do
   n <- letSubExp "n" =<< divRounding (toExp j_m_i) (toExp s')
 
   zero_stride <- letSubExp "zero_stride" $ I.BasicOp $ I.CmpOp (CmpEq int64) s_sign zero
-  nonzero_stride <- letSubExp "nonzero_stride" $ I.BasicOp $ I.UnOp I.Not zero_stride
+  nonzero_stride <- letSubExp "nonzero_stride" $ I.BasicOp $ I.UnOp (I.Neg I.Bool) zero_stride
 
   -- Bounds checks depend on whether we are slicing forwards or
   -- backwards.  If forwards, we must check '0 <= i && i <= j'.  If
@@ -1305,7 +1303,7 @@ certifyingNonzero loc t x m = do
     letSubExp "zero" $
       I.BasicOp $
         CmpOp (CmpEq (IntType t)) x (intConst t 0)
-  nonzero <- letSubExp "nonzero" $ I.BasicOp $ UnOp I.Not zero
+  nonzero <- letSubExp "nonzero" $ I.BasicOp $ UnOp (I.Neg I.Bool) zero
   c <- assert "nonzero_cert" nonzero "division by zero" loc
   certifying c m
 
@@ -1412,7 +1410,7 @@ internaliseBinOp _ desc E.Equal x y t _ =
   simpleCmpOp desc (I.CmpEq $ internalisePrimType t) x y
 internaliseBinOp _ desc E.NotEqual x y t _ = do
   eq <- letSubExp (desc ++ "true") $ I.BasicOp $ I.CmpOp (I.CmpEq $ internalisePrimType t) x y
-  fmap pure $ letSubExp desc $ I.BasicOp $ I.UnOp I.Not eq
+  fmap pure $ letSubExp desc $ I.BasicOp $ I.UnOp (I.Neg I.Bool) eq
 internaliseBinOp _ desc E.Less x y (E.Signed t) _ =
   simpleCmpOp desc (I.CmpSlt t) x y
 internaliseBinOp _ desc E.Less x y (E.Unsigned t) _ =
@@ -1537,7 +1535,7 @@ isOverloadedFunction qname desc loc = do
           cmp_f =<< letSubExp "eq" =<< eAll rs
       where
         isEqlOp "!=" = Just $ \eq ->
-          letTupExp' desc $ I.BasicOp $ I.UnOp I.Not eq
+          letTupExp' desc $ I.BasicOp $ I.UnOp (I.Neg I.Bool) eq
         isEqlOp "==" = Just $ \eq ->
           pure [eq]
         isEqlOp _ = Nothing

src/Futhark/Optimise/ArrayLayout/Layout.hs

@@ -87,7 +87,7 @@ reduceStrideAndOffset (BinOpExp oper a b) = case (a, b) of
           Sub _ _ -> Just (s, o - valueIntegral v)
           Mul _ _ -> Just (s * valueIntegral v, o * valueIntegral v)
           _ -> Nothing
-    reduce _ (UnOpExp Not _) = Nothing
+    reduce _ (UnOpExp (Neg Bool) _) = Nothing
     reduce _ (UnOpExp (Complement _) _) = Nothing
     reduce _ (UnOpExp (Abs _) _) = Nothing
     reduce _ (UnOpExp _ sub_op) = reduceStrideAndOffset sub_op

src/Futhark/Optimise/BlkRegTiling.hs

@@ -128,12 +128,10 @@ kkLoopBody
         let e = le64 i + le64 k * pe64 tr_par
         pure (i, k, e)
       --
-      --
       mkCompLoopRxRy fits_ij css_init (a_idx_fn, b_idx_fn) (ltid_y, ltid_x) = do
         css <- forLoop ry [css_init] $ \i [css_merge] -> do
           css <- forLoop rx [css_merge] $ \j [css_merge'] ->
-            resultBodyM
-              =<< letTupExp' "foo"
+            (resultBodyM <=< letTupExp' "foo")
               =<< eIf
                 ( toExp $
                     if fits_ij
@@ -143,16 +141,8 @@ kkLoopBody
                       -- is garbage anyways and should not be written.
                       -- so fits_ij should be always true!!!
 
-                        le64 iii
-                          + le64 i
-                          + pe64 ry
-                            * le64 ltid_y
-                              .<. pe64 height_A
-                              .&&. le64 jjj
-                          + le64 j
-                          + pe64 rx
-                            * le64 ltid_x
-                              .<. pe64 width_B
+                        (le64 iii + le64 i + pe64 ry * le64 ltid_y .<. pe64 height_A)
+                          .&&. (le64 jjj + le64 j + pe64 rx * le64 ltid_x .<. pe64 width_B)
                 )
                 ( do
                     a <- a_idx_fn ltid_y i
@@ -184,8 +174,7 @@ kkLoopBody
             css_init <- index "css_init" css_merge [ltid_y, ltid_x]
 
             css <- forLoop tk [css_init] $ \k [acc_merge] ->
-              resultBodyM
-                =<< letTupExp' "foo"
+              (resultBodyM <=< letTupExp' "foo")
                 =<< eIf
                   ( toExp $
                       if epilogue

src/Futhark/Optimise/Simplify/Engine.hs

@@ -297,7 +297,7 @@ protectIf _ _ taken (Let pat aux (Match [cond] [Case [Just (BoolValue True)] tak
     Match [cond'] [Case [Just (BoolValue True)] taken_body] untaken_body $
       MatchDec if_ts MatchFallback
 protectIf _ _ taken (Let pat aux (BasicOp (Assert cond msg loc))) = do
-  not_taken <- letSubExp "loop_not_taken" $ BasicOp $ UnOp Not taken
+  not_taken <- letSubExp "loop_not_taken" $ BasicOp $ UnOp (Neg Bool) taken
   cond' <- letSubExp "protect_assert_disj" $ BasicOp $ BinOp LogOr not_taken cond
   auxing aux $ letBind pat $ BasicOp $ Assert cond' msg loc
 protectIf protect _ taken (Let pat aux (Op op))
@@ -380,7 +380,7 @@ matchingExactlyThis ses prior this = do
   letSubExp "matching_just_this"
     =<< eBinOp
       LogAnd
-      (eUnOp Not (eAny prior_matches))
+      (eUnOp (Neg Bool) (eAny prior_matches))
       (eSubExp =<< matching (zip ses this))
 
 -- | We are willing to hoist potentially unsafe statements out of

src/Futhark/Optimise/Simplify/Rules/BasicOp.hs

@@ -224,7 +224,7 @@ ruleBasicOp vtable pat _ (CmpOp (CmpEq t) se1 se2)
           p_and_eq_x_y <-
             letSubExp "p_and_eq_x_y" $ BasicOp $ BinOp LogAnd p eq_x_y
           not_p <-
-            letSubExp "not_p" $ BasicOp $ UnOp Not p
+            letSubExp "not_p" $ BasicOp $ UnOp (Neg Bool) p
           not_p_and_eq_x_z <-
             letSubExp "p_and_eq_x_y" $ BasicOp $ BinOp LogAnd not_p eq_x_z
           letBind pat $

src/Futhark/Optimise/Simplify/Rules/Match.hs

@@ -80,7 +80,7 @@ ruleMatch _ pat _ ([cond], [Case [Just (BoolValue True)] tb], fb, MatchDec ts _)
           (pure $ BasicOp $ BinOp LogAnd cond tres)
           ( eBinOp
               LogAnd
-              (pure $ BasicOp $ UnOp Not cond)
+              (pure $ BasicOp $ UnOp (Neg Bool) cond)
               (pure $ BasicOp $ SubExp fres)
           )
       certifying (tcs <> fcs) $ letBind pat e
@@ -102,7 +102,7 @@ ruleMatch _ pat _ ([cond], [Case [Just (BoolValue True)] tb], fb, _)
         else
           if zeroIshInt t && oneIshInt f
             then Simplify $ do
-              cond_neg <- letSubExp "cond_neg" $ BasicOp $ UnOp Not cond
+              cond_neg <- letSubExp "cond_neg" $ BasicOp $ UnOp (Neg Bool) cond
               letBind pat $ BasicOp $ ConvOp (BToI (intValueType t)) cond_neg
             else Skip
 -- Simplify

src/Futhark/Optimise/Simplify/Rules/Simple.hs

@@ -51,7 +51,7 @@ simplifyCmpOp look _ (CmpOp CmpEq {} (Constant (IntValue x)) (Var v))
   | Just (BasicOp (ConvOp BToI {} b), cs) <- look v =
       case valueIntegral x :: Int of
         1 -> Just (SubExp b, cs)
-        0 -> Just (UnOp Not b, cs)
+        0 -> Just (UnOp (Neg Bool) b, cs)
         _ -> Just (SubExp (Constant (BoolValue False)), cs)
 simplifyCmpOp _ _ _ = Nothing
 
@@ -176,11 +176,11 @@ simplifyBinOp defOf _ (BinOp LogAnd e1 e2)
   | isCt1 e1 = resIsSubExp e2
   | isCt1 e2 = resIsSubExp e1
   | Var v <- e1,
-    Just (BasicOp (UnOp Not e1'), v_cs) <- defOf v,
+    Just (BasicOp (UnOp (Neg Bool) e1'), v_cs) <- defOf v,
     e1' == e2 =
       Just (SubExp $ Constant $ BoolValue False, v_cs)
   | Var v <- e2,
-    Just (BasicOp (UnOp Not e2'), v_cs) <- defOf v,
+    Just (BasicOp (UnOp (Neg Bool) e2'), v_cs) <- defOf v,
     e2' == e1 =
       Just (SubExp $ Constant $ BoolValue False, v_cs)
 simplifyBinOp defOf _ (BinOp LogOr e1 e2)
@@ -189,11 +189,11 @@ simplifyBinOp defOf _ (BinOp LogOr e1 e2)
   | isCt1 e1 = constRes $ BoolValue True
   | isCt1 e2 = constRes $ BoolValue True
   | Var v <- e1,
-    Just (BasicOp (UnOp Not e1'), v_cs) <- defOf v,
+    Just (BasicOp (UnOp (Neg Bool) e1'), v_cs) <- defOf v,
     e1' == e2 =
       Just (SubExp $ Constant $ BoolValue True, v_cs)
   | Var v <- e2,
-    Just (BasicOp (UnOp Not e2'), v_cs) <- defOf v,
+    Just (BasicOp (UnOp (Neg Bool) e2'), v_cs) <- defOf v,
     e2' == e1 =
       Just (SubExp $ Constant $ BoolValue True, v_cs)
 simplifyBinOp defOf _ (BinOp (SMax it) e1 e2)
@@ -226,8 +226,8 @@ resIsSubExp = Just . (,mempty) . SubExp
 simplifyUnOp :: SimpleRule rep
 simplifyUnOp _ _ (UnOp op (Constant v)) =
   constRes =<< doUnOp op v
-simplifyUnOp defOf _ (UnOp Not (Var v))
-  | Just (BasicOp (UnOp Not v2), v_cs) <- defOf v =
+simplifyUnOp defOf _ (UnOp (Neg Bool) (Var v))
+  | Just (BasicOp (UnOp (Neg Bool) v2), v_cs) <- defOf v =
       Just (SubExp v2, v_cs)
 simplifyUnOp _ _ _ =
   Nothing