never executed always true always false

    1 {-# LANGUAGE QuasiQuotes #-}
    2 
    3 -- | This is an extremely simplified version of type-strengthening
    4 module Conjure.Process.InferAttributes ( inferAttributes ) where
    5 
    6 import Conjure.Bug
    7 import Conjure.Prelude
    8 import Conjure.Language
    9 import Conjure.Language.Domain.AddAttributes ( mkMin )
   10 import Conjure.Language.Expression.DomainSizeOf ( domainSizeOf )
   11 import Conjure.Language.NameResolution ( resolveX, resolveD )
   12 
   13 
   14 inferAttributes ::
   15     MonadFailDoc m =>
   16     MonadUserError m =>
   17     NameGen m =>
   18     (?typeCheckerMode :: TypeCheckerMode) =>
   19     Model -> m Model
   20 inferAttributes = flip evalStateT [] . go where
   21     go ::
   22         MonadFailDoc m =>
   23         MonadUserError m =>
   24         NameGen m =>
   25         MonadState [(Name, ReferenceTo)] m =>
   26         Model -> m Model
   27     go m = do
   28         forM_ (mStatements m) $ \ st ->
   29             case st of
   30                 Declaration decl ->
   31                     case decl of
   32                         FindOrGiven forg nm dom       -> do
   33                             dom' <- resolveD dom
   34                             modify ((nm, DeclNoRepr forg nm dom' NoRegion) :)
   35                         Letting nm x                  -> do
   36                             x' <- resolveX x
   37                             modify ((nm, Alias x') :)
   38                         LettingDomainDefnUnnamed nm x -> do
   39                             x' <- resolveX x
   40                             modify ((nm, Alias (Domain (DomainUnnamed nm x'))) :)
   41                         LettingDomainDefnEnum (Name ename) nms -> do
   42                             modify ( [ (nm, Alias (Constant (ConstantInt (TagEnum ename) i)))
   43                                      | (nm, i) <- zip nms [1..]
   44                                      ] ++)
   45                         LettingDomainDefnEnum{}     -> bug "inferAttributes"
   46                         GivenDomainDefnEnum{}       -> return ()             -- ignoring
   47                 _ -> return ()
   48         transformBiM inferAttributesD m
   49 
   50 inferAttributesD ::
   51     MonadFailDoc m =>
   52     MonadUserError m =>
   53     NameGen m =>
   54     MonadState [(Name, ReferenceTo)] m =>
   55     (?typeCheckerMode :: TypeCheckerMode) =>
   56     Domain () Expression ->
   57     m (Domain () Expression)
   58 inferAttributesD (DomainPartition () (PartitionAttr partsNum1 partsSize1 isRegular1) innerDomain0) = do
   59     innerDomain <- resolveD innerDomain0
   60     -- there cannot be more parts than there are members
   61     let partsNum2 =
   62             case domainSizeOf innerDomain of
   63                 Left _err -> partsNum1
   64                 Right n   -> case partsNum1 of
   65                                 SizeAttr_None -> SizeAttr_MaxSize n
   66                                 SizeAttr_Size x -> SizeAttr_Size x
   67                                 SizeAttr_MinSize x -> SizeAttr_MinMaxSize x n
   68                                 SizeAttr_MaxSize x -> SizeAttr_MaxSize (mkMin x n)
   69                                 SizeAttr_MinMaxSize x y -> SizeAttr_MinMaxSize x (mkMin y n)
   70     -- there cannot be more in a part than there are members
   71     let partsSize2 =
   72             case domainSizeOf innerDomain of
   73                 Left _err -> partsNum2
   74                 Right n   -> case partsSize1 of
   75                                 SizeAttr_None -> SizeAttr_MaxSize n
   76                                 SizeAttr_Size x -> SizeAttr_Size x
   77                                 SizeAttr_MinSize x -> SizeAttr_MinMaxSize x n
   78                                 SizeAttr_MaxSize x -> SizeAttr_MaxSize (mkMin x n)
   79                                 SizeAttr_MinMaxSize x y -> SizeAttr_MinMaxSize x (mkMin y n)
   80     return (DomainPartition () (PartitionAttr partsNum2 partsSize2 isRegular1) innerDomain0)
   81 inferAttributesD d = return d
   82