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

* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Make genMap support mapping applications.
  Allow arguments to builtins to be applications.

diff --git a/Generate.hs b/Generate.hs
index 3e3a21d1fa356b8c20a403de4e90283a2600c37f..e6a5d45503c6879b1b4df8e6136754074f92d9c9 100644 (file)
--- a/Generate.hs
+++ b/Generate.hs
@@ -84,9 +84,11 @@ genFCall' (Right name) _ _ = error $ "Cannot generate builtin function call assi
 
 -- | Generate a generate statement for the builtin function "map"
 genMap :: BuiltinBuilder
-genMap = genVarArgs genMap'
-genMap' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
-genMap' (Left res) f [mapped_f, arg] =
+genMap (Left res) f [Left mapped_f, Left (Var arg)] =
+  -- mapped_f must be a CoreExpr (since we can't represent functions as VHDL
+  -- expressions). arg must be a CoreExpr (and should be a CoreSyn.Var), since
+  -- we must index it (which we couldn't if it was a VHDL Expr, since only
+  -- VHDLNames can be indexed).
   let
     -- Setup the generate scheme
     len         = (tfvec_len . Var.varType) res
@@ -102,7 +104,9 @@ genMap' (Left res) f [mapped_f, arg] =
     resname     = mkIndexedName (varToVHDLName res) n_expr
     argexpr     = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
   in do
-    app_concsms <- genApplication (Right resname) mapped_f [Right argexpr]
+    let (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs mapped_f
+    let valargs = get_val_args (Var.varType real_f) already_mapped_args
+    app_concsms <- genApplication (Right resname) real_f (map Left valargs ++ [Right argexpr])
     -- Return the generate statement
     return [AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms]
 

diff --git a/Normalize.hs b/Normalize.hs
index eab4ff70654d0900eb4c8b3787fe8bc02d725d72..ee5ea8be621172a8d5b6269570f6e2b303776401 100644 (file)
--- a/Normalize.hs
+++ b/Normalize.hs
@@ -436,18 +436,24 @@ funextract expr@(App _ _) | is_var fexpr = do
     -- Find the function called and the arguments
     (fexpr, args) = collectArgs expr
     Var f = fexpr
-    -- Leave simple arguments untouched
-    doarg (Var arg) = return $ Var arg
-    -- Change any arguments that have a function type, but no free variables.
-    -- We could use is_applicable here, but I think arguments to functions
-    -- could only have forall typing when existential typing is enabled. Not
-    -- sure, though.
-    doarg arg | is_fun arg && not (has_free_vars arg) = do
-      -- Create a new top level binding that binds the argument
-      id <- mkBinderFor arg "fun"
-      Trans.lift $ addGlobalBind id arg
-      -- Replace the argument with a reference to the argument
-      change $ Var id
+    -- Change any arguments that have a function type, but are not simple yet
+    -- (ie, a variable or application). This means to create a new function
+    -- for map (\f -> ...) b, but not for map (foo a) b.
+    --
+    -- We could use is_applicable here instead of is_fun, but I think
+    -- arguments to functions could only have forall typing when existential
+    -- typing is enabled. Not sure, though.
+    doarg arg | not (is_simple arg) && is_fun arg = do
+      -- Create a new top level binding that binds the argument. Its body will
+      -- be extended with lambda expressions, to take any free variables used
+      -- by the argument expression.
+      let free_vars = VarSet.varSetElems $ CoreFVs.exprFreeVars arg
+      let body = MkCore.mkCoreLams free_vars arg
+      id <- mkBinderFor body "fun"
+      Trans.lift $ addGlobalBind id body
+      -- Replace the argument with a reference to the new function, applied to
+      -- all vars it uses.
+      change $ MkCore.mkCoreApps (Var id) (map Var free_vars)
     -- Leave all other arguments untouched
     doarg arg = return arg