never executed always true always false

    1 {-# LANGUAGE QuasiQuotes #-}
    2 
    3 module Conjure.Rules.Vertical.Relation.RelationAsSet where
    4 
    5 import Conjure.Rules.Import
    6 
    7 
    8 rule_Comprehension :: Rule
    9 rule_Comprehension = "relation-comprehension{RelationAsSet}" `namedRule` theRule where
   10     theRule (Comprehension body gensOrConds) = do
   11         (gocBefore, (pat, rel), gocAfter) <- matchFirst gensOrConds $ \ goc -> case goc of
   12             Generator (GenInExpr pat@Single{} expr) -> return (pat, matchDefs [opToSet, opToMSet] expr)
   13             _ -> na "rule_Comprehension"
   14         TypeRelation{}   <- typeOf rel
   15         Relation_AsSet{} <- representationOf rel
   16         [set]            <- downX1 rel
   17         return
   18             ( "Vertical rule for comprehension for relation domains, RelationAsSet representation."
   19             , return $
   20                 Comprehension body
   21                     $  gocBefore
   22                     ++ [ Generator (GenInExpr pat set) ]
   23                     ++ gocAfter
   24             )
   25     theRule _ = na "rule_Comprehension"
   26 
   27 
   28 rule_PowerSet_Comprehension :: Rule
   29 rule_PowerSet_Comprehension = "relation-powerSet-comprehension{RelationAsSet}" `namedRule` theRule where
   30     theRule (Comprehension body gensOrConds) = do
   31         (gocBefore, (pat, expr), gocAfter) <- matchFirst gensOrConds $ \ goc -> case goc of
   32             Generator (GenInExpr pat expr) -> return (pat, expr)
   33             _ -> na "rule_Comprehension"
   34         rel <- matchDefs [opToSet,opToMSet,opToRelation] <$> match opPowerSet expr
   35         Relation_AsSet{} <- representationOf rel
   36         [set] <- downX1 rel
   37         return
   38             ( "Vertical rule for powerSet comprehension for relation domains, RelationAsSet representation."
   39             , return $
   40                 Comprehension body
   41                     $  gocBefore
   42                     ++ [ Generator (GenInExpr pat (make opPowerSet set)) ]
   43                     ++ gocAfter
   44             )
   45     theRule _ = na "rule_PowerSet_Comprehension"
   46 
   47 
   48 rule_Card :: Rule
   49 rule_Card = "relation-card{RelationAsSet}" `namedRule` theRule where
   50     theRule p = do
   51         rel              <- match opTwoBars p
   52         TypeRelation{}   <- typeOf rel
   53         Relation_AsSet{} <- representationOf rel
   54         [set]            <- downX1 rel
   55         return
   56             ( "Vertical rule for set cardinality, ExplicitVarSizeWithMarker representation."
   57             , return [essence| |&set| |]
   58             )
   59 
   60 
   61 rule_In :: Rule
   62 rule_In = "relation-in{RelationAsSet}" `namedRule` theRule where
   63     theRule [essence| &x in &rel |] = do
   64         TypeRelation{} <- typeOf rel
   65         Relation_AsSet Set_Explicit <- representationOf rel
   66         tableCheck x rel
   67         xParts <- downX1 x
   68         let vars = fromList xParts
   69         [set] <- downX1 rel
   70         [matrix] <- downX1 set
   71         (index:_) <- indexDomainsOf matrix
   72         parts <- downX1 matrix
   73         (iPat, i) <- quantifiedVar
   74         let oneRow = fromList [ [essence| &p[&i] |] | p <- parts ]
   75         let table = [essence| [ &oneRow | &iPat : &index ] |]
   76         return
   77             ( "relation membership to table"
   78             , return [essence| table(&vars, &table) |]
   79             )
   80     theRule _ = na "rule_In"
   81 
   82     tableCheck ::
   83         MonadFailDoc m =>
   84         (?typeCheckerMode :: TypeCheckerMode) =>
   85         Expression -> Expression -> m ()
   86     tableCheck x rel | categoryOf rel < CatDecision = do
   87         tyX <- typeOf x
   88         case tyX of
   89             TypeTuple ts | and [ case t of TypeInt{} -> True ; _ -> False | t <- ts ] -> return ()
   90             _ -> na "rule_In"
   91     tableCheck _ _ = na "rule_In"