From: Christiaan Baaij <baaijcpr@toors-MacBook-Pro-2.local>
Date: Sat, 20 Mar 2010 15:42:05 +0000 (+0100)
Subject: Fix zipWith template to work with partially applied functions, add support for boolea... 
X-Git-Url: https://git.stderr.nl/gitweb?p=matthijs%2Fmaster-project%2Fc%CE%BBash.git;a=commitdiff_plain;h=b849c09f1b86d2851da13f56cce82bd02d03eb28

Fix zipWith template to work with partially applied functions, add support for boolean negation, and update error message of classopresolution transformation
---

diff --git "a/c\316\273ash/CLasH/Normalize.hs" "b/c\316\273ash/CLasH/Normalize.hs"
index 86ade5b..2e341cf 100644
--- "a/c\316\273ash/CLasH/Normalize.hs"
+++ "b/c\316\273ash/CLasH/Normalize.hs"
@@ -416,12 +416,12 @@ classopresolution expr@(App (App (Var sel) ty) dict) =
     Nothing -> return expr
     Just cls -> case collectArgs dict of
       (_, []) -> return expr -- Dict is not an application (e.g., not inlined yet)
-      (dictdc, (ty':selectors)) | tyargs_neq ty ty' -> error $ "Applying class selector to dictionary without matching type?\n" ++ pprString expr
+      (dictdc, (ty':selectors)) | 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)
   where
diff --git "a/c\316\273ash/CLasH/VHDL/Constants.hs" "b/c\316\273ash/CLasH/VHDL/Constants.hs"
index 22bf14a..3b796a2 100644
--- "a/c\316\273ash/CLasH/VHDL/Constants.hs"
+++ "b/c\316\273ash/CLasH/VHDL/Constants.hs"
@@ -264,6 +264,9 @@ boolOrId = "||"
 boolAndId :: String
 boolAndId = "&&"
 
+boolNot :: String
+boolNot = "not"
+
 -- Numeric Operations
 
 -- | plus operation identifier
diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs"
index a9947a2..a6f3590 100644
--- "a/c\316\273ash/CLasH/VHDL/Generate.hs"
+++ "b/c\316\273ash/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)
   }
@@ -1603,6 +1603,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             ) )