-- argexpr1 <- MonadState.lift tsType $ varToVHDLExpr start
-- Input from vec[current n]
let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName vecName n_cur
- (app_concsms, used) <- genApplication (Right resname,res_type) (exprToVar folded_f) ( if left then
+ let (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs folded_f
+ let valargs = get_val_args (Var.varType real_f) already_mapped_args
+ (app_concsms, used) <- genApplication (Right resname,res_type) real_f ((zip (map Left valargs) (map CoreUtils.exprType valargs)) ++ ( if left then
[(Right argexpr1, startType), (Right argexpr2, tfvec_elem vecType)]
else
[(Right argexpr2, tfvec_elem vecType), (Right argexpr1, startType)]
- )
+ ))
-- Return the conditional generate part
return (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
let argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
-- Input from vec[current n]
let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName vecName n_cur
- (app_concsms, used) <- genApplication (Right resname,res_type) (exprToVar folded_f) ( if left then
+ let (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs folded_f
+ let valargs = get_val_args (Var.varType real_f) already_mapped_args
+ (app_concsms, used) <- genApplication (Right resname,res_type) real_f ((zip (map Left valargs) (map CoreUtils.exprType valargs)) ++ ( if left then
[(Right argexpr1, startType), (Right argexpr2, tfvec_elem vecType)]
else
[(Right argexpr2, tfvec_elem vecType), (Right argexpr1, startType)]
- )
+ ))
-- Return the conditional generate part
return (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
-- Input from start
[argexpr] <- argsToVHDLExprs [start]
let startassign = mkUncondAssign (Right resname) argexpr
- (app_concsms, used) <- genApplication (Right resname, res_type) (exprToVar app_f) [(Right argexpr, startType)]
+ let (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs app_f
+ let valargs = get_val_args (Var.varType real_f) already_mapped_args
+ (app_concsms, used) <- genApplication (Right resname, res_type) real_f ((zip (map Left valargs) (map CoreUtils.exprType valargs)) ++ [(Right argexpr, startType)])
-- Return the conditional generate part
let gensm = AST.GenerateSm cond_label cond_scheme [] (if iter then
[startassign]
let resname = mkIndexedName tmp_name n_cur
-- Input from tmp[previous n]
let argexpr = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
- (app_concsms, used) <- genApplication (Right resname, res_type) (exprToVar app_f) [(Right argexpr, res_type)]
+ let (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs app_f
+ let valargs = get_val_args (Var.varType real_f) already_mapped_args
+ (app_concsms, used) <- genApplication (Right resname, res_type) real_f ((zip (map Left valargs) (map CoreUtils.exprType valargs)) ++ [(Right argexpr, res_type)])
-- Return the conditional generate part
return (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
-- Function to generate VHDL for applications
-----------------------------------------------------------------------------
genApplication ::
- (Either CoreSyn.CoreBndr AST.VHDLName) -- ^ Where to store the result?
+ (Either CoreSyn.CoreBndr AST.VHDLName, Type.Type) -- ^ Where to store the result?
-> CoreSyn.CoreBndr -- ^ The function to apply
- -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The arguments to apply
+ -> [(Either CoreSyn.CoreExpr AST.Expr, Type.Type)] -- ^ The arguments to apply
-> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
-- ^ The corresponding VHDL concurrent statements and entities
-- instantiated.
-genApplication dst f args = do
+genApplication (dst, dsttype) f args = do
nonemptydst <- case dst of
Left bndr -> hasNonEmptyType bndr
Right _ -> return True
then
if Var.isGlobalId f then
case Var.idDetails f of
- IdInfo.DataConWorkId dc -> case dst of
+ IdInfo.DataConWorkId dc -> do -- case dst of
-- It's a datacon. Create a record from its arguments.
- Left bndr -> do
+ --Left bndr -> do
-- We have the bndr, so we can get at the type
- htype_either <- MonadState.lift tsType $ mkHTypeEither (Var.varType bndr)
- let argsNoState = filter (\x -> not (either hasStateType (\x -> False) x)) args
- let dcs = datacons_for bndr
+ htype_either <- MonadState.lift tsType $ mkHTypeEither dsttype
+ let argsNoState = filter (\x -> not (either hasStateType (\x -> False) x)) (map fst args)
+ let dcs = datacons_for dsttype
case (dcs, argsNoState) of
-- This is a type with a single datacon and a single
-- argument, so no record is created (the type of the
-- In all other cases, a record type is created.
_ -> case htype_either of
Right htype@(AggrType _ _ _) -> do
- let dc_i = datacon_index (Var.varType bndr) dc
+ let dc_i = datacon_index dsttype dc
let labels = getFieldLabels htype dc_i
arg_exprs <- argsToVHDLExprs argsNoState
let (final_labels, final_exprs) = case getConstructorFieldLabel htype of
simple_assign = do
expr <- MonadState.lift tsType $ dataconToVHDLExpr dc
return ([mkUncondAssign dst expr], [])
-
- Right _ -> error "\nGenerate.genApplication(DataConWorkId): Can't generate dataconstructor application without an original binder"
+ --
+ -- Right _ -> do
+ -- let dcs = datacons_for dsttype
+ -- error $ "\nGenerate.genApplication(DataConWorkId): Can't generate dataconstructor application without an original binder" ++ show dcs
IdInfo.DataConWrapId dc -> case dst of
-- It's a datacon. Create a record from its arguments.
Left bndr ->
-- Local binder that references a top level binding. Generate a
-- component instantiation.
signature <- getEntity f
- args' <- argsToVHDLExprs args
+ args' <- argsToVHDLExprs (map fst args)
let entity_id = ent_id signature
-- TODO: Using show here isn't really pretty, but we'll need some
-- unique-ish value...
-- Local binder that references a top level binding. Generate a
-- component instantiation.
signature <- getEntity f
- args' <- argsToVHDLExprs args
+ args' <- argsToVHDLExprs (map fst args)
let entity_id = ent_id signature
-- TODO: Using show here isn't really pretty, but we'll need some
-- unique-ish value...
projects / matthijs / master-project / cλash.git / blobdiff