X-Git-Url: https://git.stderr.nl/gitweb?p=matthijs%2Fmaster-project%2Fc%CE%BBash.git;a=blobdiff_plain;f=Flatten.hs;h=d25ef73aceabb2feec43007b1a469b267a72ce09;hp=30a9bbabe9754911b551c9dad1e5ccc41d1e2401;hb=HEAD;hpb=6e1beb07825c53ab0da16b815d58c24a1b4ea449 diff --git a/Flatten.hs b/Flatten.hs index 30a9bba..d25ef73 100644 --- a/Flatten.hs +++ b/Flatten.hs @@ -54,11 +54,10 @@ markSignal use id = markSignals use [id] -- | Flatten a haskell function flattenFunction :: HsFunction -- ^ The function to flatten - -> CoreBind -- ^ The function value + -> (CoreBndr, CoreExpr) -- ^ The function value -> FlatFunction -- ^ The resulting flat function -flattenFunction _ (Rec _) = error "Recursive binders not supported" -flattenFunction hsfunc bind@(NonRec var expr) = +flattenFunction hsfunc (var, expr) = FlatFunction args res defs sigs where init_state = ([], [], 0) @@ -218,9 +217,12 @@ flattenExpr binds app@(App _ _) = do sig_id <- genSignalId SigInternal ty -- TODO: fromInteger is defined for more types than just SizedWord let len = sized_word_len ty - -- TODO: to_stdlogicvector doesn't work here, since SizedWord - -- translates to a different type... - addDef $ UncondDef (Right $ Literal ("to_stdlogicvector(to_unsigned(" ++ (show int) ++ ", " ++ (show len) ++ "))") Nothing) sig_id + -- Use a to_unsigned to translate the number (a natural) to an unsiged + -- (array of bits) + let lit_str = "to_unsigned(" ++ (show int) ++ ", " ++ (show len) ++ ")" + -- Set the signal to our literal unconditionally, but add the type so + -- the literal will be typecast to the proper type. + addDef $ UncondDef (Right $ Literal lit_str (Just ty)) sig_id return ([], Single sig_id) else flattenApplicationExpr binds (CoreUtils.exprType app) f args @@ -265,11 +267,12 @@ flattenExpr binds expr@(Case scrut b _ alts) = do -- TODO: Special casing for higher order functions -- Flatten the scrutinee (_, res) <- flattenExpr binds scrut + -- Put the scrutinee in the BindMap + let binds' = (b, Left res) : binds case alts of - -- TODO include b in the binds list - [alt] -> flattenSingleAltCaseExpr binds res b alt + [alt] -> flattenSingleAltCaseExpr binds' res b alt -- Reverse the alternatives, so the __DEFAULT alternative ends up last - otherwise -> flattenMultipleAltCaseExpr binds res b (reverse alts) + otherwise -> flattenMultipleAltCaseExpr binds' res b (reverse alts) where flattenSingleAltCaseExpr :: BindMap