[project @ 2006-01-18 12:16:06 by simonpj]

[ghc-hetmet.git] / ghc / compiler / parser / RdrHsSyn.lhs

diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index c8c29a1..a955791 100644 (file)
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -11,7 +11,7 @@ module RdrHsSyn (
        mkHsOpApp, mkClassDecl, 
        mkHsNegApp, mkHsIntegral, mkHsFractional,
        mkHsDo, mkHsSplice,
-        mkTyData, mkPrefixCon, mkRecCon,
+        mkTyData, mkPrefixCon, mkRecCon, mkInlineSpec, 
        mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
 
        cvBindGroup,
@@ -53,13 +53,13 @@ import HsSyn                -- Lots of it
 import RdrName         ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc, 
                          isRdrDataCon, isUnqual, getRdrName, isQual,
                          setRdrNameSpace )
-import BasicTypes      ( maxPrecedence )
+import BasicTypes      ( maxPrecedence, Activation, InlineSpec(..), alwaysInlineSpec, neverInlineSpec )
 import Lexer           ( P, failSpanMsgP )
 import TysWiredIn      ( unitTyCon ) 
 import ForeignCall     ( CCallConv, Safety, CCallTarget(..), CExportSpec(..),
                          DNCallSpec(..), DNKind(..), CLabelString )
 import OccName         ( srcDataName, varName, isDataOcc, isTcOcc, 
-                         occNameUserString )
+                         occNameString )
 import SrcLoc
 import OrdList         ( OrdList, fromOL )
 import Bag             ( Bag, emptyBag, snocBag, consBag, foldrBag )
@@ -158,7 +158,7 @@ mkClassDecl (cxt, cname, tyvars) fds sigs mbinds
                tcdMeths = mbinds
                }
 
-mkTyData new_or_data (L _ (context, tname, tyvars)) ksig data_cons maybe_deriv
+mkTyData new_or_data (context, tname, tyvars) ksig data_cons maybe_deriv
   = TyData { tcdND = new_or_data, tcdCtxt = context, tcdLName = tname,
             tcdTyVars = tyvars,  tcdCons = data_cons, 
             tcdKindSig = ksig, tcdDerivs = maybe_deriv }
@@ -601,9 +601,11 @@ checkValSig
        :: LHsExpr RdrName
        -> LHsType RdrName
        -> P (Sig RdrName)
-checkValSig (L l (HsVar v)) ty | isUnqual v = return (Sig (L l v) ty)
+checkValSig (L l (HsVar v)) ty 
+  | isUnqual v && not (isDataOcc (rdrNameOcc v))
+  = return (TypeSig (L l v) ty)
 checkValSig (L l other)     ty
-  = parseError l "Type signature given for an expression"
+  = parseError l "Invalid type signature"
 
 mkGadtDecl
         :: Located RdrName
@@ -671,6 +673,13 @@ mkRecConstrOrUpdate exp loc fs@(_:_)
 mkRecConstrOrUpdate _ loc []
   = parseError loc "Empty record update"
 
+mkInlineSpec :: Maybe Activation -> Bool -> InlineSpec
+-- The Maybe is becuase the user can omit the activation spec (and usually does)
+mkInlineSpec Nothing   True  = alwaysInlineSpec        -- INLINE
+mkInlineSpec Nothing   False = neverInlineSpec         -- NOINLINE
+mkInlineSpec (Just act) inl   = Inline act inl
+
+
 -----------------------------------------------------------------------------
 -- utilities for foreign declarations
 
@@ -793,8 +802,8 @@ mkExport :: CallConv
 mkExport (CCall  cconv) (L loc entity, v, ty) = return $ 
   ForD (ForeignExport v ty (CExport (CExportStatic entity' cconv)) False)
   where
-    entity' | nullFastString entity = mkExtName (unLoc v)
-           | otherwise             = entity
+    entity' | nullFS entity = mkExtName (unLoc v)
+           | otherwise     = entity
 mkExport DNCall (L loc entity, v, ty) =
   parseError (getLoc v){-TODO: not quite right-}
        "Foreign export is not yet supported for .NET"
@@ -804,10 +813,9 @@ mkExport DNCall (L loc entity, v, ty) =
 -- of the Haskell name is then performed, so if you foreign export (++),
 -- it's external name will be "++". Too bad; it's important because we don't
 -- want z-encoding (e.g. names with z's in them shouldn't be doubled)
--- (This is why we use occNameUserString.)
 --
 mkExtName :: RdrName -> CLabelString
-mkExtName rdrNm = mkFastString (occNameUserString (rdrNameOcc rdrNm))
+mkExtName rdrNm = mkFastString (occNameString (rdrNameOcc rdrNm))
 \end{code}