Merge branch 'master' of http://git.stderr.nl/matthijs/master-project/cλash

Conflicts:
	cλash/CLasH/Normalize.hs
	cλash/CLasH/Normalize/NormalizeTools.hs

diff --git a/cλash/CLasH/Normalize.hs b/cλash/CLasH/Normalize.hs
index 2fc34c606f083c3cf05a83b1e2e666a1042614bb..31474d59328bd0342fc6244262061eba736b8c80 100644 (file)
--- a/cλash/CLasH/Normalize.hs
+++ b/cλash/CLasH/Normalize.hs
@@ -445,12 +445,12 @@ classopresolution expr@(App (App (Var sel) ty) dict) | not is_builtin =
     Just cls -> case collectArgs dict of
       (_, []) -> return expr -- Dict is not an application (e.g., not inlined yet)
       (Var dictdc, (ty':selectors)) | not (Maybe.isJust (Id.isDataConId_maybe dictdc)) -> return expr -- Dictionary is not a datacon yet (but e.g., a top level binder)
-                                | tyargs_neq ty ty' -> error $ "Applying class selector to dictionary without matching type?\n" ++ pprString expr
+                                | tyargs_neq ty ty' -> error $ "Normalize.classopresolution: Applying class selector to dictionary without matching type?\n" ++ pprString expr
                                 | otherwise ->
         let selector_ids = Class.classSelIds cls in
         -- Find the selector used in the class' list of selectors
         case List.elemIndex sel selector_ids of
-          Nothing -> error $ "Selector not found in class' selector list? This should not happen!\nExpression: " ++ pprString expr ++ "\nClass: " ++ show cls ++ "\nSelectors: " ++ show selector_ids
+          Nothing -> error $ "Normalize.classopresolution: Selector not found in class' selector list? This should not happen!\nExpression: " ++ pprString expr ++ "\nClass: " ++ show cls ++ "\nSelectors: " ++ show selector_ids
           -- Get the corresponding argument from the dictionary
           Just n -> change (selectors!!n)
       (_, _) -> return expr -- Not applying a variable? Don't touch

diff --git a/cλash/CLasH/VHDL/Constants.hs b/cλash/CLasH/VHDL/Constants.hs
index b9cbb0b1853b0949ebac5be513f1418151f5ddcb..e6381fd7411037d5d6051143db3a44b6552d956f 100644 (file)
--- a/cλash/CLasH/VHDL/Constants.hs
+++ b/cλash/CLasH/VHDL/Constants.hs
@@ -278,6 +278,9 @@ boolOrId = "||"
 boolAndId :: String
 boolAndId = "&&"
 
+boolNot :: String
+boolNot = "not"
+
 -- Numeric Operations
 
 -- | plus operation identifier

diff --git a/cλash/CLasH/VHDL/Generate.hs b/cλash/CLasH/VHDL/Generate.hs
index 61e95b450d10313901b973f402717f7ba9656c69..2258d974f21d512bb0ceaf89f9825ab3dfe2c994 100644 (file)
--- a/cλash/CLasH/VHDL/Generate.hs
+++ b/cλash/CLasH/VHDL/Generate.hs
@@ -584,9 +584,7 @@ genMap (Left res) f [Left mapped_f, Left (CoreSyn.Var arg)] = do {
 genMap' (Right name) _ _ = error $ "\nGenerate.genMap': Cannot generate map function call assigned to a VHDLName: " ++ show name
     
 genZipWith :: BuiltinBuilder
-genZipWith = genVarArgs genZipWith'
-genZipWith' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
-genZipWith' (Left res) f args@[zipped_f, arg1, arg2] = do {
+genZipWith (Left res) f args@[Left zipped_f, Left (CoreSyn.Var arg1), Left (CoreSyn.Var arg2)] = do {
   -- Setup the generate scheme
   ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
           -- TODO: Use something better than varToString
@@ -598,10 +596,12 @@ genZipWith' (Left res) f args@[zipped_f, arg1, arg2] = do {
           -- Create the content of the generate statement: Applying the zipped_f to
           -- each of the elements in arg1 and arg2, storing to each element in res
         ; resname     = mkIndexedName (varToVHDLName res) n_expr
+        ; (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs zipped_f
+        ; valargs     = get_val_args (Var.varType real_f) already_mapped_args
         ; argexpr1    = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
         ; argexpr2    = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
         } ;
-  ; (app_concsms, used) <- genApplication (Right resname) zipped_f [Right argexpr1, Right argexpr2]
+  ; (app_concsms, used) <- genApplication (Right resname) real_f (map Left valargs ++ [Right argexpr1, Right argexpr2])
     -- Return the generate functions
   ; return ([AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms], used)
   }
@@ -814,15 +814,15 @@ genUnzip' (Left res) f args@[arg] = do
     _ -> error $ "Unzipping a value that is not a vector? Value: " ++ pprString arg ++ "\nType: " ++ pprString (Var.varType arg) ++ "\nhtype: " ++ show htype
 
 genCopy :: BuiltinBuilder 
-genCopy = genNoInsts $ genVarArgs genCopy'
-genCopy' :: (Either CoreSyn.CoreBndr AST.VHDLName ) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
-genCopy' (Left res) f args@[arg] =
-  let
-    resExpr = AST.Aggregate [AST.ElemAssoc (Just AST.Others) 
-                (AST.PrimName (varToVHDLName arg))]
-    out_assign = mkUncondAssign (Left res) resExpr
-  in 
-    return [out_assign]
+genCopy = genNoInsts genCopy'
+genCopy' :: (Either CoreSyn.CoreBndr AST.VHDLName ) -> CoreSyn.CoreBndr -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm]
+genCopy' (Left res) f [arg] = do {
+  ; [arg'] <- argsToVHDLExprs [arg]
+  ; let { resExpr = AST.Aggregate [AST.ElemAssoc (Just AST.Others) arg']
+        ; out_assign = mkUncondAssign (Left res) resExpr
+        }
+  ; return [out_assign]
+  }
     
 genConcat :: BuiltinBuilder
 genConcat = genNoInsts $ genVarArgs genConcat'
@@ -1604,6 +1604,7 @@ globalNameTable = Map.fromList
   , (gteqId           , (2, genOperator2 (AST.:>=:) ) )
   , (boolOrId         , (2, genOperator2 AST.Or     ) )
   , (boolAndId        , (2, genOperator2 AST.And    ) )
+  , (boolNot          , (1, genOperator1 AST.Not    ) )
   , (plusId           , (2, genOperator2 (AST.:+:)  ) )
   , (timesId          , (2, genTimes                ) )
   , (negateId         , (1, genNegation             ) )