Document +RTS --info, and make it a Read'able Haskell value

4 files changed, 30 insertions, 19 deletions

diff --git a/rts/Makefile b/rts/Makefile
index 6e8ca5401e..2bc31b3882 100644
--- a/rts/Makefile
+++ b/rts/Makefile
@@ -149,13 +149,13 @@ endif
 endif
 
 RtsMessages_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\"
-RtsFlags_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\"
-RtsFlags_CC_OPTS += -DRtsWay=\"rts$(_way)\"
-RtsFlags_CC_OPTS += -DHostPlatform=\"$(HOSTPLATFORM)\"
-RtsFlags_CC_OPTS += -DBuildPlatform=\"$(BUILDPLATFORM)\"
-RtsFlags_CC_OPTS += -DTargetPlatform=\"$(TARGETPLATFORM)\"
-RtsFlags_CC_OPTS += -DGhcUnregisterised=\"$(GhcUnregisterised)\"
-RtsFlags_CC_OPTS += -DGhcEnableTablesNextToCode=\"$(GhcEnableTablesNextToCode)\"
+RtsUtils_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\"
+RtsUtils_CC_OPTS += -DRtsWay=\"rts$(_way)\"
+RtsUtils_CC_OPTS += -DHostPlatform=\"$(HOSTPLATFORM)\"
+RtsUtils_CC_OPTS += -DBuildPlatform=\"$(BUILDPLATFORM)\"
+RtsUtils_CC_OPTS += -DTargetPlatform=\"$(TARGETPLATFORM)\"
+RtsUtils_CC_OPTS += -DGhcUnregisterised=\"$(GhcUnregisterised)\"
+RtsUtils_CC_OPTS += -DGhcEnableTablesNextToCode=\"$(GhcEnableTablesNextToCode)\"
 
 ifeq "$(way)" "mp"
 SRC_HC_OPTS += -I$$PVM_ROOT/include
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 4c1f739e89..e8aefd8fce 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -684,18 +684,7 @@ error = rtsTrue;
                   }
                   else if (strequal("info",
                                &rts_argv[arg][2])) {
-                      char *s;
-                      printf("RTS info:\n");
-                      printf("RTS from GHC " ProjectVersion "\n");
-                      printf("RTS way " RtsWay "\n");
-                      printf("Host platform " HostPlatform "\n");
-                      printf("Build platform " BuildPlatform "\n");
-                      printf("Target platform " TargetPlatform "\n");
-                      s = strcmp(GhcUnregisterised, "YES") == 0 ? "un" : "";
-                      printf("Compiler is %sregisterised\n", s);
-                      s = strcmp(GhcEnableTablesNextToCode, "YES") == 0
-                        ? "" : "not ";
-                      printf("Tables are %snext to code\n", s);
+                      printRtsInfo();
                       exit(0);
                   }
                   else {
diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c
index 94c357e5ba..c730d7aec4 100644
--- a/rts/RtsUtils.c
+++ b/rts/RtsUtils.c
@@ -460,3 +460,23 @@ int genericRaise(int sig) {
         return raise(sig);
 #endif
 }
+
+static void mkRtsInfoPair(char *key, char *val) {
+    /* XXX should check for "s, \s etc in key and val */
+    printf(" ,(\"%s\", \"%s\")\n", key, val);
+}
+
+void printRtsInfo(void) {
+    /* The first entry is just a hack to make it easy to get the
+     * commas right */
+    printf(" [(\"GHC RTS\", \"Yes\")\n");
+    mkRtsInfoPair("GHC version",             ProjectVersion);
+    mkRtsInfoPair("RTS way",                 RtsWay);
+    mkRtsInfoPair("Host platform",           HostPlatform);
+    mkRtsInfoPair("Build platform",          BuildPlatform);
+    mkRtsInfoPair("Target platform",         TargetPlatform);
+    mkRtsInfoPair("Compiler unregisterised", GhcUnregisterised);
+    mkRtsInfoPair("Tables next to code",     GhcEnableTablesNextToCode);
+    printf(" ]\n");
+}
+
diff --git a/rts/RtsUtils.h b/rts/RtsUtils.h
index cad4216264..c29c959d76 100644
--- a/rts/RtsUtils.h
+++ b/rts/RtsUtils.h
@@ -51,4 +51,6 @@ extern void heapCheckFail( void );
 extern void* __hscore_get_saved_termios(int fd);
 extern void __hscore_set_saved_termios(int fd, void* ts);
 
+void printRtsInfo(void);
+
 #endif /* RTSUTILS_H */