[project @ 2003-07-16 08:49:01 by ross]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcArrows.lhs

diff --git a/ghc/compiler/typecheck/TcArrows.lhs b/ghc/compiler/typecheck/TcArrows.lhs
index 026c006..b31c03a 100644 (file)
--- a/ghc/compiler/typecheck/TcArrows.lhs
+++ b/ghc/compiler/typecheck/TcArrows.lhs
@@ -133,6 +133,18 @@ tcCmd env cmd@(HsArrApp fun arg _ ho_app lr src_loc) (cmd_stk, res_ty)
        HsHigherOrderApp -> tc
        HsFirstOrderApp  -> popArrowBinders tc
 
+-------------------------------------------
+--             Command application
+
+tcCmd env cmd@(HsApp fun arg) (cmd_stk, res_ty)
+  = addErrCtxt (cmdCtxt cmd)   $
+    do  { arg_ty <- newTyVarTy openTypeKind
+
+       ; fun' <- tcCmd env fun (arg_ty:cmd_stk, res_ty)
+
+       ; arg' <- tcCheckRho arg arg_ty
+
+       ; return (HsApp fun' arg') }
 
 -------------------------------------------
 --             Lambda