Add more modes to mkDerivedConstants

We now generate a platformConstants file that we can read at runtime.

6 files changed, 116 insertions, 12 deletions

diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index ad92b6f2e2..fee9d38da1 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -461,9 +461,16 @@ $(compiler_stage1_depfile_haskell) : compiler/stage1/$(PLATFORM_H)
 $(compiler_stage2_depfile_haskell) : compiler/stage2/$(PLATFORM_H)
 $(compiler_stage3_depfile_haskell) : compiler/stage3/$(PLATFORM_H)
 
-$(compiler_stage1_depfile_haskell) : $(includes_H_CONFIG) $(includes_H_PLATFORM) $(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS) $(PRIMOP_BITS)
-$(compiler_stage2_depfile_haskell) : $(includes_H_CONFIG) $(includes_H_PLATFORM) $(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS) $(PRIMOP_BITS)
-$(compiler_stage3_depfile_haskell) : $(includes_H_CONFIG) $(includes_H_PLATFORM) $(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS) $(PRIMOP_BITS)
+COMPILER_INCLUDES_DEPS += $(includes_H_CONFIG)
+COMPILER_INCLUDES_DEPS += $(includes_H_PLATFORM)
+COMPILER_INCLUDES_DEPS += $(includes_GHCCONSTANTS)
+COMPILER_INCLUDES_DEPS += $(includes_GHCCONSTANTS_HASKELL_TYPE)
+COMPILER_INCLUDES_DEPS += $(includes_DERIVEDCONSTANTS)
+COMPILER_INCLUDES_DEPS += $(PRIMOP_BITS)
+
+$(compiler_stage1_depfile_haskell) : $(COMPILER_INCLUDES_DEPS)
+$(compiler_stage2_depfile_haskell) : $(COMPILER_INCLUDES_DEPS)
+$(compiler_stage3_depfile_haskell) : $(COMPILER_INCLUDES_DEPS)
 
 # Every Constants.o object file depends on includes/GHCConstants.h:
 $(eval $(call compiler-hs-dependency,Constants,$(includes_GHCCONSTANTS) includes/HaskellConstants.hs))
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 723bf44b8b..3d94cd72fc 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -20,6 +20,7 @@ module DynFlags (
         WarningFlag(..),
         ExtensionFlag(..),
         Language(..),
+        PlatformConstants(..),
         FatalMessager, LogAction, FlushOut(..), FlushErr(..),
         ProfAuto(..),
         glasgowExtsFlags,
@@ -705,8 +706,9 @@ data Settings = Settings {
   sOpt_l                 :: [String],
   sOpt_windres           :: [String],
   sOpt_lo                :: [String], -- LLVM: llvm optimiser
-  sOpt_lc                :: [String]  -- LLVM: llc static compiler
+  sOpt_lc                :: [String], -- LLVM: llc static compiler
 
+  sPlatformConstants     :: PlatformConstants
  }
 
 targetPlatform :: DynFlags -> Platform
@@ -3138,3 +3140,5 @@ compilerInfo dflags
        ("Global Package DB",           systemPackageConfig dflags)
       ]
 
+#include "../includes/dist-derivedconstants/header/GHCConstantsHaskellType.hs"
+
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 7d905d35c6..2154cd3235 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -172,15 +172,23 @@ initSysTools mbMinusB
              -- format, '/' separated
 
        let settingsFile = top_dir </> "settings"
+           platformConstantsFile = top_dir </> "platformConstants"
            installed :: FilePath -> FilePath
            installed file = top_dir </> file
 
        settingsStr <- readFile settingsFile
+       platformConstantsStr <- readFile platformConstantsFile
        mySettings <- case maybeReadFuzzy settingsStr of
                      Just s ->
                          return s
                      Nothing ->
                          pgmError ("Can't parse " ++ show settingsFile)
+       platformConstants <- case maybeReadFuzzy platformConstantsStr of
+                            Just s ->
+                                return s
+                            Nothing ->
+                                pgmError ("Can't parse " ++
+                                          show platformConstantsFile)
        let getSetting key = case lookup key mySettings of
                             Just xs ->
                                 return $ case stripPrefix "$topdir" xs of
