Flatten.hs

   1 module Flatten where
   2 import CoreSyn
   3 import qualified Control.Monad.State as State
   4
   5 -- | A datatype that maps each of the single values in a haskell structure to
   6 -- a mapto. The map has the same structure as the haskell type mapped, ie
   7 -- nested tuples etc.
   8 data HsValueMap mapto =
   9   Tuple [HsValueMap mapto]
  10   | Single mapto
  11   | Unused
  12   deriving (Show, Eq)
  13
  14 data FlatFunction = FlatFunction {
  15   args   :: [SignalDefMap],
  16   res    :: SignalUseMap,
  17   --sigs   :: [SignalDef],
  18   apps   :: [App],
  19   conds  :: [CondDef]
  20 } deriving (Show, Eq)
  21
  22 type SignalUseMap = HsValueMap SignalUse
  23 type SignalDefMap = HsValueMap SignalDef
  24
  25 data SignalUse = SignalUse {
  26   sigUseId :: Int
  27 } deriving (Show, Eq)
  28
  29 data SignalDef = SignalDef {
  30   sigDefId :: Int
  31 } deriving (Show, Eq)
  32
  33 data App = App {
  34   appFunc :: HsFunction,
  35   appArgs :: [SignalUseMap],
  36   appRes  :: SignalDefMap
  37 } deriving (Show, Eq)
  38
  39 data CondDef = CondDef {
  40   cond    :: SignalUse,
  41   high    :: SignalUse,
  42   low     :: SignalUse,
  43   condRes :: SignalDef
  44 } deriving (Show, Eq)
  45
  46 -- | How is a given (single) value in a function's type (ie, argument or
  47 -- return value) used?
  48 data HsValueUse =
  49   Port           -- ^ Use it as a port (input or output)
  50   | State Int    -- ^ Use it as state (input or output). The int is used to
  51                  --   match input state to output state.
  52   | HighOrder {  -- ^ Use it as a high order function input
  53     hoName :: String,  -- ^ Which function is passed in?
  54     hoArgs :: [HsUseMap]   -- ^ Which arguments are already applied? This
  55                          -- ^ map should only contain Port and other
  56                          --   HighOrder values.
  57   }
  58   deriving (Show, Eq)
  59
  60 type HsUseMap = HsValueMap HsValueUse
  61
  62 data HsFunction = HsFunction {
  63   hsFuncName :: String,
  64   hsFuncArgs :: [HsUseMap],
  65   hsFuncRes  :: HsUseMap
  66 } deriving (Show, Eq)
  67
  68 type BindMap = [(
  69   String,              -- ^ The bind name
  70   Either               -- ^ The bind value which is either
  71     SignalUse          -- ^ a signal
  72     (
  73       HsValueUse,      -- ^ or a HighOrder function
  74       [SignalUse]      -- ^ With these signals already applied to it
  75     )
  76   )]
  77
  78 type FlattenState = State.State ([App], [CondDef], Int)
  79
  80 -- | Flatten a haskell function
  81 flattenFunction ::
  82   HsFunction                      -- ^ The function to flatten
  83   -> CoreBind                     -- ^ The function value
  84   -> FlatFunction                 -- ^ The resulting flat function
  85
  86 flattenFunction _ (Rec _) = error "Recursive binders not supported"
  87 flattenFunction hsfunc bind@(NonRec var expr) =
  88   FlatFunction args res apps conds
  89   where
  90     init_state        = ([], [], 0)
  91     (fres, end_state) = State.runState (flattenExpr expr) init_state
  92     (args, res)       = fres
  93     (apps, conds, _)  = end_state
  94
  95 flattenExpr ::
  96   CoreExpr
  97   -> FlattenState ([SignalDefMap], SignalUseMap)
  98
  99 flattenExpr _ = do
 100   return ([], Tuple [])
 101
 102
 103
 104
 105 -- vim: set ts=8 sw=2 sts=2 expandtab: