never executed always true always false

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