X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;h=08375b7bd1d54a178d327b8905a4334e217031ec;hb=ee39139fa25cb75c8acc40b10d90f6482b8d1b30;hp=eb454203ebeda699ebcc9c595f4a6f395dbdfee7;hpb=3f4773d25a4c44a0e4c9503806562a6741da3508;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/VHDL.hs b/VHDL.hs index eb45420..08375b7 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -264,6 +264,11 @@ mkConcSm :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The binding to process -> VHDLState [AST.ConcSm] -- ^ The corresponding VHDL component instantiations. + +-- Ignore Cast expressions, they should not longer have any meaning as long as +-- the type works out. +mkConcSm (bndr, Cast expr ty) = mkConcSm (bndr, expr) + mkConcSm (bndr, app@(CoreSyn.App _ _))= do let (CoreSyn.Var f, args) = CoreSyn.collectArgs app let valargs' = filter isValArg args @@ -289,18 +294,33 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do -- It's a global value imported from elsewhere. These can be builtin -- functions. funSignatures <- getA vsNameTable + signatures <- getA vsSignatures case (Map.lookup (bndrToString f) funSignatures) of Just (arg_count, builder) -> if length valargs == arg_count then - let - sigs = map (bndrToString.varBndr) valargs - sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs - func = builder sigsNames - src_wform = AST.Wform [AST.WformElem func Nothing] - dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr)) - assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing) - in - return [AST.CSSASm assign] + case builder of + Left funBuilder -> + let + sigs = map (bndrToString.varBndr) valargs + sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs + func = funBuilder sigsNames + src_wform = AST.Wform [AST.WformElem func Nothing] + dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr)) + assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing) + in + return [AST.CSSASm assign] + Right genBuilder -> + let + ty = Var.varType bndr + len = tfvec_len ty + sigs = map varBndr valargs + signature = Maybe.fromMaybe + (error $ "Using function '" ++ (bndrToString (head sigs)) ++ "' without signature? This should not happen!") + (Map.lookup (head sigs) signatures) + arg_names = map (mkVHDLExtId . bndrToString) (tail sigs) + dst_name = mkVHDLExtId (bndrToString bndr) + genSm = genBuilder len signature (arg_names ++ [dst_name]) + in return [AST.CSGSm genSm] else error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString valargs Nothing -> error $ "Using function from another module that is not a known builtin: " ++ pprString f