X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=0be4f60be94c58bec17826191353d832ad83482a;hb=4e12174b5b6515c056d4f83edcc18b991c71465d;hp=d92b9ae96f4b3f3379862275c9081b19bc77f5a0;hpb=d699d2f50e6d172308ef56adec01ace357ef0a0f;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 d92b9ae..0be4f60 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -44,15 +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 @@ -111,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 @@ -129,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 @@ -162,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" @@ -645,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 @@ -1376,7 +1407,10 @@ globalNameTable = Map.fromList , (hwandId , (2, genOperator2 AST.And ) ) , (hworId , (2, genOperator2 AST.Or ) ) , (hwnotId , (1, genOperator1 AST.Not ) ) - , (equalsId , (2, genOperator2 (AST.:=:) ) ) + , (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 ) ) @@ -1386,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")) ]