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

* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Unify all BuiltinBuilder functions.
  Give HighOrdAlu an and operation.
  Let tfvec_len and tfvec_elem give a proper error message.
  No longer use a view pattern in HsTools.

Conflicts:
	Generate.hs

diff --git a/Generate.hs b/Generate.hs
index 7de216129dfbed6cf4d55fb4e415d00fbc746c19..7b8dcf0894fb0ca41296f08addd659d07868b651 100644 (file)
--- a/Generate.hs
+++ b/Generate.hs
@@ -92,10 +92,9 @@ genMap' res f [mapped_f, arg] = do
     argports   = map (Monad.liftM fst) (ent_args entity)
     resport     = (Monad.liftM fst) (ent_res entity)
     -- Assign the ports
-    inport      = mkAssocElemIndexed (argports!!0) (varToString arg) nPar
-    outport     = mkAssocElemIndexed resport (varToString res) nPar
-    clk_port    = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
-    portassigns = Maybe.catMaybes [inport,outport,clk_port]
+    inport      = mkAssocElemIndexed (argports!!0) (varToVHDLId arg) nPar
+    outport     = mkAssocElemIndexed resport (varToVHDLId res) nPar
+    portassigns = Maybe.catMaybes [inport,outport]
     -- Generate the portmap
     mapLabel    = "map" ++ (AST.fromVHDLId entity_id)
     compins     = mkComponentInst mapLabel entity_id portassigns
@@ -123,11 +122,10 @@ genZipWith' res f args@[zipped_f, arg1, arg2] = do
     argports    = map (Monad.liftM fst) (ent_args entity)
     resport     = (Monad.liftM fst) (ent_res entity)
     -- Assign the ports
-    inport1     = mkAssocElemIndexed (argports!!0) (varToString arg1) nPar
-    inport2     = mkAssocElemIndexed (argports!!1) (varToString arg2) nPar 
-    outport     = mkAssocElemIndexed resport (varToString res) nPar
-    clk_port    = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
-    portassigns = Maybe.catMaybes [inport1,inport2,outport,clk_port]
+    inport1     = mkAssocElemIndexed (argports!!0) (varToVHDLId arg1) nPar
+    inport2     = mkAssocElemIndexed (argports!!1) (varToVHDLId arg2) nPar 
+    outport     = mkAssocElemIndexed resport (varToVHDLId res) nPar
+    portassigns = Maybe.catMaybes [inport1,inport2,outport]
     -- Generate the portmap
     mapLabel    = "zipWith" ++ (AST.fromVHDLId entity_id)
     compins     = mkComponentInst mapLabel entity_id portassigns
@@ -150,85 +148,77 @@ genFoldl' resVal f [folded_f, startVal, inVec] = do
   let  len         = (tfvec_len . Var.varType) inVec
   let  genlabel       = mkVHDLExtId ("foldlVector" ++ (varToString inVec))
   let  blockLabel  = mkVHDLExtId ("foldlVector" ++ (varToString startVal))
-  let  nPar        = AST.unsafeVHDLBasicId "n"
   let  range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
-  let  genScheme   = AST.ForGn nPar range
+  let  genScheme   = AST.ForGn (AST.unsafeVHDLBasicId "n") range
   -- Make the intermediate vector
   let  tmpVec      = AST.BDISD $ AST.SigDec (mkVHDLExtId "tmp") vecType Nothing
-    -- Return the generate functions
-  let genSm       = AST.GenerateSm genlabel genScheme []  [ AST.CSGSm (genFirstCell entity [startVal, inVec, resVal])
-                                                          , AST.CSGSm (genOtherCell entity [startVal, inVec, resVal])
-                                                          , AST.CSGSm (genLastCell entity [startVal, inVec, resVal])
-                                                          ]
-  return [AST.CSBSm $ AST.BlockSm blockLabel [] (AST.PMapAspect []) [tmpVec] [AST.CSGSm genSm]]
+  -- Get the entity name and port names
+  let entity_id   = ent_id entity
+  let argports    = map (Monad.liftM fst) (ent_args entity)
+  let resport     = (Monad.liftM fst) (ent_res entity)
+  -- Return the generate functions
+  let genSm       = AST.GenerateSm genlabel genScheme [] 
+                      [ AST.CSGSm (genFirstCell (entity_id, argports, resport) 
+                                    [startVal, inVec, resVal])
+                      , AST.CSGSm (genOtherCell (entity_id, argports, resport) 
+                                    [startVal, inVec, resVal])
+                      , AST.CSGSm (genLastCell (entity_id, argports, resport) 
+                                    [startVal, inVec, resVal])
+                      ]
+  return $ [AST.CSBSm $ AST.BlockSm blockLabel [] (AST.PMapAspect []) [tmpVec] [AST.CSGSm genSm]]
   where
