X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=e5d6bf5e18086bb96e7261bca829202b69767b24;hb=28fc9c7226af6124a2c72c1f23c8e1b6cf196e18;hp=4a62878af5f8756be751e2a9e28feeafe9496499;hpb=04de89474351850ea9dca0350fa383f1b2aff8ea;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 4a62878..e5d6bf5 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -166,32 +166,40 @@ genSizedInt = genFromInteger genTFVec :: BuiltinBuilder genTFVec (Left res) f [Left veclist] = do { - ; let (CoreSyn.Let (CoreSyn.Rec [(bndr, app@(CoreSyn.App _ _))]) rez) = veclist - ; let (CoreSyn.Var f, args) = CoreSyn.collectArgs app - ; let valargs = get_val_args (Var.varType f) args - ; apps <- genApplication (Left bndr) f (map Left valargs) + ; let (CoreSyn.Let (CoreSyn.Rec letbndrs) rez) = trace ("\n***\n" ++ show veclist ++ "\n**\n" ++ pprString veclist ++ "\n***\n") veclist + ; letapps <- mapM genLetApp letbndrs + ; let bndrs = Maybe.catMaybes (map fst letapps) ; (aap,kooi) <- reduceFSVECListToHsList rez - ; sigs <- mapM (\x -> MonadState.lift vsType $ varToVHDLExpr x) (bndr:aap) + ; sigs <- mapM (\x -> MonadState.lift vsType $ varToVHDLExpr x) (bndrs ++ aap) ; let vecsigns = concatsigs sigs ; let vecassign = mkUncondAssign (Left res) vecsigns - ; sig_dec_maybes <- mapM mkSigDec (bndr:aap) + ; sig_dec_maybes <- mapM mkSigDec (bndrs ++ aap) ; let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes) - ; let block_label = mkVHDLExtId ("FSVec_" ++ (show (map varToString (bndr:aap)))) - ; let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (apps ++ kooi ++ [vecassign]) + ; let block_label = mkVHDLExtId ("FSVec_" ++ (show (map varToString (bndrs ++ aap)))) + ; let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs ((concat (map snd letapps)) ++ kooi ++ [vecassign]) ; return $ [AST.CSBSm block] } where concatsigs x = AST.Aggregate (map (\z -> AST.ElemAssoc Nothing z) x) - +genLetApp :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> VHDLSession (Maybe CoreSyn.CoreBndr, [AST.ConcSm]) +genLetApp (bndr, app@(CoreSyn.App _ _)) = do + let (CoreSyn.Var f, args) = CoreSyn.collectArgs app + let valargs = get_val_args (Var.varType f) args + apps <- genApplication (Left bndr) f (map Left valargs) + return (Just bndr, apps) + +genLetApp _ = return (Nothing,[]) + +reduceFSVECListToHsList :: CoreSyn.CoreExpr -> VHDLSession ([CoreSyn.CoreBndr], [AST.ConcSm]) reduceFSVECListToHsList app@(CoreSyn.App _ letexpr) = do case letexpr of - (CoreSyn.Let (CoreSyn.Rec [(bndr, app@(CoreSyn.App _ _))]) rez) -> do - let (CoreSyn.Var f, args) = CoreSyn.collectArgs app - let valargs = get_val_args (Var.varType f) args - app <- genApplication (Left bndr) f (map Left valargs) + (CoreSyn.Let (CoreSyn.Rec letbndrs) rez) -> do + letapps <- mapM genLetApp letbndrs + let bndrs = Maybe.catMaybes (map fst letapps) + let app = (map snd letapps) (vars, apps) <- reduceFSVECListToHsList rez - return ((bndr:vars),(app ++ apps)) + return ((bndrs ++ vars),((concat app) ++ apps)) otherwise -> return ([],[])