Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project

* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Don't generate a state proc for an empty state.
  Make splitNormalized work for non-recursive lets.
  Add and use splitNormalized helper function.

diff --combined cλash/CLasH/VHDL/Generate.hs
index 99d5d270dc976ef84abe470bac6249a02db1feaa,149c6eca1fcd6e28d0e782f5af8a60ca9e61b998..0be4f60be94c58bec17826191353d832ad83482a
--- 1/cλash/CLasH/VHDL/Generate.hs
--- 2/cλash/CLasH/VHDL/Generate.hs
+++ b/cλash/CLasH/VHDL/Generate.hs
@@@ -44,17 -44,13 +44,15 @@@ getEntity :
  
  getEntity fname = Utils.makeCached fname tsEntities $ do
        expr <- Normalize.getNormalized fname
-       -- Strip off lambda's, these will be arguments
-       let (args, letexpr) = CoreSyn.collectBinders expr
+       -- Split the normalized expression
+       let (args, binds, res) = Normalize.splitNormalized expr
        -- Generate ports for all non-empty types
        args' <- catMaybesM $ mapM mkMap args
-       -- There must be a let at top level 
-       let (CoreSyn.Let binds (CoreSyn.Var res)) = letexpr
        -- TODO: Handle Nothing
        res' <- mkMap res
 -      let vhdl_id = mkVHDLBasicId $ varToString fname ++ "_" ++ varToStringUniq fname
 +      count <- getA tsEntityCounter 
 +      let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count
 +      putA tsEntityCounter (count + 1)
        let ent_decl = createEntityAST vhdl_id args' res'
        let signature = Entity vhdl_id args' res' ent_decl
        return signature
@@@ -113,12 -109,12 +111,12 @@@ getArchitecture :
  
  getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
    expr <- Normalize.getNormalized fname
+   -- Split the normalized expression
+   let (args, binds, res) = Normalize.splitNormalized expr
+   
+   -- Get the entity for this function
    signature <- getEntity fname
    let entity_id = ent_id signature
-   -- Strip off lambda's, these will be arguments
-   let (args, letexpr) = CoreSyn.collectBinders expr
-   -- There must be a let at top level 
-   let (CoreSyn.Let (CoreSyn.Rec binds) (CoreSyn.Var res)) = letexpr
  
    -- Create signal declarations for all binders in the let expression, except
    -- for the output port (that will already have an output port declared in
@@@ -131,9 -127,9 +129,9 @@@
    let (in_state_maybes, out_state_maybes) = unzip state_vars
    let (statementss, used_entitiess) = unzip sms
    -- Create a state proc, if needed
-   let state_proc = case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes) of
-         ([in_state], [out_state]) -> [AST.CSPSm $ mkStateProcSm (in_state, out_state)]
-         ([], []) -> []
+   state_proc <- case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes) of
+         ([in_state], [out_state]) -> mkStateProcSm (in_state, out_state)
+         ([], []) -> return []
          (ins, outs) -> error $ "Weird use of state in " ++ show fname ++ ". In: " ++ show ins ++ " Out: " ++ show outs
    -- Join the create statements and the (optional) state_proc
    let statements = concat statementss ++ state_proc
@@@ -164,9 -160,12 +162,12 @@@
  
  mkStateProcSm :: 
    (CoreSyn.CoreBndr, CoreSyn.CoreBndr) -- ^ The current and new state variables
-   -> AST.ProcSm -- ^ The resulting statement
- mkStateProcSm (old, new) =
-   AST.ProcSm label [clk] [statement]
+   -> TranslatorSession [AST.ConcSm] -- ^ The resulting statements
+ mkStateProcSm (old, new) = do
+   nonempty <- hasNonEmptyType old 
+   if nonempty 
+     then return [AST.CSPSm $ AST.ProcSm label [clk] [statement]]
+     else return []
    where
      label       = mkVHDLBasicId $ "state"
      clk         = mkVHDLBasicId "clock"
@@@ -647,34 -646,6 +648,34 @@@ genZip' (Left res) f args@[arg1, arg2] 
      -- Return the generate functions
    ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
    }
 +  
 +-- | Generate a generate statement for the builtin function "fst"
 +genFst :: BuiltinBuilder
 +genFst = genNoInsts $ genVarArgs genFst'
 +genFst' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
 +genFst' (Left res) f args@[arg] = do {
 +  ; labels <- MonadState.lift tsType $ getFieldLabels (Var.varType arg)
 +  ; let { argexpr'    = varToVHDLName arg
 +        ; argexprA    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (labels!!0)
 +        ; assign      = mkUncondAssign (Left res) argexprA
 +        } ;
 +    -- Return the generate functions
 +  ; return [assign]
 +  }
 +  
 +-- | Generate a generate statement for the builtin function "snd"
 +genSnd :: BuiltinBuilder
 +genSnd = genNoInsts $ genVarArgs genSnd'
 +genSnd' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
 +genSnd' (Left res) f args@[arg] = do {
 +  ; labels <- MonadState.lift tsType $ getFieldLabels (Var.varType arg)
 +  ; let { argexpr'    = varToVHDLName arg
 +        ; argexprB    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (labels!!1)
 +        ; assign      = mkUncondAssign (Left res) argexprB
 +        } ;
 +    -- Return the generate functions
 +  ; return [assign]
 +  }
      
  -- | Generate a generate statement for the builtin function "unzip"
  genUnzip :: BuiltinBuilder
@@@ -1406,10 -1377,6 +1407,10 @@@ globalNameTable = Map.fromLis
    , (hwandId          , (2, genOperator2 AST.And    ) )
    , (hworId           , (2, genOperator2 AST.Or     ) )
    , (hwnotId          , (1, genOperator1 AST.Not    ) )
 +  , (equalityId       , (2, genOperator2 (AST.:=:)  ) )
 +  , (inEqualityId     , (2, genOperator2 (AST.:/=:) ) )
 +  , (boolOrId         , (2, genOperator2 AST.Or     ) )
 +  , (boolAndId        , (2, genOperator2 AST.And    ) )
    , (plusId           , (2, genOperator2 (AST.:+:)  ) )
    , (timesId          , (2, genOperator2 (AST.:*:)  ) )
    , (negateId         , (1, genNegation             ) )
@@@ -1419,8 -1386,6 +1420,8 @@@
    , (resizeId         , (1, genResize               ) )
    , (sizedIntId       , (1, genSizedInt             ) )
    , (smallIntegerId   , (1, genFromInteger          ) )
 +  , (fstId            , (1, genFst                  ) )
 +  , (sndId            , (1, genSnd                  ) )
    --, (tfvecId          , (1, genTFVec                ) )
    , (minimumId        , (2, error $ "\nFunction name: \"minimum\" is used internally, use another name"))
    ]