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

* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Add a hardware module for a generalized Alu.
  Make mkConcSm support a = b style bindings.
  Make appsimpl also simplify dataconstructors.
  Make subeverywhere support NonRec Lets.

diff --git a/HighOrdAlu.hs b/HighOrdAlu.hs
new file mode 100644 (file)
index 0000000..11636f2
--- /dev/null
+++ b/HighOrdAlu.hs
@@ -0,0 +1,30 @@
+module HighOrdAlu where
+
+import Prelude hiding (
+  null, length, head, tail, last, init, take, drop, (++), map, foldl, foldr,
+  zipWith, zip, unzip, concat, reverse, iterate )
+import Bits
+import Types
+import Data.Param.TFVec
+import Data.RangedWord
+
+constant :: e -> Op D4 e
+constant e a b =
+  e +> (e +> (e +> singleton e))
+
+inv = hwnot
+
+invop :: Op n Bit
+invop a b = map inv a
+
+type Op n e = (TFVec n e -> TFVec n e -> TFVec n e)
+type Opcode = Bit
+
+alu :: Op n e -> Op n e -> Opcode -> TFVec n e -> TFVec n e -> TFVec n e
+alu op1 op2 opc a b =
+  case opc of
+    Low -> op1 a b
+    High -> op2 a b
+
+zero_inv_alu :: Opcode -> TFVec D4 Bit -> TFVec D4 Bit -> TFVec D4 Bit
+zero_inv_alu = alu (constant Low) invop

diff --git a/Normalize.hs b/Normalize.hs
index 747a95b0c6eccd898bfbd12e0bec80f33a0910ae..9ee919ab524be8a211b99fe4b22bd7a03478079a 100644 (file)
--- a/Normalize.hs
+++ b/Normalize.hs
@@ -140,7 +140,7 @@ letflattop = everywhere ("letflat", letflat)
 --------------------------------
 -- Remove a = b bindings from let expressions everywhere
 letremovetop :: Transform
-letremovetop = everywhere ("letremove", inlinebind (\(b, e) -> case e of (Var v) -> True; otherwise -> False))
+letremovetop = everywhere ("letremove", inlinebind (\(b, e) -> case e of (Var v) | not $ Id.isDataConWorkId v -> True; otherwise -> False))
 
 --------------------------------
 -- Function inlining
@@ -288,8 +288,9 @@ caseremovetop = everywhere ("caseremove", caseremove)
 --------------------------------
 -- Make sure that all arguments in an application are simple variables.
 appsimpl, appsimpltop :: Transform
--- Don't simplify arguments that are already simple
-appsimpl expr@(App f (Var _)) = return expr
+-- Don't simplify arguments that are already simple. Do simplify datacons,
+-- however, since we can't portmap literals.
+appsimpl expr@(App f (Var v)) | not $ Id.isDataConWorkId v = return expr
 -- Simplify all non-applicable (to prevent loops with inlinefun) arguments,
 -- except for type arguments (since a let can't bind type vars, only a lambda
 -- can). Do this by introducing a new Let that binds the argument and passing

diff --git a/NormalizeTools.hs b/NormalizeTools.hs
index 8e57ba8f2ec2446301ebcf22ec83e03f577470b7..f016cfa9fc34684604a8efe487ac8f254297d5c3 100644 (file)
--- a/NormalizeTools.hs
+++ b/NormalizeTools.hs
@@ -119,6 +119,11 @@ subeverywhere trans (App a b) = do
   b' <- trans b
   return $ App a' b'
 
+subeverywhere trans (Let (NonRec b bexpr) expr) = do
+  bexpr' <- trans bexpr
+  expr' <- trans expr
+  return $ Let (NonRec b bexpr') expr'
+
 subeverywhere trans (Let (Rec binds) expr) = do
   expr' <- trans expr
   binds' <- mapM transbind binds

diff --git a/VHDL.hs b/VHDL.hs
index 90fc9dd7e9b7cec6e738c1f59b4b71281d6cec0b..72b0a925ec8554753109ff04946eb667a6581c04 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -269,6 +269,12 @@ mkConcSm ::
 -- the type works out.
 mkConcSm (bndr, Cast expr ty) = mkConcSm (bndr, expr)
 
+-- For simple a = b assignments, just generate an unconditional signal
+-- assignment. This should only happen for dataconstructors without arguments.
+-- TODO: Integrate this with the below code for application (essentially this
+-- is an application without arguments)
+mkConcSm (bndr, Var v) = return $ [mkUncondAssign (Left bndr) (varToVHDLExpr v)]
+
 mkConcSm (bndr, app@(CoreSyn.App _ _))= do
   let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
   let valargs' = filter isValArg args