Fix builtin functions (!),take and RangedWord

diff --git a/Adders.hs b/Adders.hs
index 6529642f4758ad640b1b93e736ef566e4b1f63eb..3afb163b69c3263b6ef861d2edf18298a0b49c85 100644 (file)
--- a/Adders.hs
+++ b/Adders.hs
@@ -9,8 +9,9 @@ import Prelude hiding (
   null, length, head, tail, last, init, take, drop, (++), map, foldl, foldr,
   zipWith, zip, unzip, concat, reverse, iterate )
 
-import Language.Haskell.Syntax
+-- import Language.Haskell.Syntax
 import Types
+import Types.Data.Num.Decimal.Literals
 import Data.Param.TFVec
 import Data.RangedWord
 import Data.SizedInt
@@ -23,11 +24,11 @@ mainIO f = Sim.simulateIO (Sim.stateless f) ()
 stateless :: (i -> o) -> (i -> () -> ((), o))
 stateless f = \i s -> (s, f i)
 
-show_add f = do print ("Sum:   " P.++ (displaysigs s)); print ("Carry: " P.++ (displaysig c))
-  where
-    a = [High, High, High, High]
-    b = [Low, Low, Low, High]
-    (s, c) = f (a, b)
+-- show_add f = do print ("Sum:   " P.++ (displaysigs s)); print ("Carry: " P.++ (displaysig c))
+--   where
+--     a = [High, High, High, High]
+--     b = [Low, Low, Low, High]
+--     (s, c) = f (a, b)
 
 mux2 :: Bit -> (Bit, Bit) -> Bit
 mux2 Low (a, b) = a
@@ -178,8 +179,8 @@ highordtest = \x ->
 
 xand a b = hwand a b
 
-functiontest :: TFVec D3 (TFVec D4 Bit) -> TFVec D12 Bit
-functiontest = \v -> let r = concat v in r
+functiontest :: TFVec D12 Bit -> TFVec D6 Bit
+functiontest = \v -> let r = take d6 v in r
 
 functiontest2 :: SizedInt D8 -> SizedInt D7
 functiontest2 = \a -> let r = Data.SizedInt.resize a in r
@@ -201,24 +202,24 @@ highordtest2 = \a b ->
                 \c d -> op' d c
 -- Four bit adder, using the continous adder below
 -- [a] -> [b] -> ([s], cout)
-con_adder_4 as bs = 
- ([s3, s2, s1, s0], c)
- where
-   ((s0, _):(s1, _):(s2, _):(s3, c):_) = con_adder (P.zip ((P.reverse as) P.++ lows) ((P.reverse bs) P.++ lows))
+-- con_adder_4 as bs = 
+--  ([s3, s2, s1, s0], c)
+--  where
+--    ((s0, _):(s1, _):(s2, _):(s3, c):_) = con_adder (P.zip ((P.reverse as) P.++ lows) ((P.reverse bs) P.++ lows))
 
 -- Continuous sequential version
 -- Stream a -> Stream b -> Stream (sum, cout)
-con_adder :: Stream (Bit, Bit) -> Stream (Bit, Bit)
+-- con_adder :: Stream (Bit, Bit) -> Stream (Bit, Bit)
 
 -- Forward to con_adder_int, but supply an initial state
-con_adder pin =
- con_adder_int pin Low
+-- con_adder pin =
+--  con_adder_int pin Low
 
 -- Stream a -> Stream b -> state -> Stream (s, c)
-con_adder_int :: Stream (Bit, Bit) -> Bit -> Stream (Bit, Bit)
-con_adder_int ((a,b):rest) cin =
- (s, cout) : con_adder_int rest cout
- where
-   (s, cout) = full_adder (a, b, cin)
+-- con_adder_int :: Stream (Bit, Bit) -> Bit -> Stream (Bit, Bit)
+-- con_adder_int ((a,b):rest) cin =
+--  (s, cout) : con_adder_int rest cout
+--  where
+--    (s, cout) = full_adder (a, b, cin)
 
 -- vim: set ts=8 sw=2 sts=2 expandtab:

diff --git a/cλash/CLasH/VHDL/Constants.hs b/cλash/CLasH/VHDL/Constants.hs
index d9ed855bf2f63b65ed8c8684147841c3df453ee1..04e727410b0e8ed63061fa6c12078ad3823f9038 100644 (file)
--- a/cλash/CLasH/VHDL/Constants.hs
+++ b/cλash/CLasH/VHDL/Constants.hs
@@ -125,6 +125,9 @@ initId = "init"
 tailId :: String
 tailId = "tail"
 
+-- | minimum ftp function identifier
+minimumId :: String
+minimumId = "minimum"
 
 -- | take function identifier
 takeId :: String

diff --git a/cλash/CLasH/VHDL/Generate.hs b/cλash/CLasH/VHDL/Generate.hs
index 448308613a9df0b89a03965defb504112346a28b..5618532c2f1771fd18d88ba417120072e94206fb 100644 (file)
--- a/cλash/CLasH/VHDL/Generate.hs
+++ b/cλash/CLasH/VHDL/Generate.hs
@@ -146,12 +146,17 @@ genFromInteger' (Left res) f lits = do {
         ; (tycon, args) = Type.splitTyConApp ty
         ; name = Name.getOccString (TyCon.tyConName tycon)
         } ;
