X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=clash%2FCLasH%2FVHDL%2FGenerate.hs;h=543e91870c91e2b75f81c70ee4b3f6def1af768f;hb=e6ccae0292cdcf1c47eae5c939f6def8f36560a3;hp=da078f7873ff203f25e353ea6e72c7310b728fc2;hpb=8dbc46595b3e05117b361eeb1babc0b1f033dbb6;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/clash/CLasH/VHDL/Generate.hs b/clash/CLasH/VHDL/Generate.hs
index da078f7..543e918 100644
--- a/clash/CLasH/VHDL/Generate.hs
+++ b/clash/CLasH/VHDL/Generate.hs
@@ -714,11 +714,13 @@ genFold' len left (Left res) f [(Left folded_f,_), (start,startType), (vec,vecTy
       -- 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)
 
@@ -736,11 +738,13 @@ genFold' len left (Left res) f [(Left folded_f,_), (start,startType), (vec,vecTy
       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)
 
@@ -969,7 +973,9 @@ genIterateOrGenerate' len iter (Left res) f [(Left app_f,_), (start,startType)]
       -- 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]
@@ -987,7 +993,9 @@ genIterateOrGenerate' len iter (Left res) f [(Left app_f,_), (start,startType)]
       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)
 
@@ -1060,13 +1068,13 @@ genSplit' (Left res) f args@[(vecIn,vecInType)] = do {
 -- 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
@@ -1074,13 +1082,13 @@ genApplication dst f args = do
     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
@@ -1091,7 +1099,7 @@ genApplication dst f args = do
                 -- 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
@@ -1125,8 +1133,10 @@ genApplication dst f args = do
                     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 ->
@@ -1157,7 +1167,7 @@ genApplication dst f args = do
                     -- 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...
@@ -1196,7 +1206,7 @@ genApplication dst f args = do
                -- 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...