Rename TApp -> TStrCat, implement TNumToStr

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, TApp,
+        TAdd, TSub, TMul, TDiv, TLog, TExp, TMax, TMin, TStrCat, TNumToStr,
         Nat(..),
         IsModule(..), addModuleRules, addRules,
 
@@ -2772,7 +2772,8 @@ primitive type TExp :: # -> #
 primitive type TMax :: # -> # -> #
 primitive type TMin :: # -> # -> #
 
-primitive type TApp :: $ -> $ -> $
+primitive type TStrCat :: $ -> $ -> $
+primitive type TNumToStr :: # -> $
 
 ------------------
 

src/comp/CType.hs

@@ -66,7 +66,8 @@ 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
@@ -511,6 +512,9 @@ 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,7 +93,7 @@ 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 TypeOps
@@ -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
@@ -428,6 +429,8 @@ normITAp (ITCon op _ _) (ITNum x) | isJust (res) =
 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

@@ -81,7 +81,7 @@ idPrimSnd = prelude_id_no fsPrimSnd
 idPrimPair = prelude_id_no fsPrimPair
 idFalse = prelude_id_no fsFalse
 idTrue = prelude_id_no fsTrue
-idSizeOf, idTAdd, idTSub, idTMul, idTDiv, idTLog, idTExp, idTMax, idTMin, idTApp :: Id
+idSizeOf, idTAdd, idTSub, idTMul, idTDiv, idTLog, idTExp, idTMax, idTMin :: Id
 idSizeOf = prelude_id_no fsSizeOf
 idTAdd = prelude_id_no fsTAdd
 idTSub = prelude_id_no fsTSub
@@ -91,7 +91,9 @@ idTLog = prelude_id_no fsTLog
 idTExp = prelude_id_no fsTExp
 idTMax = prelude_id_no fsTMax
 idTMin = prelude_id_no fsTMin
-idTApp = prelude_id_no fsTApp
+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,7 +279,8 @@ fsTLog             = mkFString "TLog"
 fsTExp             = mkFString "TExp"
 fsTMax             = mkFString "TMax"
 fsTMin             = mkFString "TMin"
-fsTApp             = mkFString "TApp"
+fsTStrCat          = mkFString "TStrCat"
+fsTNumToStr        = mkFString "TNumToStr"
 fsStaticAssert     = mkFString "staticAssert"
 fsDynamicAssert    = mkFString "dynamicAssert"
 fsContinuousAssert = mkFString "continuousAssert"

src/comp/TypeOps.hs

@@ -2,7 +2,7 @@ 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, idTApp)
+import PreIds(idTAdd, idTSub, idTMul, idTDiv, idTLog, idTExp, idTMax, idTMin, idTStrCat, idTNumToStr)
 import Util(divC, log2)
 import FStringCompat(FString, concatFString)
 
@@ -21,11 +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 == idTApp = Just $ concatFString xs
+opStrT i xs | i == idTStrCat = Just $ concatFString xs
 opStrT _ _ = Nothing
 
 strOpNames :: [Id]
-strOpNames = [idTApp]
+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/TApp.bs → testsuite/bsc.typechecker/string/TStrCat.bs

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

testsuite/bsc.typechecker/string/string.exp

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

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

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