Used unsigned instead of natural as representation of RangedWord

diff --git a/cλash/CLasH/VHDL/Generate.hs b/cλash/CLasH/VHDL/Generate.hs
index eff5d75896735dbd397ce669fd2a3f6cc75cf972..d1bf3751e3209dc0d1b8b8f8453bdb225ba12b57 100644 (file)
--- a/cλash/CLasH/VHDL/Generate.hs
+++ b/cλash/CLasH/VHDL/Generate.hs
@@ -348,12 +348,13 @@ genFCall' switch (Left res) f args = do
 genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 
 genFromSizedWord :: BuiltinBuilder
-genFromSizedWord = genNoInsts $ genExprArgs $ genExprRes genFromSizedWord'
-genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
-genFromSizedWord' (Left res) f args = do
-  let fname = varToString f
-  return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId))  $
-             map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
+genFromSizedWord = genNoInsts $ genExprArgs genFromSizedWord'
+genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession [AST.ConcSm]
+genFromSizedWord' (Left res) f args@[arg] = do
+  return $ [mkUncondAssign (Left res) arg]
+  -- let fname = varToString f
+  -- return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId))  $
+  --            map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
 genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 
 genResize :: BuiltinBuilder
@@ -382,17 +383,17 @@ genFromInteger' (Left res) f lits = do {
         ; (tycon, args) = Type.splitTyConApp ty
         ; name = Name.getOccString (TyCon.tyConName tycon)
         } ;
-  ; case name of
-    "RangedWord" -> return $ AST.PrimLit (show (last lits))
-    otherwise -> do {
-      ; len <- case name of
-        "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
-        "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
-        "RangedWord" -> MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
-      ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId
-      ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname))
-                [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
+  ; len <- case name of
+    "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
+    "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
+    "RangedWord" -> do {
+      ; bound <- MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
+      ; return $ floor (logBase 2 (fromInteger (toInteger (bound)))) + 1
       }
+  ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId ; "RangedWord" -> toUnsignedId
+  ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname))
+            [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
+
   }
 
 genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
@@ -860,7 +861,8 @@ genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do
   reslabels <- MonadState.lift tsType $ getFieldLabels (Var.varType res)
   let resname' = varToVHDLName res
   let resname = mkSelectedName resname' (reslabels!!0)
-  let argexpr = vhdlNameToVHDLExpr $ mkIndexedName (AST.NSimple ram_id) rdaddr
+  let rdaddr_int = genExprFCall (mkVHDLBasicId toIntegerId) rdaddr
+  let argexpr = vhdlNameToVHDLExpr $ mkIndexedName (AST.NSimple ram_id) rdaddr_int
   let assign = mkUncondAssign (Right resname) argexpr
   let block_label = mkVHDLExtId ("blockRAM" ++ (varToString res))
   let block = AST.BlockSm block_label [] (AST.PMapAspect []) [ram_dec] [assign, mkUpdateProcSm]
@@ -872,7 +874,8 @@ genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do
       where
         proclabel   = mkVHDLBasicId "updateRAM"
         rising_edge = mkVHDLBasicId "rising_edge"
-        ramloc      = mkIndexedName (AST.NSimple ram_id) wraddr
+        wraddr_int  = genExprFCall (mkVHDLBasicId toIntegerId) wraddr
+        ramloc      = mkIndexedName (AST.NSimple ram_id) wraddr_int
         wform       = AST.Wform [AST.WformElem data_in Nothing]
         ramassign      = AST.SigAssign ramloc wform
         rising_edge_clk = genExprFCall rising_edge (AST.PrimName $ AST.NSimple clockId)
@@ -1055,12 +1058,11 @@ genUnconsVectorFuns elemTM vectorTM  =
     sPar = AST.unsafeVHDLBasicId "s"
     resId   = AST.unsafeVHDLBasicId "res"    
     exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM,