@@ -326,7 +334,8 @@ initSysTools mbMinusB
                     sOpt_l       = [],
                     sOpt_windres = [],
                     sOpt_lo      = [],
-                    sOpt_lc      = []
+                    sOpt_lc      = [],
+                    sPlatformConstants = platformConstants
              }
 \end{code}
 
diff --git a/ghc/ghc.mk b/ghc/ghc.mk
index c45e28891a..e1545033be 100644
--- a/ghc/ghc.mk
+++ b/ghc/ghc.mk
@@ -127,12 +127,19 @@ all_ghc_stage3 : $(GHC_STAGE3)
 $(INPLACE_LIB)/settings : settings
 	"$(CP)" $< $@
 
+$(INPLACE_LIB)/platformConstants: $(includes_GHCCONSTANTS_HASKELL_VALUE)
+	"$(CP)" $< $@
+
 # The GHC programs need to depend on all the helper programs they might call,
 # and the settings files they use
 
-$(GHC_STAGE1) : | $(UNLIT) $(INPLACE_LIB)/settings
-$(GHC_STAGE2) : | $(UNLIT) $(INPLACE_LIB)/settings
-$(GHC_STAGE3) : | $(UNLIT) $(INPLACE_LIB)/settings
+GHC_DEPENDENCIES += $(UNLIT)
+GHC_DEPENDENCIES += $(INPLACE_LIB)/settings
+GHC_DEPENDENCIES += $(INPLACE_LIB)/platformConstants
+
+$(GHC_STAGE1) : | $(GHC_DEPENDENCIES)
+$(GHC_STAGE2) : | $(GHC_DEPENDENCIES)
+$(GHC_STAGE3) : | $(GHC_DEPENDENCIES)
 
 ifeq "$(GhcUnregisterised)" "NO"
 $(GHC_STAGE1) : | $(SPLIT)
diff --git a/includes/ghc.mk b/includes/ghc.mk
index 7a5969c04e..e8b9837407 100644
--- a/includes/ghc.mk
+++ b/includes/ghc.mk
@@ -132,6 +132,8 @@ endif
 
 includes_DERIVEDCONSTANTS = includes/dist-derivedconstants/header/DerivedConstants.h
 includes_GHCCONSTANTS = includes/dist-derivedconstants/header/GHCConstants.h
+includes_GHCCONSTANTS_HASKELL_TYPE = includes/dist-derivedconstants/header/GHCConstantsHaskellType.hs
+includes_GHCCONSTANTS_HASKELL_VALUE = includes/dist-derivedconstants/header/platformConstants
 
 ifeq "$(PORTING_HOST)-$(AlienScript)" "YES-"
 
@@ -170,7 +172,21 @@ $(includes_GHCCONSTANTS) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $
 ifeq "$(AlienScript)" ""
 	./$< --gen-haskell >$@
 else
-	$(AlienScript) run ./$< >$@
+	$(AlienScript) run ./$< --gen-haskell >$@
+endif
+
+$(includes_GHCCONSTANTS_HASKELL_TYPE) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/.
+ifeq "$(AlienScript)" ""
+	./$< --gen-haskell-type >$@
+else
+	$(AlienScript) run ./$< --gen-haskell-type >$@
+endif
+
+$(includes_GHCCONSTANTS_HASKELL_VALUE) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/.
+ifeq "$(AlienScript)" ""
+	./$< --gen-haskell-value >$@
+else
+	$(AlienScript) run ./$< --gen-haskell-value >$@
 endif
 endif
 
@@ -181,11 +197,11 @@ endif
 
 $(eval $(call clean-target,includes,,\
   $(includes_H_CONFIG) $(includes_H_PLATFORM) \
-  $(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS)))
+  $(includes_GHCCONSTANTS) $(includes_GHCCONSTANTS_HASKELL_TYPE) $(includes_GHCCONSTANTS_HASKELL_VALUE) $(includes_DERIVEDCONSTANTS)))
 
 $(eval $(call all-target,includes,,\
   $(includes_H_CONFIG) $(includes_H_PLATFORM) \
-  $(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS)))
+  $(includes_GHCCONSTANTS) $(includes_GHCCONSTANTS_HASKELL_TYPE) $(includes_GHCCONSTANTS_HASKELL_VALUE) $(includes_DERIVEDCONSTANTS)))
 
 install: install_includes
 
diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c
index bb3b3a911f..bb60df9422 100644
--- a/includes/mkDerivedConstants.c
+++ b/includes/mkDerivedConstants.c
@@ -29,7 +29,7 @@
 #include <stdio.h>
 #include <string.h>
 
-enum Mode { Gen_Haskell, Gen_Header } mode;
+enum Mode { Gen_Haskell, Gen_Haskell_Type, Gen_Haskell_Value, Gen_Header } mode;
 
 #define str(a,b) #a "_" #b
 
@@ -45,6 +45,12 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
         printf("oFFSET_" str " :: Int\n");                                  \
         printf("oFFSET_" str " = %" FMT_SizeT "\n", (size_t)offset);        \
         break;                                                              \
+    case Gen_Haskell_Type:                                                  \
+        printf("    , pc_OFFSET_" str " :: Int\n");                         \
+        break;                                                              \
+    case Gen_Haskell_Value:                                                 \
+        printf("    , pc_OFFSET_" str " = %" FMT_SizeT "\n", (size_t)offset); \
+        break;                                                              \
     case Gen_Header:                                                        \
         printf("#define OFFSET_" str " %" FMT_SizeT "\n", (size_t)offset);  \
         break;                                                              \
@@ -53,6 +59,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
 #define ctype(type)                                                         \
     switch (mode) {                                                         \
     case Gen_Haskell:                                                       \
+    case Gen_Haskell_Type:                                                  \
+    case Gen_Haskell_Value:                                                 \
         break;                                                              \
     case Gen_Header:                                                        \
         printf("#define SIZEOF_" #type " %" FMT_SizeT "\n",                 \
@@ -69,6 +77,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
 #define field_type_(str, s_type, field)                                     \
     switch (mode) {                                                         \
     case Gen_Haskell:                                                       \
+    case Gen_Haskell_Type:                                                  \
+    case Gen_Haskell_Value:                                                 \
         break;                                                              \
     case Gen_Header:                                                        \
         printf("#define REP_" str " b");                                    \
@@ -79,6 +89,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
 #define field_type_gcptr_(str, s_type, field)                               \
     switch (mode) {                                                         \
     case Gen_Haskell:                                                       \
+    case Gen_Haskell_Type:                                                  \
+    case Gen_Haskell_Value:                                                 \
         break;                                                              \
     case Gen_Header:                                                        \
         printf("#define REP_" str " gcptr\n");                              \
@@ -98,6 +110,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
 #define struct_field_macro(str)                                             \
     switch (mode) {                                                         \
     case Gen_Haskell:                                                       \
+    case Gen_Haskell_Type:                                                  \
+    case Gen_Haskell_Value:                                                 \
         break;                                                              \
     case Gen_Header:                                                        \
         printf("#define " str "(__ptr__)  REP_" str "[__ptr__+OFFSET_" str "]\n"); \
@@ -121,6 +135,12 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
         printf("sIZEOF_" str " :: Int\n");                                  \
         printf("sIZEOF_" str " = %" FMT_SizeT "\n", (size_t)size);          \
         break;                                                              \
+    case Gen_Haskell_Type:                                                  \
+        printf("    , pc_SIZEOF_" str " :: Int\n");                         \
+        break;                                                              \
+    case Gen_Haskell_Value:                                                 \
+        printf("    , pc_SIZEOF_" str " = %" FMT_SizeT "\n", (size_t)size); \
+        break;                                                              \
     case Gen_Header:                                                        \
         printf("#define SIZEOF_" str " %" FMT_SizeT "\n", (size_t)size);    \
         break;                                                              \
@@ -129,6 +149,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
 #define def_closure_size(str, size)                                         \
     switch (mode) {                                                         \
     case Gen_Haskell:                                                       \
+    case Gen_Haskell_Type:                                                  \
+    case Gen_Haskell_Value:                                                 \
         break;                                                              \
     case Gen_Header:                                                        \
         printf("#define SIZEOF_" str " (SIZEOF_StgHeader+%" FMT_SizeT ")\n", (size_t)size); \
@@ -154,6 +176,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
 #define closure_field_macro(str)                                            \
     switch (mode) {                                                         \
     case Gen_Haskell:                                                       \
+    case Gen_Haskell_Type:                                                  \
+    case Gen_Haskell_Value:                                                 \
         break;                                                              \
     case Gen_Header:                                                        \
         printf("#define " str "(__ptr__)  REP_" str "[__ptr__+SIZEOF_StgHeader+OFFSET_" str "]\n"); \
@@ -169,6 +193,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
 #define closure_payload_macro(str)                                          \
     switch (mode) {                                                         \
     case Gen_Haskell:                                                       \
+    case Gen_Haskell_Type:                                                  \
+    case Gen_Haskell_Value:                                                 \
         break;                                                              \
     case Gen_Header:                                                        \
         printf("#define " str "(__ptr__,__ix__)  W_[__ptr__+SIZEOF_StgHeader+OFFSET_" str " + WDS(__ix__)]\n"); \
@@ -205,6 +231,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
 #define tso_field_offset_macro(str)                                         \
     switch (mode) {                                                         \
     case Gen_Haskell:                                                       \
+    case Gen_Haskell_Type:                                                  \
+    case Gen_Haskell_Value:                                                 \
         break;                                                              \
     case Gen_Header:                                                        \
         printf("#define TSO_OFFSET_" str " (SIZEOF_StgHeader+SIZEOF_OPT_StgTSOProfInfo+OFFSET_" str ")\n"); \
@@ -218,6 +246,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
 #define tso_field_macro(str)                                                \
     switch (mode) {                                                         \
     case Gen_Haskell:                                                       \
+    case Gen_Haskell_Type:                                                  \
+    case Gen_Haskell_Value:                                                 \
         break;                                                              \
     case Gen_Header:                                                        \
     printf("#define " str "(__ptr__)  REP_" str "[__ptr__+TSO_OFFSET_" str "]\n") \
@@ -232,6 +262,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
 #define opt_struct_size(s_type, option)					                    \
     switch (mode) {                                                         \
     case Gen_Haskell:                                                       \
+    case Gen_Haskell_Type:                                                  \
+    case Gen_Haskell_Value:                                                 \
         break;                                                              \
     case Gen_Header:                                                        \
         printf("#ifdef " #option "\n");					                    \
@@ -255,6 +287,12 @@ main(int argc, char *argv[])
         if (0 == strcmp("--gen-haskell", argv[1])) {
             mode = Gen_Haskell;
         }
+        else if (0 == strcmp("--gen-haskell-type", argv[1])) {
+            mode = Gen_Haskell_Type;
+        }
+        else if (0 == strcmp("--gen-haskell-value", argv[1])) {
+            mode = Gen_Haskell_Value;
+        }
         else {
             printf("Bad args\n");
             exit(1);
@@ -268,6 +306,16 @@ main(int argc, char *argv[])
     switch (mode) {
     case Gen_Haskell:
         break;
+    case Gen_Haskell_Type:
+        printf("data PlatformConstants = PlatformConstants {\n");
+        /* Now a kludge that allows the real entries to all start with a
+           comma, which makes life a little easier */
+        printf("    pc_platformConstants :: ()\n");
+        break;
+    case Gen_Haskell_Value:
+        printf("PlatformConstants {\n");
+        printf("    pc_platformConstants = ()\n");
+        break;
     case Gen_Header:
         printf("/* This file is created automatically.  Do not edit by hand.*/\n\n");
 
@@ -528,5 +576,18 @@ main(int argc, char *argv[])
     struct_field(StgAsyncIOResult, errCode);
 #endif
 
+    switch (mode) {
+    case Gen_Haskell:
+        break;
+    case Gen_Haskell_Type:
+        printf("  } deriving (Read, Show)\n");
+        break;
+    case Gen_Haskell_Value:
+        printf("  }\n");
+        break;
+    case Gen_Header:
+        break;
+    }
+
     return 0;
 }