never executed always true always false

    1 {-# LANGUAGE QuasiQuotes #-}
    2 
    3 module Conjure.Rules.Vertical.Function.FunctionNDPartial where
    4 
    5 import Conjure.Rules.Import
    6 
    7 
    8 rule_Image_NotABool :: Rule
    9 rule_Image_NotABool = "function-image{FunctionNDPartial}-not-a-bool" `namedRule` theRule where
   10     theRule [essence| image(&f,&x) |] = do
   11         Function_NDPartial  <- representationOf f
   12         TypeFunction _ tyTo <- typeOf f
   13         case tyTo of
   14             TypeBool -> na "function ? --> bool"
   15             _        -> return ()
   16         [flags,values]      <- downX1 f
   17         toIndex             <- downX1 x
   18         let
   19             flagsIndexed  = make opMatrixIndexing flags  toIndex
   20             valuesIndexed = make opMatrixIndexing values toIndex
   21 
   22         return
   23             ( "Function image, FunctionNDPartial representation, not-a-bool"
   24             , return [essence| { &valuesIndexed
   25                                @ such that &flagsIndexed
   26                                } |]
   27             )
   28     theRule _ = na "rule_Image_NotABool"
   29 
   30 
   31 rule_Image_Bool :: Rule
   32 rule_Image_Bool = "function-image{FunctionNDPartial}-bool" `namedRule` theRule where
   33     theRule p = do
   34         let
   35             imageChild ch@[essence| image(&f,&x) |] = do
   36                 Function_NDPartial  <- representationOf f
   37                 TypeFunction _ tyTo <- typeOf f
   38                 case tyTo of
   39                     TypeBool -> do
   40                         [flags,values]      <- downX1 f
   41                         toIndex             <- downX1 x
   42                         let flagsIndexed  = make opMatrixIndexing flags  toIndex
   43                         let valuesIndexed = make opMatrixIndexing values toIndex
   44                         tell $ return flagsIndexed
   45                         return valuesIndexed
   46                     _ -> return ch
   47             imageChild ch = return ch
   48         (p', flags) <- runWriterT (descendM imageChild p)
   49         case flags of
   50             [] -> na "rule_Image_Bool"
   51             _  -> do
   52                 let flagsCombined = make opAnd $ fromList flags
   53                 return
   54                     ( "Function image, FunctionNDPartial representation, bool"
   55                     , return [essence| { &p' @ such that &flagsCombined } |]
   56                     )
   57 
   58 
   59 rule_InDefined :: Rule
   60 rule_InDefined = "function-in-defined{FunctionNDPartial}" `namedRule` theRule where
   61     theRule [essence| &x in defined(&f) |] = do
   62         Function_NDPartial  <- representationOf f
   63         [flags,_values]     <- downX1 f
   64         toIndex             <- downX1 x
   65         let flagsIndexed  = make opMatrixIndexing flags toIndex
   66         return
   67             ( "Function in defined, FunctionNDPartial representation"
   68             , return flagsIndexed
   69             )
   70     theRule _ = na "rule_InDefined"
   71 
   72 
   73 rule_Comprehension :: Rule
   74 rule_Comprehension = "function-comprehension{FunctionNDPartial}" `namedRule` theRule where
   75     theRule (Comprehension body gensOrConds) = do
   76         (gocBefore, (pat, func), gocAfter) <- matchFirst gensOrConds $ \ goc -> case goc of
   77             Generator (GenInExpr pat@Single{} expr) -> return (pat, matchDefs [opToSet,opToMSet,opToRelation] expr)
   78             _ -> na "rule_Comprehension"
   79         Function_NDPartial                    <- representationOf func
   80         DomainFunction _ _ innerDomainFr _    <- domainOf func
   81         [flags,values]                        <- downX1 func
   82         let upd val old = lambdaToFunction pat old val
   83         return
   84             ( "Mapping over a function, FunctionNDPartial representation"
   85             , do
   86                 (jPat, j) <- quantifiedVar
   87                 let kRange = case innerDomainFr of
   88                         DomainTuple ts  -> map fromInt [1 .. genericLength ts]
   89                         DomainRecord rs -> map (fromName . fst) rs
   90                         _ -> bug $ vcat [ "FunctionNDPartial.rule_Comprehension"
   91                                         , "innerDomainFr:" <+> pretty innerDomainFr
   92                                         ]
   93                     toIndex       = [ [essence| &j[&k] |] | k <- kRange ]
   94                     flagsIndexed  = make opMatrixIndexing flags  toIndex
   95                     valuesIndexed = make opMatrixIndexing values toIndex
   96                     val           = [essence| (&j, &valuesIndexed) |]
   97                 return $ Comprehension (upd val body)
   98                     $  gocBefore
   99                     ++ [ Generator (GenDomainNoRepr jPat (forgetRepr innerDomainFr))
  100                        , Condition flagsIndexed
  101                        ]
  102                     ++ transformBi (upd val) gocAfter
  103             )
  104     theRule _ = na "rule_Comprehension"