X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Generate.hs;h=654dc8625cbc864ce49c15a9c7963d05419bda80;hb=597f1b6823417f2c4cc54549f2a9d1b9f131893c;hp=8053f9852a5653107e1f802842727214f14516fb;hpb=3f4773d25a4c44a0e4c9503806562a6741da3508;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Generate.hs b/Generate.hs
index 8053f98..654dc86 100644
--- a/Generate.hs
+++ b/Generate.hs
@@ -1,11 +1,21 @@
 module Generate where
 
+-- Standard modules
 import qualified Control.Monad as Monad
 import qualified Maybe
 
+-- ForSyDe
 import qualified ForSyDe.Backend.VHDL.AST as AST
+
+-- GHC API
+import CoreSyn
+import qualified Var
+
+-- Local imports
 import Constants
 import VHDLTypes
+import VHDLTools
+import CoreTools
 
 -- | Generate a binary operator application. The first argument should be a
 -- constructor from the AST.Expr type, e.g. AST.And.
@@ -25,30 +35,31 @@ genExprFCall fName args =
 
 -- | Generate a generate statement for the builtin function "map"
 genMapCall :: 
-  Int -- | The length of the vector 
-  -> Entity -- | The entity to map
-  -> AST.VHDLId -- | The input vector
-  -> AST.VHDLId -- | The output vector
+  Entity -- | The entity to map
+  -> [CoreSyn.CoreBndr] -- | The vectors
   -> AST.GenerateSm -- | The resulting generate statement
-genMapCall len entity arg res = genSm
+genMapCall entity [arg, res] = genSm
   where
-    label = AST.unsafeVHDLBasicId "mapVector"
-    nPar  = AST.unsafeVHDLBasicId "n"
-    range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
-    genScheme = AST.ForGn nPar range
-    entity_id = ent_id entity
-    argport = map (Monad.liftM fst) (ent_args entity)
-    resport = (Monad.liftM fst) (ent_res entity)
-    inport = mkAssocElem (head argport) arg
-    outport = mkAssocElem resport res
-    portmaps = Maybe.catMaybes [inport,outport]
-    portmap = AST.CSISm $ AST.CompInsSm (AST.unsafeVHDLBasicId "map12") (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
-    genSm = AST.GenerateSm label genScheme [] [portmap]
-    -- | Create an VHDL port -> signal association
-    mkAssocElem :: Maybe AST.VHDLId -> AST.VHDLId -> Maybe AST.AssocElem
-    mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName 
-                    (AST.NSimple signal) [AST.PrimName $ AST.NSimple nPar])))
-    mkAssocElem Nothing _ = Nothing
+    -- Setup the generate scheme
+    len         = (tfvec_len . Var.varType) res
+    label       = mkVHDLExtId ("mapVector" ++ (varToString res))
+    nPar        = AST.unsafeVHDLBasicId "n"
+    range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
+    genScheme   = AST.ForGn nPar range
+    -- Get the entity name and port names
+    entity_id   = ent_id entity
+    argport     = map (Monad.liftM fst) (ent_args entity)
+    resport     = (Monad.liftM fst) (ent_res entity)
+    -- Assign the ports
+    inport      = mkAssocElemIndexed (head argport) (varToString arg) nPar
+    outport     = mkAssocElemIndexed resport (varToString res) nPar
+    clk_port    = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
+    portassigns = Maybe.catMaybes [inport,outport,clk_port]
+    -- Generate the portmap
+    mapLabel    = "map" ++ (AST.fromVHDLId entity_id)
+    compins     = mkComponentInst mapLabel entity_id portassigns
+    -- Return the generate functions
+    genSm       = AST.GenerateSm label genScheme [] [compins]
 
 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
                     -> AST.TypeMark -- ^ type of the vector
@@ -62,7 +73,10 @@ genUnconsVectorFuns elemTM vectorTM  =
   , AST.SubProgBody tailSpec    [AST.SPVD tailVar]  [tailExpr, tailRet]         
   , AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet]         
   , AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet]    
-  , AST.SubProgBody plusgtSpec  [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]     
+  , AST.SubProgBody plusgtSpec  [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]
+  , AST.SubProgBody emptySpec   [AST.SPVD emptyVar] [emptyExpr]
+  , AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet] 
+  , AST.SubProgBody copySpec    [AST.SPVD copyVar]      [copyExpr]
   ]
   where 
     ixPar   = AST.unsafeVHDLBasicId "ix"
@@ -201,3 +215,37 @@ genUnconsVectorFuns elemTM vectorTM  =
                    ((AST.PrimName $ AST.NSimple aPar) AST.:&: 
                     (AST.PrimName $ AST.NSimple vecPar))
     plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+    emptySpec = AST.Function emptyId [] vectorTM
+    emptyVar = 
+          AST.VarDec resId 
+              (AST.SubtypeIn vectorTM
+                (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
+                 [AST.ToRange (AST.PrimLit "0")
+                          (AST.PrimLit "-1")]))
+              Nothing
+    emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
+    singletonSpec = AST.Function singletonId [AST.IfaceVarDec aPar elemTM ] 
+                                         vectorTM
+    -- variable res : fsvec_x (0 to 0) := (others => a);
+    singletonVar = 
+      AST.VarDec resId 
+             (AST.SubtypeIn vectorTM
+               (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
+                [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "0")]))
+             (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others) 
+                                          (AST.PrimName $ AST.NSimple aPar)])
+    singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+    copySpec = AST.Function copyId [AST.IfaceVarDec nPar   naturalTM,
+                                   AST.IfaceVarDec aPar   elemTM   ] vectorTM 
+    -- variable res : fsvec_x (0 to n-1) := (others => a);
+    copyVar = 
+      AST.VarDec resId 
+             (AST.SubtypeIn vectorTM
+               (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
+                [AST.ToRange (AST.PrimLit "0")
+                            ((AST.PrimName (AST.NSimple nPar)) AST.:-:
+                             (AST.PrimLit "1"))   ]))
+             (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others) 
+                                          (AST.PrimName $ AST.NSimple aPar)])
+    -- return res
+    copyExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)