X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=ba84747854c05bd14582cd7d71f1b8e84d0008ee;hb=53dde2157115e5212dd8991208b57c46a7b3a44a;hp=f89b989528bcca0db71736a47d86e6c3bf1fd778;hpb=10dfe589f40e65d51ca1585beecf00ae85169cae;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs"
index f89b989..ba84747 100644
--- "a/c\316\273ash/CLasH/VHDL/Generate.hs"
+++ "b/c\316\273ash/CLasH/VHDL/Generate.hs"
@@ -50,7 +50,9 @@ getEntity fname = Utils.makeCached fname tsEntities $ do
       args' <- catMaybesM $ mapM mkMap args
       -- 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
@@ -127,9 +129,9 @@ getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
   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
@@ -160,9 +162,12 @@ getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
 
 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"
@@ -643,6 +648,34 @@ genZip' (Left res) f args@[arg1, arg2] = do {
     -- 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
@@ -830,7 +863,7 @@ genApplication dst f args = do
           let entity_id = ent_id signature
           -- TODO: Using show here isn't really pretty, but we'll need some
           -- unique-ish value...
-          let label = "comp_ins_" ++ (either show prettyShow) dst
+          let label = "comp_ins_" ++ (either (prettyShow . varToVHDLName) prettyShow) dst
           let portmaps = mkAssocElems args' ((either varToVHDLName id) dst) signature
           return ([mkComponentInst label entity_id portmaps], [f])
         False -> do
@@ -1374,6 +1407,10 @@ globalNameTable = Map.fromList
   , (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             ) )
@@ -1383,6 +1420,8 @@ globalNameTable = Map.fromList
   , (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"))
   ]