mkStateProcSm (old, new) = do
nonempty <- hasNonEmptyType old
if nonempty
- then return [AST.CSPSm $ AST.ProcSm label [clk] [statement]]
+ then return [AST.CSPSm $ AST.ProcSm label [clockId,resetId] [statement]]
else return []
where
label = mkVHDLBasicId $ "state"
- clk = mkVHDLBasicId "clock"
rising_edge = AST.NSimple $ mkVHDLBasicId "rising_edge"
wform = AST.Wform [AST.WformElem (AST.PrimName $ varToVHDLName new) Nothing]
- assign = AST.SigAssign (varToVHDLName old) wform
- rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)]
- statement = AST.IfSm rising_edge_clk [assign] [] Nothing
+ clk_assign = AST.SigAssign (varToVHDLName old) wform
+ rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clockId)]
+ resetn_is_low = (AST.PrimName $ AST.NSimple resetId) AST.:=: (AST.PrimLit "'0'")
+ reset_statement = []
+ clk_statement = [AST.ElseIf rising_edge_clk [clk_assign]]
+ statement = AST.IfSm resetn_is_low reset_statement clk_statement Nothing
-- | Transforms a core binding into a VHDL concurrent statement
let valargs = get_val_args (Var.varType f) args
genApplication (Left bndr) f (map Left valargs)
--- A single alt case must be a selector. This means thee scrutinee is a simple
+-- A single alt case must be a selector. This means the scrutinee is a simple
-- variable, the alternative is a dataalt with a single non-wild binder that
-- is also returned.
mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt]))
-- first is the default case, if there is any.
mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) b ty [(_, _, CoreSyn.Var false), (con, _, CoreSyn.Var true)])) = do
scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut
- let cond_expr = scrut' AST.:=: (altconToVHDLExpr con)
+ altcon <- MonadState.lift tsType $ altconToVHDLExpr con
+ let cond_expr = scrut' AST.:=: altcon
true_expr <- MonadState.lift tsType $ varToVHDLExpr true
false_expr <- MonadState.lift tsType $ varToVHDLExpr false
return ([mkCondAssign (Left bndr) cond_expr true_expr false_expr], [])
-- | A function to wrap a builder-like function that expects its arguments to
-- be Literals
genLitArgs ::
- (dst -> func -> [Literal.Literal] -> res)
- -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
-genLitArgs wrap dst func args = wrap dst func args'
- where
- args' = map exprToLit litargs
- -- FIXME: Check if we were passed an CoreSyn.App
- litargs = concat (map getLiterals exprargs)
- (exprargs, []) = Either.partitionEithers args
+ (dst -> func -> [Literal.Literal] -> TranslatorSession [AST.ConcSm])
+ -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm])
+genLitArgs wrap dst func args = do
+ hscenv <- MonadState.lift tsType $ getA tsHscEnv
+ let (exprargs, []) = Either.partitionEithers args
+ -- FIXME: Check if we were passed an CoreSyn.App
+ let litargs = concat (map (getLiterals hscenv) exprargs)
+ let args' = map exprToLit litargs
+ concsms <- wrap dst func args'
+ return concsms
-- | A function to wrap a builder-like function that produces an expression
-- and expects it to be assigned to the destination.
wform = AST.Wform [AST.WformElem data_in Nothing]
ramassign = AST.SigAssign ramloc wform
rising_edge_clk = genExprFCall rising_edge (AST.PrimName $ AST.NSimple clockId)
- statement = AST.IfSm (AST.And rising_edge_clk (wrenable AST.:=: AST.PrimLit "'1'")) [ramassign] [] Nothing
+ statement = AST.IfSm (AST.And rising_edge_clk wrenable) [ramassign] [] Nothing
-----------------------------------------------------------------------------
-- Function to generate VHDL for applications
, (hwnotId , (1, genOperator1 AST.Not ) )
, (equalityId , (2, genOperator2 (AST.:=:) ) )
, (inEqualityId , (2, genOperator2 (AST.:/=:) ) )
+ , (ltId , (2, genOperator2 (AST.:<:) ) )
+ , (lteqId , (2, genOperator2 (AST.:<=:) ) )
+ , (gtId , (2, genOperator2 (AST.:>:) ) )
+ , (gteqId , (2, genOperator2 (AST.:>=:) ) )
, (boolOrId , (2, genOperator2 AST.Or ) )
, (boolAndId , (2, genOperator2 AST.And ) )
, (plusId , (2, genOperator2 (AST.:+:) ) )