From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Mon, 29 Jun 2009 13:06:21 +0000 (+0200)
Subject: Added "lengthT"
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=bdaeea7a42e08a5a2bc88b44a9cf320266cb2b73;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Added "lengthT"
---

diff --git a/Constants.hs b/Constants.hs
index c538293..1637d58 100644
--- a/Constants.hs
+++ b/Constants.hs
@@ -197,6 +197,8 @@ hwnotId = "hwnot"
 hwandId :: String
 hwandId = "hwand"
 
+lengthTId :: String
+lengthTId = "lengthT"
 
 ------------------
 -- VHDL type marks
diff --git a/Generate.hs b/Generate.hs
index 7c274e5..3e3a21d 100644
--- a/Generate.hs
+++ b/Generate.hs
@@ -374,6 +374,7 @@ genUnconsVectorFuns elemTM vectorTM  =
   , (selId, AST.SubProgBody selSpec  [AST.SPVD selVar] [selFor, selRet])
   , (ltplusId, AST.SubProgBody ltplusSpec [AST.SPVD ltplusVar] [ltplusExpr, ltplusRet]  )  
   , (plusplusId, AST.SubProgBody plusplusSpec [AST.SPVD plusplusVar] [plusplusExpr, plusplusRet])
+  , (lengthTId, AST.SubProgBody lengthTSpec [] [lengthTExpr])
   ]
   where 
     ixPar   = AST.unsafeVHDLBasicId "ix"
@@ -607,6 +608,9 @@ genUnconsVectorFuns elemTM vectorTM  =
                      ((AST.PrimName $ AST.NSimple vec1Par) AST.:&: 
                       (AST.PrimName $ AST.NSimple vec2Par))
     plusplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+    lengthTSpec = AST.Function (mkVHDLExtId lengthTId) [AST.IfaceVarDec vecPar vectorTM] naturalTM
+    lengthTExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NAttribute $ 
+                                AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing))
 
 -----------------------------------------------------------------------------
 -- A table of builtin functions
@@ -637,6 +641,7 @@ globalNameTable = Map.fromList
   , (emptyId          , (0, genFCall                ) )
   , (singletonId      , (1, genFCall                ) )
   , (copyId           , (2, genFCall                ) )
+  , (lengthTId        , (1, genFCall                ) )
   , (hwxorId          , (2, genOperator2 AST.Xor    ) )
   , (hwandId          , (2, genOperator2 AST.And    ) )
   , (hworId           , (2, genOperator2 AST.Or     ) )
diff --git a/HighOrdAlu.hs b/HighOrdAlu.hs
index 331fa1d..d453f64 100644
--- a/HighOrdAlu.hs
+++ b/HighOrdAlu.hs
@@ -10,12 +10,11 @@ import Data.RangedWord
 
 constant :: e -> Op D4 e
 constant e a b =
-  e +> (e +> (e +> (singleton e )))
+  copy (lengthT a) e
 
 invop :: Op n Bit
 invop a b = map hwnot a
 
-
 andop :: Op n Bit
 andop a b = zipWith hwand a b