never executed always true always false

    1 {-# LANGUAGE Rank2Types #-}
    2 {-# LANGUAGE KindSignatures #-}
    3 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
    4 {-# HLINT ignore "Use camelCase" #-}
    5 
    6 module Conjure.Representations.Internal
    7     ( Representation(..)
    8     , TypeOf_ReprCheck, TypeOf_DownD, TypeOf_SymmetryOrdering, TypeOf_Structural, TypeOf_DownC, TypeOf_Up
    9     , DomainX, DomainC
   10     , DispatchFunction, ReprOptionsFunction
   11     , rDownToX
   12     , mkOutName
   13     ) where
   14 
   15 -- conjure
   16 import Conjure.Prelude
   17 import Conjure.Language.Definition
   18 import Conjure.Language.Domain
   19 import Conjure.Language.Pretty
   20 import qualified Data.Kind  as T (Type)
   21 
   22 type DomainX x = Domain HasRepresentation x
   23 type DomainC = Domain HasRepresentation Constant
   24 
   25 -- | This data type represents a representation selection rule.
   26 -- The 3 functions -- rDownD, rDownC, and rUp -- all work one level at a time.
   27 -- The maybe for rDownD and rDownC is Nothing when representation doesn't change anything.
   28 -- Like for primitives.
   29 -- * rDownD is for refining a class level domain.
   30 -- * rDownC is for refining constants, together with an instance level domain.
   31 -- * rUp is for translating low level constants upwards
   32 --   It takes in a instance level domain for the high level object.
   33 -- * rCheck is for calculating all representation options.
   34 --   It take a function to be used as a "checker" for inner domains, if any.
   35 data Representation (m :: T.Type -> T.Type) = Representation
   36     { rCheck            :: TypeOf_ReprCheck        m
   37     , rDownD            :: TypeOf_DownD            m
   38     , rStructural       :: TypeOf_Structural       m
   39     , rDownC            :: TypeOf_DownC            m
   40     , rUp               :: TypeOf_Up               m
   41     , rSymmetryOrdering :: TypeOf_SymmetryOrdering m
   42     }
   43 
   44 type TypeOf_ReprCheck (m :: T.Type -> T.Type) = 
   45        forall x . (Data x, Pretty x, ExpressionLike x)
   46     => (Domain () x -> m [DomainX x])               -- other checkers for inner domains
   47     -> Domain () x                                  -- this domain
   48     -> m [DomainX x]                                -- with all repr options
   49 
   50 type TypeOf_DownD (m :: T.Type -> T.Type) = 
   51                 (Name, DomainX Expression)
   52     -> m (Maybe [(Name, DomainX Expression)])
   53 
   54 type TypeOf_SymmetryOrdering (m :: T.Type -> T.Type) = 
   55        ((Expression -> m [Expression]) -> Expression -> DomainX Expression -> m Expression) -- inner S.O.
   56     -> (Expression -> m [Expression])               -- general downX1
   57     -> Expression                                   -- this as an expression
   58     -> DomainX Expression                           -- name and domain
   59     -> m Expression                                 -- output, of type [int]
   60 
   61 type TypeOf_Structural (m :: T.Type -> T.Type) = 
   62        (DomainX Expression -> m (Expression -> m [Expression]))
   63                                                     -- other structural constraints for inner domains
   64     -> (Expression -> m [Expression])               -- general downX1
   65     -> DomainX Expression                           -- this domain
   66     -> m (      Expression                          -- the original variable, before refinement
   67           -> m [Expression]                         -- structural constraints
   68          )
   69 
   70 type TypeOf_DownC (m :: T.Type -> T.Type) = 
   71                  (Name, DomainC, Constant)          -- the input name, domain and constant
   72     -> m (Maybe [(Name, DomainC, Constant)])        -- the outputs names, domains, and constants
   73 
   74 type TypeOf_Up (m :: T.Type -> T.Type) = 
   75         [(Name, Constant)] ->                       -- all known constants, representing a solution at the low level
   76         (Name, DomainC) ->                          -- the name and domain we are working on
   77         m (Name, Constant)                          -- the output constant, at the high level
   78 
   79 
   80 type DispatchFunction m x =
   81         Data x =>
   82         Pretty x =>
   83         Domain HasRepresentation x ->
   84         Representation m
   85 
   86 type ReprOptionsFunction m r x =
   87         Data x =>
   88         Pretty x =>
   89         ExpressionLike x =>
   90         Domain () x ->
   91         m [Domain HasRepresentation x]
   92 
   93 
   94 rDownToX ::
   95     (Monad m,MonadFail m) =>
   96     Representation m ->                             -- for a given representation
   97     FindOrGiven ->                                  -- and a declaration: forg
   98     Name ->                                         --                  : name
   99     Domain HasRepresentation Expression ->          --                  : domain
  100     m [Expression]                                  -- expressions referring to the representation
  101 rDownToX repr forg name domain = do
  102     pairs <- rDownD repr (name, domain)
  103     return [ Reference n (Just (DeclHasRepr forg n d))
  104            | (n,d) <- concat pairs
  105            ]
  106 
  107 mkOutName :: Maybe Name -> Domain HasRepresentation x -> Name -> Name
  108 mkOutName Nothing       domain origName = mconcat [origName, "_", Name (reprTreeEncoded domain)]
  109 mkOutName (Just suffix) domain origName = mconcat [origName, "_", Name (reprTreeEncoded domain), "_", suffix]