[project @ 1998-11-08 17:10:35 by sof]

[ghc-hetmet.git] / ghc / compiler / hsSyn / HsDecls.lhs

diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index f466d59..9de522d 100644 (file)
--- a/ghc/compiler/hsSyn/HsDecls.lhs
+++ b/ghc/compiler/hsSyn/HsDecls.lhs
@@ -4,7 +4,7 @@
 \section[HsDecls]{Abstract syntax: global declarations}
 
 Definitions for: @FixityDecl@, @TyDecl@ and @ConDecl@, @ClassDecl@,
-@InstDecl@, @DefaultDecl@.
+@InstDecl@, @DefaultDecl@ and @ForeignDecl@.
 
 \begin{code}
 module HsDecls where
@@ -13,14 +13,13 @@ module HsDecls where
 
 -- friends:
 import HsBinds         ( HsBinds, MonoBinds, Sig, nullMonoBinds )
-import HsPragmas       ( DataPragmas, ClassPragmas,
-                         InstancePragmas, ClassOpPragmas
-                       )
+import HsPragmas       ( DataPragmas, ClassPragmas )
 import HsTypes
 import HsCore          ( UfExpr )
 import BasicTypes      ( Fixity, NewOrData(..) )
 import IdInfo          ( ArgUsageInfo, FBTypeInfo, ArityInfo, UpdateInfo )
 import Demand          ( Demand )
+import CallConv                ( CallConv, pprCallConv )
 
 -- others:
 import Name            ( getOccName, OccName, NamedThing(..) )
@@ -44,6 +43,7 @@ data HsDecl flexi name pat
   | DefD       (DefaultDecl name)
   | ValD       (HsBinds flexi name pat)
   | SigD       (IfaceSig name)
+  | ForD        (ForeignDecl name)
 \end{code}
 
 \begin{code}
@@ -56,6 +56,7 @@ hsDeclName (TyD (TySynonym name _ _ _))                 = name
 hsDeclName (ClD (ClassDecl _ name _ _ _ _ _ _ _)) = name
 hsDeclName (SigD (IfaceSig name _ _ _))                  = name
 hsDeclName (InstD (InstDecl _ _ _ (Just name) _)) = name
+hsDeclName (ForD  (ForeignDecl name _ _ _ _ _))   = name
 -- Others don't make sense
 #ifdef DEBUG
 hsDeclName x                                 = pprPanic "HsDecls.hsDeclName" (ppr x)
@@ -72,6 +73,7 @@ instance (NamedThing name, Outputable name, Outputable pat)
     ppr (ValD binds) = ppr binds
     ppr (DefD def)   = ppr def
     ppr (InstD inst) = ppr inst
+    ppr (ForD fd)    = ppr fd
 
 #ifdef DEBUG
 -- hsDeclName needs more context when DEBUG is on
@@ -286,7 +288,7 @@ instance (NamedThing name, Outputable name, Outputable pat)
 
 %************************************************************************
 %*                                                                     *
-\subsection[InstDecl]{An instance declaration (also, @SpecInstSig@)}
+\subsection[InstDecl]{An instance declaration
 %*                                                                     *
 %************************************************************************
 
@@ -319,21 +321,6 @@ instance (NamedThing name, Outputable name, Outputable pat)
                 nest 4 (ppr binds) ]
 \end{code}
 
-A type for recording what instances the user wants to specialise;
-called a ``Sig'' because it's sort of like a ``type signature'' for an
-instance.
-\begin{code}
-data SpecInstSig name
-  = SpecInstSig  name              -- class
-                (HsType name)    -- type to specialise to
-                SrcLoc
-
-instance (NamedThing name, Outputable name)
-             => Outputable (SpecInstSig name) where
-
-    ppr (SpecInstSig clas ty _)
-      = hsep [text "{-# SPECIALIZE instance", ppr clas, ppr ty, text "#-}"]
-\end{code}
 
 %************************************************************************
 %*                                                                     *
@@ -359,6 +346,59 @@ instance (NamedThing name, Outputable name)
 
 %************************************************************************
 %*                                                                     *
+\subsection{Foreign function interface declaration}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+data ForeignDecl name = 
+   ForeignDecl 
+        name 
+       ForKind   
+       (HsType name)
+       ExtName
+       CallConv
+       SrcLoc
+
+instance (NamedThing name, Outputable name)
+             => Outputable (ForeignDecl name) where
+
+    ppr (ForeignDecl nm imp_exp ty ext_name cconv src_loc)
+      = ptext SLIT("foreign") <+> ppr_imp_exp <+> pprCallConv cconv <+> 
+        ppr ext_name <+> ppr_unsafe <+> ppr nm <+> ptext SLIT("::")  <+> ppr ty
+        where
+         (ppr_imp_exp, ppr_unsafe) =
+          case imp_exp of
+            FoLabel     -> (ptext SLIT("label"), empty)
+            FoExport    -> (ptext SLIT("export"), empty)
+            FoImport us 
+               | us        -> (ptext SLIT("import"), ptext SLIT("unsafe"))
+               | otherwise -> (ptext SLIT("import"), empty)
+
+data ForKind
+ = FoLabel
+ | FoExport
+ | FoImport Bool -- True  => unsafe call.
+
+data ExtName
+ = Dynamic 
+ | ExtName FAST_STRING (Maybe FAST_STRING)
+
+isDynamic :: ExtName -> Bool
+isDynamic Dynamic = True
+isDynamic _      = False
+
+
+instance Outputable ExtName where
+  ppr Dynamic     = ptext SLIT("dynamic")
+  ppr (ExtName nm mb_mod) = 
+     case mb_mod of { Nothing -> empty; Just m -> doubleQuotes (ptext m) } <+> 
+     doubleQuotes (ptext nm)
+
+\end{code}
+
+%************************************************************************
+%*                                                                     *
 \subsection{Signatures in interface files}
 %*                                                                     *
 %************************************************************************
@@ -382,7 +422,8 @@ data HsIdInfo name
   | HsUpdate           UpdateInfo
   | HsArgUsage         ArgUsageInfo
   | HsFBType           FBTypeInfo
-       -- ToDo: specialisations
+  | HsSpecialise       [HsTyVar name] [HsType name] (UfExpr name)
+
 
 data HsStrictnessInfo name
   = HsStrictnessInfo [Demand]