Commit 86c16f65e80f0935b92c1f0c91356d97d406ef20

  • avatar
  • Ville Tirronen <ville.tirronen @j…u.fi> (Committer)
  • Thu Jul 05 13:47:14 EEST 2018
  • avatar
  • Ville Tirronen <ville.tirronen @j…u.fi> (Author)
  • Thu Jul 05 13:47:14 EEST 2018
DC: Error rule for assigning to patterns

Made a special case for assigning to pattern

Signed-off-by: Ville Tirronen <ville.tirronen@jyu.fi>
DerivationChecker/DCService/src/Service.hs
(1 / 0)
  
11{-#LANGUAGE OverloadedStrings#-}
22{-#LANGUAGE PartialTypeSignatures#-}
33{-#LANGUAGE DeriveGeneric#-}
4{-#GHC_OPTIONS -fno-warn-partial-type-signatures#-}
45module Main where
56import SubLanguage
67import Expr
DerivationChecker/src/Explain.hs
(2 / 0)
  
130130 bad0 "You've changed a pattern block in a case statement, but I don't see any sense how. Could you try to eliminate a single pattern at a time? (Also, don't replace variables on the left of the `->`. They only tell you what to choose)"
131131 PatternElimBad r ->
132132 bad "You removed the following patterns {}, but I don't think you can remove them." (Only (show r))
133 MuckingPatterns ->
134 bad0 "You are changing the patterns (ie. the parts before `->`) of a case statement. Don't. Patterns tell how to name things, but they don't contain any values by themselves."
133135 MultipleReasons _ ->
134136 bad0
135137 $ "You are making too many changes at one time. Try taking smaller steps"
DerivationChecker/src/Reason.hs
(1 / 0)
  
3636 | BadLogic r r r
3737 | PatternElimConfused
3838 | PatternElimBad [r]
39 | MuckingPatterns
3940 | GeneralErrorStep (ErrorMsg r)
4041 | MultipleReasons [Reason r] -- This btw. sucks.
4142 deriving (Eq,Show,Ord,Generic,Functor)
DerivationChecker/src/SubLanguage.hs
(9 / 0)
  
8080 <> treeRes resIte
8181 <> treeRes resBool
8282 <> treeRes resBadBool
83 <> treeRes resCasePatternMuck
8384 <> treeRes resCaseElim
8485
8586pp :: Exp () -> IO ()
358358 count :: Expr v Int -> Int
359359 count (Paren' n) = n+1
360360 count e = getSum (foldMap Sum e)
361
362resCasePatternMuck :: RuleResolverCore
363resCasePatternMuck = Analytical False $ \l r -> case (l, r) of
364 (Cases _ ms₁, Cases _ ms₂)
365 | (() <$ ms₁) == (() <$ ms₂) -- same shape
366 , or [p₁/=p₂ | (p₁,_) <- ms₁| (p₂,_) <- ms₂] -- patterns changed
367 -> Just MuckingPatterns
368 _ -> Nothing
361369
362370resCaseElim :: RuleResolverCore
363371resCaseElim = Analytical False $ \l r -> case (l,r) of
DerivationChecker/tests/Tests.hs
(7 / 0)
  
146146 ,testCase "case statement (remove patterns 1)" $
147147 resolveChngs totalResolver "case 1 of {0 -> 0; 1 -> 1; 2 -> 0; }" "case 1 of {1 -> 1; 2 -> 0; }"
148148 ~~ Just ( PatternElimGood ["0"])
149
149150 ,testCase "case statement (remove patterns 2)" $
150151 resolveChngs totalResolver "case 1 of {0 -> False; 1 -> True; 2 -> False; }" "case 1 of {0->False; 1 -> True;}"
151152 ~~ Just ( PatternElimGood ["2"] )
153
152154 ,testCase "case statement (remove patterns 3)" $
153155 resolveChngs totalResolver "case 1 of {0 -> 0; 1 -> 1; 2 -> 0; }" "case 1 of {1 -> 1}"
154156 ~~ Just ( PatternElimGood ["0","2"])
157
155158 ,testCase "case statement (remove patterns 4)" $
156159 resolveChngs totalResolver "case 1 of {0 -> 0; 1 -> 1; 2 -> 0; }" "case 1 of {0 -> 0;}"
157160 ~~ Just ( PatternElimBad ["1"])
161
162 ,testCase "case statement (Muck patterns)" $
163 resolveChngs totalResolver "case 1:[] of {x:ys -> 0; x:y:xs -> 1}" "case 1:[] of {1:ys -> 0; 1:y:xs -> 1}"
164 ~~ Just ( MuckingPatterns)
158165
159166 ,testCase "case statement (List)" $
160167 resolveChngs totalResolver "case 1:2:3:[] of {[] -> 0; (x:xs) -> x+sum xs}" "1+sum (2:3:[])"