never executed always true always false

    1 {-# LANGUAGE QuasiQuotes #-}
    2 
    3 module Conjure.Rules.Vertical.Permutation.PermutationAsFunction where
    4 
    5 import Conjure.Rules.Import
    6 
    7 rule_Cardinality :: Rule
    8 rule_Cardinality = "permutation-cardinality" `namedRule` theRule
    9   where
   10     theRule po = do
   11       p <- match opTwoBars po
   12       TypePermutation {} <- typeOf p
   13       Permutation_AsFunction <- representationOf p
   14       DomainPermutation _ _ innerDom <- domainOf p
   15       [fun, _] <- downX1 p
   16       return
   17         ( "Vertical rule for permutation cardinality, AsFunction representation.",
   18           do
   19             (iPat, i) <- quantifiedVarOverDomain (forgetRepr innerDom)
   20             return [essence|  sum([ toInt(&i != image(&fun, &i)) | &iPat : &innerDom ]) |]
   21         )
   22 
   23 rule_Defined :: Rule
   24 rule_Defined = "permutation-defined" `namedRule` theRule
   25   where
   26     theRule po = do
   27       p <- match opDefined po
   28       TypePermutation {} <- typeOf p
   29       Permutation_AsFunction <- representationOf p
   30       [fun, _] <- downX1 p
   31       return
   32         ( "Vertical rule for permutation defined, AsFunction representation.",
   33           return [essence| defined(&fun) |]
   34         )
   35 
   36 rule_Comprehension :: Rule
   37 rule_Comprehension = "permutation-comprehension-tuples{AsFunction}" `namedRule` theRule
   38   where
   39     theRule (Comprehension body gensOrConds) = do
   40       (gocBefore, (pat, perm), gocAfter) <- matchFirst gensOrConds $ \case
   41         Generator (GenInExpr pat expr) -> return (pat, matchDefs [opToSet] expr)
   42         _ -> na "rule_Comprehension"
   43       TypePermutation {} <- typeOf perm
   44       Permutation_AsFunction <- representationOf perm
   45       [f, _] <- downX1 perm
   46       return
   47         ( "Vertical rule for permutation-comprehension",
   48           do
   49             (lPat, l) <- quantifiedVar
   50             (rPat, r) <- quantifiedVar
   51             return
   52               $ Comprehension body
   53               $ gocBefore
   54               ++ [ Generator
   55                      ( GenInExpr
   56                          pat
   57                          [essence| [(&l,&r) 
   58                                                                 | (&lPat, &rPat) <- &f
   59                                                                 , &l != &r] |]
   60                      )
   61                  ]
   62               ++ gocAfter
   63         )
   64     theRule _ = na "rule_Comprehension"
   65 
   66 rule_Image :: Rule
   67 rule_Image = "permutation-image{AsFunction}" `namedRule` theRule
   68   where
   69     theRule [essence| image(&p, &i) |] = do
   70       TypePermutation inner <- typeOf p
   71       case match permutationLiteral p of
   72         Nothing -> do
   73           typeI <- typeOf i
   74           if let ?typeCheckerMode = StronglyTyped in typesUnify [inner, typeI]
   75             then do
   76               [f, _] <- downX1 p
   77               return
   78                 ( "Vertical rule for permutation application to a single value",
   79                   do
   80                     return [essence| [&i, catchUndef(image(&f,&i),0)][toInt(&i in defined(&f))+1] |]
   81                 )
   82             else
   83               if let ?typeCheckerMode = StronglyTyped in typeI `containsType` inner
   84                 then na "rule_Image"
   85                 else
   86                   return
   87                     ( "Vertical rule for permutation application to a type the permutation doesn't care about",
   88                       return i
   89                     )
   90         _ -> na "rule_Image"
   91     theRule _ = na "rule_Image"
   92 
   93 rule_Image_permInverse :: Rule
   94 rule_Image_permInverse = "permutation-image-permInverse{AsFunction}" `namedRule` theRule
   95   where
   96     theRule [essence| image(permInverse(&p), &i) |] = do
   97       TypePermutation inner <- typeOf p
   98       case match permutationLiteral p of
   99         Nothing -> do
  100           typeI <- typeOf i
  101           if let ?typeCheckerMode = StronglyTyped in typesUnify [inner, typeI]
  102             then do
  103               [_, f] <- downX1 p
  104               return
  105                 ( "Vertical rule for permutation application to a single value",
  106                   do
  107                     return [essence| [&i, catchUndef(image(&f,&i),0)][toInt(&i in defined(&f))+1] |]
  108                 )
  109             else
  110               if let ?typeCheckerMode = StronglyTyped in typeI `containsType` inner
  111                 then na "rule_Image_permInverse"
  112                 else
  113                   return
  114                     ( "Vertical rule for permutation application to a type the permutation doesn't care about",
  115                       return i
  116                     )
  117         Just (_, [[_, _]]) ->
  118           return
  119             ( "Vertical rule for permutation application, where the permutation is a literal and contains 2 objects",
  120               return [essence| image(&p, &i) |]
  121             )
  122         _ -> na "rule_Image_permInverse" -- TODO: missing case for permutation literal
  123     theRule _ = na "rule_Image_permInverse"
  124 
  125 
  126 rule_double_permInverse :: Rule
  127 rule_double_permInverse = "permutation-image-permInverse{AsFunction}" `namedRule` theRule
  128   where
  129     theRule [essence| permInverse(permInverse(&p)) |] =
  130       return
  131         ( "Double permInverse",
  132           return p
  133         )
  134     theRule _ = na "rule_double_permInverse"