Write the resulting vhdl to file.

[matthijs/master-project/cλash.git] / Translator.hs

diff --git a/Translator.hs b/Translator.hs
index 769708f3632f911d6a1f6f9eb55049ebcb5440ef..4992d1cca7910940f4c1cfc6cc22cdf686ca143b 100644 (file)
--- a/Translator.hs
+++ b/Translator.hs
@@ -26,6 +26,7 @@ import qualified Monad
 -- ForSyDe to get access to these modules.
 import qualified ForSyDe.Backend.VHDL.AST as AST
 import qualified ForSyDe.Backend.VHDL.Ppr
+import qualified ForSyDe.Backend.VHDL.FileIO
 import qualified ForSyDe.Backend.Ppr
 -- This is needed for rendering the pretty printed VHDL
 import Text.PrettyPrint.HughesPJ (render)
@@ -49,6 +50,7 @@ main =
           -- Turn bind into VHDL
           let vhdl = State.evalState (mkVHDL binds) (VHDLSession 0 [])
           liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr vhdl
+          liftIO $ ForSyDe.Backend.VHDL.FileIO.writeDesignFile vhdl "../vhdl/vhdl/output.vhdl"
           return ()
   where
     -- Turns the given bind into VHDL
@@ -206,7 +208,7 @@ expandExpr ::
                                          -- the expression's result.
 expandExpr binds lam@(Lam b expr) = do
   -- Generate a new signal to which we will expect this argument to be bound.
-  signal_name <- uniqueName ("arg-" ++ getOccString b)
+  signal_name <- uniqueName ("arg_" ++ getOccString b)
   -- Find the type of the binder
   let (arg_ty, _) = Type.splitFunTy (CoreUtils.exprType lam)
   -- Create signal names for the binder
@@ -329,7 +331,7 @@ expandApplicationExpr ::
 expandApplicationExpr binds ty f args = do
   let name = getOccString f
   -- Generate a unique name for the application
-  appname <- uniqueName ("app-" ++ name)
+  appname <- uniqueName ("app_" ++ name)
   -- Lookup the hwfunction to instantiate
   HWFunction vhdl_id inports outport <- getHWFunc name
   -- Expand each of the args, so each of them is reduced to output signals
@@ -337,7 +339,7 @@ expandApplicationExpr binds ty f args = do
   -- Bind each of the input ports to the expanded arguments
   let inmaps = concat $ zipWith createAssocElems inports arg_res_signals
   -- Create signal names for our result
-  let res_signal = getPortNameMapForTy (appname ++ "-out") ty
+  let res_signal = getPortNameMapForTy (appname ++ "_out") ty
   -- Create the corresponding signal declarations
   let signal_decls = mkSignalsFromMap res_signal
   -- Bind each of the output ports to our output signals
@@ -531,8 +533,7 @@ getPortNameMapForTy name ty =
     -- Expand tuples we find
     Tuple (getPortNameMapForTys name 0 args)
   else -- Assume it's a type constructor application, ie simple data type
-    -- TODO: Don't hardcode the type here
-    Signal (AST.unsafeVHDLBasicId name) vhdl_bit_ty
+    Signal (AST.unsafeVHDLBasicId name) (vhdl_ty ty)
   where
     (tycon, args) = Type.splitTyConApp ty 
 
@@ -595,7 +596,7 @@ uniqueName :: String -> VHDLState String
 uniqueName name = do
   count <- State.gets nameCount -- Get the funcs element from the session
   State.modify (\s -> s {nameCount = count + 1})
-  return $ name ++ "-" ++ (show count)
+  return $ name ++ "_" ++ (show count)
 
 -- Shortcut
 mkVHDLId :: String -> AST.VHDLId
@@ -612,4 +613,22 @@ builtin_funcs =
 vhdl_bit_ty :: AST.TypeMark
 vhdl_bit_ty = AST.unsafeVHDLBasicId "Bit"
 
+-- Translate a Haskell type to a VHDL type
+vhdl_ty :: Type -> AST.TypeMark
+vhdl_ty ty = Maybe.fromMaybe
+  (error $ "Unsupported Haskell type: " ++ (showSDoc $ ppr ty))
+  (vhdl_ty_maybe ty)
+
+-- Translate a Haskell type to a VHDL type
+vhdl_ty_maybe :: Type -> Maybe AST.TypeMark
+vhdl_ty_maybe ty =
+  case Type.splitTyConApp_maybe ty of
+    Just (tycon, args) ->
+      let name = TyCon.tyConName tycon in
+        -- TODO: Do something more robust than string matching
+        case getOccString name of
+          "Bit"      -> Just vhdl_bit_ty
+          otherwise  -> Nothing
+    otherwise -> Nothing
+
 -- vim: set ts=8 sw=2 sts=2 expandtab: