From 3bc6a8f292acbe50bd655924d326389676fdf941 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=96zg=C3=BCr=20Akg=C3=BCn?= Date: Mon, 6 May 2024 15:39:24 +0100 Subject: [PATCH 1/8] format --- src/Conjure/Language/RepresentationOf.hs | 43 +++++++++++++----------- 1 file changed, 23 insertions(+), 20 deletions(-) diff --git a/src/Conjure/Language/RepresentationOf.hs b/src/Conjure/Language/RepresentationOf.hs index 01c5ea1f11..c42feae252 100644 --- a/src/Conjure/Language/RepresentationOf.hs +++ b/src/Conjure/Language/RepresentationOf.hs @@ -1,39 +1,42 @@ module Conjure.Language.RepresentationOf where -- conjure -import Conjure.Prelude -import Conjure.Language.Domain -import Conjure.Language.Type ( TypeCheckerMode ) +import Conjure.Language.Domain +import Conjure.Language.Type (TypeCheckerMode) +import Conjure.Prelude class RepresentationOf a where - representationTreeOf - :: (MonadFailDoc m, ?typeCheckerMode :: TypeCheckerMode) - => a -> m (Tree (Maybe HasRepresentation)) + representationTreeOf :: + (MonadFailDoc m, ?typeCheckerMode :: TypeCheckerMode) => + a -> + m (Tree (Maybe HasRepresentation)) representationOf :: (RepresentationOf a, MonadFailDoc m, ?typeCheckerMode :: TypeCheckerMode) => a -> m HasRepresentation -representationOf a = do - tree <- representationTreeOf a - case rootLabel tree of - Nothing -> failDoc "doesn't seem to have a representation" +representationOf a = + case representationTreeOf a of + Nothing -> failDoc "doesn't seem to have a representation tree" + Just tree -> + case rootLabel tree of + Nothing -> failDoc "doesn't seem to have a representation" Just NoRepresentation -> failDoc "doesn't seem to have a representation" Just r -> return r hasRepresentation :: (RepresentationOf a, MonadFailDoc m, ?typeCheckerMode :: TypeCheckerMode) => a -> m () hasRepresentation x = - case representationOf x of - Nothing -> failDoc "doesn't seem to have a representation" - Just _ -> return () + case representationTreeOf x of + Nothing -> failDoc "doesn't seem to have a representation" + Just _ -> return () sameRepresentation :: (RepresentationOf a, MonadFailDoc m, ?typeCheckerMode :: TypeCheckerMode) => a -> a -> m () sameRepresentation x y = - case (representationOf x, representationOf y) of - (Just rx, Just ry) | rx == ry -> return () - _ -> failDoc "doesn't seem to have the same representation" + case (representationOf x, representationOf y) of + (Just rx, Just ry) | rx == ry -> return () + _ -> failDoc "doesn't seem to have the same representation" sameRepresentationTree :: (RepresentationOf a, MonadFailDoc m, ?typeCheckerMode :: TypeCheckerMode) => a -> a -> m () sameRepresentationTree x y = do - xTree <- representationTreeOf x - yTree <- representationTreeOf y - unless (xTree == yTree) $ - failDoc "doesn't seem to have the same representation tree" + xTree <- representationTreeOf x + yTree <- representationTreeOf y + unless (xTree == yTree) + $ failDoc "doesn't seem to have the same representation tree" From 6b4fcd27a69942313f3baf6cd0bc1d7f4d1cd2b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=96zg=C3=BCr=20Akg=C3=BCn?= Date: Mon, 6 May 2024 15:40:01 +0100 Subject: [PATCH 2/8] remove 3 horizontal sequence rules - these were copied over from functions and are not required for sequences --- src/Conjure/Rules/Horizontal/Sequence.hs | 131 ----------------------- src/Conjure/UI/Model.hs | 3 - 2 files changed, 134 deletions(-) diff --git a/src/Conjure/Rules/Horizontal/Sequence.hs b/src/Conjure/Rules/Horizontal/Sequence.hs index 3175631510..8cb4401c3d 100644 --- a/src/Conjure/Rules/Horizontal/Sequence.hs +++ b/src/Conjure/Rules/Horizontal/Sequence.hs @@ -379,137 +379,6 @@ rule_Restrict_Comprehension = "sequence-restrict-comprehension" `namedRule` theR theRule _ = na "rule_Restrict_Comprehension" --- | image(f,x) can be nasty for non-total sequences. --- 1. if f is a total sequence, it can readily be replaced by a set expression. --- 2.1. if f isn't total, and if the return type is right, it will always end up as a generator for a comprehension. --- a vertical rule is needed for such cases. --- 2.2. if the return type is not "right", i.e. it is a bool or an int, i.e. sth we cannot quantify over, --- the vertical rule is harder. - -rule_Image_Bool :: Rule -rule_Image_Bool = "sequence-image-bool" `namedRule` theRule where - theRule Reference{} = na "rule_Image_Int" - theRule p = do - let - onChildren - :: MonadState (Maybe (Expression, Expression)) m - => Expression - -> m (Expression -> Expression) - onChildren ch = do - let - try = do - (func, arg) <- match opImage ch - case match opRestrict func of - Nothing -> return () - Just{} -> na "rule_Image_Bool" -- do not use this rule for restricted sequences - TypeSequence TypeBool <- typeOf func - return (func, arg) - case try of - Nothing -> return (const ch) -- do not failDoc if a child is not of proper form - Just (func, arg) -> do -- just return it back unchanged - seenBefore <- gets id - case seenBefore of - Nothing -> do - modify $ const $ Just (func, arg) - return id - Just{} -> - return (const ch) - - let (children_, gen) = uniplate p - (genChildren, mFunc) <- runStateT (mapM onChildren children_) Nothing - let - mkP :: Expression -> Expression - mkP new = gen $ fmap ($ new) genChildren - (func, arg) <- maybe (na "rule_Image_Bool") return mFunc -- Nothing signifies no relevant children - return - ( "Sequence image, bool." - , do - (iPat, i) <- quantifiedVar - return $ mkP $ make opOr $ Comprehension [essence| &i[2] |] - [ Generator (GenInExpr iPat func) - , Condition [essence| &i[1] = &arg |] - ] - ) - - -rule_Image_Int :: Rule -rule_Image_Int = "sequence-image-int" `namedRule` theRule where - theRule Reference{} = na "rule_Image_Int" - theRule p = do - let - onChildren - :: MonadState (Maybe (Expression, Expression)) m - => Expression - -> m (Expression -> Expression) - onChildren ch = do - let - try = do - (func, arg) <- match opImage ch - case match opRestrict func of - Nothing -> return () - Just{} -> na "rule_Image_Int" -- do not use this rule for restricted sequences - TypeSequence (TypeInt _) <- typeOf func - return (func, arg) - case try of - Nothing -> return (const ch) -- do not failDoc if a child is not of proper form - Just (func, arg) -> do -- just return it back unchanged - seenBefore <- gets id - case seenBefore of - Nothing -> do - modify $ const $ Just (func, arg) - return id - Just{} -> - return (const ch) - - let (children_, gen) = uniplate p - (genChildren, mFunc) <- runStateT (mapM onChildren children_) Nothing - let - mkP :: Expression -> Expression - mkP new = gen $ fmap ($ new) genChildren - (func, arg) <- maybe (na "rule_Image_Int") return mFunc -- Nothing signifies no relevant children - return - ( "Sequence image, int." - , do - (iPat, i) <- quantifiedVar - let val = make opSum $ Comprehension [essence| &i[2] |] - [ Generator (GenInExpr iPat func) - , Condition [essence| &i[1] = &arg |] - ] - isDefined = [essence| &arg in defined(&func) |] - return $ mkP $ WithLocals val (DefinednessConstraints [isDefined]) - ) - - -rule_Comprehension_Image :: Rule -rule_Comprehension_Image = "sequence-image-comprehension" `namedRule` theRule where - theRule (Comprehension body gensOrConds) = do - (gofBefore, (pat, expr), gofAfter) <- matchFirst gensOrConds $ \ gof -> case gof of - Generator (GenInExpr pat@Single{} expr) -> return (pat, expr) - _ -> na "rule_Comprehension_Image" - (mkModifier, expr2) <- match opModifier expr - (func, arg) <- match opImage expr2 - TypeSequence{} <- typeOf func - case match opRestrict func of - Nothing -> return () - Just{} -> na "rule_Image_Bool" -- do not use this rule for restricted sequences - let upd val old = lambdaToFunction pat old val - return - ( "Mapping over the image of a sequence" - , do - (iPat, i) <- quantifiedVar - (jPat, j) <- quantifiedVar - return $ Comprehension - (upd j body) - $ gofBefore - ++ [ Generator (GenInExpr iPat (mkModifier func)) - , Condition [essence| &i[1] = &arg |] - , Generator (GenInExpr jPat [essence| &i[2] |]) - ] - ++ transformBi (upd j) gofAfter - ) - theRule _ = na "rule_Comprehension_Image" - - rule_Substring :: Rule rule_Substring = "substring" `namedRule` theRule where theRule [essence| &a substring &b |] = do diff --git a/src/Conjure/UI/Model.hs b/src/Conjure/UI/Model.hs index baf8cb0579..7d13a30218 100644 --- a/src/Conjure/UI/Model.hs +++ b/src/Conjure/UI/Model.hs @@ -1575,9 +1575,6 @@ horizontalRules = , Horizontal.Function.rule_DefinedOrRange_Difference , Horizontal.Sequence.rule_Comprehension_Literal - , Horizontal.Sequence.rule_Image_Bool - , Horizontal.Sequence.rule_Image_Int - , Horizontal.Sequence.rule_Comprehension_Image , Horizontal.Sequence.rule_Image_Literal_Bool , Horizontal.Sequence.rule_Image_Literal_Int , Horizontal.Sequence.rule_Eq_Literal From 2bd675a0d4e660d3a2296678fc3c966285c67d33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=96zg=C3=BCr=20Akg=C3=BCn?= Date: Wed, 8 May 2024 13:01:23 +0100 Subject: [PATCH 3/8] bring one of the rules back --- src/Conjure/Rules/Horizontal/Sequence.hs | 30 ++++++++++++++++++++++++ src/Conjure/UI/Model.hs | 1 + 2 files changed, 31 insertions(+) diff --git a/src/Conjure/Rules/Horizontal/Sequence.hs b/src/Conjure/Rules/Horizontal/Sequence.hs index 8cb4401c3d..5203759290 100644 --- a/src/Conjure/Rules/Horizontal/Sequence.hs +++ b/src/Conjure/Rules/Horizontal/Sequence.hs @@ -379,6 +379,36 @@ rule_Restrict_Comprehension = "sequence-restrict-comprehension" `namedRule` theR theRule _ = na "rule_Restrict_Comprehension" +rule_Comprehension_Image :: Rule +rule_Comprehension_Image = "sequence-image-comprehension" `namedRule` theRule where + theRule (Comprehension body gensOrConds) = do + (gofBefore, (pat, expr), gofAfter) <- matchFirst gensOrConds $ \ gof -> case gof of + Generator (GenInExpr pat@Single{} expr) -> return (pat, expr) + _ -> na "rule_Comprehension_Image" + (mkModifier, expr2) <- match opModifier expr + (func, arg) <- match opImage expr2 + TypeSequence{} <- typeOf func + case match opRestrict func of + Nothing -> return () + Just{} -> na "rule_Image_Bool" -- do not use this rule for restricted sequences + let upd val old = lambdaToFunction pat old val + return + ( "Mapping over the image of a sequence" + , do + (iPat, i) <- quantifiedVar + (jPat, j) <- quantifiedVar + return $ Comprehension + (upd j body) + $ gofBefore + ++ [ Generator (GenInExpr iPat (mkModifier func)) + , Condition [essence| &i[1] = &arg |] + , Generator (GenInExpr jPat [essence| &i[2] |]) + ] + ++ transformBi (upd j) gofAfter + ) + theRule _ = na "rule_Comprehension_Image" + + rule_Substring :: Rule rule_Substring = "substring" `namedRule` theRule where theRule [essence| &a substring &b |] = do diff --git a/src/Conjure/UI/Model.hs b/src/Conjure/UI/Model.hs index 7d13a30218..616c2f619e 100644 --- a/src/Conjure/UI/Model.hs +++ b/src/Conjure/UI/Model.hs @@ -1575,6 +1575,7 @@ horizontalRules = , Horizontal.Function.rule_DefinedOrRange_Difference , Horizontal.Sequence.rule_Comprehension_Literal + , Horizontal.Sequence.rule_Comprehension_Image , Horizontal.Sequence.rule_Image_Literal_Bool , Horizontal.Sequence.rule_Image_Literal_Int , Horizontal.Sequence.rule_Eq_Literal From fa1a12aff883fce784b27a13dd2a15fa841b2408 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=96zg=C3=BCr=20Akg=C3=BCn?= Date: Wed, 8 May 2024 14:54:42 +0100 Subject: [PATCH 4/8] update expected model --- .../basic/sequence_subseq_dups/expected/model.eprime | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/tests/exhaustive/basic/sequence_subseq_dups/expected/model.eprime b/tests/exhaustive/basic/sequence_subseq_dups/expected/model.eprime index 7a0286b781..4f16192b1b 100644 --- a/tests/exhaustive/basic/sequence_subseq_dups/expected/model.eprime +++ b/tests/exhaustive/basic/sequence_subseq_dups/expected/model.eprime @@ -15,10 +15,11 @@ such that b_ExplicitBounded_Length = conjure_aux1_ExplicitBounded_Length, and([q6 <= b_ExplicitBounded_Length -> and([b_ExplicitBounded_Values[q6] = - sum([toInt(q8 = conjure_aux1_ExplicitBounded_Values[q6]) * catchUndef([1, 1, 2; int(1..3)][q8], 0) - | q8 : int(1..3)]), - or([q10 = conjure_aux1_ExplicitBounded_Values[q6] | q10 : int(1..3), q10 <= 3]), - q6 <= conjure_aux1_ExplicitBounded_Length; + sum([toInt(1 = conjure_aux1_ExplicitBounded_Values[q6]), + toInt(2 = conjure_aux1_ExplicitBounded_Values[q6]), + toInt(3 = conjure_aux1_ExplicitBounded_Values[q6]) * 2; + int(1..3)]), + conjure_aux1_ExplicitBounded_Values[q6] <= 3, q6 <= conjure_aux1_ExplicitBounded_Length; int(1..3)]) | q6 : int(1..2)]), and([q1 > b_ExplicitBounded_Length -> b_ExplicitBounded_Values[q1] = 1 | q1 : int(1..2)]), From 9bd202cff84bbbf3f1a460ae601a48773da374df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=96zg=C3=BCr=20Akg=C3=BCn?= Date: Wed, 8 May 2024 14:55:23 +0100 Subject: [PATCH 5/8] update expected model --- .../basic/sequence_subseq_nodups/expected/model.eprime | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/tests/exhaustive/basic/sequence_subseq_nodups/expected/model.eprime b/tests/exhaustive/basic/sequence_subseq_nodups/expected/model.eprime index 96f6872240..f2dda32fe8 100644 --- a/tests/exhaustive/basic/sequence_subseq_nodups/expected/model.eprime +++ b/tests/exhaustive/basic/sequence_subseq_nodups/expected/model.eprime @@ -15,10 +15,11 @@ such that b_ExplicitBounded_Length = conjure_aux1_ExplicitBounded_Length, and([q6 <= b_ExplicitBounded_Length -> and([b_ExplicitBounded_Values[q6] = - sum([toInt(q8 = conjure_aux1_ExplicitBounded_Values[q6]) * catchUndef([3, 1, 2; int(1..3)][q8], 0) - | q8 : int(1..3)]), - or([q10 = conjure_aux1_ExplicitBounded_Values[q6] | q10 : int(1..3), q10 <= 3]), - q6 <= conjure_aux1_ExplicitBounded_Length; + sum([toInt(1 = conjure_aux1_ExplicitBounded_Values[q6]) * 3, + toInt(2 = conjure_aux1_ExplicitBounded_Values[q6]), + toInt(3 = conjure_aux1_ExplicitBounded_Values[q6]) * 2; + int(1..3)]), + conjure_aux1_ExplicitBounded_Values[q6] <= 3, q6 <= conjure_aux1_ExplicitBounded_Length; int(1..3)]) | q6 : int(1..2)]), and([q1 > b_ExplicitBounded_Length -> b_ExplicitBounded_Values[q1] = 1 | q1 : int(1..2)]), From 579ef2a34baec5e9ed508205a985ef5a0ebbd55e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=96zg=C3=BCr=20Akg=C3=BCn?= Date: Sun, 12 May 2024 22:31:24 +0100 Subject: [PATCH 6/8] bring back the rules, except for direct references --- src/Conjure/Rules/Horizontal/Sequence.hs | 98 ++++++++++++++++++++++++ src/Conjure/UI/Model.hs | 2 + 2 files changed, 100 insertions(+) diff --git a/src/Conjure/Rules/Horizontal/Sequence.hs b/src/Conjure/Rules/Horizontal/Sequence.hs index 5203759290..6b40159d12 100644 --- a/src/Conjure/Rules/Horizontal/Sequence.hs +++ b/src/Conjure/Rules/Horizontal/Sequence.hs @@ -379,6 +379,104 @@ rule_Restrict_Comprehension = "sequence-restrict-comprehension" `namedRule` theR theRule _ = na "rule_Restrict_Comprehension" + +rule_Image_Bool :: Rule +rule_Image_Bool = "sequence-image-bool" `namedRule` theRule where + theRule Reference{} = na "rule_Image_Bool" + theRule p = do + let + onChildren + :: MonadState (Maybe (Expression, Expression)) m + => Expression + -> m (Expression -> Expression) + onChildren ch = do + let + try = do + (func, arg) <- match opImage ch + case match opRestrict func of + Nothing -> return () + Just{} -> na "rule_Image_Bool" -- do not use this rule for restricted sequences + TypeSequence TypeBool <- typeOf func + return (func, arg) + case try of + Nothing -> return (const ch) -- do not failDoc if a child is not of proper form + Just (func, arg) -> do -- just return it back unchanged + seenBefore <- gets id + case seenBefore of + Nothing -> do + modify $ const $ Just (func, arg) + return id + Just{} -> + return (const ch) + + let (children_, gen) = uniplate p + (genChildren, mFunc) <- runStateT (mapM onChildren children_) Nothing + let + mkP :: Expression -> Expression + mkP new = gen $ fmap ($ new) genChildren + (func, arg) <- maybe (na "rule_Image_Bool") return mFunc -- Nothing signifies no relevant children + return + ( "Sequence image, bool." + , do + (iPat, i) <- quantifiedVar + return $ mkP $ make opOr $ Comprehension [essence| &i[2] |] + [ Generator (GenInExpr iPat func) + , Condition [essence| &i[1] = &arg |] + ] + ) + + +rule_Image_Int :: Rule +rule_Image_Int = "sequence-image-int" `namedRule` theRule where + theRule Reference{} = na "rule_Image_Int" + theRule p = do + let + onChildren + :: MonadState (Maybe (Expression, Expression)) m + => Expression + -> m (Expression -> Expression) + onChildren ch = do + let + try = do + (func, arg) <- match opImage ch + case match opRestrict func of + Nothing -> return () + Just{} -> na "rule_Image_Int" -- do not use this rule for restricted sequences + case func of + Reference{} -> na "rule_Image_Int" -- do not use this rule for a direct reference + _ -> return () + TypeSequence (TypeInt _) <- typeOf func + return (func, arg) + case try of + Nothing -> return (const ch) -- do not failDoc if a child is not of proper form + Just (func, arg) -> do -- just return it back unchanged + seenBefore <- gets id + case seenBefore of + Nothing -> do + modify $ const $ Just (func, arg) + return id + Just{} -> + return (const ch) + + let (children_, gen) = uniplate p + (genChildren, mFunc) <- runStateT (mapM onChildren children_) Nothing + let + mkP :: Expression -> Expression + mkP new = gen $ fmap ($ new) genChildren + (func, arg) <- maybe (na "rule_Image_Int") return mFunc -- Nothing signifies no relevant children + return + ( "Sequence image, int." + , do + (iPat, i) <- quantifiedVar + let val = make opSum $ Comprehension [essence| &i[2] |] + [ Generator (GenInExpr iPat func) + , Condition [essence| &i[1] = &arg |] + ] + isDefined = [essence| &arg in defined(&func) |] + return $ mkP $ WithLocals val (DefinednessConstraints [isDefined]) + ) + + rule_Comprehension_Image :: Rule rule_Comprehension_Image = "sequence-image-comprehension" `namedRule` theRule where theRule (Comprehension body gensOrConds) = do diff --git a/src/Conjure/UI/Model.hs b/src/Conjure/UI/Model.hs index 616c2f619e..baf8cb0579 100644 --- a/src/Conjure/UI/Model.hs +++ b/src/Conjure/UI/Model.hs @@ -1575,6 +1575,8 @@ horizontalRules = , Horizontal.Function.rule_DefinedOrRange_Difference , Horizontal.Sequence.rule_Comprehension_Literal + , Horizontal.Sequence.rule_Image_Bool + , Horizontal.Sequence.rule_Image_Int , Horizontal.Sequence.rule_Comprehension_Image , Horizontal.Sequence.rule_Image_Literal_Bool , Horizontal.Sequence.rule_Image_Literal_Int From eedd9171c8eb6880fe7b757159f0174b6d8e2df9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=96zg=C3=BCr=20Akg=C3=BCn?= Date: Sun, 12 May 2024 22:41:47 +0100 Subject: [PATCH 7/8] apply these horizontal rules only for transformed sequences --- src/Conjure/Rules/Horizontal/Sequence.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Conjure/Rules/Horizontal/Sequence.hs b/src/Conjure/Rules/Horizontal/Sequence.hs index 6b40159d12..2b2218f847 100644 --- a/src/Conjure/Rules/Horizontal/Sequence.hs +++ b/src/Conjure/Rules/Horizontal/Sequence.hs @@ -396,6 +396,9 @@ rule_Image_Bool = "sequence-image-bool" `namedRule` theRule where case match opRestrict func of Nothing -> return () Just{} -> na "rule_Image_Bool" -- do not use this rule for restricted sequences + case match opTransform func of + Nothing -> na "rule_Image_Bool" -- only use this rule for restricted sequences + Just{} -> return () TypeSequence TypeBool <- typeOf func return (func, arg) case try of @@ -442,9 +445,9 @@ rule_Image_Int = "sequence-image-int" `namedRule` theRule where case match opRestrict func of Nothing -> return () Just{} -> na "rule_Image_Int" -- do not use this rule for restricted sequences - case func of - Reference{} -> na "rule_Image_Int" -- do not use this rule for a direct reference - _ -> return () + case match opTransform func of + Nothing -> na "rule_Image_Int" -- only use this rule for restricted sequences + Just{} -> return () TypeSequence (TypeInt _) <- typeOf func return (func, arg) case try of From 5b5156d8d4a2dd68902bd5d93405550f1f279149 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=96zg=C3=BCr=20Akg=C3=BCn?= Date: Mon, 13 May 2024 09:34:11 +0100 Subject: [PATCH 8/8] typo in comment --- src/Conjure/Rules/Horizontal/Sequence.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Conjure/Rules/Horizontal/Sequence.hs b/src/Conjure/Rules/Horizontal/Sequence.hs index 2b2218f847..b8fc6b1040 100644 --- a/src/Conjure/Rules/Horizontal/Sequence.hs +++ b/src/Conjure/Rules/Horizontal/Sequence.hs @@ -397,7 +397,7 @@ rule_Image_Bool = "sequence-image-bool" `namedRule` theRule where Nothing -> return () Just{} -> na "rule_Image_Bool" -- do not use this rule for restricted sequences case match opTransform func of - Nothing -> na "rule_Image_Bool" -- only use this rule for restricted sequences + Nothing -> na "rule_Image_Bool" -- only use this rule for transformed sequences Just{} -> return () TypeSequence TypeBool <- typeOf func return (func, arg) @@ -446,7 +446,7 @@ rule_Image_Int = "sequence-image-int" `namedRule` theRule where Nothing -> return () Just{} -> na "rule_Image_Int" -- do not use this rule for restricted sequences case match opTransform func of - Nothing -> na "rule_Image_Int" -- only use this rule for restricted sequences + Nothing -> na "rule_Image_Int" -- only use this rule for transformed sequences Just{} -> return () TypeSequence (TypeInt _) <- typeOf func return (func, arg)