From 01dc1d49af945ef87ef12562d6f26198be4a431a Mon Sep 17 00:00:00 2001 From: sortraev Date: Thu, 21 Nov 2024 12:06:13 +0100 Subject: [PATCH 1/8] Fix inc. ranges with start == end and non-zero step This changes behavior of inclusive ranges for the case where `start == end` and `start != second`, for compiled programs only. In this case the result is now `[start]` rather than a runtime error. Example: `1..0...1` now produces `[1]` rather than an "invalid range" runtime error. This makes behavior for compiled programs similar to that of the Futhark interpreter (and e.g. Haskell ranges), for at least this particular case (I have not looked for other discrepancies). --- src/Futhark/Internalise/Exps.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Futhark/Internalise/Exps.hs b/src/Futhark/Internalise/Exps.hs index b805ea777f..20ff405d7c 100644 --- a/src/Futhark/Internalise/Exps.hs +++ b/src/Futhark/Internalise/Exps.hs @@ -245,7 +245,7 @@ internaliseAppExp desc _ (E.Range start maybe_second end loc) = do bounds_invalid_downwards <- letSubExp "bounds_invalid_downwards" $ I.BasicOp $ - I.CmpOp le_op start' end' + I.CmpOp lt_op start' end' bounds_invalid_upwards <- letSubExp "bounds_invalid_upwards" $ I.BasicOp $ From d1427033151067f958e79f549ef8c28f3a15ea2e Mon Sep 17 00:00:00 2001 From: sortraev Date: Sat, 23 Nov 2024 14:23:16 +0100 Subject: [PATCH 2/8] Remove unused le_op --- src/Futhark/Internalise/Exps.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Futhark/Internalise/Exps.hs b/src/Futhark/Internalise/Exps.hs index 20ff405d7c..8d02701647 100644 --- a/src/Futhark/Internalise/Exps.hs +++ b/src/Futhark/Internalise/Exps.hs @@ -215,10 +215,10 @@ internaliseAppExp desc _ (E.Range start maybe_second end loc) = do ) ++ [ErrorVal int64 end'_i64, " is invalid."] - (it, le_op, lt_op) <- + (it, lt_op) <- case E.typeOf start of - E.Scalar (E.Prim (E.Signed it)) -> pure (it, CmpSle it, CmpSlt it) - E.Scalar (E.Prim (E.Unsigned it)) -> pure (it, CmpUle it, CmpUlt it) + E.Scalar (E.Prim (E.Signed it)) -> pure (it, CmpSlt it) + E.Scalar (E.Prim (E.Unsigned it)) -> pure (it, CmpUlt it) start_t -> error $ "Start value in range has type " ++ prettyString start_t let one = intConst it 1 From 3ecec2c9f710ea5ea8ceece39ce39059a347376c Mon Sep 17 00:00:00 2001 From: sortraev Date: Mon, 25 Nov 2024 13:41:33 +0100 Subject: [PATCH 3/8] Split logic for distance, step_wrong_dir, bounds_invalid For conciseness, but also to better comprehend which (and where) changes need to be made. --- src/Futhark/Internalise/Exps.hs | 96 ++++++++++++++------------------- 1 file changed, 40 insertions(+), 56 deletions(-) diff --git a/src/Futhark/Internalise/Exps.hs b/src/Futhark/Internalise/Exps.hs index 8d02701647..cd8a9157fb 100644 --- a/src/Futhark/Internalise/Exps.hs +++ b/src/Futhark/Internalise/Exps.hs @@ -242,6 +242,37 @@ internaliseAppExp desc _ (E.Range start maybe_second end loc) = do step_sign <- letSubExp "s_sign" $ BasicOp $ I.UnOp (I.SSignum it) step step_sign_i64 <- asIntS Int64 step_sign + distance <- do + difference <- + letSubExp "difference" $ + I.BasicOp $ + I.BinOp (Sub it I.OverflowWrap) end' start' + distance_exclusive_i64 <- + asIntS Int64 + =<< ( letSubExp "distance_exclusive" $ + I.BasicOp $ + I.UnOp (Abs it) difference + ) + case end of + ToInclusive {} -> + letSubExp "distance_inclusive" $ + I.BasicOp $ + I.BinOp + (Add Int64 I.OverflowWrap) + distance_exclusive_i64 + (intConst Int64 1) + _ -> pure distance_exclusive_i64 + + downwards <- + letSubExp "downwards" $ + I.BasicOp $ + I.CmpOp (I.CmpEq $ IntType it) step_sign negone + + step_wrong_dir <- case end of + DownToExclusive {} -> letSubExp "upwards" $ I.BasicOp $ I.UnOp (I.Neg I.Bool) downwards + UpToExclusive {} -> pure downwards + ToInclusive {} -> pure $ constant False + bounds_invalid_downwards <- letSubExp "bounds_invalid_downwards" $ I.BasicOp $ @@ -250,62 +281,15 @@ internaliseAppExp desc _ (E.Range start maybe_second end loc) = do letSubExp "bounds_invalid_upwards" $ I.BasicOp $ I.CmpOp lt_op end' start' - - (distance, step_wrong_dir, bounds_invalid) <- case end of - DownToExclusive {} -> do - step_wrong_dir <- - letSubExp "step_wrong_dir" $ - I.BasicOp $ - I.CmpOp (I.CmpEq $ IntType it) step_sign one - distance <- - letSubExp "distance" $ - I.BasicOp $ - I.BinOp (Sub it I.OverflowWrap) start' end' - distance_i64 <- asIntS Int64 distance - pure (distance_i64, step_wrong_dir, bounds_invalid_downwards) - UpToExclusive {} -> do - step_wrong_dir <- - letSubExp "step_wrong_dir" $ - I.BasicOp $ - I.CmpOp (I.CmpEq $ IntType it) step_sign negone - distance <- letSubExp "distance" $ I.BasicOp $ I.BinOp (Sub it I.OverflowWrap) end' start' - distance_i64 <- asIntS Int64 distance - pure (distance_i64, step_wrong_dir, bounds_invalid_upwards) - ToInclusive {} -> do - downwards <- - letSubExp "downwards" $ - I.BasicOp $ - I.CmpOp (I.CmpEq $ IntType it) step_sign negone - distance_downwards_exclusive <- - letSubExp "distance_downwards_exclusive" $ - I.BasicOp $ - I.BinOp (Sub it I.OverflowWrap) start' end' - distance_upwards_exclusive <- - letSubExp "distance_upwards_exclusive" $ - I.BasicOp $ - I.BinOp (Sub it I.OverflowWrap) end' start' - - bounds_invalid <- - letSubExp "bounds_invalid" - =<< eIf - (eSubExp downwards) - (resultBodyM [bounds_invalid_downwards]) - (resultBodyM [bounds_invalid_upwards]) - distance_exclusive <- - letSubExp "distance_exclusive" - =<< eIf - (eSubExp downwards) - (resultBodyM [distance_downwards_exclusive]) - (resultBodyM [distance_upwards_exclusive]) - distance_exclusive_i64 <- asIntS Int64 distance_exclusive - distance <- - letSubExp "distance" $ - I.BasicOp $ - I.BinOp - (Add Int64 I.OverflowWrap) - distance_exclusive_i64 - (intConst Int64 1) - pure (distance, constant False, bounds_invalid) + bounds_invalid <- case end of + DownToExclusive {} -> pure bounds_invalid_downwards + UpToExclusive {} -> pure bounds_invalid_upwards + ToInclusive {} -> + letSubExp "bounds_invalid" + =<< eIf + (eSubExp downwards) + (resultBodyM [bounds_invalid_downwards]) + (resultBodyM [bounds_invalid_upwards]) step_invalid <- letSubExp "step_invalid" $ From b0314975a6471c11a70a0a92bbe7f74c190f9e7d Mon Sep 17 00:00:00 2001 From: sortraev Date: Mon, 25 Nov 2024 13:47:54 +0100 Subject: [PATCH 4/8] Rename end -> inclusiveness --- src/Futhark/Internalise/Exps.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Futhark/Internalise/Exps.hs b/src/Futhark/Internalise/Exps.hs index cd8a9157fb..539c0fc7f0 100644 --- a/src/Futhark/Internalise/Exps.hs +++ b/src/Futhark/Internalise/Exps.hs @@ -184,9 +184,9 @@ internaliseAppExp desc _ (E.Index e idxs loc) = do v_t <- lookupType v pure $ I.BasicOp $ I.Index v $ fullSlice v_t idxs' certifying cs $ mapM (letSubExp desc <=< index) vs -internaliseAppExp desc _ (E.Range start maybe_second end loc) = do +internaliseAppExp desc _ (E.Range start maybe_second inclusiveness loc) = do start' <- internaliseExp1 "range_start" start - end' <- internaliseExp1 "range_end" $ case end of + end' <- internaliseExp1 "range_end" $ case inclusiveness of DownToExclusive e -> e ToInclusive e -> e UpToExclusive e -> e @@ -208,7 +208,7 @@ internaliseAppExp desc _ (E.Range start maybe_second end loc) = do Nothing -> [] Just second_i64 -> ["..", ErrorVal int64 second_i64] ) - ++ ( case end of + ++ ( case inclusiveness of DownToExclusive {} -> ["..>"] ToInclusive {} -> ["..."] UpToExclusive {} -> ["..<"] @@ -223,7 +223,7 @@ internaliseAppExp desc _ (E.Range start maybe_second end loc) = do let one = intConst it 1 negone = intConst it (-1) - default_step = case end of + default_step = case inclusiveness of DownToExclusive {} -> negone ToInclusive {} -> one UpToExclusive {} -> one @@ -253,7 +253,7 @@ internaliseAppExp desc _ (E.Range start maybe_second end loc) = do I.BasicOp $ I.UnOp (Abs it) difference ) - case end of + case inclusiveness of ToInclusive {} -> letSubExp "distance_inclusive" $ I.BasicOp $ @@ -268,7 +268,7 @@ internaliseAppExp desc _ (E.Range start maybe_second end loc) = do I.BasicOp $ I.CmpOp (I.CmpEq $ IntType it) step_sign negone - step_wrong_dir <- case end of + step_wrong_dir <- case inclusiveness of DownToExclusive {} -> letSubExp "upwards" $ I.BasicOp $ I.UnOp (I.Neg I.Bool) downwards UpToExclusive {} -> pure downwards ToInclusive {} -> pure $ constant False @@ -281,7 +281,7 @@ internaliseAppExp desc _ (E.Range start maybe_second end loc) = do letSubExp "bounds_invalid_upwards" $ I.BasicOp $ I.CmpOp lt_op end' start' - bounds_invalid <- case end of + bounds_invalid <- case inclusiveness of DownToExclusive {} -> pure bounds_invalid_downwards UpToExclusive {} -> pure bounds_invalid_upwards ToInclusive {} -> From 64230272ada9931707ba207d6b6bba8109fa1ede Mon Sep 17 00:00:00 2001 From: sortraev Date: Mon, 25 Nov 2024 14:11:17 +0100 Subject: [PATCH 5/8] Simplifying refactoring * split step and step_zero computations. * no need to compute sign. * inline some definitions which were used only once. --- src/Futhark/Internalise/Exps.hs | 39 ++++++++++++++------------------- 1 file changed, 17 insertions(+), 22 deletions(-) diff --git a/src/Futhark/Internalise/Exps.hs b/src/Futhark/Internalise/Exps.hs index 539c0fc7f0..9ce3001e6e 100644 --- a/src/Futhark/Internalise/Exps.hs +++ b/src/Futhark/Internalise/Exps.hs @@ -221,26 +221,22 @@ internaliseAppExp desc _ (E.Range start maybe_second inclusiveness loc) = do E.Scalar (E.Prim (E.Unsigned it)) -> pure (it, CmpUlt it) start_t -> error $ "Start value in range has type " ++ prettyString start_t - let one = intConst it 1 - negone = intConst it (-1) - default_step = case inclusiveness of - DownToExclusive {} -> negone - ToInclusive {} -> one - UpToExclusive {} -> one - - (step, step_zero) <- case maybe_second' of - Just second' -> do - subtracted_step <- - letSubExp "subtracted_step" $ - I.BasicOp $ - I.BinOp (I.Sub it I.OverflowWrap) second' start' - step_zero <- letSubExp "step_zero" $ I.BasicOp $ I.CmpOp (I.CmpEq $ IntType it) start' second' - pure (subtracted_step, step_zero) - Nothing -> - pure (default_step, constant False) + let zero = intConst it 0 - step_sign <- letSubExp "s_sign" $ BasicOp $ I.UnOp (I.SSignum it) step - step_sign_i64 <- asIntS Int64 step_sign + step <- case maybe_second' of + Just second' -> + letSubExp "subtracted_step" $ + I.BasicOp $ + I.BinOp (I.Sub it I.OverflowWrap) second' start' + Nothing -> pure $ intConst it $ -- use default step of 1 or -1. + case inclusiveness of + DownToExclusive {} -> -1 + _ -> 1 + + step_zero <- + letSubExp "step_zero" $ + I.BasicOp $ + I.CmpOp (I.CmpEq $ IntType it) step zero distance <- do difference <- @@ -266,8 +262,7 @@ internaliseAppExp desc _ (E.Range start maybe_second inclusiveness loc) = do downwards <- letSubExp "downwards" $ I.BasicOp $ - I.CmpOp (I.CmpEq $ IntType it) step_sign negone - + I.CmpOp (CmpSlt it) step zero step_wrong_dir <- case inclusiveness of DownToExclusive {} -> letSubExp "upwards" $ I.BasicOp $ I.UnOp (I.Neg I.Bool) downwards UpToExclusive {} -> pure downwards @@ -307,7 +302,7 @@ internaliseAppExp desc _ (E.Range start maybe_second inclusiveness loc) = do pos_step <- letSubExp "pos_step" $ I.BasicOp $ - I.BinOp (Mul Int64 I.OverflowWrap) step_i64 step_sign_i64 + I.UnOp (Abs Int64) step_i64 num_elems <- certifying cs $ From 4fd1b0b080fa3d42d96271b58dbb322abce3a7f4 Mon Sep 17 00:00:00 2001 From: sortraev Date: Tue, 26 Nov 2024 12:34:58 +0100 Subject: [PATCH 6/8] Remove dead code (range bounds are always signed) --- src/Futhark/Internalise/Exps.hs | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/src/Futhark/Internalise/Exps.hs b/src/Futhark/Internalise/Exps.hs index 9ce3001e6e..c3311a3331 100644 --- a/src/Futhark/Internalise/Exps.hs +++ b/src/Futhark/Internalise/Exps.hs @@ -194,12 +194,9 @@ internaliseAppExp desc _ (E.Range start maybe_second inclusiveness loc) = do traverse (internaliseExp1 "range_second") maybe_second -- Construct an error message in case the range is invalid. - let conv = case E.typeOf start of - E.Scalar (E.Prim (E.Unsigned _)) -> asIntZ Int64 - _ -> asIntS Int64 - start'_i64 <- conv start' - end'_i64 <- conv end' - maybe_second'_i64 <- traverse conv maybe_second' + start'_i64 <- asIntS Int64 start' + end'_i64 <- asIntS Int64 end' + maybe_second'_i64 <- traverse (asIntS Int64) maybe_second' let errmsg = errorMsg $ ["Range "] @@ -215,11 +212,10 @@ internaliseAppExp desc _ (E.Range start maybe_second inclusiveness loc) = do ) ++ [ErrorVal int64 end'_i64, " is invalid."] - (it, lt_op) <- - case E.typeOf start of - E.Scalar (E.Prim (E.Signed it)) -> pure (it, CmpSlt it) - E.Scalar (E.Prim (E.Unsigned it)) -> pure (it, CmpUlt it) - start_t -> error $ "Start value in range has type " ++ prettyString start_t + let it = case E.typeOf start of + E.Scalar (E.Prim (E.Signed start_t)) -> start_t + start_t -> error $ "Start value in range has type " ++ prettyString start_t + let lt_op = CmpSlt it let zero = intConst it 0 @@ -262,7 +258,7 @@ internaliseAppExp desc _ (E.Range start maybe_second inclusiveness loc) = do downwards <- letSubExp "downwards" $ I.BasicOp $ - I.CmpOp (CmpSlt it) step zero + I.CmpOp lt_op step zero step_wrong_dir <- case inclusiveness of DownToExclusive {} -> letSubExp "upwards" $ I.BasicOp $ I.UnOp (I.Neg I.Bool) downwards UpToExclusive {} -> pure downwards From 5ed6783e84fd4f3f34fefcddb1e3ce9b2b6e9dd7 Mon Sep 17 00:00:00 2001 From: sortraev Date: Tue, 26 Nov 2024 13:35:00 +0100 Subject: [PATCH 7/8] Style fixes --- src/Futhark/Internalise/Exps.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/Futhark/Internalise/Exps.hs b/src/Futhark/Internalise/Exps.hs index c3311a3331..ddeb41af62 100644 --- a/src/Futhark/Internalise/Exps.hs +++ b/src/Futhark/Internalise/Exps.hs @@ -213,8 +213,8 @@ internaliseAppExp desc _ (E.Range start maybe_second inclusiveness loc) = do ++ [ErrorVal int64 end'_i64, " is invalid."] let it = case E.typeOf start of - E.Scalar (E.Prim (E.Signed start_t)) -> start_t - start_t -> error $ "Start value in range has type " ++ prettyString start_t + E.Scalar (E.Prim (E.Signed start_t)) -> start_t + start_t -> error $ "Start value in range has type " ++ prettyString start_t let lt_op = CmpSlt it let zero = intConst it 0 @@ -224,10 +224,11 @@ internaliseAppExp desc _ (E.Range start maybe_second inclusiveness loc) = do letSubExp "subtracted_step" $ I.BasicOp $ I.BinOp (I.Sub it I.OverflowWrap) second' start' - Nothing -> pure $ intConst it $ -- use default step of 1 or -1. - case inclusiveness of - DownToExclusive {} -> -1 - _ -> 1 + Nothing -> pure $ + intConst it $ -- use default step of 1 or -1. + case inclusiveness of + DownToExclusive {} -> -1 + _ -> 1 step_zero <- letSubExp "step_zero" $ @@ -241,10 +242,10 @@ internaliseAppExp desc _ (E.Range start maybe_second inclusiveness loc) = do I.BinOp (Sub it I.OverflowWrap) end' start' distance_exclusive_i64 <- asIntS Int64 - =<< ( letSubExp "distance_exclusive" $ - I.BasicOp $ - I.UnOp (Abs it) difference - ) + =<< letSubExp + "distance_exclusive" + (I.BasicOp $ I.UnOp (Abs it) difference) + case inclusiveness of ToInclusive {} -> letSubExp "distance_inclusive" $ From 533fd3453270d06b5161ee8b440cbff422d37393 Mon Sep 17 00:00:00 2001 From: sortraev Date: Tue, 26 Nov 2024 13:39:11 +0100 Subject: [PATCH 8/8] Inc range tests with `start == end` and neg. step Add tests with `start == end` for negative (and positive, since it was missing) step. Also, add inclusive range test with a zero step, and remove some duplicate test cases. --- tests/range0.fut | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/tests/range0.fut b/tests/range0.fut index b53f6e1c6e..c848c801e2 100644 --- a/tests/range0.fut +++ b/tests/range0.fut @@ -5,8 +5,6 @@ -- input { 1 5 } output { [1i32, 2i32, 3i32, 4i32, 5i32] } -- input { 5 1 } error: 5...1 -- input { 5 0 } error: 5...0 --- input { 0 5 } output { [0i32, 1i32, 2i32, --- 3i32, 4i32, 5i32] } -- == -- entry: test1 @@ -14,7 +12,6 @@ -- input { 1 5 } output { [1i32, 2i32, 3i32, 4i32] } -- input { 5 1 } error: 5..<1 -- input { 5 0 } error: 5..<0 --- input { 0 5 } output { [0i32, 1i32, 2i32, 3i32, 4i32] } -- == -- entry: test2 @@ -22,7 +19,6 @@ -- input { 1 5 } error: 1..>5 -- input { 5 1 } output { [5i32, 4i32, 3i32, 2i32] } -- input { 5 0 } output { [5i32, 4i32, 3i32, 2i32, 1i32] } --- input { 0 5 } error: 0..>5 -- == -- entry: test3 @@ -31,6 +27,9 @@ -- input { 5 4 1 } output { [5i32, 4i32, 3i32, 2i32, 1i32] } -- input { 5 0 0 } output { [5i32, 0i32] } -- input { 0 2 5 } output { [0i32, 2i32, 4i32] } +-- input { 1 1 5 } error: 1..1...5 +-- input { 1 0 1 } output { [1i32] } +-- input { 1 2 1 } output { [1i32] } -- == -- entry: test4