X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;ds=sidebyside;f=Translator.hs;h=2a752a79d34c94cc5ccc4b32cc296b7aaeade5d2;hb=059c20c7b953a21097939a47ecac7f6cad05541a;hp=5e36b3856b631666cc4fb62fb932631e21a33943;hpb=bf0b6fedf46d525cc7e4d389b4fb7dd539174939;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Translator.hs b/Translator.hs index 5e36b38..2a752a7 100644 --- a/Translator.hs +++ b/Translator.hs @@ -91,9 +91,10 @@ moduleToVHDL core list = do mapM addBuiltIn builtin_funcs -- Create entities and architectures for them Monad.zipWithM processBind statefuls binds - modFuncs nameFlatFunction - modFuncs VHDL.createEntity - modFuncs VHDL.createArchitecture + modFuncMap $ Map.map (\fdata -> fdata {flatFunc = fmap nameFlatFunction (flatFunc fdata)}) + modFuncMap $ Map.mapWithKey (\hsfunc fdata -> fdata {funcEntity = VHDL.createEntity hsfunc fdata}) + funcs <- getFuncMap + modFuncMap $ Map.mapWithKey (\hsfunc fdata -> fdata {funcArch = VHDL.createArchitecture funcs hsfunc fdata}) funcs <- getFuncs return $ VHDL.getDesignFiles (map snd funcs) @@ -332,21 +333,15 @@ mkHsFunction f ty stateful= -- | Adds signal names to the given FlatFunction nameFlatFunction :: - HsFunction - -> FuncData - -> VHDLState () + FlatFunction + -> FlatFunction -nameFlatFunction hsfunc fdata = - let func = flatFunc fdata in - case func of - -- Skip (builtin) functions without a FlatFunction - Nothing -> do return () - -- Name the signals in all other functions - Just flatfunc -> - let s = flat_sigs flatfunc in - let s' = map nameSignal s in - let flatfunc' = flatfunc { flat_sigs = s' } in - setFlatFunc hsfunc flatfunc' +nameFlatFunction flatfunc = + -- Name the signals + let + s = flat_sigs flatfunc + s' = map nameSignal s in + flatfunc { flat_sigs = s' } where nameSignal :: (SignalId, SignalInfo) -> (SignalId, SignalInfo) nameSignal (id, info) =