X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=619121aeee2cce42075c57eef886565ee1dd3985;hb=034f715bdc540686ab63a77023223a08dc663039;hp=a2f2fb1dc4991716b3072b885d62287a6eadb3a2;hpb=1ccb9c8289bfb3c2701bf62435332b4c94b04169;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs"
index a2f2fb1..619121a 100644
--- "a/c\316\273ash/CLasH/VHDL/Generate.hs"
+++ "b/c\316\273ash/CLasH/VHDL/Generate.hs"
@@ -161,6 +161,47 @@ genFromInteger' (Left res) f lits = do {
 
 genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 
+genSizedInt :: BuiltinBuilder
+genSizedInt = genFromInteger
+
+genTFVec :: BuiltinBuilder
+genTFVec (Left res) f [Left veclist] = do {
+  ; let (CoreSyn.Let (CoreSyn.Rec letbndrs) rez) = veclist
+  ; letapps <- mapM genLetApp letbndrs
+  ; let bndrs = Maybe.catMaybes (map fst letapps)
+  ; (aap,kooi) <- reduceFSVECListToHsList rez
+  ; sigs <- mapM (\x -> MonadState.lift vsType $ varToVHDLExpr x) (bndrs ++ aap)
+  ; let vecsigns = concatsigs sigs
+  ; let vecassign = mkUncondAssign (Left res) vecsigns
+  ; sig_dec_maybes <- mapM mkSigDec (bndrs ++ aap)
+  ; let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
+  ; let block_label = mkVHDLExtId ("FSVec_" ++ (show (map varToString (bndrs ++ aap))))
+  ; let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs ((concat (map snd letapps)) ++ kooi ++ [vecassign])  
+  ; return $ [AST.CSBSm block]
+  }
+  where
+    concatsigs x = AST.Aggregate (map (\z -> AST.ElemAssoc Nothing z) x) 
+
+genLetApp :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> VHDLSession (Maybe CoreSyn.CoreBndr, [AST.ConcSm])
+genLetApp (bndr, app@(CoreSyn.App _ _)) = do
+  let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
+  let valargs = get_val_args (Var.varType f) args
+  apps <- genApplication (Left bndr) f (map Left valargs)
+  return (Just bndr, apps)
+  
+genLetApp _ = return (Nothing,[])
+
+reduceFSVECListToHsList :: CoreSyn.CoreExpr -> VHDLSession ([CoreSyn.CoreBndr], [AST.ConcSm])
+reduceFSVECListToHsList app@(CoreSyn.App _ letexpr) = do
+  case letexpr of
+    (CoreSyn.Let (CoreSyn.Rec letbndrs) rez) -> do
+      letapps <- mapM genLetApp letbndrs
+      let bndrs = Maybe.catMaybes (map fst letapps)
+      let app = (map snd letapps)
+      (vars, apps) <- reduceFSVECListToHsList rez
+      return ((bndrs ++ vars),((concat app) ++ apps))
+    otherwise -> return ([],[])
+
 
 -- | Generate a generate statement for the builtin function "map"
 genMap :: BuiltinBuilder
@@ -549,6 +590,17 @@ genApplication dst f args = do
                 let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
                 mkUncondAssign (Right sel_name) arg
           Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder"
+        IdInfo.DataConWrapId dc -> case dst of
+          -- It's a datacon. Create a record from its arguments.
+          Left bndr -> do 
+            case (Map.lookup (varToString f) globalNameTable) of
+             Just (arg_count, builder) ->
+              if length args == arg_count then
+                builder dst f args
+              else
+                error $ "\nGenerate.genApplication(DataConWrapId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
+             Nothing -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper: " ++ (show dc)
+          Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper application without an original binder"
         IdInfo.VanillaId -> do
           -- It's a global value imported from elsewhere. These can be builtin
           -- functions. Look up the function name in the name table and execute
@@ -561,7 +613,7 @@ genApplication dst f args = do
                 builder dst f args
               else
                 error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
-            Nothing -> error $ "\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ pprString f
+            Nothing -> error $ ("\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ (pprString f))
         IdInfo.ClassOpId cls -> do
           -- FIXME: Not looking for what instance this class op is called for
           -- Is quite stupid of course.
@@ -1012,4 +1064,6 @@ globalNameTable = Map.fromList
   , (fromSizedWordId  , (1, genFromSizedWord        ) )
   , (fromIntegerId    , (1, genFromInteger          ) )
   , (resizeId         , (1, genResize               ) )
+  , (sizedIntId       , (1, genSizedInt             ) )
+  , (tfvecId          , (1, genTFVec                ) )
   ]