X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Normalize.hs;h=d5b993acd298cb8b7c2ee05c015f22c06ec522bf;hb=7762251a1355fbcbb08317926ca232951c146744;hp=a299fd3673acc2d6f50788098aa6ae8896296b01;hpb=7eb34cb0e082185b256b7231ee84cb04e006f51c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Normalize.hs b/Normalize.hs index a299fd3..d5b993a 100644 --- a/Normalize.hs +++ b/Normalize.hs @@ -29,11 +29,13 @@ import qualified NameSet import qualified CoreFVs import qualified CoreUtils import qualified MkCore +import qualified HscTypes import Outputable ( showSDoc, ppr, nest ) -- Local imports import NormalizeTypes import NormalizeTools +import VHDLTypes import CoreTools import Pretty @@ -453,14 +455,15 @@ funextracttop = everywhere ("funextract", funextract) transforms = [argproptop, funextracttop, etatop, betatop, castproptop, letremovetop, letrectop, letsimpltop, letflattop, casewildtop, scrutsimpltop, casevalsimpltop, caseremovetop, inlinenonreptop, appsimpltop] -- Turns the given bind into VHDL -normalizeModule :: - UniqSupply.UniqSupply -- ^ A UniqSupply we can use +normalizeModule :: + HscTypes.HscEnv + -> UniqSupply.UniqSupply -- ^ A UniqSupply we can use -> [(CoreBndr, CoreExpr)] -- ^ All bindings we know (i.e., in the current module) -> [CoreBndr] -- ^ The bindings to generate VHDL for (i.e., the top level bindings) -> [Bool] -- ^ For each of the bindings to generate VHDL for, if it is stateful - -> [(CoreBndr, CoreExpr)] -- ^ The resulting VHDL + -> ([(CoreBndr, CoreExpr)], TypeState) -- ^ The resulting VHDL -normalizeModule uniqsupply bindings generate_for statefuls = runTransformSession uniqsupply $ do +normalizeModule env uniqsupply bindings generate_for statefuls = runTransformSession env uniqsupply $ do -- Put all the bindings in this module in the tsBindings map putA tsBindings (Map.fromList bindings) -- (Recursively) normalize each of the requested bindings @@ -469,8 +472,9 @@ normalizeModule uniqsupply bindings generate_for statefuls = runTransformSession bindings_map <- getA tsBindings let bindings = Map.assocs bindings_map normalized_bindings <- getA tsNormalized + typestate <- getA tsType -- But return only the normalized bindings - return $ filter ((flip VarSet.elemVarSet normalized_bindings) . fst) bindings + return $ (filter ((flip VarSet.elemVarSet normalized_bindings) . fst) bindings, typestate) normalizeBind :: CoreBndr -> TransformSession () normalizeBind bndr = @@ -510,7 +514,8 @@ normalizeBind bndr = -- Find all vars used with a function type. All of these should be global -- binders (i.e., functions used), since any local binders with a function -- type should have been inlined already. - let used_funcs_set = CoreFVs.exprSomeFreeVars (\v -> (Type.isFunTy . snd . Type.splitForAllTys . Id.idType) v) expr' + bndrs <- getGlobalBinders + let used_funcs_set = CoreFVs.exprSomeFreeVars (\v -> not (Id.isDictId v) && v `elem` bndrs) expr' let used_funcs = VarSet.varSetElems used_funcs_set -- Process each of the used functions recursively mapM normalizeBind used_funcs