From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Fri, 19 Jun 2009 08:13:43 +0000 (+0200)
Subject: Added global vector function generation
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=241a1d6f8a4bc9cccc0cacb05e8348fa3e204f74;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Added global vector function generation
---

diff --git a/Constants.hs b/Constants.hs
new file mode 100644
index 0000000..3a0e088
--- /dev/null
+++ b/Constants.hs
@@ -0,0 +1,174 @@
+module Constants where
+  
+import qualified ForSyDe.Backend.VHDL.AST as AST
+
+--------------
+-- Identifiers
+--------------
+
+-- | reset and clock signal identifiers in String form
+resetStr, clockStr :: String
+resetStr = "resetn"
+clockStr = "clock"
+
+-- | reset and clock signal identifiers in basic AST.VHDLId form
+resetId, clockId :: AST.VHDLId
+resetId = AST.unsafeVHDLBasicId resetStr
+clockId = AST.unsafeVHDLBasicId clockStr
+
+
+-- | \"types\" identifier
+typesId :: AST.VHDLId
+typesId = AST.unsafeVHDLBasicId "types"
+
+-- | work identifier
+workId :: AST.VHDLId
+workId = AST.unsafeVHDLBasicId "work"
+
+-- | std identifier
+stdId :: AST.VHDLId
+stdId = AST.unsafeVHDLBasicId "std"
+
+
+-- | textio identifier
+textioId :: AST.VHDLId
+textioId = AST.unsafeVHDLBasicId "textio"
+
+-- | range attribute identifier
+rangeId :: AST.VHDLId
+rangeId = AST.unsafeVHDLBasicId "range"
+
+
+-- | range attribute identifier
+imageId :: AST.VHDLId
+imageId = AST.unsafeVHDLBasicId "image"
+
+-- | event attribute identifie
+eventId :: AST.VHDLId
+eventId = AST.unsafeVHDLBasicId "event"
+
+
+-- | default function identifier
+defaultId :: AST.VHDLId
+defaultId = AST.unsafeVHDLBasicId "default"
+
+-- FSVec function identifiers
+
+-- | ex (operator ! in original Haskell source) function identifier
+exId :: AST.VHDLId
+exId = AST.unsafeVHDLBasicId "ex"
+
+-- | sel (function select in original Haskell source) function identifier
+selId :: AST.VHDLId
+selId = AST.unsafeVHDLBasicId "sel"
+
+
+-- | ltplus (function (<+) in original Haskell source) function identifier
+ltplusId :: AST.VHDLId
+ltplusId = AST.unsafeVHDLBasicId "ltplus"
+
+
+-- | plusplus (function (++) in original Haskell source) function identifier
+plusplusId :: AST.VHDLId
+plusplusId = AST.unsafeVHDLBasicId "plusplus"
+
+
+-- | empty function identifier
+emptyId :: AST.VHDLId
+emptyId = AST.unsafeVHDLBasicId "empty"
+
+-- | plusgt (function (+>) in original Haskell source) function identifier
+plusgtId :: AST.VHDLId
+plusgtId = AST.unsafeVHDLBasicId "plusgt"
+
+-- | singleton function identifier
+singletonId :: AST.VHDLId
+singletonId = AST.unsafeVHDLBasicId "singleton"
+
+-- | length function identifier
+lengthId :: AST.VHDLId
+lengthId = AST.unsafeVHDLBasicId "length"
+
+
+-- | isnull (function null in original Haskell source) function identifier
+isnullId :: AST.VHDLId
+isnullId = AST.unsafeVHDLBasicId "isnull"
+
+
+-- | replace function identifier
+replaceId :: AST.VHDLId
+replaceId = AST.unsafeVHDLBasicId "replace"
+
+
+-- | head function identifier
+headId :: AST.VHDLId
+headId = AST.unsafeVHDLBasicId "head"
+
+
+-- | last function identifier
+lastId :: AST.VHDLId
+lastId = AST.unsafeVHDLBasicId "last"
+
+
+-- | init function identifier
+initId :: AST.VHDLId
+initId = AST.unsafeVHDLBasicId "init"
+
+
+-- | tail function identifier
+tailId :: AST.VHDLId
+tailId = AST.unsafeVHDLBasicId "tail"
+
+
+-- | take function identifier
+takeId :: AST.VHDLId
+takeId = AST.unsafeVHDLBasicId "take"
+
+
+-- | drop function identifier
+dropId :: AST.VHDLId
+dropId = AST.unsafeVHDLBasicId "drop"
+
+-- | shiftl function identifier
+shiftlId :: AST.VHDLId
+shiftlId = AST.unsafeVHDLBasicId "shiftl"
+
+-- | shiftr function identifier
+shiftrId :: AST.VHDLId
+shiftrId = AST.unsafeVHDLBasicId "shiftr"
+
+-- | rotl function identifier
+rotlId :: AST.VHDLId
+rotlId = AST.unsafeVHDLBasicId "rotl"
+
+-- | reverse function identifier
+rotrId :: AST.VHDLId
+rotrId = AST.unsafeVHDLBasicId "rotr"
+
+-- | reverse function identifier
+reverseId :: AST.VHDLId
+reverseId = AST.unsafeVHDLBasicId "reverse"
+
+-- | copy function identifier
+copyId :: AST.VHDLId
+copyId = AST.unsafeVHDLBasicId "copy"
+
+------------------
+-- VHDL type marks
+------------------
+
+-- | Stardard logic type mark
+std_logicTM :: AST.TypeMark
+std_logicTM = AST.unsafeVHDLBasicId "std_logic"
+
+-- | boolean type mark
+booleanTM :: AST.TypeMark
+booleanTM = AST.unsafeVHDLBasicId "boolean"
+
+-- | fsvec_index AST. TypeMark
+tfvec_indexTM :: AST.TypeMark
+tfvec_indexTM = AST.unsafeVHDLBasicId "tfvec_index"
+
+-- | natural AST. TypeMark
+naturalTM :: AST.TypeMark
+naturalTM = AST.unsafeVHDLBasicId "natural"
\ No newline at end of file
diff --git a/Generate.hs b/Generate.hs
new file mode 100644
index 0000000..97d9488
--- /dev/null
+++ b/Generate.hs
@@ -0,0 +1,157 @@
+module Generate where
+  
+import qualified ForSyDe.Backend.VHDL.AST as AST
+import Constants
+
+-- | Generate a function call from the Function Name and a list of expressions
+--   (its arguments)
+genExprFCall :: AST.VHDLId -> [AST.Expr] -> AST.Expr
+genExprFCall fName args = 
+   AST.PrimFCall $ AST.FCall (AST.NSimple fName)  $
+             map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
+
+-- | List version of genExprFCall1
+genExprFCall1L :: AST.VHDLId -> [AST.Expr] -> AST.Expr
+genExprFCall1L fName [arg] = genExprFCall fName [arg]
+genExprFCall1L _ _ = error "Generate.genExprFCall1L incorrect length"
+
+-- | List version of genExprFCall2
+genExprFCall2L :: AST.VHDLId -> [AST.Expr] -> AST.Expr
+genExprFCall2L fName [arg1, arg2] = genExprFCall fName [arg1,arg2]
+genExprFCall2L _ _ = error "Generate.genExprFCall2L incorrect length"
+
+genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
+                    -> AST.TypeMark -- ^ type of the vector
+                    -> [AST.SubProgBody]
+genUnconsVectorFuns elemTM vectorTM  = 
+  [ AST.SubProgBody exSpec      []                  [exExpr]                    
+  , AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet]   
+    , AST.SubProgBody headSpec    []                  [headExpr]                  
+    , AST.SubProgBody lastSpec    []                  [lastExpr]                  
+    , AST.SubProgBody initSpec    [AST.SPVD initVar]  [initExpr, initRet]         
+    , AST.SubProgBody tailSpec    [AST.SPVD tailVar]  [tailExpr, tailRet]         
+    , AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet]         
+    , AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet]         
+  ]
+  where 
+    ixPar   = AST.unsafeVHDLBasicId "ix"
+    vecPar  = AST.unsafeVHDLBasicId "vec"
+    nPar    = AST.unsafeVHDLBasicId "n"
+    iId     = AST.unsafeVHDLBasicId "i"
+    iPar    = iId
+    aPar    = AST.unsafeVHDLBasicId "a"
+    resId   = AST.unsafeVHDLBasicId "res"
+    exSpec = AST.Function exId [AST.IfaceVarDec vecPar vectorTM,
+                               AST.IfaceVarDec ixPar  naturalTM] elemTM
+    exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed 
+              (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $ 
+                AST.NSimple ixPar]))
+    replaceSpec = AST.Function replaceId  [ AST.IfaceVarDec vecPar vectorTM
+                                          , AST.IfaceVarDec iPar   naturalTM
+                                          , AST.IfaceVarDec aPar   elemTM
+                                          ] vectorTM 
+       -- variable res : fsvec_x (0 to vec'length-1);
+    replaceVar =
+         AST.VarDec resId 
+                (AST.SubtypeIn vectorTM
+                  (Just $ AST.IndexConstraint 
+                   [AST.ToRange (AST.PrimLit "0")
+                            (AST.PrimName (AST.NAttribute $ 
+                              AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
+                                (AST.PrimLit "1"))   ]))
+                Nothing
+       --  res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
+    replaceExpr = AST.NSimple resId AST.:=
+           (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
+            AST.PrimName (AST.NSimple aPar) AST.:&: 
+             vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
+                      ((AST.PrimName (AST.NAttribute $ 
+                                AST.AttribName (AST.NSimple vecPar) lengthId Nothing)) 
+                                                              AST.:-: AST.PrimLit "1"))
+    replaceRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+    vecSlice init last =  AST.PrimName (AST.NSlice 
+                                        (AST.SliceName 
+                                              (AST.NSimple vecPar) 
+                                              (AST.ToRange init last)))
+    headSpec = AST.Function headId [AST.IfaceVarDec vecPar vectorTM] elemTM
+       -- return vec(0);
+    headExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName 
+                    (AST.NSimple vecPar) [AST.PrimLit "0"])))
+    lastSpec = AST.Function lastId [AST.IfaceVarDec vecPar vectorTM] elemTM
+       -- return vec(vec'length-1);
+    lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName 
+                    (AST.NSimple vecPar) 
+                    [AST.PrimName (AST.NAttribute $ 
+                                AST.AttribName (AST.NSimple vecPar) lengthId Nothing) 
+                                                             AST.:-: AST.PrimLit "1"])))
+    initSpec = AST.Function initId [AST.IfaceVarDec vecPar vectorTM] vectorTM 
+       -- variable res : fsvec_x (0 to vec'length-2);
+    initVar = 
+         AST.VarDec resId 
+                (AST.SubtypeIn vectorTM
+                  (Just $ AST.IndexConstraint 
+                   [AST.ToRange (AST.PrimLit "0")
+                            (AST.PrimName (AST.NAttribute $ 
+                              AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
+                                (AST.PrimLit "2"))   ]))
+                Nothing
+       -- resAST.:= vec(0 to vec'length-2)
+    initExpr = AST.NSimple resId AST.:= (vecSlice 
+                               (AST.PrimLit "0") 
+                               (AST.PrimName (AST.NAttribute $ 
+                                  AST.AttribName (AST.NSimple vecPar) lengthId Nothing) 
+                                                             AST.:-: AST.PrimLit "2"))
+    initRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+    tailSpec = AST.Function tailId [AST.IfaceVarDec vecPar vectorTM] vectorTM
+       -- variable res : fsvec_x (0 to vec'length-2); 
+    tailVar = 
+         AST.VarDec resId 
+                (AST.SubtypeIn vectorTM
+                  (Just $ AST.IndexConstraint 
+                   [AST.ToRange (AST.PrimLit "0")
+                            (AST.PrimName (AST.NAttribute $ 
+                              AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
+                                (AST.PrimLit "2"))   ]))
+                Nothing       
+       -- res AST.:= vec(1 to vec'length-1)
+    tailExpr = AST.NSimple resId AST.:= (vecSlice 
+                               (AST.PrimLit "1") 
+                               (AST.PrimName (AST.NAttribute $ 
+                                  AST.AttribName (AST.NSimple vecPar) lengthId Nothing) 
+                                                             AST.:-: AST.PrimLit "1"))
+    tailRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+    takeSpec = AST.Function takeId [AST.IfaceVarDec nPar   naturalTM,
+                                   AST.IfaceVarDec vecPar vectorTM ] vectorTM
+       -- variable res : fsvec_x (0 to n-1);
+    takeVar = 
+         AST.VarDec resId 
+                (AST.SubtypeIn vectorTM
+                  (Just $ AST.IndexConstraint 
+                   [AST.ToRange (AST.PrimLit "0")
+                               ((AST.PrimName (AST.NSimple nPar)) 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"))
+    takeRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+    dropSpec = AST.Function dropId [AST.IfaceVarDec nPar   naturalTM,
+                                   AST.IfaceVarDec vecPar vectorTM ] vectorTM 
+       -- variable res : fsvec_x (0 to vec'length-n-1);
+    dropVar = 
+         AST.VarDec resId 
+                (AST.SubtypeIn vectorTM
+                  (Just $ AST.IndexConstraint 
+                   [AST.ToRange (AST.PrimLit "0")
+                            (AST.PrimName (AST.NAttribute $ 
+                              AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
+                               (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
+               Nothing
+       -- res AST.:= vec(n to vec'length-1)
+    dropExpr = AST.NSimple resId AST.:= (vecSlice 
+                               (AST.PrimName $ AST.NSimple nPar) 
+                               (AST.PrimName (AST.NAttribute $ 
+                                  AST.AttribName (AST.NSimple vecPar) lengthId Nothing) 
+                                                             AST.:-: AST.PrimLit "1"))
+    dropRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
\ No newline at end of file
diff --git a/GlobalNameTable.hs b/GlobalNameTable.hs
new file mode 100644
index 0000000..ef4b25e
--- /dev/null
+++ b/GlobalNameTable.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module GlobalNameTable (globalNameTable) where
+
+import Language.Haskell.TH
+import qualified Data.Map as Map
+
+import qualified ForSyDe.Backend.VHDL.AST as AST
+import qualified Data.Param.TFVec as V
+
+import VHDLTypes
+import Constants
+import Generate
+
+mkGlobalNameTable :: [(String, (Int, [AST.Expr] -> AST.Expr ) )] -> NameTable
+mkGlobalNameTable = Map.fromList
+
+globalNameTable :: NameTable
+globalNameTable = mkGlobalNameTable
+  [ (show ('(V.!))           , (2, genExprFCall2L exId                           ) )
+  , ("head"          , (1, genExprFCall1L headId                         ) )
+  ]
\ No newline at end of file