never executed always true always false

    1 module Conjure.Language.ZeroVal ( zeroVal, EnumerateDomain ) where
    2 
    3 -- conjure
    4 import Conjure.Prelude
    5 import Conjure.Bug
    6 import Conjure.Language.Definition
    7 import Conjure.Language.Domain
    8 import Conjure.Language.Pretty
    9 import Conjure.Process.Enumerate ( EnumerateDomain, enumerateDomain )
   10 
   11 
   12 zeroVal :: (MonadFailDoc m, EnumerateDomain m, Pretty r) => Domain r Constant -> m Constant
   13 zeroVal DomainBool = return $ ConstantBool False
   14 zeroVal (DomainInt t []) = return $ ConstantInt t 0
   15 zeroVal (DomainInt _ (r:_)) = zeroValR r
   16 zeroVal (DomainTuple ds) = ConstantAbstract . AbsLitTuple <$> mapM zeroVal ds
   17 zeroVal (DomainRecord xs) = do
   18     values <- forM xs $ \ (nm, dom) -> do
   19         z <- zeroVal dom
   20         return (nm, z)
   21     return $ ConstantAbstract $ AbsLitRecord values
   22 zeroVal (DomainVariant xs@((nm, dom):_)) = do
   23     z <- zeroVal dom
   24     return $ ConstantAbstract $ AbsLitVariant (Just [(n, forgetRepr d) | (n,d) <- xs]) nm z
   25 zeroVal (DomainMatrix index inner) = do
   26     z  <- zeroVal inner
   27     is <- case index of
   28             DomainInt _ rs -> rangesInts rs
   29             _ -> failDoc $ "Matrix indexed by a domain that isn't int:" <+> pretty index
   30     return $ ConstantAbstract $ AbsLitMatrix index $ replicate (length is) z
   31 zeroVal d@(DomainSet _ (SetAttr sizeAttr) inner) = do
   32     z       <- zeroVal inner
   33     minSize <- getMin d sizeAttr
   34     return $ ConstantAbstract $ AbsLitSet $ replicate (fromInteger minSize) z
   35 zeroVal d@(DomainSequence _ (SequenceAttr sizeAttr _) inner) = do
   36     z       <- zeroVal inner
   37     minSize <- getMin d sizeAttr
   38     return $ ConstantAbstract $ AbsLitSequence $ replicate (fromInteger minSize) z
   39 zeroVal d@(DomainFunction _ (FunctionAttr sizeAttr partialityAttr _) innerFr innerTo) =
   40     case partialityAttr of
   41         PartialityAttr_Partial -> do
   42             minSize <- getMin d sizeAttr
   43             zFr     <- zeroVal innerFr
   44             zTo     <- zeroVal innerTo
   45             return $ ConstantAbstract $ AbsLitFunction $ replicate (fromInteger minSize) (zFr, zTo)
   46         PartialityAttr_Total   -> do
   47             froms   <- enumerateDomain (forgetRepr innerFr)
   48             zTo     <- zeroVal innerTo
   49             return $ ConstantAbstract $ AbsLitFunction [ (fr, zTo) | fr <- froms ]
   50 zeroVal d@(DomainMSet _ (MSetAttr sizeAttr _) inner) = do
   51     z       <- zeroVal inner
   52     minSize <- getMin d sizeAttr
   53     return $ ConstantAbstract $ AbsLitMSet $ replicate (fromInteger minSize) z
   54 zeroVal d@(DomainRelation _ (RelationAttr sizeAttr _) inners) = do
   55     zs      <- mapM zeroVal inners
   56     minSize <- getMin d sizeAttr
   57     return $ ConstantAbstract $ AbsLitRelation $ replicate (fromInteger minSize) zs
   58 zeroVal d@(DomainPartition _ (PartitionAttr numPartsAttr partSizeAttr _) inner) = do
   59     z        <- zeroVal inner
   60     minSize1 <- getMin d numPartsAttr
   61     minSize2 <- getMin d partSizeAttr
   62     return $ ConstantAbstract $ AbsLitPartition $ replicate (fromInteger minSize1)
   63                                                             (replicate (fromInteger minSize2) z)
   64 zeroVal d = bug $ "No 'zero' value for domain:" <+> pretty d
   65 
   66 
   67 zeroValR :: MonadFailDoc m => Range a -> m a
   68 zeroValR RangeOpen = failDoc "No 'zero' value for an open range."
   69 zeroValR (RangeSingle x) = return x
   70 zeroValR (RangeLowerBounded x) = return x
   71 zeroValR (RangeUpperBounded x) = return x
   72 zeroValR (RangeBounded x _) = return x
   73 
   74 
   75 getMin :: (MonadFailDoc m, Pretty r, Pretty x) => Domain r x -> SizeAttr Constant -> m Integer
   76 getMin _ SizeAttr_None = return 0
   77 getMin d (SizeAttr_Size x) = returnInt d x
   78 getMin d (SizeAttr_MinSize x) = returnInt d x
   79 getMin _ (SizeAttr_MaxSize _) = return 0
   80 getMin d (SizeAttr_MinMaxSize x _) = returnInt d x
   81 
   82 
   83 returnInt :: (MonadFailDoc m, Pretty r, Pretty x) => Domain r x -> Constant -> m Integer
   84 returnInt _ (ConstantInt _ x) = return x
   85 returnInt d _ = failDoc $ "Attribute expected to be an int in:" <+> pretty d