--- /dev/null
+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
--------------------------------
-- 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
--------------------------------
-- 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
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
-- 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