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               [values] <- downX1 f
   78               return
   79                 ( "Vertical rule for permutation application to a single value",
   80                   do
   81                     return [essence| elementId(&values, &i) |]
   82                 )
   83             else
   84               if let ?typeCheckerMode = StronglyTyped in typeI `containsType` inner
   85                 then na "rule_Image"
   86                 else
   87                   return
   88                     ( "Vertical rule for permutation application to a type the permutation doesn't care about",
   89                       return i
   90                     )
   91         _ -> na "rule_Image"
   92     theRule _ = na "rule_Image"
   93 
   94 rule_Image_permInverse :: Rule
   95 rule_Image_permInverse = "permutation-image-permInverse{AsFunction}" `namedRule` theRule
   96   where
   97     theRule [essence| image(permInverse(&p), &i) |] = do
   98       TypePermutation inner <- typeOf p
   99       case match permutationLiteral p of
  100         Nothing -> do
  101           typeI <- typeOf i
  102           if let ?typeCheckerMode = StronglyTyped in typesUnify [inner, typeI]
  103             then do
  104               [_, f] <- downX1 p
  105               [values] <- downX1 f
  106               return
  107                 ( "Vertical rule for permutation application to a single value",
  108                   do
  109                     return [essence| elementId(&values, &i) |]
  110                 )
  111             else
  112               if let ?typeCheckerMode = StronglyTyped in typeI `containsType` inner
  113                 then na "rule_Image_permInverse"
  114                 else
  115                   return
  116                     ( "Vertical rule for permutation application to a type the permutation doesn't care about",
  117                       return i
  118                     )
  119         Just (_, [[_, _]]) ->
  120           return
  121             ( "Vertical rule for permutation application, where the permutation is a literal and contains 2 objects",
  122               return [essence| image(&p, &i) |]
  123             )
  124         _ -> na "rule_Image_permInverse" -- TODO: missing case for permutation literal
  125     theRule _ = na "rule_Image_permInverse"
  126 
  127 
  128 rule_double_permInverse :: Rule
  129 rule_double_permInverse = "permutation-image-permInverse{AsFunction}" `namedRule` theRule
  130   where
  131     theRule [essence| permInverse(permInverse(&p)) |] =
  132       return
  133         ( "Double permInverse",
  134           return p
  135         )
  136     theRule _ = na "rule_double_permInverse"