-  ; len <- case name of
-    "SizedInt" -> MonadState.lift vsType $ tfp_to_int (sized_int_len_ty ty)
-    "SizedWord" -> MonadState.lift vsType $ tfp_to_int (sized_word_len_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))]
+  ; case name of
+    "RangedWord" -> return $ AST.PrimLit (show (last lits))
+    otherwise -> do {
+      ; len <- case name of
+        "SizedInt" -> MonadState.lift vsType $ tfp_to_int (sized_int_len_ty ty)
+        "SizedWord" -> MonadState.lift vsType $ tfp_to_int (sized_word_len_ty ty)
+        "RangedWord" -> MonadState.lift vsType $ 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))]
+      }
   }
 
 genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
@@ -689,7 +694,8 @@ genUnconsVectorFuns elemTM vectorTM  =
   , (replaceId, (AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet],[]))
   , (lastId, (AST.SubProgBody lastSpec    []                  [lastExpr],[]))
   , (initId, (AST.SubProgBody initSpec    [AST.SPVD initVar]  [initExpr, initRet],[]))
-  , (takeId, (AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet],[]))
+  , (minimumId, (AST.SubProgBody minimumSpec [] [minimumExpr],[]))
+  , (takeId, (AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet],[minimumId]))
   , (dropId, (AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet],[]))
   , (plusgtId, (AST.SubProgBody plusgtSpec  [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet],[]))
   , (emptyId, (AST.SubProgBody emptySpec   [AST.SPCD emptyVar] [emptyExpr],[]))
@@ -712,12 +718,14 @@ genUnconsVectorFuns elemTM vectorTM  =
     vec1Par = AST.unsafeVHDLBasicId "vec1"
     vec2Par = AST.unsafeVHDLBasicId "vec2"
     nPar    = AST.unsafeVHDLBasicId "n"
+    leftPar = AST.unsafeVHDLBasicId "nLeft"
+    rightPar = AST.unsafeVHDLBasicId "nRight"
     iId     = AST.unsafeVHDLBasicId "i"
     iPar    = iId
     aPar    = AST.unsafeVHDLBasicId "a"
     fPar = AST.unsafeVHDLBasicId "f"
     sPar = AST.unsafeVHDLBasicId "s"
-    resId   = AST.unsafeVHDLBasicId "res"
+    resId   = AST.unsafeVHDLBasicId "res"    
     exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM,
                                AST.IfaceVarDec ixPar  naturalTM] elemTM
     exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed 
@@ -775,21 +783,32 @@ genUnconsVectorFuns elemTM vectorTM  =
                                   AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) 
                                                              AST.:-: AST.PrimLit "2"))
     initRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+    minimumSpec = AST.Function (mkVHDLExtId minimumId) [AST.IfaceVarDec leftPar   naturalTM,
+                                   AST.IfaceVarDec rightPar naturalTM ] naturalTM
+    minimumExpr = AST.IfSm ((AST.PrimName $ AST.NSimple leftPar) AST.:<: (AST.PrimName $ AST.NSimple rightPar))
+                        [AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple leftPar)]
+                        []
+                        (Just $ AST.Else [minimumExprRet])
+      where minimumExprRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple rightPar)
     takeSpec = AST.Function (mkVHDLExtId takeId) [AST.IfaceVarDec nPar   naturalTM,
                                    AST.IfaceVarDec vecPar vectorTM ] vectorTM
-       -- variable res : fsvec_x (0 to n-1);
+       -- variable res : fsvec_x (0 to (minimum (n,vec'length))-1);
+    minLength = AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId minimumId))  
+                              [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple nPar)
+                              ,Nothing AST.:=>: AST.ADExpr (AST.PrimName (AST.NAttribute $ 
+                                AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]
     takeVar = 
          AST.VarDec resId 
                 (AST.SubtypeIn vectorTM
                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
                    [AST.ToRange (AST.PrimLit "0")
-                               ((AST.PrimName (AST.NSimple nPar)) AST.:-:
+                               (minLength AST.:-:
                                 (AST.PrimLit "1"))   ]))
                 Nothing
        -- res AST.:= vec(0 to n-1)
     takeExpr = AST.NSimple resId AST.:= 
-                    (vecSlice (AST.PrimLit "1") 
-                              (AST.PrimName (AST.NSimple $ nPar) AST.:-: AST.PrimLit "1"))
+                    (vecSlice (AST.PrimLit "0") 
+                              (minLength AST.:-: AST.PrimLit "1"))
     takeRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
     dropSpec = AST.Function (mkVHDLExtId dropId) [AST.IfaceVarDec nPar   naturalTM,
                                    AST.IfaceVarDec vecPar vectorTM ] vectorTM 
@@ -1045,7 +1064,7 @@ genUnconsVectorFuns elemTM vectorTM  =
 -- builder function.
 globalNameTable :: NameTable
 globalNameTable = Map.fromList
-  [ (exId             , (2, genFCall False          ) )
+  [ (exId             , (2, genFCall True          ) )
   , (replaceId        , (3, genFCall False          ) )
   , (headId           , (1, genFCall True           ) )
   , (lastId           , (1, genFCall True           ) )
@@ -1092,4 +1111,5 @@ globalNameTable = Map.fromList
   , (resizeId         , (1, genResize               ) )
   , (sizedIntId       , (1, genSizedInt             ) )
   , (tfvecId          , (1, genTFVec                ) )
+  , (minimumId        , (2, error $ "\nFunction name: \"minimum\" is used internally, use another name"))
   ]