FlattenTypes.hs

   1 module FlattenTypes where
   2
   3 import Data.Traversable
   4 import qualified Control.Monad.State as State
   5
   6 import CoreSyn
   7 import qualified Type
   8
   9 import HsValueMap
  10
  11 -- | A signal identifier
  12 type UnnamedSignal = Int
  13
  14 -- | A map of a Haskell value to signal ids
  15 type SignalMap sigid = HsValueMap sigid
  16
  17 -- | How is a given (single) value in a function's type (ie, argument or
  18 -- return value) used?
  19 data HsValueUse =
  20   Port           -- ^ Use it as a port (input or output)
  21   | State Int    -- ^ Use it as state (input or output). The int is used to
  22                  --   match input state to output state.
  23   | HighOrder {  -- ^ Use it as a high order function input
  24     hoName :: String,  -- ^ Which function is passed in?
  25     hoArgs :: [HsUseMap]   -- ^ Which arguments are already applied? This
  26                          -- ^ map should only contain Port and other
  27                          --   HighOrder values.
  28   }
  29   deriving (Show, Eq, Ord)
  30
  31 -- | A map from a Haskell value to the use of each single value
  32 type HsUseMap = HsValueMap HsValueUse
  33
  34 -- | Builds a HsUseMap with the same structure has the given HsValueMap in
  35 --   which all the Single elements are marked as State, with increasing state
  36 --   numbers.
  37 useAsState :: HsValueMap a -> HsUseMap
  38 useAsState map =
  39   map'
  40   where
  41     -- Traverse the existing map, resulting in a function that maps an initial
  42     -- state number to the final state number and the new map
  43     PassState f = traverse asState map
  44     -- Run this function to get the new map
  45     (_, map')   = f 0
  46     -- This function maps each element to a State with a unique number, by
  47     -- incrementing the state count.
  48     asState x   = PassState (\s -> (s+1, State s))
  49
  50 -- | Builds a HsUseMap with the same structure has the given HsValueMap in
  51 --   which all the Single elements are marked as Port.
  52 useAsPort :: HsValueMap a -> HsUseMap
  53 useAsPort map = fmap (\x -> Port) map
  54
  55 -- | A Haskell function with a specific signature. The signature defines what
  56 --   use the arguments and return value of the function get.
  57 data HsFunction = HsFunction {
  58   hsFuncName :: String,
  59   hsFuncArgs :: [HsUseMap],
  60   hsFuncRes  :: HsUseMap
  61 } deriving (Show, Eq, Ord)
  62
  63 -- | A flattened function application
  64 data FApp sigid = FApp {
  65   appFunc :: HsFunction,
  66   appArgs :: [SignalMap sigid],
  67   appRes  :: SignalMap sigid
  68 } deriving (Show, Eq)
  69
  70 -- | A conditional signal definition
  71 data CondDef sigid = CondDef {
  72   cond    :: sigid,
  73   high    :: sigid,
  74   low     :: sigid,
  75   condRes :: sigid
  76 } deriving (Show, Eq)
  77
  78 -- | Information on a signal definition
  79 data SignalInfo = SignalInfo {
  80   sigName :: Maybe String,
  81   sigTy   :: Type.Type
  82 }
  83
  84 -- | A flattened function
  85 data FlatFunction' sigid = FlatFunction {
  86   flat_args   :: [SignalMap sigid],
  87   flat_res    :: SignalMap sigid,
  88   flat_apps   :: [FApp sigid],
  89   flat_conds  :: [CondDef sigid],
  90   flat_sigs   :: [(sigid, SignalInfo)]
  91 }
  92
  93 -- | A flat function that does not have its signals named
  94 type FlatFunction = FlatFunction' UnnamedSignal
  95
  96 -- | A list of binds in effect at a particular point of evaluation
  97 type BindMap = [(
  98   CoreBndr,            -- ^ The bind name
  99   Either               -- ^ The bind value which is either
 100     (SignalMap UnnamedSignal)
 101                        -- ^ a signal
 102     (
 103       HsValueUse,      -- ^ or a HighOrder function
 104       [UnnamedSignal]  -- ^ With these signals already applied to it
 105     )
 106   )]
 107
 108 -- | The state during the flattening of a single function
 109 type FlattenState = State.State ([FApp UnnamedSignal], [CondDef UnnamedSignal], [(UnnamedSignal, SignalInfo)], UnnamedSignal)
 110
 111 -- | Add an application to the current FlattenState
 112 addApp :: (FApp UnnamedSignal) -> FlattenState ()
 113 addApp a = do
 114   (apps, conds, sigs, n) <- State.get
 115   State.put (a:apps, conds, sigs, n)
 116
 117 -- | Add a conditional definition to the current FlattenState
 118 addCondDef :: (CondDef UnnamedSignal) -> FlattenState ()
 119 addCondDef c = do
 120   (apps, conds, sigs, n) <- State.get
 121   State.put (apps, c:conds, sigs, n)
 122
 123 -- | Generates a new signal id, which is unique within the current flattening.
 124 genSignalId :: Type.Type -> FlattenState UnnamedSignal
 125 genSignalId ty = do
 126   (apps, conds, sigs, n) <- State.get
 127   -- Generate a new numbered but unnamed signal
 128   let s = (n, SignalInfo Nothing ty)
 129   State.put (apps, conds, s:sigs, n+1)
 130   return n