-    genFirstCell :: Entity -> [CoreSyn.CoreBndr] -> AST.GenerateSm 
-    genFirstCell entity [startVal, inVec, resVal] = cellGn
+    genFirstCell (entity_id, argports, resport) [startVal, inVec, resVal] = cellGn
       where
         cellLabel    = mkVHDLExtId "firstcell"
         cellGenScheme = AST.IfGn ((AST.PrimName $ AST.NSimple nPar)  AST.:=: (AST.PrimLit "0"))
+        tmpId       = mkVHDLExtId "tmp"
         nPar        = AST.unsafeVHDLBasicId "n"
-        -- Get the entity name and port names
-        entity_id   = ent_id entity
-        argports    = map (Monad.liftM fst) (ent_args entity)
-        resport     = (Monad.liftM fst) (ent_res entity)
         -- Assign the ports
         inport1     = mkAssocElem (argports!!0) (varToString startVal)
-        inport2     = mkAssocElemIndexed (argports!!1) (varToString inVec) nPar 
-        outport     = mkAssocElemIndexed resport "tmp" nPar
-        clk_port    = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
-        portassigns = Maybe.catMaybes [inport1,inport2,outport,clk_port]
+        inport2     = mkAssocElemIndexed (argports!!1) (varToVHDLId inVec) nPar 
+        outport     = mkAssocElemIndexed resport tmpId nPar
+        portassigns = Maybe.catMaybes [inport1,inport2,outport]
         -- Generate the portmap
         mapLabel    = "cell" ++ (AST.fromVHDLId entity_id)
         compins     = mkComponentInst mapLabel entity_id portassigns
         -- Return the generate functions
         cellGn       = AST.GenerateSm cellLabel cellGenScheme [] [compins]
-    genOtherCell :: Entity -> [CoreSyn.CoreBndr] -> AST.GenerateSm
-    genOtherCell entity [startVal, inVec, resVal] = cellGn
+    genOtherCell (entity_id, argports, resport) [startVal, inVec, resVal] = cellGn
       where
         len         = (tfvec_len . Var.varType) inVec
         cellLabel    = mkVHDLExtId "othercell"
         cellGenScheme = AST.IfGn $ AST.And ((AST.PrimName $ AST.NSimple nPar)  AST.:>: (AST.PrimLit "0"))
                                 ((AST.PrimName $ AST.NSimple nPar)  AST.:<: (AST.PrimLit $ show (len-1)))
+        tmpId       = mkVHDLExtId "tmp"
         nPar        = AST.unsafeVHDLBasicId "n"
-        -- Get the entity name and port names
-        entity_id   = ent_id entity
-        argports    = map (Monad.liftM fst) (ent_args entity)
-        resport     = (Monad.liftM fst) (ent_res entity)
         -- Assign the ports
-        inport1     = mkAssocElemIndexed (argports!!0) "tmp" (AST.unsafeVHDLBasicId "n-1")
-        inport2     = mkAssocElemIndexed (argports!!1) (varToString inVec) nPar 
-        outport     = mkAssocElemIndexed resport "tmp" nPar
-        clk_port    = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
-        portassigns = Maybe.catMaybes [inport1,inport2,outport,clk_port]
+        inport1     = mkAssocElemIndexed (argports!!0) tmpId (AST.unsafeVHDLBasicId "n-1")
+        inport2     = mkAssocElemIndexed (argports!!1) (varToVHDLId inVec) nPar 
+        outport     = mkAssocElemIndexed resport tmpId nPar
+        portassigns = Maybe.catMaybes [inport1,inport2,outport]
         -- Generate the portmap
         mapLabel    = "cell" ++ (AST.fromVHDLId entity_id)
         compins     = mkComponentInst mapLabel entity_id portassigns
         -- Return the generate functions
         cellGn      = AST.GenerateSm cellLabel cellGenScheme [] [compins]
