never executed always true always false

    1 {-# LANGUAGE QuasiQuotes #-}
    2 
    3 module Conjure.Rules.Vertical.Set.ExplicitVarSizeWithMarker where
    4 
    5 import Conjure.Rules.Import
    6 
    7 
    8 rule_Comprehension :: Rule
    9 rule_Comprehension = "set-comprehension{ExplicitVarSizeWithMarker}" `namedRule` theRule where
   10     theRule (Comprehension body gensOrConds) = do
   11         (gocBefore, (pat, s), gocAfter) <- matchFirst gensOrConds $ \ goc -> case goc of
   12             Generator (GenInExpr pat@Single{} s) -> return (pat, matchDefs [opToSet,opToMSet] s)
   13             _ -> na "rule_Comprehension"
   14         TypeSet{}                     <- typeOf s
   15         Set_ExplicitVarSizeWithMarker <- representationOf s
   16         [marker, values]              <- downX1 s
   17         DomainMatrix index _          <- domainOf values
   18         let upd val old = lambdaToFunction pat old val
   19         return
   20             ( "Vertical rule for set-comprehension, ExplicitVarSizeWithMarker representation"
   21             , do
   22                 (jPat, j) <- quantifiedVar
   23                 let val = [essence| &values[&j] |]
   24                 return $ Comprehension (upd val body)
   25                         $  gocBefore
   26                         ++ [ Generator (GenDomainNoRepr jPat index)
   27                            , Condition [essence| &j <= &marker |]
   28                            ]
   29                         ++ transformBi (upd val) gocAfter
   30                )
   31     theRule _ = na "rule_Comprehension"
   32 
   33 
   34 rule_PowerSet_Comprehension :: Rule
   35 rule_PowerSet_Comprehension = "set-powerSet-comprehension{ExplicitVarSizeWithMarker}" `namedRule` theRule where
   36     theRule (Comprehension body gensOrConds) = do
   37         (gocBefore, (setPat, setPatNum, expr), gocAfter) <- matchFirst gensOrConds $ \ goc -> case goc of
   38             Generator (GenInExpr setPat@(AbsPatSet pats) expr) -> return (setPat, length pats, expr)
   39             _ -> na "rule_PowerSet_Comprehension"
   40         s                             <- match opPowerSet expr
   41         TypeSet{}                     <- typeOf s
   42         Set_ExplicitVarSizeWithMarker <- representationOf s
   43         [marker, values]              <- downX1 s
   44         DomainMatrix index _          <- domainOf values
   45         let upd val old = lambdaToFunction setPat old val
   46         return
   47             ( "Vertical rule for set-comprehension, ExplicitVarSizeWithMarker representation"
   48             , do
   49                 outPats <- replicateM setPatNum quantifiedVar
   50                 let val = AbstractLiteral $ AbsLitSet
   51                         [ [essence| &values[&j] |] | (_,j) <- outPats ]
   52                 return $ Comprehension (upd val body) $ concat
   53                         [ gocBefore
   54                         , concat
   55                             [ [ Generator (GenDomainNoRepr pat index)
   56                               , Condition [essence| &patX <= &marker |]
   57                               ]
   58                             | (pat,patX) <- take 1 outPats
   59                             ]
   60                         , concat
   61                             [ [ Generator (GenDomainNoRepr pat index)
   62                               , Condition [essence| &patX > &beforeX |]
   63                               , Condition [essence| &patX <= &marker |]
   64                               ]
   65                             | ((_, beforeX), (pat, patX)) <- zip outPats (tail outPats)
   66                             ]
   67                         , transformBi (upd val) gocAfter
   68                         ]
   69             )
   70     theRule _ = na "rule_PowerSet_Comprehension"
   71 
   72 
   73 rule_Card :: Rule
   74 rule_Card = "set-card{ExplicitVarSizeWithMarker}" `namedRule` theRule where
   75     theRule p = do
   76         s                             <- match opTwoBars p
   77         TypeSet{}                     <- typeOf s
   78         Set_ExplicitVarSizeWithMarker <- representationOf s
   79         [marker, _values]             <- downX1 s
   80         return
   81             ( "Vertical rule for set cardinality, ExplicitVarSizeWithMarker representation."
   82             , return marker
   83             )