Add a base case to splitTupleConstructorArgs.

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

diff --git a/Translator.hs b/Translator.hs
index 4d32dd2c4bcc5e059f492a328da7177b5d51ca2e..12393e8891f175dec71bedf6e7266a998f534a5b 100644 (file)
--- a/Translator.hs
+++ b/Translator.hs
@@ -18,6 +18,9 @@ import Outputable ( showSDoc, ppr )
 import GHC.Paths ( libdir )
 import DynFlags ( defaultDynFlags )
 import List ( find )
+import qualified List
+import qualified Monad
+
 -- The following modules come from the ForSyDe project. They are really
 -- internal modules, so ForSyDe.cabal has to be modified prior to installing
 -- ForSyDe to get access to these modules.
@@ -41,7 +44,7 @@ main =
           --core <- GHC.compileToCoreSimplified "Adders.hs"
           core <- GHC.compileToCoreSimplified "Adders.hs"
           liftIO $ printBinds (cm_binds core)
-          let bind = findBind "inv" (cm_binds core)
+          let bind = findBind "dup" (cm_binds core)
           let NonRec var expr = bind
           -- Turn bind into VHDL
           let vhdl = State.evalState (mkVHDL bind) (VHDLSession 0 builtin_funcs)
@@ -238,8 +241,20 @@ expandBuildTupleExpr ::
   -> [CoreExpr]                          -- A list of expressions to put in the tuple
   -> VHDLState ( [AST.SigDec], [AST.ConcSm], [SignalNameMap AST.VHDLId], SignalNameMap AST.VHDLId)
                                          -- See expandExpr
-expandBuildTupleExpr binds args =
-  error $ "Tuple construction not supported"
+expandBuildTupleExpr binds args = do
+  -- Split the tuple constructor arguments into types and actual values.
+  let (_, vals) = splitTupleConstructorArgs args
+  -- Expand each of the values in the tuple
+  (signals_declss, statementss, arg_signalss, res_signals) <-
+    (Monad.liftM List.unzip4) $ mapM (expandExpr binds) vals
+  if any (not . null) arg_signalss
+    then error "Putting high order functions in tuples not supported"
+    else
+      return (
+        concat signals_declss,
+        concat statementss,
+        [],
+        Tuple res_signals)
 
 -- Expands the application of argument to a function into VHDL
 expandApplicationExpr ::
@@ -325,22 +340,15 @@ expandArgs ::
                                          -- expressions passed in.
 expandArgs binds (e:exprs) = do
   -- Expand the first expression
-  arg <- case e of
-    -- A simple variable reference should be in our binds map
-    Var id -> return $ let
-        -- Lookup the id in our binds map
-        Signal signalid = Maybe.fromMaybe
-          (error $ "Argument " ++ getOccString id ++ "is unknown")
-          (lookup id binds)
-      in
-        -- Create a VHDL name from the signal name
-        Signal signalid
-    -- Other expressions are unsupported
-    otherwise -> error ("Unsupported expression used as argument: " ++ (showSDoc $ ppr e))
-  -- Expand the rest
-  (sigs, comps, args) <- expandArgs binds exprs
-  -- Return all results
-  return (sigs, comps, arg:args)
+  (signal_decls, statements, arg_signals, res_signal) <- expandExpr binds e
+  if not (null arg_signals)
+    then error $ "Passing functions as arguments not supported: " ++ (showSDoc $ ppr e)
+    else do
+      (signal_decls', statements', res_signals') <- expandArgs binds exprs
+      return (
+        signal_decls ++ signal_decls',
+        statements ++ statements',
+        res_signal : res_signals')
 
 expandArgs _ [] = return ([], [], [])
 
@@ -366,6 +374,8 @@ splitTupleConstructorArgs (e:es) =
   where
     (tys, vals) = splitTupleConstructorArgs es
 
+splitTupleConstructorArgs [] = ([], [])
+
 mapOutputPorts ::
   SignalNameMap AST.VHDLId      -- The output portnames of the component
   -> SignalNameMap AST.VHDLId   -- The output portnames and/or signals to map these to