functiontest :: TFVec D3 (TFVec D4 Bit) -> TFVec D12 Bit
functiontest = \v -> let r = concat v in r
+functiontest2 :: SizedInt D8 -> SizedInt D8
+functiontest2 = \a -> let r = a + 1 in r
+
xhwnot x = hwnot x
maptest :: TFVec D4 Bit -> TFVec D4 Bit
getLiterals app@(CoreSyn.App _ _) = literals
where
(CoreSyn.Var f, args) = CoreSyn.collectArgs app
- literals = filter (is_lit) args
\ No newline at end of file
+ literals = filter (is_lit) args
-> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
genExprArgs ty_state wrap dst func args = wrap dst func args'
where args' = map (either ((varToVHDLExpr ty_state).exprToVar) id) args
-
+
-- | A function to wrap a builder-like function that expects its arguments to
-- be variables.
genVarArgs ::
signatures <- getA vsSignatures
-- This is a local id, so it should be a function whose definition we
-- have and which can be turned into a component instantiation.
- let
- signature = Maybe.fromMaybe
- (error $ "\nGenerate.genApplication: Using function '" ++ (varToString f) ++ "' without signature? This should not happen!")
- (Map.lookup f signatures)
- entity_id = ent_id signature
- -- TODO: Using show here isn't really pretty, but we'll need some
- -- unique-ish value...
- label = "comp_ins_" ++ (either show prettyShow) dst
- portmaps = mkAssocElems (map (either (exprToVHDLExpr ty_state) id) args) ((either varToVHDLName id) dst) signature
- in
- return [mkComponentInst label entity_id portmaps]
+ case (Map.lookup f signatures) of
+ Just signature -> let
+ -- We have a signature, this is a top level binding. Generate a
+ -- component instantiation.
+ entity_id = ent_id signature
+ -- TODO: Using show here isn't really pretty, but we'll need some
+ -- unique-ish value...
+ label = "comp_ins_" ++ (either show prettyShow) dst
+ portmaps = mkAssocElems (map (either (exprToVHDLExpr ty_state) id) args) ((either varToVHDLName id) dst) signature
+ in
+ return [mkComponentInst label entity_id portmaps]
+ Nothing -> do
+ -- No signature, so this must be a local variable reference. It
+ -- should have a representable type (and thus, no arguments) and a
+ -- signal should be generated for it. Just generate an
+ -- unconditional assignment here.
+ ty_state <- getA vsType
+ return $ [mkUncondAssign dst ((varToVHDLExpr ty_state) f)]
+
IdInfo.ClassOpId cls -> do
-- FIXME: Not looking for what instance this class op is called for
-- Is quite stupid of course.
-- let simplification
--------------------------------
letsimpl, letsimpltop :: Transform
--- Don't simplifiy lets that are already simple
-letsimpl expr@(Let _ (Var _)) = return expr
-- Put the "in ..." value of a let in its own binding, but not when the
-- expression is applicable (to prevent loops with inlinefun).
-letsimpl (Let (Rec binds) expr) | not $ is_applicable expr = do
- id <- mkInternalVar "foo" (CoreUtils.exprType expr)
- let bind = (id, expr)
- change $ Let (Rec (bind:binds)) (Var id)
+letsimpl expr@(Let (Rec binds) res) | not $ is_applicable expr = do
+ local_var <- Trans.lift $ is_local_var res
+ if not local_var
+ then do
+ -- If the result is not a local var already (to prevent loops with
+ -- ourselves), extract it.
+ id <- mkInternalVar "foo" (CoreUtils.exprType res)
+ let bind = (id, res)
+ change $ Let (Rec (bind:binds)) (Var id)
+ else
+ -- If the result is already a local var, don't extract it.
+ return expr
+
-- Leave all other expressions unchanged
letsimpl expr = return expr
-- Perform this transform everywhere
--------------------------------
-- Remove a = b bindings from let expressions everywhere
letremovetop :: Transform
-letremovetop = everywhere ("letremove", inlinebind (\(b, e) -> case e of (Var v) | not $ Id.isDataConWorkId v -> return True; otherwise -> return False))
+letremovetop = everywhere ("letremove", inlinebind (\(b, e) -> Trans.lift $ is_local_var e))
--------------------------------
-- Function inlining
--------------------------------
-- Make sure that all arguments of a representable type are simple variables.
appsimpl, appsimpltop :: Transform
--- Don't simplify arguments that are already simple.
-appsimpl expr@(App f (Var v)) = return expr
-- Simplify all representable arguments. Do this by introducing a new Let
-- that binds the argument and passing the new binder in the application.
appsimpl expr@(App f arg) = do
-- Check runtime representability
repr <- isRepr arg
- if repr
+ local_var <- Trans.lift $ is_local_var arg
+ if repr && not local_var
then do -- Extract representable arguments
id <- mkInternalVar "arg" (CoreUtils.exprType arg)
change $ Let (Rec [(id, arg)]) (App f (Var id))
-- Find all vars used with a function type. All of these should be global
-- binders (i.e., functions used), since any local binders with a function
-- type should have been inlined already.
- let used_funcs_set = CoreFVs.exprSomeFreeVars (\v -> (Type.isFunTy . snd . Type.splitForAllTys . Id.idType) v) expr'
+ bndrs <- getGlobalBinders
+ let used_funcs_set = CoreFVs.exprSomeFreeVars (\v -> not (Id.isDictId v) && v `elem` bndrs) expr'
let used_funcs = VarSet.varSetElems used_funcs_set
-- Process each of the used functions recursively
mapM normalizeBind used_funcs
- -- FIXME: Can't we inline these 'implicit' function calls or something?
- -- TODO: Add an extra let expression to the current finding, so the VHDL
- -- Will make a signa assignment for this 'implicit' function call
- --
- -- Find all the other free variables used that are used. This applies to
- -- variables that are actually a reference to a Class function. Example:
- --
- -- functiontest :: SizedInt D8 -> SizedInt D8
- -- functiontest = \a -> let r = a + 1 in r
- --
- -- The literal(Lit) '1' will be turned into a variable (Var)
- -- As it will call the 'fromInteger' class function that belongs
- -- to the Num class. So we need to translate the refenced function
- -- let used_vars_set = CoreFVs.exprSomeFreeVars (\v -> (Type.isAlgType . snd . Type.splitForAllTys . Id.idType) v) expr'
- -- let used_vars = VarSet.varSetElems used_vars_set
- -- -- Filter for dictionary args, they should not be translated
- -- -- FIXME: check for other non-translatable stuff as well
- -- let trans_vars = filter (\v -> (not . TcType.isDictTy . Id.idType) v) used_vars
- -- mapM normalizeBind trans_vars
return ()
-- We don't have a value for this binder. This really shouldn't
-- happen for local id's...
-- Apply the second
(expr'', changed) <- Writer.listen $ second expr'
if Monoid.getAny $
- -- trace ("Trying to apply transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n") $
+-- trace ("Trying to apply transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n") $
changed
then
-- trace ("Applying transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n") $
- -- trace ("Result of applying " ++ name ++ ":\n" ++ showSDoc (nest 4 $ ppr expr'') ++ "\n" ++ "Type: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr'') ++ "\n" ) $
+-- trace ("Result of applying " ++ name ++ ":\n" ++ showSDoc (nest 4 $ ppr expr'') ++ "\n" ++ "Type: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr'') ++ "\n" ) $
applyboth first (name, second) $
expr''
else
- -- trace ("No changes") $
+-- trace ("No changes") $
return expr''
-- Apply the given transformation to all direct subexpressions (only), not the
isRepr :: CoreSyn.CoreExpr -> TransformMonad Bool
isRepr (Type ty) = return False
isRepr expr = Trans.lift $ MonadState.lift tsType $ VHDLTools.isReprType (CoreUtils.exprType expr)
+
+is_local_var :: CoreSyn.CoreExpr -> TransformSession Bool
+is_local_var (CoreSyn.Var v) = do
+ bndrs <- getGlobalBinders
+ return $ not $ v `elem` bndrs
+is_local_var _ = return False
-- 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)
+-- Simple a = b assignments are just like applications, but without arguments.
+-- We can't just generate an unconditional assignment here, since b might be a
+-- top level binding (e.g., a function with no arguments).
mkConcSm (bndr, Var v) = do
- ty_state <- getA vsType
- return $ [mkUncondAssign (Left bndr) ((varToVHDLExpr ty_state) v)]
+ genApplication (Left bndr) v []
mkConcSm (bndr, app@(CoreSyn.App _ _))= do
let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
projects / matthijs / master-project / cλash.git / commitdiff