Clean up imports in Generate.hs

[matthijs/master-project/cλash.git] / cλash / CLasH / VHDL / Generate.hs

diff --git a/cλash/CLasH/VHDL/Generate.hs b/cλash/CLasH/VHDL/Generate.hs
index 4a62878af5f8756be751e2a9e28feeafe9496499..25eac722e714566346f3bf9e634f1aad89de72d1 100644 (file)
--- a/cλash/CLasH/VHDL/Generate.hs
+++ b/cλash/CLasH/VHDL/Generate.hs
@@ -1,14 +1,9 @@
-{-# LANGUAGE PackageImports #-}
-

 module CLasH.VHDL.Generate where
 
 -- Standard modules
 module CLasH.VHDL.Generate where
 
 -- Standard modules

-import qualified Control.Monad as Monad

 import qualified Data.Map as Map
 import qualified Maybe
 import qualified Data.Either as Either
 import qualified Data.Map as Map
 import qualified Maybe
 import qualified Data.Either as Either

-import qualified Control.Monad.Trans.State as State
-import qualified "transformers" Control.Monad.Identity as Identity

 import Data.Accessor
 import Data.Accessor.MonadState as MonadState
 import Debug.Trace
 import Data.Accessor
 import Data.Accessor.MonadState as MonadState
 import Debug.Trace


@@ -17,8 +12,8 @@ import Debug.Trace
 import qualified Language.VHDL.AST as AST
 
 -- GHC API
 import qualified Language.VHDL.AST as AST
 
 -- GHC API

-import CoreSyn
-import Type
+import qualified CoreSyn
+import qualified Type

 import qualified Var
 import qualified IdInfo
 import qualified Literal
 import qualified Var
 import qualified IdInfo
 import qualified Literal


@@ -166,38 +161,46 @@ genSizedInt = genFromInteger
 
 genTFVec :: BuiltinBuilder
 genTFVec (Left res) f [Left veclist] = do {
 
 genTFVec :: BuiltinBuilder
 genTFVec (Left res) f [Left veclist] = do {

-  ; let (CoreSyn.Let (CoreSyn.Rec [(bndr, app@(CoreSyn.App _ _))]) rez) = veclist
-  ; 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)
+  ; let (CoreSyn.Let (CoreSyn.Rec letbndrs) rez) = veclist
+  ; letapps <- mapM genLetApp letbndrs
+  ; let bndrs = Maybe.catMaybes (map fst letapps)

   ; (aap,kooi) <- reduceFSVECListToHsList rez
   ; (aap,kooi) <- reduceFSVECListToHsList rez

-  ; sigs <- mapM (\x -> MonadState.lift vsType $ varToVHDLExpr x) (bndr:aap)
+  ; sigs <- mapM (\x -> MonadState.lift vsType $ varToVHDLExpr x) (bndrs ++ aap)

   ; let vecsigns = concatsigs sigs
   ; let vecassign = mkUncondAssign (Left res) vecsigns
   ; let vecsigns = concatsigs sigs
   ; let vecassign = mkUncondAssign (Left res) vecsigns

-  ; sig_dec_maybes <- mapM mkSigDec (bndr:aap)
+  ; sig_dec_maybes <- mapM mkSigDec (bndrs ++ aap)

   ; let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
   ; let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)

-  ; let block_label = mkVHDLExtId ("FSVec_" ++ (show (map varToString (bndr:aap))))
-  ; let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (apps ++ kooi ++ [vecassign])  
+  ; 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) 
   ; 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
 reduceFSVECListToHsList app@(CoreSyn.App _ letexpr) = do
   case letexpr of

-    (CoreSyn.Let (CoreSyn.Rec [(bndr, app@(CoreSyn.App _ _))]) rez) -> do
-      let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
-      let valargs = get_val_args (Var.varType f) args
-      app <- genApplication (Left bndr) f (map Left valargs)
+    (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
       (vars, apps) <- reduceFSVECListToHsList rez

-      return ((bndr:vars),(app ++ apps))
+      return ((bndrs ++ vars),((concat app) ++ apps))

     otherwise -> return ([],[])
 
 
 -- | Generate a generate statement for the builtin function "map"
 genMap :: BuiltinBuilder
     otherwise -> return ([],[])
 
 
 -- | Generate a generate statement for the builtin function "map"
 genMap :: BuiltinBuilder

-genMap (Left res) f [Left mapped_f, Left (Var arg)] = do {
+genMap (Left res) f [Left mapped_f, Left (CoreSyn.Var arg)] = do {

   -- mapped_f must be a CoreExpr (since we can't represent functions as VHDL
   -- expressions). arg must be a CoreExpr (and should be a CoreSyn.Var), since
   -- we must index it (which we couldn't if it was a VHDL Expr, since only
   -- mapped_f must be a CoreExpr (since we can't represent functions as VHDL
   -- expressions). arg must be a CoreExpr (and should be a CoreSyn.Var), since
   -- we must index it (which we couldn't if it was a VHDL Expr, since only


@@ -273,7 +276,7 @@ genFold'' len left (Left res) f [folded_f, start, vec] = do
   -- An expression for len-1
   let len_min_expr = (AST.PrimLit $ show (len-1))
   -- evec is (TFVec n), so it still needs an element type
   -- An expression for len-1
   let len_min_expr = (AST.PrimLit $ show (len-1))
   -- evec is (TFVec n), so it still needs an element type

-  let (nvec, _) = splitAppTy (Var.varType vec)
+  let (nvec, _) = Type.splitAppTy (Var.varType vec)

   -- Put the type of the start value in nvec, this will be the type of our
   -- temporary vector
   let tmp_ty = Type.mkAppTy nvec (Var.varType start)
   -- Put the type of the start value in nvec, this will be the type of our
   -- temporary vector
   let tmp_ty = Type.mkAppTy nvec (Var.varType start)


@@ -421,7 +424,7 @@ genConcat' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var
 genConcat' (Left res) f args@[arg] = do {
     -- Setup the generate scheme
   ; len1 <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg
 genConcat' (Left res) f args@[arg] = do {
     -- Setup the generate scheme
   ; len1 <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg

-  ; let (_, nvec) = splitAppTy (Var.varType arg)
+  ; let (_, nvec) = Type.splitAppTy (Var.varType arg)

   ; len2 <- MonadState.lift vsType $ tfp_to_int $ tfvec_len_ty nvec
           -- TODO: Use something better than varToString
   ; let { label       = mkVHDLExtId ("concatVector" ++ (varToString res))
   ; len2 <- MonadState.lift vsType $ tfp_to_int $ tfvec_len_ty nvec
           -- TODO: Use something better than varToString
   ; let { label       = mkVHDLExtId ("concatVector" ++ (varToString res))


@@ -605,7 +608,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
                 builder dst f args
               else
                 error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args

-            Nothing -> return $ trace ("\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.
         IdInfo.ClassOpId cls -> do
           -- FIXME: Not looking for what instance this class op is called for
           -- Is quite stupid of course.