Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project
authorChristiaan Baaij <christiaan.baaij@gmail.com>
Tue, 23 Jun 2009 13:39:25 +0000 (15:39 +0200)
committerChristiaan Baaij <christiaan.baaij@gmail.com>
Tue, 23 Jun 2009 13:39:25 +0000 (15:39 +0200)
* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Support turning dataconstructors into VHDL constants.
  Use varToVHDLExpr in mkConcSm.

Generate.hs
VHDL.hs

index 637ef27a0186847712f1c2a8303f7f16c3f72c1e..9a3a48cb791045280920b85f772f4a6acd0fc156 100644 (file)
@@ -31,23 +31,35 @@ genMapCall ::
   -> AST.GenerateSm -- | The resulting generate statement
 genMapCall len entity [arg, res] = genSm
   where
-    label = AST.unsafeVHDLBasicId ("mapVector" ++ (AST.fromVHDLId res))
+    label = mkVHDLExtId ("mapVector" ++ (AST.fromVHDLId res))
     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]
+    inport = mkAssocElemI (head argport) arg
+    outport = mkAssocElemI resport res
+    clk_port = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
+    portmaps = Maybe.catMaybes [inport,outport,clk_port]
+    portname = mkVHDLExtId ("map" ++ (AST.fromVHDLId entity_id))
     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 
+    mkAssocElemI :: Maybe AST.VHDLId -> AST.VHDLId -> Maybe AST.AssocElem
+    mkAssocElemI (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName 
                     (AST.NSimple signal) [AST.PrimName $ AST.NSimple nPar])))
+    mkAssocElemI Nothing _ = Nothing
+    mkAssocElem :: Maybe AST.VHDLId -> String -> Maybe AST.AssocElem
+    mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NSimple (mkVHDLExtId signal))) 
     mkAssocElem Nothing _ = Nothing
+    mkVHDLExtId :: String -> AST.VHDLId
+    mkVHDLExtId s = 
+      AST.unsafeVHDLExtId $ strip_invalid s
+      where 
+        -- Allowed characters, taken from ForSyde's mkVHDLExtId
+        allowed = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ " \"#&\\'()*+,./:;<=>_|!$%@?[]^`{}~-"
+        strip_invalid = filter (`elem` allowed)
 
 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
                     -> AST.TypeMark -- ^ type of the vector
diff --git a/VHDL.hs b/VHDL.hs
index 6a89930bf57c1d21d0a3c5bfb69f61923b225a88..90fc9dd7e9b7cec6e738c1f59b4b71281d6cec0b 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -310,13 +310,15 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
                   return [AST.CSSASm assign]
               Right genBuilder ->
                 let
+                  ty = Var.varType bndr
+                  len = tfvec_len ty 
                   sigs = map varBndr valargs
                   signature = Maybe.fromMaybe
                     (error $ "Using function '" ++ (bndrToString (head sigs)) ++ "' without signature? This should not happen!") 
                     (Map.lookup (head sigs) signatures)
                   arg_names = map (mkVHDLExtId . bndrToString) (tail sigs)
                   dst_name = mkVHDLExtId (bndrToString bndr)
-                  genSm = genBuilder 4 signature (arg_names ++ [dst_name])  
+                  genSm = genBuilder len signature (arg_names ++ [dst_name])  
                 in return [AST.CSGSm genSm]
           else
             error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString valargs