Implement type-level string append function

doc/BSV_ref_guide/BSV_lang.tex

@@ -3972,14 +3972,15 @@ \subsection{Type synonyms}
 
 \index{Alias}
 \index{NumAlias}
+\index{StrAlias}
 
 The \te{typedef} statement must always be at the top level of a
 package, not within a module.  To introduce a local name within a
-module, use \te{Alias} or \te{NumAlias} (see \LibRefGuide).  Since
+module, use \te{Alias}, \te{NumAlias} or \te{StrAlias} (see \LibRefGuide).  Since
 these introduce new names which are type variables as opposed to
 types, the new names must begin with lower case letters.
-\te{NumAlias} is used to give new names to numeric types, while
-\te{Alias} is used for types which can be the types of variables.
+\te{Alias} is used for types which can be the types of variables,
+while \te{NumAlias} and \te{StrAlias} are used to give new names to numeric and string types.
 Example:
 
 \begin{verbatim}

doc/libraries_ref_guide/LibDoc/Prelude.tex

@@ -48,6 +48,8 @@ \subsection{Type classes}
 \hline
 \te{NumAlias} & Types which give a new name to a numeric type.\\
 \hline
+\te{StrAlias} & Types which give a new name to a string type.\\
+\hline
 \te{FShow} & Types which can convert a value to a \te{Fmt}
 representation for use with \te{\$display} system tasks.\\
 \hline
@@ -1457,8 +1459,10 @@ \subsubsection{Alias and NumAlias}
 \label{sec-alias}
 \index{Alias}
 \index{NumAlias}
-\index[typeclass]{NumAlias}
+\index{StrAlias}
 \index[typeclass]{Alias}
+\index[typeclass]{NumAlias}
+\index[typeclass]{StrAlias}
 
 \te{Alias} specifies that two types can be used interchangeably,
 providing a way to introduce local names for types within a module.
@@ -1480,6 +1484,15 @@ \subsubsection{Alias and NumAlias}
 endtypeclass
 \end{verbatim}
 
+\te{StrAlias} is used to give a new name to a string type.
+
+\begin{verbatim}
+typeclass StrAlias#(string type a, string type b)
+   dependencies (a determines b,
+                 b determines a);
+endtypeclass
+\end{verbatim}
+
 {\bf Examples}
 \begin{verbatim}
    Alias#(fp, FixedPoint#(i,f));
@@ -4154,7 +4167,7 @@ \subsubsection{Rules}
 
 
 %================================================================
-\subsection{Operations on Numeric Types}
+\subsection{Operations on Numeric and String Types}
 
 \subsubsection{Size Relationship/Provisos}
 
@@ -4338,6 +4351,46 @@ \subsubsection{valueOf and SizeOf pseudo-functions}
    Bit#(SizeOf#(any_type)) = pack(structIn);
 \end{libverbatim}
 
+% ================================================================
+\subsubsection{String type pseudo-functions}
+\index{stringOf@\texttt{valueOf} (pseudo-function of types)}
+\index{TStrCat@\texttt{TStrCat} (pseudo-function on types)}
+\index{TNumToStr@\texttt{TNumToStr} (pseudo-function on types)}
+\index[function]{Prelude!stringOf}
+\index[function]{Prelude!TStrCat}
+\index[function]{Prelude!TNumToStr}
+
+Prelude also provides similar pseudo-functions for string types.
+The pseudo-function \te{stringOf} is used to convert a string type into a \te{String} value.
+The type-level pseudo-function \te{TStrCat} is used to concatenate two string types,
+and \te{TNumToStr} is used to convert a numeric type into a string type.
+
+\begin{center}
+\begin{tabular}{|p{1 in}|p{4.6 in}|}
+\hline
+& \\
+\te{stringOf}&Converts a string type into its String value.\\
+\cline{2-2}
+&\begin{libverbatim}
+function String stringOf (t) ;
+\end{libverbatim}
+\\
+\hline
+\end{tabular}
+\end{center}
+
+\begin{center}
+\begin{tabular}{|p {1 in}|p{1.5 in}| p{2.0 in}|}
+\hline
+Type Function& Type Relationship& Description\\
+\hline
+\hline
+\te{TStrCat}&\verb'TStrCat#(s1,s2)'&Concatenate $s1$ and $s2$\\
+\hline
+\te{TNumToStr}&\verb'TNumToStr#(n)'&Convert numeric type $n$ to a string type\\
+\hline
+\end{tabular}
+\end{center}
 
 % ================================================================
 \subsection{Registers and Wires}

