From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Mon, 22 Jun 2009 11:39:00 +0000 (+0200)
Subject: Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=98734f52c51081459172bd28c0913162264cf3e5;hp=cfc96ca7a1a615b1e36fbee996631f13f8b494cd;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Merge branch 'cλash' of git.stderr.nl/matthijs/projects/master-project

* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Check parameter counts in mkConcSm instead of the actual generate functions.
  Make the hw functions builtin operators instead of components.
  Fix typo.
---

diff --git a/Generate.hs b/Generate.hs
index 2beacb8..23e4a2c 100644
--- a/Generate.hs
+++ b/Generate.hs
@@ -3,6 +3,15 @@ module Generate where
 import qualified ForSyDe.Backend.VHDL.AST as AST
 import Constants
 
+-- | Generate a binary operator application. The first argument should be a
+-- constructor from the AST.Expr type, e.g. AST.And.
+genExprOp2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
+genExprOp2 op [arg1, arg2] = op arg1 arg2
+
+-- | Generate a unary operator application
+genExprOp1 :: (AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
+genExprOp1 op [arg] = op arg
+
 -- | Generate a function call from the Function Name and a list of expressions
 --   (its arguments)
 genExprFCall :: AST.VHDLId -> [AST.Expr] -> AST.Expr
@@ -10,16 +19,6 @@ 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]
@@ -154,4 +153,4 @@ genUnconsVectorFuns elemTM vectorTM  =
                                (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
+    dropRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
diff --git a/GlobalNameTable.hs b/GlobalNameTable.hs
index c860dcb..756c611 100644
--- a/GlobalNameTable.hs
+++ b/GlobalNameTable.hs
@@ -17,6 +17,10 @@ mkGlobalNameTable = Map.fromList
 
 globalNameTable :: NameTable
 globalNameTable = mkGlobalNameTable
-  [ ("!"    , (2, genExprFCall2L exId                           ) )
-  , ("head"           , (1, genExprFCall1L headId                         ) )
-  ]
\ No newline at end of file
+  [ ("!"              , (2, genExprFCall exId                             ) )
+  , ("head"           , (1, genExprFCall headId                           ) )
+  , ("hwxor"          , (2, genExprOp2 AST.Xor                            ) )
+  , ("hwand"          , (2, genExprOp2 AST.And                            ) )
+  , ("hwor"           , (2, genExprOp2 AST.And                            ) )
+  , ("hwnot"          , (1, genExprOp1 AST.Not                            ) )
+  ]
diff --git a/VHDL.hs b/VHDL.hs
index 76a2552..0f60fcb 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -280,20 +280,23 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
           let sel_name = mkSelectedName bndr label in
           mkUncondAssign (Right sel_name) (varToVHDLExpr arg)
     IdInfo.VanillaGlobal -> do
-      -- It's a global value imported from elsewhere. These can be builting
+      -- It's a global value imported from elsewhere. These can be builtin
       -- functions.
       funSignatures <- getA vsNameTable
       case (Map.lookup (bndrToString f) funSignatures) of
-        Just funSignature ->
-          let
-            sigs = map (bndrToString.varBndr) args
-            sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
-            func = (snd funSignature) sigsNames
-            src_wform = AST.Wform [AST.WformElem func Nothing]
-            dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
-            assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
-          in
-            return $ AST.CSSASm assign
+        Just (arg_count, builder) ->
+          if length args == arg_count then
+            let
+              sigs = map (bndrToString.varBndr) args
+              sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
+              func = builder sigsNames
+              src_wform = AST.Wform [AST.WformElem func Nothing]
+              dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
+              assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
+            in
+              return $ AST.CSSASm assign
+          else
+            error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString args
         Nothing -> error $ "Using function from another module that is not a known builtin: " ++ pprString f
     IdInfo.NotGlobalId -> do
       signatures <- getA vsSignatures