@@ -306,17 +306,17 @@ execApp' env ctxt (EP _ fp _) (_:fn:EConstant (Str s):rest)
307-- Throw away the 'World' argument to the foreign function
307-- Throw away the 'World' argument to the foreign function
309−execApp' env ctxt f@(EP _ fp _) args@(ty:fn:xs)
309+execApp' env ctxt f@(EP _ fp _) args@(ty:fn:xs) | fp == mkfprim
310− | Just (FFun f argTs retT) <- foreignFromTT fn,
310+ = case foreignFromTT fn of
311− fp == mkfprim && length xs >= length argTs =
311+ Just (FFun f argTs retT) | length xs >= length argTs ->
312− do let (args', xs') = (take (length argTs) xs, -- foreign args
312+ do let (args', xs') = (take (length argTs) xs, -- foreign args
313− drop (length argTs + 1) xs) -- rest
313+ drop (length argTs + 1) xs) -- rest
314− res <- stepForeign (ty:fn:args')
314+ res <- stepForeign (ty:fn:args')
315− case res of
315+ case res of
316− Nothing -> fail $ "Could not call foreign function \"" ++ f ++
316+ Nothing -> fail $ "Could not call foreign function \"" ++ f ++
317− "\" with args " ++ show args
317+ "\" with args " ++ show args
318− Just r -> return (mkEApp r xs')
318+ Just r -> return (mkEApp r xs')
319− | otherwise = return (mkEApp f args)
319+ Nothing -> return (mkEApp f args)
321execApp' env ctxt c@(EP (DCon _ arity) n _) args =
321execApp' env ctxt c@(EP (DCon _ arity) n _) args =
322 do args' <- mapM tryForce (take arity args)
322 do args' <- mapM tryForce (take arity args)