src/Libraries/Base1/Prelude.bs

@@ -7,7 +7,7 @@ package Prelude(
         PrimParam(..), PrimPort(..),
         Bit, Rules, Module, Integer, Real, String, Char, SizeOf, Id__,
         PrimAction, ActionValue, Action, ActionValue_, ActionWorld, AVStruct,
-        TAdd, TSub, TMul, TDiv, TLog, TExp, TMax, TMin,
+        TAdd, TSub, TMul, TDiv, TLog, TExp, TMax, TMin, TStrCat, TNumToStr,
         Nat(..),
         IsModule(..), addModuleRules, addRules,
 
@@ -2770,6 +2770,9 @@ primitive type TExp :: # -> #
 primitive type TMax :: # -> # -> #
 primitive type TMin :: # -> # -> #
 
+primitive type TStrCat :: $ -> $ -> $
+primitive type TNumToStr :: # -> $
+
 ------------------
 
 --- Bit operations

src/Libraries/Base1/PreludeBSV.bsv

@@ -1113,7 +1113,7 @@ endfunction: lcm
 
 // =========================
 
-// Alias and NumAlias
+// Alias, NumAlias and StrAlias
 
 typeclass Alias#(type a, type b)
    dependencies (a determines b,
@@ -1131,6 +1131,14 @@ endtypeclass
 instance NumAlias#(a,a);
 endinstance
 
+typeclass StrAlias#(string type a, string type b)
+   dependencies (a determines b,
+                 b determines a);
+endtypeclass
+
+instance StrAlias#(a,a);
+endinstance
+
 // =========================
 
 // Saturation Modes

src/comp/CType.hs

@@ -66,12 +66,13 @@ import Position
 import Id
 import IdPrint
 import PreIds(idArrow, idPrimPair, idPrimUnit, idBit, idString,
-              idPrimAction, idAction, idActionValue_, idActionValue
+              idPrimAction, idAction, idActionValue_, idActionValue,
+              idTNumToStr
               {-, idSizeOf -})
 import Util(itos)
 import ErrorUtil
 import Pragma(IfcPragma)
-import NumType
+import TypeOps
 import PVPrint(PVPrint(..))
 import FStringCompat
 
@@ -507,6 +508,13 @@ normTAp (TCon (TyCon op _ _)) (TCon (TyNum x xpos))
         | isJust (res) = cTNum (fromJust res) (getPosition op)
   where res = opNumT op [x]
 
+normTAp (TAp (TCon (TyCon op _ _)) (TCon (TyStr x xpos))) (TCon (TyStr y ypos))
+        | isJust (res) = cTStr (fromJust res) (getPosition op)
+  where res = opStrT op [x, y]
+
+normTAp (TCon (TyCon op _ _)) (TCon (TyNum x xpos))
+        | op == idTNumToStr = cTStr (mkNumFString x) (getPosition op)
+
 normTAp f a = TAp f a
 
 getTypeKind :: Type -> Maybe Kind

src/comp/ISyntax.hs

@@ -93,10 +93,10 @@ import Eval
 import Id
 import Wires(ResetId, ClockDomain, ClockId, noClockId, noResetId, noDefaultClockId, noDefaultResetId, WireProps)
 import IdPrint
-import PreIds(idSizeOf, idId, idBind, idReturn, idPack, idUnpack, idMonad, idLiftModule, idBit, idFromInteger)
+import PreIds(idSizeOf, idId, idBind, idReturn, idPack, idUnpack, idMonad, idLiftModule, idBit, idFromInteger, idTNumToStr)
 import Backend
 import Prim(PrimOp(..))
-import NumType
+import TypeOps
 import ConTagInfo
 import VModInfo(VModInfo, vArgs, vName, VName(..), {- VeriPortProp(..), -}
                 VArgInfo(..), VFieldInfo(..), isParam, VWireInfo)
@@ -105,6 +105,7 @@ import Pragma(Pragma, PProp, RulePragma, ISchedulePragma,
               extractSchedPragmaIds, removeSchedPragmaIds, mapSPIds)
 import Position
 import Data.Maybe
+import FStringCompat(mkNumFString)
 
 import qualified Data.Set as S
 import Flags
@@ -425,6 +426,11 @@ normITAp (ITAp (ITCon op _ _) (ITNum x)) (ITNum y) | isJust (res) =
 normITAp (ITCon op _ _) (ITNum x) | isJust (res) =
     mkNumConT (fromJust res)
   where res = opNumT op [x]
+normITAp (ITAp (ITCon op _ _) (ITStr x)) (ITStr y) | isJust (res) =
+    ITStr (fromJust res)
+  where res = opStrT op [x, y]
+normITAp (ITCon op _ _) (ITNum x) | op == idTNumToStr =
+    ITStr (mkNumFString x)
 
 normITAp f@(ITCon op _ _) a | op == idSizeOf && notVar a =
         -- trace ("normITAp: " ++ ppReadable (ITAp f a)) $

src/comp/PreIds.hs

@@ -91,6 +91,9 @@ idTLog = prelude_id_no fsTLog
 idTExp = prelude_id_no fsTExp
 idTMax = prelude_id_no fsTMax
 idTMin = prelude_id_no fsTMin
+idTStrCat, idTNumToStr :: Id
+idTStrCat = prelude_id_no fsTStrCat
+idTNumToStr = prelude_id_no fsTNumToStr
 idAction, idPrimAction, idToPrimAction, idFromPrimAction :: Id
 idAction = prelude_id_no fsAction
 idPrimAction = prelude_id_no fsPrimAction

src/comp/PreStrings.hs

@@ -279,6 +279,8 @@ fsTLog             = mkFString "TLog"
 fsTExp             = mkFString "TExp"
 fsTMax             = mkFString "TMax"
 fsTMin             = mkFString "TMin"
+fsTStrCat          = mkFString "TStrCat"
+fsTNumToStr        = mkFString "TNumToStr"
 fsStaticAssert     = mkFString "staticAssert"
 fsDynamicAssert    = mkFString "dynamicAssert"
 fsContinuousAssert = mkFString "continuousAssert"

src/comp/Pred.hs

@@ -20,7 +20,7 @@ import Position
 import Id
 import IdPrint
 import Type
-import NumType
+import TypeOps
 import PFPrint
 import CSyntax(CExpr)
 import CType
@@ -261,12 +261,14 @@ expandSyn t0 = exp [] t0 []
         truncType k n t = internalError ("expandSyn,truncType\n" ++ ppReadable (k, n, t0, t))
 
 isTFun :: Id -> Bool
-isTFun i = i `elem` numOpNames
+isTFun i = i `elem` numOpNames ++ strOpNames
 
 apTFun :: Type -> Id -> [Type] -> Type
 apTFun _ i [TCon (TyNum x px), TCon (TyNum y py)] | Just n <- opNumT i [x, y] = TCon (TyNum n p')
   where p' = bestPosition px py
 apTFun _ i [TCon (TyNum x px)] | Just n <- opNumT i [x] = TCon (TyNum n px)
+apTFun _ i [TCon (TyStr x px), TCon (TyStr y py)] | Just s <- opStrT i [x, y] = TCon (TyStr s p')
+  where p' = bestPosition px py
 apTFun t _ as = foldl TAp t as
 
 -----------------------------------------------------------------------------

src/comp/NumType.hs → src/comp/TypeOps.hs

@@ -1,9 +1,10 @@
-module NumType(opNumT, numOpNames) where
--- common routines for handling numeric types
+module TypeOps(opNumT, numOpNames, opStrT, strOpNames) where
+-- common routines for handling numeric and string types
 
 import Id
-import PreIds(idTAdd, idTSub, idTMul, idTDiv, idTLog, idTExp, idTMax, idTMin)
+import PreIds(idTAdd, idTSub, idTMul, idTDiv, idTLog, idTExp, idTMax, idTMin, idTStrCat, idTNumToStr)
 import Util(divC, log2)
+import FStringCompat(FString, concatFString)
 
 -- do a numeric type operation on a list of arguments
 -- note that we have to validate that the result is going to
@@ -20,4 +21,11 @@ opNumT i [x, y] | i == idTMin = Just (min x y)
 opNumT _ _      = Nothing
 
 numOpNames :: [Id]
-numOpNames = [idTAdd, idTSub, idTMul, idTDiv, idTExp, idTLog, idTMax, idTMin]
+numOpNames = [idTAdd, idTSub, idTMul, idTDiv, idTExp, idTLog, idTMax, idTMin, idTNumToStr]
+
+opStrT :: Id -> [FString] -> Maybe FString
+opStrT i xs | i == idTStrCat = Just $ concatFString xs
+opStrT _ _ = Nothing
+
+strOpNames :: [Id]
+strOpNames = [idTStrCat]

testsuite/bsc.typechecker/string/TNumToStr.bs

@@ -0,0 +1,32 @@
+package TNumToStr where
+
+data (WrapStr :: $ -> *) s = WrapStr
+data (WrapNum :: # -> *) s = WrapNum
+
+printWrapStr :: WrapStr s -> Action
+printWrapStr _ = $display (stringOf s)
+
+a :: WrapStr (TNumToStr 42)
+a = WrapStr
+
+class FoldNumsStr a s | a -> s where {}
+
+instance (FoldNumsStr a s) => FoldNumsStr (WrapNum i, a) (TStrCat (TNumToStr i) (TStrCat "_" s)) where {}
+instance FoldNumsStr (WrapNum i) (TNumToStr i) where {}
+instance FoldNumsStr () "" where {}
+
+b :: (FoldNumsStr (WrapNum 1, WrapNum 22, WrapNum 333) s) => WrapStr s
+b = WrapStr
+
+c :: (FoldNumsStr () s) => WrapStr s
+c = WrapStr
+
+sysTNumToStr :: Module Empty
+sysTNumToStr = module
+
+  rules
+    when True ==> do
+      printWrapStr a
+      printWrapStr b
+      printWrapStr c
+      $finish

testsuite/bsc.typechecker/string/TStrCat.bs

@@ -0,0 +1,31 @@
+package TStrCat where
+
+data (WrapStr :: $ -> *) s = WrapStr
+
+printWrapStr :: WrapStr s -> Action
+printWrapStr _ = $display (stringOf s)
+
+a :: WrapStr (TStrCat "aaa" "bbb")
+a = WrapStr
+
+class FlatWrapStr a s | a -> s where {}
+
+instance (FlatWrapStr a s2) => FlatWrapStr (WrapStr s1, a) (TStrCat s1 (TStrCat "_" s2)) where {}
+instance FlatWrapStr (WrapStr s) s where {}
+instance FlatWrapStr () "" where {}
+
+b :: (FlatWrapStr (WrapStr "aaa", WrapStr "bbb", WrapStr "ccc") s) => WrapStr s
+b = WrapStr
+
+c :: (FlatWrapStr () s) => WrapStr s
+c = WrapStr
+
+sysTStrCat :: Module Empty
+sysTStrCat = module
+
+  rules
+    when True ==> do
+      printWrapStr a
+      printWrapStr b
+      printWrapStr c
+      $finish

testsuite/bsc.typechecker/string/string.exp

@@ -15,3 +15,5 @@ test_c_veri StringOf
 test_c_veri_bsv StringOfBSV
 
 test_c_veri TypeClassString
+test_c_veri TStrCat
+test_c_veri TNumToStr

testsuite/bsc.typechecker/string/sysTNumToStr.out.expected

@@ -0,0 +1,3 @@
+42
+1_22_333
+

testsuite/bsc.typechecker/string/sysTStrCat.out.expected

@@ -0,0 +1,3 @@
+aaabbb
+aaa_bbb_ccc
+