BSV: Pretty-print module return types when possible

The BSV pretty-printer would print a function like this:

```
module [Module] helloWorld#(Module#(Empty) m)(Empty);
  let e <- m;
endmodule
```

Without the `[Module]` bit, resulting in a function declaration that wouldn't
typecheck. This patch makes a best-effort attempt to pretty-print this bit
whenever possible. More specifically:

* We check if the return type of a function is equal to `M ty`, where `M` is a
  type constructor like `Module`. If so, pretty-print `[M]`.
* Otherwise, check if the return type is equal to `m ty`, where `m` is a type
  variable with a corresponding `IsModule#(m, c)` constraint. If so,
  pretty-print `[m]`.

  The `findModId` function is responsible for finding type variables like `m`.
  While investigating this issue, I noticed a bug in which `findModId` would
  drop the `IsModule#(m, c)` constraint in which `m` appears, which would cause
  the constraint not to be pretty-printed. I've fixed this bug as part of this
  patch.

Fixes B-Lang-org#663.

src/comp/CVPrint.hs

@@ -50,6 +50,7 @@ module CVPrint (
 import Prelude hiding ((<>))
 #endif
 
+import Control.Applicative((<|>))
 import Data.Char(toLower)
 import Data.List(genericReplicate)
 import Lex(isIdChar)
@@ -152,17 +153,30 @@ p2defs :: PDetail -> CDefn -> CDefn -> Doc
 p2defs d (CPragma (Pproperties _ props))
          (CValueSign df2@(CDef i qt@(CQType ps ty) cs@[CClause cps [] cexp])) | all isVar cps =
       let (ys, x) = getArrows ty
-          ity = case x of (TAp (TCon _) y) -> y;
-                          (TAp (TVar _) y) -> y;
-                          z -> z
+          -- mModTC will be `Just modTC` if the return type is an application of
+          -- a type constructor (e.g., `Module`) to some type, where modTC is
+          -- the type constructor. Otherwise, mModTC will be Nothing.
+          (mModTC, ity) = case x of
+                            TAp (TCon modTC) y -> (Just modTC, y)
+                            TAp (TVar _) y -> (Nothing, y)
+                            z -> (Nothing, z)
           f [] = empty
           f xs = t"#(" <>
                  sepList (zipWith (\ x c -> -- t"parameter" <+>
                                             pvPrint d 0 x <> t"" <+> pvPrint d 10 c)
                                   xs cps)
                  (t",") <> t")"
           (mId,ps') = findModId ps
-          line1 = t"module" <+> pvpId d i <> f ys <> t"(" <> pvPrint d 0 ity <> t")"
+          -- Check if we need to print `[<module-ty>]` after the `module`
+          -- keyword. This can happen if the return type is an application of a
+          -- type constructor (e.g., `Module`) to some type, or if the return
+          -- type is an application of a type variable with a corresponding
+          -- IsModule constraint. If one of these conditions hold, then mPPMod
+          -- will be `Just <pretty-printed-module>`. Otherwise, mPPMod will be
+          -- Nothing.
+          mPPMod = fmap (pvPrint d 0) mModTC <|> fmap (pvPrint d 0) mId
+          line1 = t"module" <+> maybe empty brackets mPPMod
+                            <+> pvpId d i <> f ys <> t"(" <> pvPrint d 0 ity <> t")"
        in
         if isModule mId x then
          (pProps d props $+$
@@ -976,12 +990,14 @@ ppBody d isMod (Cletrec ds e) =
 ppBody d True e = (pparen True (pp d e) <> t";")
 ppBody d _ e = (t"  return" <+> pparen True (pvPrint d 1 e) <> t";")
 
+-- Search for a CPred of the form IsModule#(m, c) in the list of CPreds `ps`. If
+-- one is found, return (Just m, ps). Otherwise, return (Nothing, []).
 findModId :: [CPred] -> (Maybe Id, [CPred])
 findModId [] = (Nothing,[])
 findModId (p:ps) =
    case p of
      (CPred (CTypeclass isM) [TVar (TyVar iM _ _), _]) | getIdBaseString isM == getIdBaseString idIsModule
-       -> (Just iM,ps)
+       -> (Just iM,p:ps)
      _ -> let (i,ps') = findModId ps in (i,p:ps')
 
 ppValueSignRest :: PDetail -> Doc -> [CPred] -> Bool -> Bool -> Doc -> CExpr -> String -> Doc

testsuite/bsc.syntax/bsv05_parse_pretty/.gitignore

@@ -4,6 +4,7 @@ EmptyRule.bsv-pretty-out.bsv
 Map.bsv-pretty-out.bsv
 MethodCalledMethodI.bsv-pretty-out.bsv
 MethodCalledMethodII.bsv-pretty-out.bsv
+ModuleArgument.bsv-pretty-out.bsv
 MethodReturn.bsv-pretty-out.bsv
 PopCount0.bsv-pretty-out.bsv
 TypedefStruct.bsv-pretty-out.bsv

testsuite/bsc.syntax/bsv05_parse_pretty/ModuleArgument.bsv

@@ -0,0 +1,12 @@
+package ModuleArgument;
+
+module [Module] helloWorld#(Module#(Empty) mod)(Empty);
+  let e <- mod;
+endmodule
+
+module [m] fooBar#(m#(Empty) mod)(Empty)
+  provisos (IsModule#(m, c));
+  let e <- mod;
+endmodule
+
+endpackage

testsuite/bsc.syntax/bsv05_parse_pretty/bsv05-parse-pretty.exp

@@ -11,7 +11,7 @@ proc bsc_compile_prettyprint_parse { source { options "" } } {
 }
 
 proc compile_ppp_pass { source {options ""} } {
-    incr_stat "compile_ppp_pass" 
+    incr_stat "compile_ppp_pass"
     if [bsc_compile_prettyprint_parse $source $options] {
         pass "`$source' compiles, pretty-prints, and compiles again"
     } else {
@@ -54,3 +54,6 @@ compile_ppp_pass PopCount0.bsv
 
 # Map (function arguments)
 compile_ppp_pass Map.bsv
+
+# a function with a Module as an argument (regression test for #663)
+compile_ppp_pass ModuleArgument.bsv