[project @ 1998-08-14 11:47:29 by sof]

[ghc-hetmet.git] / ghc / compiler / rename / RnSource.lhs

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index ef1b761..89e484d 100644 (file)
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -20,9 +20,10 @@ import CmdLineOpts   ( opt_IgnoreIfacePragmas )
 
 import RnBinds         ( rnTopBinds, rnMethodBinds, renameSigs )
 import RnEnv           ( bindTyVarsRn, lookupBndrRn, lookupOccRn, lookupImplicitOccRn, bindLocalsRn,
-                         newDfunName, checkDupOrQualNames, checkDupNames,
+                         newDfunName, checkDupOrQualNames, checkDupNames, lookupGlobalOccRn,
                          newLocallyDefinedGlobalName, newImportedGlobalName, ifaceFlavour,
-                         listType_RDR, tupleType_RDR )
+                         listType_RDR, tupleType_RDR, addImplicitOccRn
+                       )
 import RnMonad
 
 import Name            ( Name, OccName(..), occNameString, prefixOccName,
@@ -300,6 +301,28 @@ rnDecl (DefD (DefaultDecl tys src_loc))
 
 %*********************************************************
 %*                                                     *
+\subsection{Foreign declarations}
+%*                                                     *
+%*********************************************************
+
+\begin{code}
+rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
+  = pushSrcLocRn src_loc $
+    lookupBndrRn name                  `thenRn` \ name' ->
+    (if is_export then
+        addImplicitOccRn name'
+     else
+       returnRn name')                 `thenRn_`
+    rnHsSigType fo_decl_msg ty         `thenRn` \ ty' ->
+    returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc))
+ where
+  fo_decl_msg = ptext SLIT("a foreign declaration")
+  is_export   = not (maybeToBool imp_exp) && not (isDynamic ext_nm)
+
+\end{code}
+
+%*********************************************************
+%*                                                     *
 \subsection{Support code for type/data declarations}
 %*                                                     *
 %*********************************************************
@@ -556,6 +579,14 @@ rnIdInfo (HsArity arity)   = returnRn (HsArity arity)
 rnIdInfo (HsUpdate update)     = returnRn (HsUpdate update)
 rnIdInfo (HsFBType fb)         = returnRn (HsFBType fb)
 rnIdInfo (HsArgUsage au)       = returnRn (HsArgUsage au)
+rnIdInfo (HsSpecialise tyvars tys expr)
+  = bindTyVarsRn doc tyvars    $ \ tyvars' ->
+    rnCoreExpr expr            `thenRn` \ expr' ->
+    mapRn rnHsType tys         `thenRn` \ tys' ->
+    returnRn (HsSpecialise tyvars' tys' expr')
+  where
+    doc = text "Specialise in interface pragma"
+    
 
 rnStrict (HsStrictnessInfo demands (Just (worker,cons)))
        -- The sole purpose of the "cons" field is so that we can mark the constructors
@@ -709,7 +740,7 @@ classTyVarNotInOpTyErr clas_tyvar sig
         4 (ppr sig)
 
 dupClassAssertWarn ctxt (assertion : dups)
-  = sep [hsep [ptext SLIT("Duplicated class assertion"), 
+  = sep [hsep [ptext SLIT("Duplicate class assertion"), 
               quotes (pprClassAssertion assertion),
               ptext SLIT("in the context:")],
         nest 4 (pprContext ctxt)]