From 127f2b825b582ce230d36f823ff2e18d10ee06a1 Mon Sep 17 00:00:00 2001 From: dom Date: Fri, 25 Aug 2023 16:57:39 -0400 Subject: [PATCH 1/2] Add error checking for array dimensions when using interpreter fix #1682 --- src/Language/Futhark/Interpreter.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/Language/Futhark/Interpreter.hs b/src/Language/Futhark/Interpreter.hs index 86fff8fb88..5efb298a8a 100644 --- a/src/Language/Futhark/Interpreter.hs +++ b/src/Language/Futhark/Interpreter.hs @@ -2028,12 +2028,18 @@ interpretFunction ctx fname vs = do updateType _ t = Right t - -- FIXME: we don't check array sizes. checkInput :: ValueType -> StructType -> Either T.Text () checkInput (Scalar (Prim vt)) (Scalar (Prim pt)) | vt /= pt = badPrim vt pt checkInput (Array _ _ (Prim vt)) (Array _ _ (Prim pt)) | vt /= pt = badPrim vt pt + checkInput vArr@(Array _ (F.Shape vd) _) pArr@(Array _ (F.Shape pd) _) + | length vd /= length pd = badDim vArr pArr + | not . all (== True) $ zipWith sameShape vd pd = badDim vArr pArr + where + sameShape :: Int64 -> Size -> Bool + sameShape shape0 (IntLit shape1 _ _) = fromIntegral shape0 == shape1 + sameShape _ _ = True checkInput _ _ = Right () @@ -2044,3 +2050,11 @@ interpretFunction ctx fname vs = do <+> align (pretty pt) "Got: " <+> align (pretty vt) + + badDim vd pd = + Left . docText $ + "Invalid argument dimensions." + "Expected:" + <+> align (pretty pd) + "Got: " + <+> align (pretty vd) From 4530105b2eba16c302b133c022cae133a679a772 Mon Sep 17 00:00:00 2001 From: dom Date: Mon, 28 Aug 2023 09:20:50 -0400 Subject: [PATCH 2/2] Fix style based on hlint info --- src/Language/Futhark/Interpreter.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/Futhark/Interpreter.hs b/src/Language/Futhark/Interpreter.hs index 5efb298a8a..b3aeb27543 100644 --- a/src/Language/Futhark/Interpreter.hs +++ b/src/Language/Futhark/Interpreter.hs @@ -2035,7 +2035,7 @@ interpretFunction ctx fname vs = do | vt /= pt = badPrim vt pt checkInput vArr@(Array _ (F.Shape vd) _) pArr@(Array _ (F.Shape pd) _) | length vd /= length pd = badDim vArr pArr - | not . all (== True) $ zipWith sameShape vd pd = badDim vArr pArr + | not . and $ zipWith sameShape vd pd = badDim vArr pArr where sameShape :: Int64 -> Size -> Bool sameShape shape0 (IntLit shape1 _ _) = fromIntegral shape0 == shape1