Add GHC version to Bluetcl, for use in testsuite

The Bluetcl 'version' command now has a 'ghc' subcommand that will
print the version of GHC that the Bluespec tools were compiled with.
The subcommand 'bsc' was also added, which has the same behavior as
calling 'version' with no arguments: prints the Bluespec tools version.
The auotmated printing of help messages needed to be updated to work
for commands with optional subcommands like this.

The testsuite now has a variable 'ghc_version' which can be consulted.
The tests for bug 1490 are updated to use this, because BSC compiled
with GHC 9.8.1 has regressions that need to be handled differently.

The regexp for assigning 'bsc_version' in the testsuite was broken and
was assigning it multiple lines of text (which caused confusion when
printed in the log).  Instead of fixing the regexp, the getting of the
version is changed to use Bluetcl, to print just the version info.

src/comp/bluetcl.hs

@@ -349,6 +349,8 @@ helpCmd interp [_,cmd] = do
                    isArg _                     = False
                    isKW (Just (Keyword _ _ _)) = True
                    isKW _                      = False
+                   isKWorNone Nothing          = True
+                   isKWorNone e                = isKW e
                    matched' = dropWhile isArg matched
                    cmd_words = map fst (reverse matched')
                let cmd_objs = take (length cmd_words) os
@@ -373,7 +375,7 @@ helpCmd interp [_,cmd] = do
                           else [ "", ld ]
                    subtopics = case g' of
                                  (ChooseFrom gs) ->
-                                     if (all isKW (map htclFirstCmdElem gs))
+                                     if (all isKWorNone (map htclFirstCmdElem gs))
                                      then [ "", "Subcommands: " ] ++
                                           [ "  " ++ name ++ descr
                                           | gr <- gs
@@ -400,11 +402,20 @@ helpCmd interp objs = htclCheckCmd helpGrammar fn interp objs
 --------------------------------------------------------------------------------
 
 versionGrammar :: HTclCmdGrammar
-versionGrammar = tclcmd "version" namespace helpStr ""
+versionGrammar = (tclcmd "version" namespace helpStr longHelpStr) .+.
+                 (optional $ oneOf [ kw "bsc" bscHelpStr ""
+                                   , kw "ghc" ghcHelpStr ""
+                                   ])
     where helpStr = "Returns version information for Bluespec software"
-
-versionNum :: [String] -> IO [String]
-versionNum [] = return $ [versionname, buildVersion]
+          longHelpStr = init $ unlines
+                        [ "If no argument is provided, the subcommand 'bsc' is assumed." ]
+          bscHelpStr = "Show BSC version information"
+          ghcHelpStr = "Show the GHC version used to compile BSC"
+
+versionNum :: [String] -> IO HTclObj
+versionNum [] = versionNum ["bsc"]
+versionNum ["bsc"] = return $ TLst [TStr versionname, TStr buildVersion]
+versionNum ["ghc"] = return $ TStr __GLASGOW_HASKELL_FULL_VERSION__
 versionNum xs = internalError $ "versionNum: grammar mismatch: " ++ (show xs)
 
 --------------------------------------------------------------------------------

testsuite/bsc.bugs/bluespec_inc/b1490/b1490.exp

@@ -1,17 +1,36 @@
+
+set rtsflags {+RTS -M256M -Sstderr -RTS}
+
+# GHC 9.8.1 has regressions
+set is_ghc_9_8 [ expr [regexp {^\d+\.\d+} $ghc_version majmin] && \
+		     $majmin == "9.8" ]
+set rtsflags_9_8 {+RTS -M265M -Sstderr -RTS}
+
+proc compile_verilog_pass_except { filename except rtsflags rtsflags_except} {
+    if { $except } {
+	compile_verilog_fail $filename {} $rtsflags
+	copy [make_bsc_vcomp_output_name $filename] \
+	    [make_bsc_vcomp_output_name $filename.try1]
+	compile_verilog_pass $filename {} $rtsflags_except
+    } else {
+	compile_verilog_pass $filename {} $rtsflags
+    }
+}
+
 # -----
 
-compile_verilog_pass Bug1490Bool.bsv "" "+RTS -M256M -Sstderr -RTS"
-compile_verilog_pass Bug1490MyBool.bsv "" "+RTS -M256M -Sstderr -RTS"
-compile_verilog_pass Bug1490MyUnion.bsv "" "+RTS -M256M -Sstderr -RTS"
-compile_verilog_pass Bug1490MyEnum.bsv "" "+RTS -M256M -Sstderr -RTS"
+compile_verilog_pass Bug1490Bool.bsv {} $rtsflags
+compile_verilog_pass Bug1490MyBool.bsv {} $rtsflags
+compile_verilog_pass_except Bug1490MyUnion.bsv $is_ghc_9_8 $rtsflags $rtsflags_9_8
+compile_verilog_pass Bug1490MyEnum.bsv {} $rtsflags
 
 # -----
 
 # There has been a regression and this example now exhausts the heap
-compile_verilog_fail VsortOriginal.bsv "" "+RTS -M256M -Sstderr -RTS"
+compile_verilog_fail VsortOriginal.bsv {} $rtsflags
 # Confirm that the test failed in the way we expect
 find_n_strings [make_bsc_vcomp_output_name VsortOriginal.bsv] "Heap exhausted" 1
 
-compile_verilog_pass VsortWorkaround.bsv "" "+RTS -M256M -Sstderr -RTS"
+compile_verilog_pass_except VsortWorkaround.bsv $is_ghc_9_8 $rtsflags $rtsflags_9_8
 
 # -----

testsuite/config/unix.exp

@@ -446,18 +446,33 @@ proc get_default_bsdir {} {
 }
 
 proc get_bsc_version {} {
-    global bsc
+    global bluetcl
 
-    if {$bsc != 0} then {
-        set helloworld [exec $bsc -v]
-        regexp "version .*" $helloworld version
-        if {![info exists version]} then {
-            #warning "Couldn't determine version of $bsc from `$helloworld'"
-            set version "unknown version"
-        }
-    } else { # this should have been detected
-        warning "Can't find bsc to determine version"
-        set version "unknown version"
+    bluetcl_initialize
+
+    if { [catch "exec echo \"puts \\\[::Bluetcl::version bsc\\\]\" | $bluetcl" version] } {
+        perror "failed to execute bluetcl to get BSC version: $version"
+        exit 1
+    }
+    if { $version == "" } {
+        perror "BSC version is empty"
+        exit 1
+    }
+    return $version
+}
+
+proc get_ghc_version {} {
+    global bluetcl
+
+    bluetcl_initialize
+
+    if { [catch "exec echo \"puts \\\[::Bluetcl::version ghc\\\]\" | $bluetcl" version] } {
+        perror "failed to execute bluetcl to get GHC version: $version"
+        exit 1
+    }
+    if { $version == "" } {
+        perror "GHC version is empty"
+        exit 1
     }
     return $version
 }
@@ -3177,6 +3192,12 @@ set_warning_threshold 0
 set bsdir [get_bsdir]
 verbose -log "Bluespec dir: $bsdir" 1
 
+set bsc_version [get_bsc_version]
+verbose -log "Bluespec version: $bsc_version" 1
+
+set ghc_version [get_ghc_version]
+verbose -log "Bluespec tools compiled with GHC version: $ghc_version" 1
+
 get_test_options
 verbose -log "Do verilog backend tests is $vtest" 1
 verbose -log "Do c backend tests is $ctest" 1
@@ -3235,6 +3256,8 @@ proc bsc_initialize {} {
     global bsc_initialized
     global env
     global bsc
+    global bsc_version
+    global ghc_version
     global bsdir
     global showrules
 
@@ -3251,7 +3274,6 @@ proc bsc_initialize {} {
 
         # find bsc and version and bs prelude
         set bsc [which_bsc]
-        set bsc_version [get_bsc_version]
 
         # These functions insist that the binaries be available.
         # Since they are only used for internal tests, we should only insist on
@@ -3275,6 +3297,7 @@ proc bsc_initialize {} {
         }
 
         verbose -log "Using $bsc ($bsc_version) for tests." 1
+        verbose -log "BSC was compiled with GHC version $ghc_version." 1
         verbose -log "Compiler options: $::env(BSC_OPTIONS)" 1
         if [do_internal_checks] {
             verbose -log "Path to dumpbo: $dumpbo" 1