[project @ 2002-05-23 15:37:32 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index 1da69ec..e6a3d85 100644 (file)
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -62,12 +62,13 @@ import PrelNames    ( cCallableClassName,
                          enumFromToPName, enumFromThenToPName,
                          thenMName, bindMName, failMName, returnMName, ioTyConName
                        )
-import Outputable
 import ListSetOps      ( minusList )
-import Util
 import CmdLineOpts
 import HscTypes                ( TyThing(..) )
 
+import Util
+import Outputable
+import FastString
 \end{code}
 
 %************************************************************************
@@ -146,6 +147,14 @@ tcMonoExpr in_expr@(ExprWithTySig expr poly_ty) res_ty
    tcSubExp res_ty inst_sig_ty         `thenTc` \ (co_fn, lie3) ->
 
    returnTc (co_fn <$> inst_fn expr', lie1 `plusLIE` lie2 `plusLIE` lie3)
+
+tcMonoExpr (HsType ty) res_ty
+  = failWithTc (text "Can't handle type argument:" <+> ppr ty)
+       -- This is the syntax for type applications that I was planning
+       -- but there are difficulties (e.g. what order for type args)
+       -- so it's not enabled yet.
+       -- Can't eliminate it altogether from the parser, because the
+       -- same parser parses *patterns*.
 \end{code}
 
 
@@ -239,11 +248,11 @@ tcMonoExpr e0@(HsCCall lbl args may_gc is_casm ignored_fake_result_ty) res_ty
     tcLookupTyCon ioTyConName          `thenNF_Tc` \ ioTyCon ->
     let
        new_arg_dict (arg, arg_ty)
-         = newDicts (CCallOrigin (_UNPK_ lbl) (Just arg))
+         = newDicts (CCallOrigin (unpackFS lbl) (Just arg))
                     [mkClassPred cCallableClass [arg_ty]]      `thenNF_Tc` \ arg_dicts ->
            returnNF_Tc arg_dicts       -- Actually a singleton bag
 
-       result_origin = CCallOrigin (_UNPK_ lbl) Nothing {- Not an arg -}
+       result_origin = CCallOrigin (unpackFS lbl) Nothing {- Not an arg -}
     in
 
        -- Arguments
@@ -993,7 +1002,7 @@ Overloaded literals.
 tcLit :: HsLit -> TcType -> TcM (TcExpr, LIE)
 tcLit (HsLitLit s _) res_ty
   = tcLookupClass cCallableClassName                   `thenNF_Tc` \ cCallableClass ->
-    newDicts (LitLitOrigin (_UNPK_ s))
+    newDicts (LitLitOrigin (unpackFS s))
             [mkClassPred cCallableClass [res_ty]]      `thenNF_Tc` \ dicts ->
     returnTc (HsLit (HsLitLit s res_ty), mkLIE dicts)