From 821bece9e7b59272e779193d558298ba4cc7b888 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=96mer=20Sinan=20A=C4=9Facan?= Date: Wed, 4 Sep 2019 17:50:29 +0300 Subject: Minor refactoring in deriveConstants Mainly we now generate this data PlatformConstants = PlatformConstants { pc_CONTROL_GROUP_CONST_291 :: Int, pc_STD_HDR_SIZE :: Int, pc_PROF_HDR_SIZE :: Int, pc_BLOCK_SIZE :: Int, } instead of data PlatformConstants = PlatformConstants { pc_platformConstants :: () , pc_CONTROL_GROUP_CONST_291 :: Int , pc_STD_HDR_SIZE :: Int , pc_PROF_HDR_SIZE :: Int , pc_BLOCK_SIZE :: Int ... } The first field has no use and according to (removed) comments it was to make code generator's work easier.. if anything this version is simpler because it has less repetition (the commas in strings are gone). --- utils/deriveConstants/Main.hs | 79 ++++++++++++++++++++----------------------- 1 file changed, 37 insertions(+), 42 deletions(-) diff --git a/utils/deriveConstants/Main.hs b/utils/deriveConstants/Main.hs index a812ac42c8..54533254dd 100644 --- a/utils/deriveConstants/Main.hs +++ b/utils/deriveConstants/Main.hs @@ -28,10 +28,10 @@ needing to run the program, by inspecting the object file using 'nm'. import Control.Monad (when, unless) import Data.Bits (shiftL) import Data.Char (toLower) -import Data.List (stripPrefix) +import Data.List (stripPrefix, intercalate) import Data.Map (Map) import qualified Data.Map as Map -import Data.Maybe (catMaybes) +import Data.Maybe (catMaybes, mapMaybe, fromMaybe) import Numeric (readHex) import System.Environment (getArgs) import System.Exit (ExitCode(ExitSuccess), exitFailure) @@ -697,7 +697,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram let ls = lines xs m = Map.fromList $ case os of "aix" -> parseAixObjdump ls - _ -> catMaybes $ map parseNmLine ls + _ -> mapMaybe parseNmLine ls case Map.lookup "CONTROL_GROUP_CONST_291" m of Just 292 -> return () -- OK @@ -709,8 +709,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram ++ "to 'configure'.\n" Just x -> die ("unexpected value round-tripped for CONTROL_GROUP_CONST_291: " ++ show x) - rs <- mapM (lookupResult m) (wanteds os) - return rs + mapM (lookupResult m) (wanteds os) where headers = ["#define IN_STG_CODE 0", "", "/*", @@ -739,7 +738,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram "#pragma GCC poison sizeof" ] - objdumpProgam = maybe (error "no objdump program given") id mobjdumpProgram + objdumpProgam = fromMaybe (error "no objdump program given") mobjdumpProgram prefix = "derivedConstant" mkFullName name = prefix ++ name @@ -874,20 +873,17 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram writeHaskellType :: FilePath -> [What Fst] -> IO () writeHaskellType fn ws = writeFile fn xs - where xs = unlines (headers ++ body ++ footers) - headers = ["data PlatformConstants = PlatformConstants {" - -- Now a kludge that allows the real entries to - -- all start with a comma, which makes life a - -- little easier - ," pc_platformConstants :: ()"] - footers = [" } deriving Read"] - body = concatMap doWhat ws - doWhat (GetClosureSize name _) = [" , pc_" ++ name ++ " :: Int"] - doWhat (GetFieldType name _) = [" , pc_" ++ name ++ " :: Int"] - doWhat (GetWord name _) = [" , pc_" ++ name ++ " :: Int"] - doWhat (GetInt name _) = [" , pc_" ++ name ++ " :: Int"] - doWhat (GetNatural name _) = [" , pc_" ++ name ++ " :: Integer"] - doWhat (GetBool name _) = [" , pc_" ++ name ++ " :: Bool"] + where xs = unlines [header, body, footer] + header = "data PlatformConstants = PlatformConstants {" + footer = " } deriving Read" + body = intercalate ",\n" (concatMap doWhat ws) + + doWhat (GetClosureSize name _) = [" pc_" ++ name ++ " :: Int"] + doWhat (GetFieldType name _) = [" pc_" ++ name ++ " :: Int"] + doWhat (GetWord name _) = [" pc_" ++ name ++ " :: Int"] + doWhat (GetInt name _) = [" pc_" ++ name ++ " :: Int"] + doWhat (GetNatural name _) = [" pc_" ++ name ++ " :: Integer"] + doWhat (GetBool name _) = [" pc_" ++ name ++ " :: Bool"] doWhat (StructFieldMacro {}) = [] doWhat (ClosureFieldMacro {}) = [] doWhat (ClosurePayloadMacro {}) = [] @@ -895,17 +891,16 @@ writeHaskellType fn ws = writeFile fn xs writeHaskellValue :: FilePath -> [What Snd] -> IO () writeHaskellValue fn rs = writeFile fn xs - where xs = unlines (headers ++ body ++ footers) - headers = ["PlatformConstants {" - ," pc_platformConstants = ()"] - footers = [" }"] - body = concatMap doWhat rs - doWhat (GetClosureSize name (Snd v)) = [" , pc_" ++ name ++ " = " ++ show v] - doWhat (GetFieldType name (Snd v)) = [" , pc_" ++ name ++ " = " ++ show v] - doWhat (GetWord name (Snd v)) = [" , pc_" ++ name ++ " = " ++ show v] - doWhat (GetInt name (Snd v)) = [" , pc_" ++ name ++ " = " ++ show v] - doWhat (GetNatural name (Snd v)) = [" , pc_" ++ name ++ " = " ++ show v] - doWhat (GetBool name (Snd v)) = [" , pc_" ++ name ++ " = " ++ show v] + where xs = unlines [header, body, footer] + header = "PlatformConstants {" + footer = " }" + body = intercalate ",\n" (concatMap doWhat rs) + doWhat (GetClosureSize name (Snd v)) = [" pc_" ++ name ++ " = " ++ show v] + doWhat (GetFieldType name (Snd v)) = [" pc_" ++ name ++ " = " ++ show v] + doWhat (GetWord name (Snd v)) = [" pc_" ++ name ++ " = " ++ show v] + doWhat (GetInt name (Snd v)) = [" pc_" ++ name ++ " = " ++ show v] + doWhat (GetNatural name (Snd v)) = [" pc_" ++ name ++ " = " ++ show v] + doWhat (GetBool name (Snd v)) = [" pc_" ++ name ++ " = " ++ show v] doWhat (StructFieldMacro {}) = [] doWhat (ClosureFieldMacro {}) = [] doWhat (ClosurePayloadMacro {}) = [] @@ -949,21 +944,21 @@ writeHeader :: FilePath -> [What Snd] -> IO () writeHeader fn rs = writeFile fn xs where xs = unlines (headers ++ body) headers = ["/* This file is created automatically. Do not edit by hand.*/", ""] - body = concatMap doWhat rs - doWhat (GetFieldType name (Snd v)) = ["#define " ++ name ++ " b" ++ show (v * 8)] - doWhat (GetClosureSize name (Snd v)) = ["#define " ++ name ++ " (SIZEOF_StgHeader+" ++ show v ++ ")"] - doWhat (GetWord name (Snd v)) = ["#define " ++ name ++ " " ++ show v] - doWhat (GetInt name (Snd v)) = ["#define " ++ name ++ " " ++ show v] - doWhat (GetNatural name (Snd v)) = ["#define " ++ name ++ " " ++ show v] - doWhat (GetBool name (Snd v)) = ["#define " ++ name ++ " " ++ show (fromEnum v)] + body = map doWhat rs + doWhat (GetFieldType name (Snd v)) = "#define " ++ name ++ " b" ++ show (v * 8) + doWhat (GetClosureSize name (Snd v)) = "#define " ++ name ++ " (SIZEOF_StgHeader+" ++ show v ++ ")" + doWhat (GetWord name (Snd v)) = "#define " ++ name ++ " " ++ show v + doWhat (GetInt name (Snd v)) = "#define " ++ name ++ " " ++ show v + doWhat (GetNatural name (Snd v)) = "#define " ++ name ++ " " ++ show v + doWhat (GetBool name (Snd v)) = "#define " ++ name ++ " " ++ show (fromEnum v) doWhat (StructFieldMacro nameBase) = - ["#define " ++ nameBase ++ "(__ptr__) REP_" ++ nameBase ++ "[__ptr__+OFFSET_" ++ nameBase ++ "]"] + "#define " ++ nameBase ++ "(__ptr__) REP_" ++ nameBase ++ "[__ptr__+OFFSET_" ++ nameBase ++ "]" doWhat (ClosureFieldMacro nameBase) = - ["#define " ++ nameBase ++ "(__ptr__) REP_" ++ nameBase ++ "[__ptr__+SIZEOF_StgHeader+OFFSET_" ++ nameBase ++ "]"] + "#define " ++ nameBase ++ "(__ptr__) REP_" ++ nameBase ++ "[__ptr__+SIZEOF_StgHeader+OFFSET_" ++ nameBase ++ "]" doWhat (ClosurePayloadMacro nameBase) = - ["#define " ++ nameBase ++ "(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_" ++ nameBase ++ " + WDS(__ix__)]"] + "#define " ++ nameBase ++ "(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_" ++ nameBase ++ " + WDS(__ix__)]" doWhat (FieldTypeGcptrMacro nameBase) = - ["#define REP_" ++ nameBase ++ " gcptr"] + "#define REP_" ++ nameBase ++ " gcptr" die :: String -> IO a die err = do hPutStrLn stderr err -- cgit v1.2.1