From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Thu, 13 Aug 2009 09:25:04 +0000 (+0200)
Subject: Added equals builtin. And fixed show function generation for integers
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=d699d2f50e6d172308ef56adec01ace357ef0a0f;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Added equals builtin. And fixed show function generation for integers
---

diff --git "a/c\316\273ash/CLasH/VHDL/Constants.hs" "b/c\316\273ash/CLasH/VHDL/Constants.hs"
index 50bb922..b0236f5 100644
--- "a/c\316\273ash/CLasH/VHDL/Constants.hs"
+++ "b/c\316\273ash/CLasH/VHDL/Constants.hs"
@@ -229,6 +229,10 @@ hwandId = "hwand"
 lengthTId :: String
 lengthTId = "lengthT"
 
+-- Equality Operations
+equalsId :: String
+equalsId = "=="
+
 -- Numeric Operations
 
 -- | plus operation identifier
diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs"
index 3f81f8f..d92b9ae 100644
--- "a/c\316\273ash/CLasH/VHDL/Generate.hs"
+++ "b/c\316\273ash/CLasH/VHDL/Generate.hs"
@@ -1376,6 +1376,7 @@ globalNameTable = Map.fromList
   , (hwandId          , (2, genOperator2 AST.And    ) )
   , (hworId           , (2, genOperator2 AST.Or     ) )
   , (hwnotId          , (1, genOperator1 AST.Not    ) )
+  , (equalsId         , (2, genOperator2 (AST.:=:)  ) )
   , (plusId           , (2, genOperator2 (AST.:+:)  ) )
   , (timesId          , (2, genOperator2 (AST.:*:)  ) )
   , (negateId         , (1, genNegation             ) )
diff --git "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs" "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs"
index b289501..4c41d8f 100644
--- "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs"
+++ "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs"
@@ -445,8 +445,6 @@ mk_unsigned_ty ty = do
   let ty_id = mkVHDLExtId $ "unsigned_" ++ show (size - 1)
   let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (size - 1))]
   let ty_def = AST.SubtypeIn unsignedTM (Just range)
-  let unsignedshow = mkIntegerShow ty_id
-  modA tsTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, unsignedshow)
   return (Right $ Just (ty_id, Right ty_def))
   
 mk_signed_ty ::
@@ -457,8 +455,6 @@ mk_signed_ty ty = do
   let ty_id = mkVHDLExtId $ "signed_" ++ show (size - 1)
   let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (size - 1))]
   let ty_def = AST.SubtypeIn signedTM (Just range)
-  let signedshow = mkIntegerShow ty_id
-  modA tsTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, signedshow)
   return (Right $ Just (ty_id, Right ty_def))
 
 -- Finds the field labels for VHDL type generated for the given Core type,
@@ -676,26 +672,19 @@ mkVectorShow elemTM vectorTM =
                                genExprFCall doShowId (AST.PrimName $ AST.NSimple vecPar) AST.:&:
                                AST.PrimLit "'>'" )
 
-mkIntegerShow ::
-  AST.TypeMark -- ^ The specific signed
-  -> AST.SubProgBody
-mkIntegerShow signedTM = AST.SubProgBody showSpec [] [showExpr]
-  where
-    signedPar = AST.unsafeVHDLBasicId "sint"
-    showSpec = AST.Function showId [AST.IfaceVarDec signedPar signedTM] stringTM
-    showExpr = AST.ReturnSm (Just $
-                AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId) 
-                  (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [signToInt]) Nothing )
-      where
-        signToInt = genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ signedPar)
-
 mkBuiltInShow :: [AST.SubProgBody]
 mkBuiltInShow = [ AST.SubProgBody showBitSpec [] [showBitExpr]
                 , AST.SubProgBody showBoolSpec [] [showBoolExpr]
+                , AST.SubProgBody showSingedSpec [] [showSignedExpr]
+                , AST.SubProgBody showUnsignedSpec [] [showUnsignedExpr]
+                , AST.SubProgBody showNaturalSpec [] [showNaturalExpr]
                 ]
   where
-    bitPar    = AST.unsafeVHDLBasicId "s"
-    boolPar    = AST.unsafeVHDLBasicId "b"
+    bitPar      = AST.unsafeVHDLBasicId "s"
+    boolPar     = AST.unsafeVHDLBasicId "b"
+    signedPar   = AST.unsafeVHDLBasicId "sint"
+    unsignedPar = AST.unsafeVHDLBasicId "uint"
+    naturalPar  = AST.unsafeVHDLBasicId "nat"
     showBitSpec = AST.Function showId [AST.IfaceVarDec bitPar std_logicTM] stringTM
     -- if s = '1' then return "'1'" else return "'0'"
     showBitExpr = AST.IfSm (AST.PrimName (AST.NSimple bitPar) AST.:=: AST.PrimLit "'1'")
@@ -708,6 +697,23 @@ mkBuiltInShow = [ AST.SubProgBody showBitSpec [] [showBitExpr]
                         [AST.ReturnSm (Just $ AST.PrimLit "\"True\"")]
                         []
                         (Just $ AST.Else [AST.ReturnSm (Just $ AST.PrimLit "\"False\"")])
+    showSingedSpec = AST.Function showId [AST.IfaceVarDec signedPar signedTM] stringTM
+    showSignedExpr =  AST.ReturnSm (Just $
+                        AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId) 
+                        (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [signToInt]) Nothing )
+                      where
+                        signToInt = genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ signedPar)
+    showUnsignedSpec =  AST.Function showId [AST.IfaceVarDec unsignedPar unsignedTM] stringTM
+    showUnsignedExpr =  AST.ReturnSm (Just $
+                          AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId) 
+                          (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [unsignToInt]) Nothing )
+                        where
+                          unsignToInt = genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ unsignedPar)
+    showNaturalSpec = AST.Function showId [AST.IfaceVarDec naturalPar naturalTM] stringTM
+    showNaturalExpr = AST.ReturnSm (Just $
+                        AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId)
+                        (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [AST.PrimName $ AST.NSimple $ naturalPar]) Nothing )
+                      
   
 genExprFCall :: AST.VHDLId -> AST.Expr -> AST.Expr
 genExprFCall fName args =