- go env fun [] = return (env, fun)
- go env fun (arg : args) = do { (env', arg') <- makeTrivial env arg
- ; go env' (App fun arg') args }
-
-prepareRhs env rhs -- The default case
- = return (env, rhs)
+ go n_val_args env (Cast rhs co)
+ = do { (is_val, env', rhs') <- go n_val_args env rhs
+ ; return (is_val, env', Cast rhs' co) }
+ go n_val_args env (App fun (Type ty))
+ = do { (is_val, env', rhs') <- go n_val_args env fun
+ ; return (is_val, env', App rhs' (Type ty)) }
+ go n_val_args env (App fun arg)
+ = do { (is_val, env', fun') <- go (n_val_args+1) env fun
+ ; case is_val of
+ True -> do { (env'', arg') <- makeTrivial env' arg
+ ; return (True, env'', App fun' arg') }
+ False -> return (False, env, App fun arg) }
+ go n_val_args env (Var fun)
+ = return (is_val, env, Var fun)
+ where
+ is_val = n_val_args > 0 -- There is at least one arg
+ -- ...and the fun a constructor or PAP
+ && (isDataConWorkId fun || n_val_args < idArity fun)
+ go n_val_args env other
+ = return (False, env, other)