-    genLastCell :: Entity -> [CoreSyn.CoreBndr] -> AST.GenerateSm
-    genLastCell entity [startVal, inVec, resVal] = cellGn
+    genLastCell (entity_id, argports, resport) [startVal, inVec, resVal] = cellGn
       where
         len         = (tfvec_len . Var.varType) inVec
         cellLabel    = mkVHDLExtId "lastCell"
         cellGenScheme = AST.IfGn ((AST.PrimName $ AST.NSimple nPar)  AST.:=: (AST.PrimLit $ show (len-1)))
+        tmpId       = mkVHDLExtId "tmp"
         nPar        = AST.unsafeVHDLBasicId "n"
-        -- Get the entity name and port names
-        entity_id   = ent_id entity
-        argports    = map (Monad.liftM fst) (ent_args entity)
-        resport     = (Monad.liftM fst) (ent_res entity)
         -- Assign the ports
-        inport1     = mkAssocElemIndexed (argports!!0) "tmp" (AST.unsafeVHDLBasicId "n-1")
-        inport2     = mkAssocElemIndexed (argports!!1) (varToString inVec) nPar 
-        outport     = mkAssocElemIndexed resport "tmp" nPar
-        clk_port    = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
-        portassigns = Maybe.catMaybes [inport1,inport2,outport,clk_port]
+        inport1     = mkAssocElemIndexed (argports!!0) tmpId (AST.unsafeVHDLBasicId "n-1")
+        inport2     = mkAssocElemIndexed (argports!!1) (varToVHDLId inVec) nPar 
+        outport     = mkAssocElemIndexed resport tmpId nPar
+        portassigns = Maybe.catMaybes [inport1,inport2,outport]
         -- Generate the portmap
         mapLabel    = "cell" ++ (AST.fromVHDLId entity_id)
         compins     = mkComponentInst mapLabel entity_id portassigns
         -- Generate the output assignment
         assign      = mkUncondAssign (Left resVal) (AST.PrimName (AST.NIndexed (AST.IndexedName 
-                              (AST.NSimple (mkVHDLExtId "tmp")) [AST.PrimLit $ show (len-1)])))
+                              (AST.NSimple tmpId) [AST.PrimLit $ show (len-1)])))
         -- Return the generate functions
         cellGn      = AST.GenerateSm cellLabel cellGenScheme [] [compins,assign]
 

diff --git a/VHDL.hs b/VHDL.hs
index 920b83ed6be5de1f96c84f7d7fdf26ac8feeec20..4b69df5106071bc28c5c22ec343784f0610509d9 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -315,9 +315,9 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
         label = "comp_ins_" ++ varToString bndr
         -- Add a clk port if we have state
         --clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
-        clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
+        --clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
         --portmaps = mkAssocElems sigs args res signature ++ (if hasState hsfunc then [clk_port] else [])
-        portmaps = clk_port : mkAssocElems args bndr signature
+        portmaps = mkAssocElems args bndr signature
         in
           return [mkComponentInst label entity_id portmaps]
     details -> error $ "Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details

diff --git a/VHDLTools.hs b/VHDLTools.hs
index a4d10aefa03a109a5c9393c23b81bd3ec7fd45ed..178c743b6f6b439f0bece10519671b3d45d9d075 100644 (file)
--- a/VHDLTools.hs
+++ b/VHDLTools.hs
@@ -100,9 +100,9 @@ mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NSim
 mkAssocElem Nothing _ = Nothing
 
 -- | Create an VHDL port -> signal association
-mkAssocElemIndexed :: Maybe AST.VHDLId -> String -> AST.VHDLId -> Maybe AST.AssocElem
+mkAssocElemIndexed :: Maybe AST.VHDLId -> AST.VHDLId -> AST.VHDLId -> Maybe AST.AssocElem
 mkAssocElemIndexed (Just port) signal index = Just $ Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName 
-                      (AST.NSimple (mkVHDLExtId signal)) [AST.PrimName $ AST.NSimple index])))
+                      (AST.NSimple signal) [AST.PrimName $ AST.NSimple index])))
 mkAssocElemIndexed Nothing _ _ = Nothing
 
 mkComponentInst ::
@@ -112,7 +112,9 @@ mkComponentInst ::
   -> AST.ConcSm
 mkComponentInst label entity_id portassigns = AST.CSISm compins
   where
-    compins = AST.CompInsSm (mkVHDLExtId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portassigns)
+    -- We always have a clock port, so no need to map it anywhere but here
+    clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
+    compins = AST.CompInsSm (mkVHDLExtId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect (portassigns ++ [clk_port]))
 
 -----------------------------------------------------------------------------
 -- Functions to generate VHDL Exprs