-                               AST.IfaceVarDec ixPar  naturalTM] elemTM
+                               AST.IfaceVarDec ixPar  unsignedTM] elemTM
     exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed 
-              (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $ 
-                AST.NSimple ixPar]))
+              (AST.IndexedName (AST.NSimple vecPar) [genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ ixPar)]))
     replaceSpec = AST.Function (mkVHDLExtId replaceId)  [ AST.IfaceVarDec vecPar vectorTM
-                                          , AST.IfaceVarDec iPar   naturalTM
+                                          , AST.IfaceVarDec iPar   unsignedTM
                                           , AST.IfaceVarDec aPar   elemTM
                                           ] vectorTM 
        -- variable res : fsvec_x (0 to vec'length-1);
@@ -1075,7 +1077,7 @@ genUnconsVectorFuns elemTM vectorTM  =
                 Nothing
        --  res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
     replaceExpr1 = AST.NSimple resId AST.:= AST.PrimName (AST.NSimple vecPar)
-    replaceExpr2 = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [AST.PrimName $ AST.NSimple iPar]) AST.:= AST.PrimName (AST.NSimple aPar)
+    replaceExpr2 = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ iPar)]) AST.:= AST.PrimName (AST.NSimple aPar)
     replaceRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
     vecSlice init last =  AST.PrimName (AST.NSlice 
                                         (AST.SliceName 

diff --git a/cλash/CLasH/VHDL/VHDLTools.hs b/cλash/CLasH/VHDL/VHDLTools.hs
index e5445a8eca7c21622d64d7b02ce5761204bae77f..fedd8f528a764ea49ba4404fabdaaafb000e9a11 100644 (file)
--- a/cλash/CLasH/VHDL/VHDLTools.hs
+++ b/cλash/CLasH/VHDL/VHDLTools.hs
@@ -437,9 +437,10 @@ mk_natural_ty ::
   -> TypeSession (Either String (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn)))
       -- ^ An error message or The typemark created.
 mk_natural_ty min_bound max_bound = do
-  let ty_id = mkVHDLExtId $ "nat_" ++ (show min_bound) ++ "_to_" ++ (show max_bound)
-  let range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit $ (show min_bound)) (AST.PrimLit $ (show max_bound))
-  let ty_def = AST.SubtypeIn naturalTM (Just range)
+  let bitsize = floor (logBase 2 (fromInteger (toInteger max_bound)))
+  let ty_id = mkVHDLExtId $ "natural_" ++ (show min_bound) ++ "_to_" ++ (show max_bound)
+  let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit $ show min_bound) (AST.PrimLit $ show bitsize)]
+  let ty_def = AST.SubtypeIn unsignedTM (Just range)
   return (Right $ Just (ty_id, Right ty_def))
 
 mk_unsigned_ty ::
@@ -682,14 +683,14 @@ mkBuiltInShow = [ AST.SubProgBody showBitSpec [] [showBitExpr]
                 , AST.SubProgBody showBoolSpec [] [showBoolExpr]
                 , AST.SubProgBody showSingedSpec [] [showSignedExpr]
                 , AST.SubProgBody showUnsignedSpec [] [showUnsignedExpr]
-                , AST.SubProgBody showNaturalSpec [] [showNaturalExpr]
+                -- , AST.SubProgBody showNaturalSpec [] [showNaturalExpr]
                 ]
   where
     bitPar      = AST.unsafeVHDLBasicId "s"
     boolPar     = AST.unsafeVHDLBasicId "b"
     signedPar   = AST.unsafeVHDLBasicId "sint"
     unsignedPar = AST.unsafeVHDLBasicId "uint"
-    naturalPar  = AST.unsafeVHDLBasicId "nat"
+    -- 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'")
@@ -714,10 +715,10 @@ mkBuiltInShow = [ AST.SubProgBody showBitSpec [] [showBitExpr]
                           (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 )
+    -- 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