[project @ 1999-01-19 15:19:23 by sof]

Types of foreign imports weren't being zonked, with the lethal conseq.
that any unbound kind variables weren't being defaulted to something
sensible.

Showed up when trying to compile a 'foreign import' with type

  StablePtr a -> IO ()

diff --git a/ghc/compiler/typecheck/TcForeign.lhs b/ghc/compiler/typecheck/TcForeign.lhs
index cf850f1..3208c7b 100644 (file)
--- a/ghc/compiler/typecheck/TcForeign.lhs
+++ b/ghc/compiler/typecheck/TcForeign.lhs
@@ -28,7 +28,7 @@ import RnHsSyn                ( RenamedHsDecl, RenamedForeignDecl )
 import TcMonad
 import TcEnv           ( newLocalId )
 import TcType          ( tcInstTcType, typeToTcType, tcSplitRhoTy, zonkTcTypeToType )
-import TcMonoType      ( tcHsType )
+import TcMonoType      ( tcHsTopBoxedType )
 import TcHsSyn         ( TcMonoBinds, TypecheckedForeignDecl,
                          TcForeignExportDecl )
 import TcExpr          ( tcId, tcPolyExpr )                    
@@ -92,7 +92,7 @@ tcFImport :: RenamedForeignDecl -> TcM s (Id, TypecheckedForeignDecl)
 tcFImport fo@(ForeignDecl nm FoExport hs_ty Dynamic cconv src_loc) =
    tcAddSrcLoc src_loc              $
    tcAddErrCtxt (foreignDeclCtxt fo) $
-   tcHsType hs_ty                  `thenTc`    \ sig_ty ->
+   tcHsTopBoxedType hs_ty           `thenTc`   \ sig_ty ->
    let
       -- drop the foralls before inspecting the structure
       -- of the foreign type.
@@ -107,7 +107,7 @@ tcFImport fo@(ForeignDecl nm FoExport hs_ty Dynamic cconv src_loc) =
 tcFImport fo@(ForeignDecl nm FoLabel hs_ty ext_nm cconv src_loc) =
    tcAddSrcLoc src_loc              $
    tcAddErrCtxt (foreignDeclCtxt fo) $
-   tcHsType hs_ty                  `thenTc`    \ sig_ty ->
+   tcHsTopBoxedType hs_ty          `thenTc`    \ sig_ty ->
    let
       -- drop the foralls before inspecting the structure
       -- of the foreign type.
@@ -121,7 +121,7 @@ tcFImport fo@(ForeignDecl nm imp_exp hs_ty ext_nm cconv src_loc) =
    tcAddSrcLoc src_loc              $
    tcAddErrCtxt (foreignDeclCtxt fo) $
 
-   tcHsType hs_ty                   `thenTc` \ ty ->
+   tcHsTopBoxedType hs_ty           `thenTc` \ ty ->
     -- Check that the type has the right shape
     -- and that the argument and result types are acceptable.
    let
@@ -140,7 +140,7 @@ tcFExport fo@(ForeignDecl nm imp_exp hs_ty ext_nm cconv src_loc) =
    tcAddSrcLoc src_loc              $
    tcAddErrCtxt (foreignDeclCtxt fo) $
 
-   tcHsType hs_ty                     `thenTc` \ sig_ty ->
+   tcHsTopBoxedType hs_ty             `thenTc` \ sig_ty ->
    let sig_tc_ty = typeToTcType sig_ty in
    tcPolyExpr (HsVar nm) sig_tc_ty     `thenTc`    \ (rhs, lie, _, _, _) ->
 

diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index 3f2eedb..0358f11 100644 (file)
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -254,7 +254,7 @@ tcModule rn_name_supply
        in
        zonkTopBinds all_binds          `thenNF_Tc` \ (all_binds', really_final_env)  ->
        tcSetValueEnv really_final_env  $
-       zonkForeignExports foe_decls    `thenNF_Tc` \ foe_decls' ->
+       zonkForeignExports foe_decls    `thenNF_Tc` \ foe_decls' ->
 
        let
           thin_air_ids = map (explicitLookupValueByKey really_final_env . nameUnique) thinAirIdNames
@@ -264,7 +264,7 @@ tcModule rn_name_supply
        in
        returnTc (really_final_env, 
                  (all_binds', local_tycons, local_classes, inst_info,
-                  foi_decls ++ foe_decls',
+                  (foi_decls ++ foe_decls'),
                   really_final_env,
                   thin_air_ids))
        )