content: {-# LANGUAGE CPP #-}
  module CVPrint (
          CPackage(..),
          CSignature(..),
          CExpr(..),
          CType,
          TyVar(..),
          TyCon(..),
          Kind(..),
          CImport(..),
          CQual(..),
          CClause(..),
          CPat(..),
          Literal(..),
          Type(..),
          TISort(..),
          CQType(..),
          CDef(..),
          CExport(..),
          CRule(..),
          CDefn(..),
          CDefl(..),
          CFunDeps,
          CPred(..),
          CFields,
          CStmt(..),
          IdK(..),
          CLiteral(..),
          CMStmt(..),
          COp(..),
          CPOp(..),
          CFixity(..),
          leftCon,
          anyExpr,
          noType,
          iKName,
          impName,
          tMkTuple,
          mkTuple, pMkTuple,
          pvPreds,
          getName,
          getLName,
          isTDef,
          getNK,
          HasPosition(..),
          StructSubType(..),
          pvpId, pvParameterTypes) where
  
  #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 804)
  import Prelude hiding ((<>))
  #endif
  
  import Data.Char(toLower)
  import Data.List(genericReplicate)
  import Lex(isIdChar)
  import PPrint
  import PVPrint
  import ErrorUtil
  import Position(Position, noPosition)
  import Id
  import IdPrint
  import PreStrings (fsAcute)
  import PreIds(idPrimUnit, idPrimPair, idIsModule,
                idAction, idActionValue, idPrimSelectFn, id_read)
  import CType
  import VModInfo
  import SchedInfo
  import Pragma
  import CSyntax
  import CSyntaxUtil
  import IntLit
  import IntegerUtil(integerFormat)
  import Util(itos, quote, log2, fromJustOrErr, unconsOrErr)
  
  --------
  
  pp :: (PVPrint a) => PDetail -> a -> Doc
  pp d x = pvPrint d 0 x
  
  t :: String -> Doc
  t s = text s
  
  --
  
  -- Pretty printing
  
  -- XXX excluded identifiers are commented out because BSV does not support them (yet)
  pvpExports :: PDetail -> Either [CExport] [CExport] -> [Doc]
  pvpExports d (Right []) = []
  pvpExports d (Right excludes) = [ text "/* Do not export (unsupported)" ] ++ map (pp d) excludes ++ [ text "*/" ]
  pvpExports d (Left exports) = map (pp d) exports
  
  instance PVPrint CPackage where
      pvPrint d _ (CPackage i exps imps fixs def includes) =
          (t"package" <+> pp d i <> t";") $+$ empty $+$
          pBlockNT d 0 True (pvpExports d exps ++ map (pp d) imps ++ map (pp d) fixs ++ pdefs d def ++ map (pp d) includes) (t"\n") $+$
          (t"endpackage:" <+> pp d i)
  
  pdefs :: PDetail -> [CDefn] -> [Doc]
  pdefs _ [] = []
  pdefs d (df1@(CPragma (Pproperties i1 props)):df2@(CValueSign (CDef i2 _ _)):rest)
      | i1==i2 =
    (p2defs d df1 df2):(pdefs d rest)
  pdefs d dfs@((CPragma (Pnoinline [i1])):(CValueSign (CDef i2 _ _)):_)
      | i1==i2 =
    (t"(* noinline *)") : (pdefs d $ tail dfs)
  pdefs d (df:dfs) = (pp d df):(pdefs d dfs)
  
  instance PVPrint CExport where
      pvPrint d p (CExpVar i) = t"export" <+> pvpId d i <> t ";"
      pvPrint d p (CExpCon i) = t"export" <+> pvpId d i <> t ";"
      pvPrint d p (CExpConAll i) = t"export" <+> pvpId d i <> t"(..)" <> t";"
      pvPrint d p (CExpPkg i) = t"export" <+> pvpId d i <> t"::*" <> t";"
  
  instance PVPrint CImport where
      pvPrint d p (CImpId q i) = t"import" <+> pvpId d i <> t "::*" <> t";" <+> ppQualified q
      pvPrint d p (CImpSign _ q (CSignature i _ _ _)) = t"import" <+> pvpId d i <> t "::*" <+> t "...;" <+> ppQualified q
  
  instance PVPrint CInclude where
      pvPrint d p (CInclude i) = t"`include" <+> (doubleQuotes $ t i)
  
  ppQualified :: Bool -> Doc
  ppQualified True = text "/* qualified */"
  ppQualified False = empty
  
  instance PVPrint CSignature where
      pvPrint d _ (CSignature i imps fixs def) =
          (t"signature" <+> pp d i <+> t "where {") $+$
          pBlock d 0 True (map pi imps ++ map (pp d) fixs ++ map (pp d) def) (t";") (t"}")
        where pi i = t"include" <+> pvpId d i
  
  instance PVPrint CFixity where
      pvPrint d _ (CInfix  p i) = text "`infix"  <+> text (show p) <+> ppInfix d i
      pvPrint d _ (CInfixl p i) = text "`infixl" <+> text (show p) <+> ppInfix d i
      pvPrint d _ (CInfixr p i) = text "`infixr" <+> text (show p) <+> ppInfix d i
  
  pvPreds :: PVPrint a => PDetail -> [a] -> Doc
  pvPreds d [] = empty
  pvPreds d ps = t "  provisos (" <> sepList (map (pvPrint d 0) ps) (t ",") <> t")"
  
  pvParameterTypeVars :: PDetail -> [Id] -> Doc
  pvParameterTypeVars d [] = empty
  pvParameterTypeVars d as =
      t"#(" <> sepList (map (\ y -> t"type" <+> pvPrint d 0 y) as) (t ",") <> t ")"
  
  pvParameterTypes :: PDetail -> [Type] -> Doc
  pvParameterTypes d [] = empty
  pvParameterTypes d ts =
      t"#(" <> sepList (map (\ y -> pvPrint d 0 y) ts) (t ",") <> t ")"
  
  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
            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")"
         in
          if isModule mId x then
           (pProps d props $+$
           (case cexp of
             (Cmodule _ sts) ->
               (pBlockNT d 0 False
                [line1,
                 if ps'==[]
                 then empty
                 else t "  provisos (" <> sepList (map (pvPrint d 0) ps') (t ",") <> t")"] empty)
                <> (t";") $+$
               (pBlock d 2 False (map (pp d) (reorderStmts sts))  empty (t"endmodule:" <+> pp d i))
             e -> (ppValueSignRest d (pvpId d i) ps' True True line1 e "module")))
          else (pProps d props $+$ ppValueSign d i [] qt cs)
  
  p2defs d (CPragma (Pproperties i1 props)) (CValueSign df2@(CDef i2 _ _)) | i1==i2 =
    pProps d props $+$ pvPrint d 0 df2
  
  p2defs d d1 d2 = internalError ("p2defs (" ++ show d1 ++ ")(" ++ show d2 ++ ")")
  
  pProps :: PDetail -> [PProp] -> Doc
  pProps _ [] = empty
  pProps d ps = t"(*" <+> sepList (map (pvPrint d 0) ps) (text ",") <+> text "*)"
  
  instance PVPrint CDefn where
      pvPrint d p (Ctype i [] ty) =
          sep [t"typedef",
                    nest 2 (pp d ty),
                    pp d i <> t";"]
      pvPrint d p (Ctype i as ty) =
          sep [t"typedef",
                    nest 2 (pp d ty) <+> pp d i <+>
                    pvParameterTypeVars d as <> t ";"]
  
      pvPrint d p (Cdata { cd_visible = vis,
                           cd_name = i,
                           cd_type_vars = as,
                           cd_original_summands = cs@(_:_),
                           cd_internal_summands = [],
                           cd_derivings = ds }) =  -- a hack to print original constructors
          sep [sep ((t"data1" <+> pp d i) : map (nest 2 . pvPrint d maxPrec) as) <+>
                       t(if vis then "=" else "=="),
                    nest 2 (ppOSummands d cs)]
  
      pvPrint d p (Cdata { cd_visible = vis,
                           cd_name = i,
                           cd_type_vars = as,
                           cd_internal_summands = cs,
                           cd_derivings = ds }) =
        let typarams = pvParameterTypeVars d as
            ppCon summand = pvPrint d 0 (cis_arg_type summand) <+>
                            pvpId d (getCISName summand) -- XXX print all the names?
            ppIde summand  = pvpId d (getCISName summand) -- XXX print all the names?
            isVoid (CInternalSummand { cis_arg_type = TCon (TyCon unit _ _) }) =
                (unit == idPrimUnit)
            isVoid _ = False
            isEnum = all isVoid
        in
         (if isEnum cs
           then
            t"typedef enum {" $+$
            sepList (map (nest 2 . ppIde) cs) (t",") <> (t"}")
           else
            t"typedef union tagged {" $+$
            pBlock d 4 False (map ppCon cs) (t";") (t"}"))
         <+> pp d i <+> typarams <+> ppDer d ds <> t";"
  
      pvPrint d p (Cstruct vis (SInterface ps) i [] fs ds) =
          ppIfcPrags d (Just ps) $$
          (t"interface" <+>
           pp d i <> t";" <+> if vis then empty else t"/*") $+$
          pBlock d 4 False (map (ppField d (t"method") True) fs) (t";") (t"endinterface:" <+> pp d i) <+> ppDer d ds
      pvPrint d p (Cstruct vis (SInterface ps) i as fs ds) =
          ppIfcPrags d (Just ps) $$
          (t"interface" <+>
           pvPrint d 9 i <+> pvParameterTypeVars d as
           <> t";" <+> (if vis then empty else t"/*")) $+$
          pBlock d 4 False (map (ppField d (t"method") True) fs)(t";") (t"endinterface:" <+> pp d i) <+> (if vis then empty else t"*/") <+> ppDer d ds
  
  
      pvPrint d p (Cstruct vis _ i as fs ds) =
        let typarams = pvParameterTypeVars d as
  --          ppCon (i, ty) = pvPrint d 0 ty <+> pvpId d i
        in
          t"typedef struct" <+> t "{" $+$
          pBlock d 4 False (map (ppField d empty False) fs)(t";") (t"} ") <>
          pp d i <+> typarams <+> ppDer d ds <> t";"
  
  {-        (t"typedef struct" <+>
           pp d i <> t(if vis then ";" else "; /*")) $+$
          pBlock d 4 False (map (ppField d "" False) fs)  (t";") (t"}") <+> ppDer d ds
  -}
  
      pvPrint d p (CValueSign def) = pvPrint d p def
  
      pvPrint d p (Cclass Nothing ps ik is fd ss) =
         ((pBlockNT d 0 False
          [t"typeclass" <+> pp d ik <+> pvParameterTypeVars d is,
           pvpFDs d fd,
           if ps==[]
             then empty
             else t "  provisos (" <> sepList (map (pvPrint d 0) ps) (t",") <> t")"] empty)<> (t";")) $+$
         pBlockNT d 4 False (map (\s -> ppField d (t"function") True s <> t";") ss) empty $+$
         t"endtypeclass"
  
      pvPrint d p (Cinstance (CQType ps ty) ds) =
        let (x, ys) = unravel ty
        in
         ((pBlockNT d 0 False
          [t"instance" <+> pvPrint d 9 x <> pvParameterTypes d ys,
           if ps==[]
             then empty
             else t "  provisos (" <> sepList (map (pvPrint d 0) ps) (t",") <> t")"] empty)<> (t";")) $+$
         pBlockNT d 4 False (map (pvPrint d 0) ds) empty $+$
         t"endinstance"
  
      pvPrint d p (Cprimitive i ty) =
          text "primitive" <+> pvpId d i <+> t "::" <+> pp d ty
  
      pvPrint d p (CPragma pr) = pvPrint d p pr
  
      pvPrint d p (CprimType (IdKind i k)) =
          t"primitive type" <+> pp d i <+> t "::" <+> pp d k
  
      pvPrint d p (Cforeign i ty oname opnames) =
          text "foreign" <+> pvpId d i <+> t "::"
                  <+> pp d ty
                  <> (case oname of Nothing -> empty; Just s -> text (" = " ++ show s))
                  <> (case opnames of
                      Nothing -> empty;
                      Just (is, os) ->
                          t"," <> pparen True (sep (map (text . show) is ++ po os)))
        where po [o] = [text ",", text (show o)]
              po os = [t"(" <> sepList (map (text . show) os) (t",") <> t ")"]
  
  {-
      -- XXX These are not in BSV
      pvPrint d p (CIinstance i qt) =
          t"instance" <+> pvpId d i <> t"" <+> pvPrint d 0 qt
      pvPrint d p (CItype i as usePositions) =
          sep (t"type" <+> pp d i : map (nest 2 . pvPrint d maxPrec) as)
  
      pvPrint d p (Cclass (Just _) ps ik is fd ss) =
  
      pvPrint d p (CIclass incoh ps ik is fds usePositions) =
          let pdoc = if ps==[]
                     then empty
                     else t "  provisos (" <>
                          sepList (map (pvPrint d 0) ps) (t",") <> t")"
          in  (pBlockNT d 0 False
                [t"class" <+> pp d ik <+> pvParameterTypeVars d is,
                 pvpFDs d fd, pdoc] empty)
              <> (t";")
      pvPrint d p (CIValueSign i ty) = pvpId d i <+> t "::" <+> pp d ty
  -}
      pvPrint d p x = internalError ("pvPrint CDefn bad: " ++ show x)
  
  isVar :: CPat -> Bool
  isVar (CPVar _) = True
  isVar _         = False
  
  getCPVString :: CPat -> String
  getCPVString (CPVar i) = getBSVIdString i
  getCPVString x = internalError ("getCPVString bad: " ++ show x)
  
  likeModule :: Id -> Bool
  likeModule i =
    let s = getIdBaseString i
        ln = length s
        end = drop (ln-6) s
    in if ln > 5 then end=="Module" else False
  
  isModule :: Maybe Id -> Type -> Bool
  isModule _ (TAp (TCon (TyCon i _ _)) _) =  likeModule i
  isModule (Just i') (TAp (TVar (TyVar i _ _)) _) =  i == i'
  isModule _ _          =  False
  
  newIdsn :: Integer -> [String]
  newIdsn n = ("x" ++ itos n):(newIdsn (n+1))
  
  newIds :: [Doc]
  newIds = map t (newIdsn 1)
  
  isFn :: Type -> Bool
  isFn (TAp (TAp (TCon arr) _) _) = isTConArrow arr
  isFn _         = False
  
  ppUntypedId :: PDetail -> Doc -> [Doc] -> Doc
  ppUntypedId d i ids =
    (t"function") <+> i <> t"(" <> sepList ids (text ",") <> t")"
  
  ppTypedId :: PDetail -> Maybe Id -> Doc -> Type -> [Doc] -> Doc
  ppTypedId d mi i y = ppLabelledTypedId d (if isFn y then t"function" else empty) mi (isFn y) i y
  
  ppLabelledTypedId :: PDetail -> Doc -> Maybe Id -> Bool -> Doc -> Type -> [Doc] -> Doc
  ppLabelledTypedId d intro modId isFnlike i ty ids =
    let (ys, x) = getArrows ty
        ity = case x of (TAp (TCon _) y) -> y;
                        z -> z
        g [] = empty
        g xs = t"#(" <>  sepList xs (t",") <> t")"
        f [] = intro <+> pp d x <+> i <> (if isFnlike then t"()" else empty)
        f xs = if isModule modId x
                then t"module" <+> i <> g xs <> t"(" <> pvPrint d 0 ity <> t")"
                else intro <+> pvPrint d 9 x <+> i <> t"(" <> sepList xs (text ",") <> t")"
        zs = zipWith (\ y i -> ppTypedId d Nothing i y newIds) ys ids
    in f zs
  
  ppField :: PDetail -> Doc -> Bool -> CField -> Doc
  ppField detail intro isFn field =
    let CQType f_provisos f_type = cf_type field
        field_arg_ids = case (cf_pragmas field) of
                        Just f_prags -> map (pvpId detail) argids
                            where argids = filterIArgNames f_prags
                        Nothing -> newIds
        pragmas = ppIfcPrags detail (cf_pragmas field)
        types = ppLabelledTypedId detail intro Nothing isFn
                (pvpId detail (cf_name field)) f_type field_arg_ids
        provisos | null f_provisos = empty
                 | otherwise =
                     t "provisos (" <>
                     sepList (map (pvPrint detail 0) f_provisos) (t ",") <>
                     t ")"
        -- XXX there is not BSV syntax for field defaults
    in  pragmas $+$ types $+$ provisos
  
  ppIfcPrags :: PDetail -> Maybe [IfcPragma] -> Doc
  ppIfcPrags _ Nothing = empty
  ppIfcPrags _ (Just []) = empty
  ppIfcPrags d (Just xs) = if (null filtered) then empty else prt
      where filtered = (filterPrintIfcArgs xs)
            prt = t"(*" <+> sep (punctuate comma (map (pvPrint d 0) filtered )) <+> t"*)"
  
  pvpFDs :: PDetail -> CFunDeps -> Doc
  pvpFDs d [] = empty
  pvpFDs d fd = text "  dependencies" <+> sepList (map (pvpFD d) fd) (t",")
  
  pvpFD :: PDetail -> ([Id], [Id]) -> Doc
  pvpFD d (as,rs) = sep (map (pvpId d) as) <+> t "->" <+> sep (map (pvpId d) rs)
  
  {-
  ppFDs d [] = t""
  ppFDs d fd = text " |" <+> sepList (map (ppFD d) fd) (t",")
  ppFD d (as,rs) = sep (map (pvpId d) as) <+> t "->" <+> sep (map (pvpId d) rs)
  -}
  
  --ppPreds d [] x = x
  --ppPreds d preds x = t "(" <> sepList (map (pvPrint d 0) preds) (t ",") <> t ") =>" <+> x
  
  instance PVPrint IdK where
      pvPrint d p (IdK i) = pvPrint d p i
      pvPrint d p (IdKind i k) = pparen True $ pp d i <+> t "::" <+> pp d k
      pvPrint d p (IdPKind i pk) = pparen True $ pp d i <+> t "::" <+> pp d pk
  
  pBlock :: p -> Int -> Bool -> [Doc] -> Doc -> Doc -> Doc
  pBlock d n _ [] _ ket = ket
  pBlock d n nl xs sep ket =
          (t (replicate n ' ') <>
          foldr1 ($+$) (map (\ x -> x <> if nl then sep $+$ empty else sep) xs))  $+$
          ket
  
  pBlockNT :: PDetail -> Int -> Bool -> [Doc] -> Doc -> Doc
  pBlockNT _ n _ [] _ = empty
  pBlockNT _ n nl xs sep =
          (t (replicate n ' ') <>
          foldr1 ($+$) (map (\ x -> x <> if nl then sep $+$ empty else sep) xs))
  
  ppDer :: PDetail -> [CTypeclass] -> Doc
  ppDer d [] = empty
  ppDer d is = text "deriving (" <> sepList (map (pvPrint d 0) is) (text ",") <> text ")"
  
  --isTerminated (Caction _ _) = True
  --isTerminated (Cdo _ _) = True
  --isTerminated _ = False
  
  ppMBody :: PDetail -> CExpr -> Doc
  ppMBody d e@(Cdo _ _) = pp d e
  ppMBody d e@(Caction _ _) = pp d e
  ppMBody d e = ppBody d False e
  
  ppMClause :: PDetail -> [Doc] -> CClause -> Doc -> Doc
  ppMClause d [x] (CClause ps [] e) mIf | all isVar ps =
         sep [t"method" <+> x <> t"(" <>
                     sepList (map (pvPrint d maxPrec) ps) (t",") <> t")" <+> mIf <+> t";",
              nest 2 (ppMBody d e)]
  ppMClause d xs (CClause ps mqs e) mIf =
          sep [t"// APPROXIMATELY:",
                    t"method" <+> sep (xs ++ map (pvPrint d maxPrec) ps) <+> ppQuals d mqs <+> mIf <+> t "=",
                    nest 4 (pp d e)]
  
  ppM :: PDetail -> CDefl -> Doc
  ppM d (CLValue i [CClause _ _ (Cinterface _ (Just i1) subIfc)] []) =
      sep ((t"interface"<+>pvpId d i1 <+> pvpId d i <>t";"):
           (map (\ si -> nest 2 (ppM d si)) subIfc) ++
           [t"endinterface:"<+> pvpId d i])
  ppM d (CLValue i [cl] me) =
          (ppMClause d [pvpId d i] cl (optIf d me))
          $+$ t"endmethod:" <+> pvpId d i
  ppM d (CLValueSign (CDef i _ [cl]) me) =
          (ppMClause d [pvpId d i] cl (optIf d me))
          $+$ t"endmethod:" <+> pvpId d i
  ppM d def = pvPrint d 0 def
  
  optIf :: PDetail -> [CQual] -> Doc
  optIf _ [] = empty
  optIf d qs = t"if (" <> sepList (map (pp d) qs) (t" && ") <> t")"
  
  ppRules :: PDetail -> Int -> [CSchedulePragma] -> [CRule] -> Bool -> Doc
  ppRules d p [] rs naked =
    let trs = pBlockNT d 0 False (map (pp d) rs)  empty
    in if naked then trs else (t"rules" $+$ nest 2 trs $+$ t"endrules")
  
  ppRules d p ps rs _ =
    let trs = pBlockNT d 0 False (map (pp d) rs)  empty
    in pPrint d p ps $+$ (t"rules" $+$ nest 2 trs $+$ t"endrules")
  
  ppActions :: PDetail -> CStmts -> Bool -> Doc
  ppActions d ss naked =
    let tas = pBlockNT d 0 False (map (pvPrint d 0) ss)  empty
    in if naked then tas else (t"action" $+$ nest 2 tas $+$ t"endaction")
  
  -- findSpecialOps seps a list of operands and operators into two,
  -- breaking it at the first "$" operator.  It also gathers operations with
  -- operators which are identifiers (and therefore, being user-defined, of
  -- highest precedence) into an amalgamated structure of CBinOp's.
  
  findSpecialOps :: [COp] -> ([COp],[COp],Id)
  findSpecialOps [] = ([],[],undefined)
  findSpecialOps [x] = ([x],[],undefined)
  findSpecialOps [x,y] = internalError "bad list of operators and operands"
  findSpecialOps ((CRand e1):(CRator _ i):(CRand e2):xs) |
                              (isIdChar (head (getBSVIdString i)) || (getBSVIdString i =="++")) =
    let w = CBinOp e1 i e2
    in findSpecialOps ((CRand w):xs)
  findSpecialOps (x:(y@(CRator _ i)):xs) | (getBSVIdString i) == "$" =
    ([x], xs, i)
  findSpecialOps (x:y:xs) =
    let (zs,ys,i) = findSpecialOps xs
    in (x:y:zs, ys, i)
  
  ppStrUpd :: PDetail -> CExpr -> [(Id, CExpr)] -> Doc
  ppStrUpd d e ies =
    t"(begin let new_struct_ = " <> pvPrint d 0 e <> t";" $+$
    sepList(map (\ (i,e)-> t"  new_struct_."<>pvpId d i<+>t"="<+>pvPrint d 0 e<>t";")ies)empty $+$
    t"new_struct_; end)"
  
  instance PVPrint CExpr where
      pvPrint d p (CLam i e) = ppQuant "\\ "  d p i e
      pvPrint d p (CLamT i ty e) = ppQuant "\\ "  d p i e
      pvPrint d p (Cletrec [] e) = pparen (p > 0) $
          (t"/* empty letseq */" $+$ pp d e)
      --pvPrint d p (Cletrec ds e) = pparen (p > 0) $
      --        (t"let" <+> foldr1 ($+$) (map (pp d) ds)) $+$
      --  (t"in  " <> pp d e)
      pvPrint d p (Cletrec ds e) =
          t "/* letrec */" $+$
          if (p>1) then t"(begin" <+> ppLet <>t";"$+$ t"end)"
                   else if (p==1) then t"begin" <+> ppLet <>t";"$+$ t"end"
                   else ppLet
            where ppLet = ((foldr1 ($+$) (map (pp d) ds)) $+$ pparen True (pp d e))
      pvPrint d p (Cletseq [] e) = pparen (p > 0) $
          (t"let in" <+> pp d e)
      --pvPrint d p (Cletrec ds e) = pparen (p > 0) $
      --        (t"let" <+> foldr1 ($+$) (map (pp d) ds)) $+$
      --  (t"in  " <> pp d e)
      pvPrint d p (Cletseq ds e) =
          if (p>1) then t"(begin" <+> ppLet <>t";"$+$ t"end)"
                   else if (p==1) then t"begin" <+> ppLet <>t";"$+$ t"end"
                   else ppLet
            where ppLet = ((foldr1 ($+$) (map (pp d) ds)) $+$ pparen True (pp d e))
      -- undo ._read desugaring
      pvPrint d p (CSelect e i) | i `qualEq` id_read noPosition = pvPrint d p e
      pvPrint d p (CSelect e i) = pparen (p > (maxPrec+2)) $ pvPrint d (maxPrec+2) e <> t"." <> pvpId d i
  
  --    pvPrint d p (CCon i es) = pparen (p>(maxPrec-1)) $
  --        pvpId d i <> t"{" (sepList (map (pp d) es) (t",") ) <> t"}"
  --    pvPrint d p (CCon i es) =  pvPrint d p (cVApply i es)
      pvPrint d p (CCon i [p2@(CCon i' _)])|
            getIdString i /= "," && getIdString i' == "," =
         pparen (p>(maxPrec-1)) $ (pvpId d i)<+> pparen True (pp d p2)
      pvPrint d p (CCon i [p2@(CBinOp _ i' _)])|
            getIdString i /= "," && getIdString i' == "," =
         pparen (p>(maxPrec-1)) $ (pvpId d i)<+> pparen True (pp d p2)
      pvPrint d p (CCon i []) = pvpId d i
      pvPrint d p (CCon i as) | getIdString i == "," = ppTuple d as
      pvPrint d p (CCon i as) =
       pparen (p>(maxPrec-1)) $
         (pvpId d i) <+> pparen True (sepList(map (pvPrint d 1) as) (t","))
  
      pvPrint d p (Ccase pos e arms) =
          if (p>1) then t"(begin" <+> ppCase d e arms $+$ t"end)"
                   else if (p==1) then t"begin" <+> ppCase d e arms $+$ t"end"
                   else ppCase d e arms
      pvPrint d p (CAny {}) = text "?"
      pvPrint d p (CVar i) = pvpId d i
      pvPrint d p (CStruct _ tyc []) | tyc == idPrimUnit = text "()"
      pvPrint d p (CStruct mb tyc ies) =
        pparen (p > 0) $
            mtagged <+> pvPrint d (maxPrec+1) tyc <+> t "{" <+> sepList (map f ies ) (t",") <> t"}"
          where f (i, e) = pvpId d i <+> t ":" <+> pp d e
                mtagged = case mb of
                            Just False -> text "tagged"
                            _ -> empty
      pvPrint d p (CStructUpd e ies) = ppStrUpd d e ies
  --        sep (pvPrint d (maxPrec-1) e : map (nest 2 . ppApArg) es)
  --      where ppApArg e = pvPrint d maxPrec e
      pvPrint d p (Cwrite pos e v)  = pparen (p > 0) $ pvPrint d (maxPrec+1) e <+> t "<=" <+> pvPrint d p v
      pvPrint d p (CApply (CVar i) [pos, v, idx]) | i == idPrimSelectFn noPosition =
        pvPrint d p (CSub (getPosition pos) v idx)
      pvPrint d p (CApply (CVar i) [CHasType (CVar _) (CQType [] (TAp (TCon _) ty))])
          | getIdBaseString i == "primValueOf"
        = pparen (p>(maxPrec-1)) $ t"valueOf" <> pparen True (pp d ty)
  
      pvPrint d p (CApply (CVar i)
                   [CHasType the_lit@(CLit (CLiteral _
                                            ( LInt (IntLit w b v))))
                    (CQType [] (TAp (TCon (TyCon i2 _ _)) (TCon (TyNum nTy _))))])
            | getIdBaseString i == "unpack" && getIdBaseString i2 == "Bit"
        = (t $ show nTy) <> (pp d the_lit)
  
      pvPrint d p (CApply e@(CVar _) es) = pparen (p>(maxPrec-1)) $
          pp d e <> pparen True (sepList (map (pvPrint d 1) es) (t",") )
      pvPrint d p (CApply e es) = pparen (p>(maxPrec-1)) $
          pparen True (pp d e) <> pparen True (sepList (map (pvPrint d 1) es) (t",") )
      pvPrint d p (CTaskApply e es) = pparen (p>(maxPrec-1)) $
          pp d e <> pparen True (sepList (map (pvPrint d 1) es) (t",") )
      pvPrint d p (CTaskApplyT e tt es) = pparen (p>(maxPrec-1)) $
          pp d e <> pparen True (sepList (map (pvPrint d 1) es) (t",") )
      pvPrint d p (CLit l) = pvPrint d p l
      pvPrint d p (CBinOp e1 i e2) = ppOp d p i e1 e2
      pvPrint d p (CHasType e t) = pparen (p>0) $
          pvPrint d maxPrec t <> text "'" <> (pparen True $ pp d e)
      pvPrint d p (Cif pos c tr e) = pparen (p>0) (sep [pvPrint d 1 c <+> t "?", nest 4 (pvPrint d 1 tr), t":", nest 4 (pvPrint d 1 e)])
      pvPrint d p (CSub pos e s) = pvPrint d maxPrec e <> t"[" <> pp d s <> t"]"
      pvPrint d p (CSub2 e h l) = pvPrint d maxPrec e <> t"[" <> pp d h <> t":" <> pp d l <> t"]"
      -- XXX not valid BSV
      pvPrint d p (CSubUpdate pos e_vec (e_h, e_l) e_rhs) = pvPrint d p (CSub2 e_vec e_h e_l) <> t"=" <> pvPrint d p e_rhs
      pvPrint d p (Cmodule _ is) =
       t"module " $+$ pBlock d 2 False (map (pp d) (reorderStmts is)) empty (t"endmodule")
  --  pvPrint d p (Cinterface Nothing ds) =
  --        (t"interface {" $+$ pBlock d 2 False (map (pp d) ds) (t";") (t"}"))
      pvPrint d p (Cinterface pos Nothing ds) =
          (pBlockNT d 0 False (map (ppM d) ds) empty)
  --    pvPrint d p (CLValueSign def me) = optWhen d me $ pvPrint d p def
      pvPrint d p (Cinterface pos (Just i) ds) =
          (t"interface" <+> pp d i) $+$
          (pBlock d 2 False (map (ppM d) ds)  empty (t"endinterface:" <+> pp d i))
      pvPrint d p (CmoduleVerilog m ui c r ses fs sch ps) =
          sep [
            t"(unexpected) module verilog" <+> pp d m <> t";",
            (if c==(ClockInfo [][][][]) then empty else pPrint d p c),
            (if r==(ResetInfo [][]) then empty else pPrint d p r),
            nest 4 (if null ses then empty else pparen True (sepList (map ppA ses) (t","))),
            nest 4 (t"{" $+$ pBlock d 2 False (map (ppVeriMethod d Nothing) fs) (t";") (t"}")),
            nest 4 (pp d sch),
            nest 4 (pp d ps) ]
            where ppA (s, e) = text "(" <> text (show s) <> text "," <+> pp d e <> text ")"
      pvPrint d p (CForeignFuncC i wrap_ty) =
          t"(unexpected) ForeignFuncC" <+> pp d i
      pvPrint d p (Cdo _ ss) = pparen (p>0) $ t "actionvalue" $+$ nest 2 (ppActions d ss True) $+$ t "endactionvalue"
      pvPrint d p (Caction _ ss) = pparen (p>0) $ ppActions d ss False
      pvPrint d p (Crules ps rs) = ppRules d p ps rs False
      ----
      pvPrint d p (COper []) = empty
      pvPrint d p (COper [(CRand p1)]) = pvPrint d p p1
      pvPrint d p (COper [(CRand p1), (CRator _ i), (CRand p2)])
        = ppOp d p i p1 p2
      pvPrint d p (COper ops) =
        let (ys,zs,i) = findSpecialOps ops
        in if (null zs) then pparen (p > maxPrec-1) (sep (map (pvPrint d (maxPrec-1)) ys))
           else ppOp d p i (COper ys) (COper zs)
      ----
      pvPrint d p (CCon1 _ i e) = pvPrint d p (CCon i [e])
      pvPrint d p (CSelectTT _ e i) = pvPrint d p (CSelect e i)
      ----
      pvPrint d p (CCon0 _ i) = pvpId d i
      ----
      pvPrint d p (CConT _ i es) = pvPrint d p (CCon i es)
      pvPrint d p (CStructT ty ies) = pvPrint d p (CStruct (Just True) tyc ies)
          where tyc = fromJustOrErr "pvPrint CStructT" (leftCon ty)
      pvPrint d p (CSelectT _ i) = text "." <> pvpId d i
      pvPrint d p (CLitT _ l) = pvPrint d p l
      pvPrint d p (CAnyT pos uk t) = text "?"
      pvPrint d p (CmoduleVerilogT _ m ui c r ses fs sch ps) =
          pvPrint d p (CmoduleVerilog m ui c r ses fs sch ps)
      pvPrint d p (CForeignFuncCT i prim_ty) =
          t"(unexpected) ForeignFuncC" <+> pp d i
      pvPrint d p (CTApply e ts) = pparen (p>(maxPrec-1)) $
          sep (pvPrint d (maxPrec-1) e : map (nest 2 . ppApArg) ts)
          where ppApArg ty = t"\183" <> pvPrint d maxPrec ty
      pvPrint d p (Cattributes pps) =
          text "Attributes" <> pparen True (pvPrint d 0 (map snd pps))
  --    pvPrint d p x = internalError ("pvPrint CExpr bad: " ++ show x)
  
  instance PVPrint CLiteral where
      pvPrint d p (CLiteral _ l) = pvPrint d p l
  
  isInstantiating :: CExpr -> Bool
  isInstantiating (CApply (CVar i) es)  | take 2 (getIdBaseString i) == "mk" = True
  isInstantiating (CVar i)  | take 2 (getIdBaseString i) == "mk" = True
  isInstantiating _ = False
  
  separgs :: PDetail -> CExpr -> (Doc, Doc)
  separgs d (CApply e es) = (pp d e,
          t"#(" <> sepList (map (pp d) es) (t",") <>t")" )
  separgs d e = (pp d e, empty)
  
  instance PVPrint CStmt where
      pvPrint d p (CSBindT (CPVar i) maybeInstName pprops (CQType _ ty) e) =
        let -- (tx, tys) = unravel ty
            (ep, argsp) = separgs d e
            instName = case maybeInstName of
                       Just name -> pp d name
                       Nothing -> text "the_" <> pp d i
            isInst = isInstantiating e
        in
          foldr ($+$) empty (map (pvpPProp d . snd) pprops) $+$
          (pp d ty <> t"" <+> pp d i <> t(if isInst then "();" else ";")) $+$
          (if isInst
            then ep <> {- f tys <> -} argsp <+> instName <> t"(" <> pp d i <> t");"
            else pp d i <+> t "<-" <+> pp d e <> t";")
  
      pvPrint d p (CSBindT pat _ pprops ty e) =
          foldr ($+$) empty $
              (map (pvpPProp d . snd) pprops) ++
              [pp d ty <+> pp d pat <+> t "<-" <+> pp d e <> t";"]
      pvPrint d p (CSBind pat _ pprops e) =
          foldr ($+$) empty $
              (map (pvpPProp d . snd) pprops) ++
              [t"let" <+> pp d pat <+> t "<-" <+> pp d e <> t";"]
      pvPrint d p (CSletrec ds) = foldr1 ($+$) (map (pp d) ds)
      pvPrint d p (CSletseq ds) = foldr1 ($+$) (map (pp d) ds)
      pvPrint d p (CSExpr _ e@(Ccase _ _ _)) = pvPrint d p e
      pvPrint d p (CSExpr _ e) = pvPrint d (p+2) e <> t";"
  
  isIfce :: CMStmt -> Bool
  isIfce (CMinterface _) = True
  isIfce (CMTupleInterface _ _) = True
  isIfce _ = False
  
  reorderStmts :: [CMStmt] -> [CMStmt]
  reorderStmts stmts = [x | x <- stmts, not(isIfce x)] ++ [x | x <- stmts, isIfce x]
  
  instance PVPrint CMStmt where
      pvPrint d p (CMStmt (CSExpr _ (CApply (CVar i) [Crules ps rs])))
          | getIdBaseString i == "addRules"
        = ppRules d p ps rs True
      pvPrint d p (CMStmt (CSExpr _ (COper [CRand (CVar i), CRator _ i', CRand (Crules ps rs)])))
          | getIdBaseString i == "addRules" && getIdBaseString i' == "$"
        = ppRules d p ps rs True
      pvPrint d p (CMStmt s) = pvPrint d p s
      pvPrint d p (CMrules (Crules ps rs)) = ppRules d p ps rs True
      pvPrint d p (CMrules e) = pvPrint d p e
      pvPrint d p (CMinterface (Cinterface pos (Just _) e )) = pvPrint d p (Cinterface pos Nothing e)
      pvPrint d p (CMinterface e) = pvPrint d p e
      pvPrint d p (CMTupleInterface _ es) =
          let n = length es
          in t ("return(tuple"++show n++"(") <>
              sepList (map (pvPrint d p) es) (text ",") <> text "));"
  
  instance PVPrint COp where
      pvPrint d pn (CRand p) = pvPrint d pn p
      pvPrint d _ (CRator _ i) = ppInfix d i
  
  ppQuant :: String -> PDetail -> Int -> Either Position Id -> CExpr -> Doc
  ppQuant s d p ei e =
      let ppI (Left _) = text ".*"
          ppI (Right i) = pvPrint d 0 i
      in  pparen (p>0) (sep [t s <> ppI ei <+> t "->", pp d e])
  
  ppCaseBody :: PDetail -> CExpr -> Doc
  ppCaseBody d e@(CApply (CVar i) _) | getIdBaseString i == "return"  = pparen False (pp d e)
  ppCaseBody d e = pparen True (pvPrint d 1 e)
  
  ppCase :: PDetail -> CExpr -> [CCaseArm] -> Doc
  ppCase detail scrutinee arms =
      (t"case" <+> pparen True (pvPrint detail 1 scrutinee) <+> t "matches") $+$
      pBlock detail 0 False (map ppArm arms) empty (t"endcase")
    where ppArm arm =
           sep [ppPat (cca_pattern arm) <+>
                ppQuals detail (cca_filters arm) <+> t ": ",
                nest 2 (ppCaseBody detail (cca_consequent arm))] <> t";"
          ppPat pt = pp detail pt
  
  findPs :: CExpr -> [CExpr]
  findPs (CBinOp e1 i e2) | getBSVIdString i == "," = e1:(findPs e2)
  findPs e = [e]
  
  ppTuple :: PDetail -> [CExpr] -> Doc
  ppTuple d es =
    let n = length es
    in t("tuple" ++ show n) <> pparen True (sepList (map (pvPrint d 1) es) (t","))
  
  ppOp :: PDetail -> Int -> Id -> CExpr -> CExpr -> Doc
  ppOp d pd i p1 p2 =
    let rand1 = pvPrint d 1 p1
        rand2 = pvPrint d 1 p2
        ppr = pparen (pd > 2) -- to distinguish from (_?_:_)
    in
        (case getBSVIdString i of
          "," -> let ps = p1:(findPs p2)
                 in ppTuple d ps
          "$" -> ppr (case p1 of
                      (CApply e es) -> pvPrint d 0 (CApply e (es++[p2]))
                      (CCon i es) -> pvPrint d 0 (CCon i (es++[p2]))
                      _ -> rand1 <> pparen True rand2
                    )
          "++" -> t"{" <> sepList (map (pvPrint d 0) [p1,p2]) (t",") <> t"}"
          "<+" -> ppr(t "preempts" <> pparen True (sep [ rand1 <> t",", rand2]))
          "+>" -> ppr(t "preempted" <> pparen True (sep [ rand1 <> t",", rand2]))
          "<->" -> ppr(t "mkConnection" <> pparen True (sep [ rand1 <> t",", rand2]))
  
  
  
  
          s@(c:_) | isIdChar c -> ppr(t s <> pparen True (sep [ rand1 <> t",", rand2]))
          _                    -> ppr(sep [rand1 <> t"" <+> ppInfix d i, rand2])
        )
  
  ppRQuals :: PDetail -> [CQual] -> Doc
  ppRQuals d [] = empty
  ppRQuals d qs = t"(" <> sepList (map (pp d) qs) (t" && ") <> t");"
  
  ppQuals :: PDetail -> [CQual] -> Doc
  ppQuals d [] = empty
  ppQuals d qs = t"&&&" <+> sepList (map (pp d) qs) (t" && ")
  
  ppOSummands :: PDetail -> [COriginalSummand] -> Doc
  ppOSummands d cs = sepList (map (nest 2 . ppOCon) cs) (t"; ")
    where ppOCon summand =
              sep (pvpId d (getCOSName summand) -- XXX print all the names?
                   : map (pvPrint d maxPrec) (cos_arg_types summand))
  
  --ppSummands d cs = sepList (map (nest 2 . ppCon) cs) (t"; ")
  --  where ppCon (i, t) = pvPrint d maxPrec t <> pvpId d i
  
  {-
  ppVeriPort d (s, []) = t s
  ppVeriPort d (s, prs) = t s <> t"{" <> sepList (map (pvPrint d 0) prs) (t",") <> t"}"
  -}
  
  ppVeriArg :: PDetail -> (VArgInfo, CExpr) -> Doc
  ppVeriArg d (Param (VName s), e) = t("parameter " ++ s ++ " = ")<> pvPrint d 0 e
  ppVeriArg d (Port ((VName s), pps) mclk mrst, e) =
      let clk_name = case mclk of
                         Nothing  -> t "no_clock"
                         Just clk -> pvPrint d 0 clk
          rst_name = case mrst of
                         Nothing  -> t "no_reset"
                         Just clk -> pvPrint d 0 clk
      in  t "port" <+> ppPortProps d pps <> t s <+>
          t "clocked_by (" <> clk_name <> t ")" <+>
          t "reset_by (" <> rst_name <> t ")>" <+>
          t "=" <+> pvPrint d 0 e
  ppVeriArg d (ClockArg i, e)  = t"clock " <> pvpId d i <> t" = " <> pvPrint d 0 e
  ppVeriArg d (ResetArg i, e)  = t"reset " <> pvpId d i <> t" = " <> pvPrint d 0 e
  ppVeriArg d (InoutArg (VName s) mclk mrst, e) =
      let clk_name = case mclk of
                         Nothing  -> t "no_clock"
                         Just clk -> pvPrint d 0 clk
          rst_name = case mrst of
                         Nothing  -> t "no_reset"
                         Just clk -> pvPrint d 0 clk
      in  t "inout" <+> t s <+>
          t "clocked_by (" <> clk_name <> t ")" <+>
          t "reset_by (" <> rst_name <> t ")>" <+>
          t "=" <+> pvPrint d 0 e
  
  ppVeriMethod :: PDetail -> Maybe VPort -> VFieldInfo -> Doc
  ppVeriMethod d _  (Clock i) = t"clock " <> pvpId d i
  ppVeriMethod d _  (Reset i) = t"reset " <> pvpId d i
  ppVeriMethod d _  (Inout i (VName s) mclk mrst) =
    t"ifc_inout" <+> (pvpId d i) <+> t ("(" ++ s ++ ")") <+>
    (case mclk of
       Nothing -> empty
       Just i -> t"clocked_by (" <> pvpId d i <> t")") <+>
    (case mrst of
       Nothing -> empty
       Just i -> t"reset_by (" <> pvpId d i <> t")")
  ppVeriMethod d mr (Method i mc mreset n pts mo me) =
    let f _ _ Nothing = empty
        f before after (Just (VName vn, prs)) =
           (case prs of
            [] -> empty
            xs -> t"(*" <+> sepList (map (pvPrint d 0) xs) (t ",") <> t" *) ") <>
           (t (before ++ vn ++ after))
    in
     t"method " <>
     (f "" " " mo) <>
     (pvpId d i <>
     (if n == 1 then empty else (t"[" <> (pp d n) <> t"]")) <>
     (t"(" <> sepList (map (f "" "" . Just) pts) (t",") <> t")") <>
     (f " enable (" ")" me) <>
     (f " ready ("  ")" mr) <>
     (case mc of
       Nothing -> empty
       Just i -> t" clocked_by (" <> pvpId d i <> t")") <>
     (case mreset of
       Nothing -> empty
       Just i -> t" reset_by (" <> pvpId d i <> t")"))
  
  ppPortProps :: PDetail -> [VeriPortProp] -> Doc
  ppPortProps d [] = empty
  ppPortProps d (vp:vpps) =
      text "(* " <> pvPrint d 0 vp <> text " *) " <> ppPortProps d vpps
  
  instance PVPrint CDef where
      pvPrint d p (CDefT i vs ty cs) = ppValueSign d i vs ty cs
  
      -- XXX this seems out of date with the BSV parser
      pvPrint d p (CDef i (CQType ps ty) [CClause cps []
          (CmoduleVerilog m ui c r args meths sch pts)]) | all isVar cps =
        let (ys, x) = getArrows ty
            ity = case x of (TAp (TCon _) y) -> y;
                            z -> z
            s (CLit (CLiteral _ (LString x))) = x
            s x = internalError ("pvPrint CDef not lit: " ++ show x)
            f [] = empty
            f xs = t"#(" <>
                   sepList (zipWith (\ x c -> -- t"parameter" <+>
                                              pvPrint d 0 x <> t"" <+> pvPrint d 10 c)
                                    xs cps)
                   (t",") <> t")"
            pOutMClk Nothing = empty
            pOutMClk (Just ((VName s), mg)) = t s <> pOutMGate mg
            pOutMGate Nothing = empty
            pOutMGate (Just (VName s, vpps)) = t", " <> ppPortProps d vpps <> t s
            pInMClk Nothing = empty
            pInMClk (Just ((VName s), mg)) = t s <> pInMGate mg
            -- these technically need a placeholder gate name (CLK_GATE?)
            pInMGate (Left True) = empty -- text ", (* inhigh *)"
            pInMGate (Left False) = text ", (* unused *)"
            pInMGate (Right (VName s)) = t", " <> t s
            noInputResets = null (input_resets r)
            (mId,ps') = findModId ps
         in (if isModule mId x -- xxx readies xxx
             then
             (((pBlockNT d 0 False
                [t"import \"BVI\"" <+> t(s m) <>
                 t" = module" <+> pvpId d i <> f ys <> t"(" <> pvPrint d 0 ity <> t")",
                 if ps'==[]
                 then empty
                 else t "  provisos (" <> sepList (map (pvPrint d 0) ps') (t ",") <> t")"] empty)
               <> (t";")) $+$
              (pBlock d 2 False
               ((let ClockInfo in_cs out_cs as ss = c
                 in ((map (\ (i, mc) ->
                           -- we could print this as "input_clock" if we want
                           t"clock" <+> pp d i <+> t"(" <> pOutMClk mc <> t")") out_cs) ++
                     (map (\ (i, mc) ->
                           -- we could print this as "output_clock" if we want
                           t"clock" <+> pp d i <+> t"(" <> pInMClk mc <> t")") in_cs) ++
                     (map (\ (i1, i2) -> t"ancestor" <+> pp d i1 <>t","<+> pp d i2) as) ++
                     (map (\ (i1, i2) -> t"sibling" <+> pp d i1 <>t","<+> pp d i2) ss))) ++
                (if noInputResets then [t"no_reset"] else []) ++
                (map (pPrint d p) (input_resets r)) ++ -- XXX is this right?
                (map (pPrint d p) (output_resets r)) ++ -- XXX is this right?
                (map (ppVeriArg d) args) ++
                (map (ppVeriMethod d Nothing) meths) ++
                (ppSchedInfo d p sch) ++
                [ppPathInfo d p pts])
               (t";")
               (t"endmodule:" <+> pp d i)))
             else t "ERROR (for verilog module): module not of module type"
            )
  
      -- for bsc2bsv, if CForeignFuncC is ever supported in Classic
      pvPrint d p (CDef bsv_id cqt [CClause [] [] (CForeignFuncC c_id _)]) =
        t"import \"BDPI\"" <+>
        (if (bsv_id == c_id)
         then empty
         else t (getIdString c_id) <+> t "="
        ) <+>
        ppField d (t"function") True (CField bsv_id Nothing cqt [] Nothing) <> t";" $+$
        t"endfunction"
  
      pvPrint d p df@(CDef i (CQType _ _) [CClause cps [] _]) | all isVar cps =
        p2defs d (CPragma (Pproperties i [])) (CValueSign df)
  
      pvPrint d p (CDef  i    ty cs) = ppValueSign d i [] ty cs
  
  ppPathInfo :: PDetail -> Int -> VPathInfo -> Doc
  ppPathInfo d p ps = pPrint d p ps
  
  instance PVPrint VPathInfo where
      pvPrint d p v = ppPathInfo d p v
  
  ppSchedInfo :: PDetail -> Int -> VSchedInfo -> [Doc]
  ppSchedInfo d p (SchedInfo mci rms rbm ccm) =
      let ds = makeMethodConflictDocs (pvPrint d p) pvpReadable "(" ")" mci
          mci_docs = map (\x -> text "schedule" <+> x) ds
          rms_docs = map (\p -> text "rule_between" <+> pvPrint d 0 p) rms
          rbm_docs = map (\p -> text "rule_before" <+> pvPrint d 0 p) rbm
          ccm_docs = map (\p -> text "cross-domain" <+> pvPrint d 0 p) ccm
      in  mci_docs ++ rms_docs ++ rbm_docs ++ ccm_docs
  
  ppBodyLets :: PDetail -> [CDefl] -> Doc
  ppBodyLets d [] = empty
  ppBodyLets d (d1:ds) =
     t"  " <> pp d d1 $+$ ppBodyLets d ds
  
  ppBody :: PDetail -> Bool -> CExpr -> Doc
  ppBody d isMod (Cletrec [CLValueSign (CDef i1 t1 c1) q1]
                  (Cletrec [CLValueSign (CDef i2 _ _) _] e))
                           | i1 == mkIdPost i2 fsAcute =
          ppBodyLets d [CLValueSign (CDef i2 t1 c1) q1] $+$
          (ppBody d isMod e)
  ppBody d isMod (Cletrec ds e) =
          ppBodyLets d ds $+$
          (ppBody d isMod e)
  ppBody d True e = (pparen True (pp d e) <> t";")
  ppBody d _ e = (t"  return" <+> pparen True (pvPrint d 1 e) <> t";")
  
  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)
       _ -> let (i,ps') = findModId ps in (i,p:ps')
  
  ppValueSignRest :: PDetail -> Doc -> [CPred] -> Bool -> Bool -> Doc -> CExpr -> String -> Doc
  ppValueSignRest d i ps isFnT isMod line1 cexp ender =
     ((pBlockNT d 0 False
          [line1,
           if ps==[]
             then empty
             else t "  provisos (" <> sepList (map (pvPrint d 0) ps) (t",") <> t")"] empty)<> (t";")) $+$
     (if isFnT then
                  (ppBody d isMod cexp $+$ t ("end"++ender++":") <+> i)
                 else (i <+> t "=" <+> pvPrint d 2 cexp <> t ";"))
  
  ppValueSign :: PDetail -> Id -> [TyVar] -> CQType -> [CClause] -> Doc
  
  ppValueSign d i [] (CQType ps ty) [CClause cs [] cexp] | all isVar cs =
    let id = pvpId d i
        (modId,ps') = findModId ps
        line1 = ppTypedId d modId id ty (map (t . getCPVString) cs)
    in ppValueSignRest d id ps' (isFn ty) False line1 cexp "function"
  
  ppValueSign d i [] ty cs =
          (pvpId d i <+> t "::" <+> pp d ty <> t";") $+$
          foldr1 ($+$) (map (\ cl -> ppClause d [pvpId d i] cl) cs)
  ppValueSign d i vs ty cs =
          (pvpId d i <+> t ":: /\\" <> sep (map (pvPrint d maxPrec) vs) <> t"." <> pp d ty <> t";") $+$
          foldr1 ($+$) (map (\ cl -> ppClause d [pvpId d i] cl) cs)
  
  ppRuleBody :: PDetail -> CExpr -> Doc
  ppRuleBody d (Cletrec ds (Caction _ ss)) =
             (foldr1 ($+$) (map (pp d) ds)) $+$ ppActions d ss True
  ppRuleBody d (Caction _ ss) = ppActions d ss True
  ppRuleBody d e              = pp d e <> t";"
  
  ppRuleName :: PDetail -> Maybe CExpr -> Doc
  ppRuleName d Nothing = t"dummy_name"
  ppRuleName d (Just(CLit(CLiteral _ (LString s)))) = t(f s) where
     f s = map (\ c -> if c==' ' then '_' else c) ((toLower (head s)):(tail s))
  ppRuleName d (Just i) = pp d i
  
  instance PVPrint CRule where
      pvPrint d p (CRule [] mlbl mqs e) =
              (t"rule" <+> ppRuleName d mlbl) <+> ppRQuals d mqs $+$
               nest 3 (ppRuleBody d e) $+$
              (case mlbl of Just _ -> t "endrule:" <+> ppRuleName d mlbl;
                            _ -> t"endrule")
  
      pvPrint d p (CRule rps mlbl mqs e) =
              ppRPS d rps $+$
              (t"rule" <+> ppRuleName d mlbl) <+> ppRQuals d mqs $+$
               nest 3 (ppRuleBody d e) $+$
              (case mlbl of Just _ -> t "endrule:" <+> ppRuleName d mlbl;
                            _ -> t"endrule")
  
      pvPrint d p (CRuleNest rps mlbl mqs rs) =
              ppRPS d rps $+$ t"rule" <+> ppRuleName d mlbl <+>
                (ppQuals d mqs $+$ pBlock d 2 False (map (pp d) rs) (t";") (t"endrule"))
  
  ppRPS :: PDetail -> [RulePragma] -> Doc
  ppRPS _ [] = empty
  ppRPS _ rps = t"(*" <+> sepList (map ppRP rps) (t",") <+> t "*)"
  
  ppRP :: RulePragma -> Doc
  ppRP RPfireWhenEnabled                = t"fire_when_enabled"
  ppRP RPnoImplicitConditions           = t"no_implicit_conditions"
  ppRP RPaggressiveImplicitConditions   = t"aggressive_implicit_conditions"
  ppRP RPconservativeImplicitConditions = t"conservative_implicit_conditions"
  ppRP RPnoWarn                         = t"no_warn"
  ppRP RPwarnAllConflicts                  = t"warn_all_conflicts"
  ppRP RPcanScheduleFirst               = t"can_schedule_first"
  ppRP RPclockCrossingRule              = t"clock_crossing_rule"
  ppRP (RPdoc comment)                  = t ("doc = " ++ quote comment)
  ppRP RPhide                           = t"hide"
  
  --unmkTuple :: CExpr -> [CExpr]
  --unmkTuple (CBinOp e i es) | getIdBaseString i == "," =
  --  let bs = unmkTuple es
  --  in e:bs
  --unmkTuple x = [x]
  
  pUnmkTuple :: CPat -> [CPat]
  pUnmkTuple (CPCon i [e,es]) | getIdBaseString i == "," =
    let bs = pUnmkTuple es
    in e:bs
  pUnmkTuple x = [x]
  
  instance PVPrint CDefl where
      pvPrint d p (CLValueSign def me) = optWhen d me $ pvPrint d p def
      pvPrint d p (CLValue i cs me) = optWhen d me $
          foldr1 ($+$) (map (\ cl -> ppClause d [pvpId d i] cl) cs)
  --    pvPrint d p (CLMatch ps@(CPCon i _) e) | getIdBaseString i == "," =
  --        t "match {" <> (catList(map (pvPrint d maxPrec) (pUnmkTuple ps)) (t","))<>t"} =" $+$
  --                  nest 4 (pp d e) <> t";"
      pvPrint d p (CLMatch pat e) =
          t"match"<+> pp d pat <+> t"=" $+$
                    nest 4 (pp d e) <> t";"
  
  optWhen :: PDetail -> [CQual] -> Doc -> Doc
  optWhen d [] s = s
  optWhen d qs s = s $+$ (t"    " <> ppQuals d qs)
  
  instance PVPrint CClause where
      pvPrint d p cl = ppClause d [] cl
  
  ppClause :: PDetail -> [Doc] -> CClause -> Doc
  ppClause d xs (CClause [] mqs e) =
          sep [t"let" <+> sep xs <> ppQuals d mqs <+> t "= ",
                    nest 4 (pp d e)]
          <> t";"
  ppClause d xs (CClause ps [] e) =
      let ids' = xs ++ map (ppCP d) ps
          (i, ids) = unconsOrErr "CVPrint.ppClause" ids'
          line1 = ppUntypedId d i ids
      in ppValueSignRest d i [] True False line1 e "function"
  
  ppClause d xs (CClause ps mqs e) =
      internalError ("CClause: "++ show (ps,mqs,e))
  
  ppCP :: PDetail -> CPat -> Doc
  ppCP d p =
      case pUnmkTuple p of
       [x] -> pp d x
       xs  -> t"{"<>(catList(map (pp d) xs) (t","))<>t"}"
  
  instance PVPrint CQual where
          pvPrint d p (CQGen _ pattern expr) =
              pp d expr <+> t "matches" <+> pp d expr
          pvPrint d p (CQFilter e) = pp d e
  
  
  instance PVPrint CPat where
      pvPrint d p (CPVar i) = pvpPId d i
  
      pvPrint d p (CPCon i [p2@(CPCon i' _)])|
            getIdString i /= "," && getIdString i' == "," =
         pparen (p>(maxPrec-1)) $ (t"tagged" <+> pvpId d i)<+> pp d p2
  
  
      pvPrint d p (CPCon i []) =
         pparen (p>(maxPrec-1)) (t"tagged" <+> pvpId d i)
  
      pvPrint d p pat@(CPCon i as) =
       let notTpl = getIdString i /= ","
           bs = if notTpl then as else pUnmkTuple pat
       in pparen (notTpl && p>(maxPrec-1)) $
         (if notTpl then t"tagged" <+> pvpId d i else empty )<+> t "{" <>
                  (catList(map (pvPrint d maxPrec) bs) (t","))<>t"}"
  
      pvPrint d p (CPstruct _ tyc []) | tyc == idPrimUnit = text "()"
      pvPrint d p (CPstruct _ tyc [(_, fst), (_, snd)]) | tyc == idPrimPair =
          pparen True (pvPrint d 0 fst <> t"," <+> pvPrint d 0 snd)
      pvPrint d p (CPstruct _ i fs) = pparen (p>(maxPrec-1)) $ pvpId d i <+> t "{" <+> sep (map ppFld fs ++ [t"}"])
          where ppFld (i, CPVar i') | i == i' = pvpId d i <> t";"
                ppFld (i, p) = pvpId d i <+> t "=" <+> pp d p <> t";"
      pvPrint d p (CPAs a pp) = pvPrint d maxPrec a <> t"@" <> pvPrint d maxPrec pp
      pvPrint d p (CPAny _) = text ".*"
      pvPrint d p (CPLit l) = pvPrint d p l
      pvPrint d p (CPMixedLit _ base ps) =
          let digitBits = log2 base
              f (len, Just val) = integerFormat (len `div` digitBits) base val
              f (len, Nothing)  = genericReplicate (len `div` digitBits) '?'
              pref  2 = "'b"
              pref  8 = "'o"
              pref 10 = "'d"
              pref 16 = "'h"
              pref x = internalError ("bad radix to CPMixedLit: " ++ show x)
          in  text (pref base ++ concatMap f ps)
      pvPrint d p (CPOper ops) = pparen (p > maxPrec-1) (sep (map (pvPrint d (maxPrec-1)) ops))
      pvPrint d p (CPCon1 _ i a) = pvPrint d p (CPCon i [a])
      ----
      pvPrint d p (CPConTs _ i ts as) = pparen (p>(maxPrec-1)) $ sep (pvpId d i : map ppApArg ts ++ map (pvPrint d maxPrec) as)
          where ppApArg ty = t"\183" <> pvPrint d maxPrec ty
  
  instance PVPrint CPOp where
      pvPrint d _ (CPRand p) = pp d p
      pvPrint d _ (CPRator _ i) = ppInfix d i
  
  -----
  
  -- extra instances, where PPrint instance was outside CSyntax:
  
  -- Ids
  -- moved to Id.hs
  
  -- Literals
  -- moved to Literal.hs
  
  -- Types
  
  unravel :: Type -> (Type,[Type])
  unravel (TAp (TAp a b) c) =
    let (x, ys) = unravel (TAp a b)
    in (x, ys ++[c])
  unravel (TAp a b) = (a, [b])
  unravel x = internalError ("unravel bad: " ++ show x)
  
  tUnmkTuple :: Type -> [Type]
  tUnmkTuple (TAp (TAp (TCon pair) a) b) | isTConPair pair =
    let bs = tUnmkTuple b
    in a:bs
  tUnmkTuple x = [x]
  
  instance PVPrint Type where
      pvPrint d p (TCon (TyCon special _ _))
          | special == idPrimUnit = text "void"
          -- These are needed when printing a function/method,
          -- because Action/ActionValue are keywords which introduce implicit
          -- action..endaction or actionvalue..endactionvalue blocks.
          -- It used to be that displaying "Prelude::Action" would print
          -- broken code, because then it's no longer using the keyword.
          -- So this code is to ensure that those places print the keyword,
          -- but it affects all other printing of the type, too.
          | special == idAction = text "Action"
          | special == idActionValue = text "ActionValue"
      pvPrint d p (TCon c) = pvPrint d 0 c
      pvPrint d p (TVar i) = pvPrint d 0 i
      pvPrint d p ty@(TAp (TCon (TyCon av _ _)) (TCon (TyCon special _ _)))
          -- ActionValue#(void) ==> Action
          | (qualEq idActionValue av) && (qualEq special idPrimUnit)
              = text "Action"
      pvPrint d p ty@(TAp (TAp (TCon special) a) b)
          | isTConPair special =
              let ts = tUnmkTuple ty
                  n  = length ts
              in  t"Tuple" <> t(show n) <> pvParameterTypes d ts
          | isTConArrow special =
              pparen (p > 8) (ppTypedId d Nothing (t"f") ty newIds)
  --        pparen (p > 8) (sep [pvPrint d 9 a <+> text "->", pvPrint d 8 r])
      pvPrint d p (TAp e e') = pparen (p>9) $
          let (x, ys) = unravel (TAp e e')
          in pvPrint d 9 x <> t"#(" <> sepList (map (pvPrint d 0) ys) (text ",") <> t")"
      pvPrint d p (TGen _ n) = text ('_':show n)
      pvPrint d p (TDefMonad _) = text "default_module_type"
  
  instance PVPrint TyVar where
      pvPrint d _ (TyVar i _ _) = pvpId d i
  
  instance PVPrint TyCon where
      pvPrint d _ (TyCon i _ _) = pvpId d i
      pvPrint d _ (TyNum i _) = text (itos i)
      pvPrint d _ (TyStr s _) = text (show s)
  
  -- CQTypes and CPreds
  
  instance PVPrint CQType where
      pvPrint d p (CQType [] ct) = pvPrint d p ct
      pvPrint d p (CQType preds ct) = sep [text "(" <> sepList (map (pvPrint d 0) preds) (text ",") <> text ") =>", pvPrint d 0 ct]
  
  instance PVPrint CPred where
      pvPrint d p (CPred (CTypeclass c) []) = pvpId d c
      pvPrint d p (CPred (CTypeclass c) ts) = pvpId d c <> text "#(" <> sepList (map (pvPrint d 0) ts) (text ",") <> text ")"
  
  instance PVPrint Kind where
      pvPrint _ _ KStar = text "*"
      pvPrint _ _ KNum = text "#"
      pvPrint _ _ KStr = text "$"
      pvPrint d p (Kfun l r) = pparen (p>9) $ pvPrint d 10 l <+> text "->" <+> pvPrint d 9 r
      pvPrint _ _ (KVar i) = text (show i)
  
  instance PVPrint PartialKind where
      pvPrint _ _ PKNoInfo = text "?"
      pvPrint _ _ PKStar = text "*"
      pvPrint _ _ PKNum = text "#"
      pvPrint _ _ PKStr = text "$"
      pvPrint d p (PKfun l r) = pparen (p>9) $ pvPrint d 10 l <+> text "->" <+> pvPrint d 9 r
  
  instance PVPrint TISort where
      pvPrint d p (TItype n t) = pparen (p>0) $ text "TItype" <+> pvPrint d 0 n <+> pvPrint d 1 t
      pvPrint d p (TIdata is enum) = pparen (p>0) $ text (if enum then "TIdata (enum)" else "TIdata") <+> pvPrint d 1 is
      pvPrint d p (TIstruct ss is) = pparen (p>0) $ text "TIstruct" <+> pvPrint d 1 ss <+> pvPrint d 1 is
      pvPrint d p (TIabstract) = text "TIabstract"
  
  instance PVPrint StructSubType where
      pvPrint _ _ ss = text (show ss)
  
  instance PVPrint VName where
      pvPrint _ _ (VName s) = text s
  
  instance PVPrint VModInfo where
      pvPrint d p v = pPrint d p v
  
  instance PVPrint VeriPortProp where
      pvPrint d p v = text (drop 2 (show v))
  
  -- Pragmas
  -- Moved to Pragma.hs
  
  -- IntLits
  -- Moved to IntLits
  
  -----
  
  ppInfix :: PDetail -> Id -> Doc
  ppInfix d i =
      case getBSVIdString i of
      ":=" -> t "<="
      "/=" -> t "!="
      s@(c:_) | isIdChar c -> t"`" <> t s <> t"`"
      s -> t s
  
  
  -----
  