[project @ 2000-09-22 15:56:12 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 d1b0e0e..75fa293 100644 (file)
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -55,7 +55,14 @@ module RdrHsSyn (
        extractRuleBndrsTyVars,
        extractHsCtxtRdrTyVars,
  
-       mkOpApp, mkClassDecl, mkClassOpSig, mkConDecl,
+       mkHsOpApp, mkClassDecl, mkClassOpSig, mkConDecl,
+       mkHsNegApp, mkHsIntegralLit, mkHsFractionalLit, mkNPlusKPatIn,
+
+       
+       -- some built-in names (all :: RdrName)
+       unitCon_RDR, unitTyCon_RDR, nilCon_RDR, listTyCon_RDR,
+       tupleCon_RDR, tupleTyCon_RDR, ubxTupleCon_RDR, ubxTupleTyCon_RDR,
+       funTyCon_RDR,
 
        cvBinds,
        cvMonoBindsAndSigs,
@@ -65,18 +72,20 @@ module RdrHsSyn (
 
 #include "HsVersions.h"
 
-import HsSyn
+import HsSyn           -- Lots of it
+import CmdLineOpts     ( opt_NoImplicitPrelude )
 import HsPat           ( collectSigTysFromPats )
-import Name            ( mkClassTyConOcc, mkClassDataConOcc )
 import OccName         ( mkClassTyConOcc, mkClassDataConOcc, mkWorkerOcc,
-                          mkSuperDictSelOcc, mkDefaultMethodOcc
+                          mkSuperDictSelOcc, mkDefaultMethodOcc,
+                         varName, dataName, tcName
                        )
-import RdrName         ( RdrName, isRdrTyVar, mkRdrUnqual, rdrNameOcc )
-import Util            ( thenCmp )
+import PrelNames       ( pRELUDE_Name, mkTupNameStr )
+import RdrName         ( RdrName, isRdrTyVar, mkRdrUnqual, rdrNameOcc,
+                         mkSrcUnqual, mkPreludeQual
+                       )
 import HsPragmas       
 import List            ( nub )
-import BasicTypes      ( RecFlag(..) )
-import Outputable
+import BasicTypes      ( Boxity(..), RecFlag(..) )
 \end{code}
 
  
@@ -189,6 +198,13 @@ extractPatsTyVars = filter isRdrTyVar .
                    collectSigTysFromPats
 \end{code}
 
+
+%************************************************************************
+%*                                                                     *
+\subsection{Construction functions for Rdr stuff}
+%*                                                                    *
+%************************************************************************
+
 mkClassDecl builds a RdrClassDecl, filling in the names for tycon and datacon
 by deriving them from the name of the class.  We fill in the names for the
 tycon and datacon corresponding to the class, by deriving them from the
@@ -227,11 +243,70 @@ mkConDecl cname ex_vars cxt details loc
     wkr_name = mkRdrUnqual (mkWorkerOcc (rdrNameOcc cname))
 \end{code}
 
-A useful function for building @OpApps@.  The operator is always a variable,
-and we don't know the fixity yet.
+\begin{code}
+mkHsNegApp :: RdrNameHsExpr -> RdrNameHsExpr
+-- If the type checker sees (negate 3#) it will barf, because negate
+-- can't take an unboxed arg.  But that is exactly what it will see when
+-- we write "-3#".  So we have to do the negation right now!
+-- 
+-- We also do the same service for boxed literals, because this function
+-- is also used for patterns (which, remember, are parsed as expressions)
+-- and pattern don't have negation in them.
+-- 
+-- Finally, it's important to represent minBound as minBound, and not
+-- as (negate (-minBound)), becuase the latter is out of range. 
+
+mkHsNegApp (HsLit (HsIntPrim i))    = HsLit (HsIntPrim (-i))    
+mkHsNegApp (HsLit (HsFloatPrim i))  = HsLit (HsFloatPrim (-i))  
+mkHsNegApp (HsLit (HsDoublePrim i)) = HsLit (HsDoublePrim (-i)) 
+
+mkHsNegApp (HsOverLit (HsIntegral   i n)) = HsOverLit (HsIntegral   (-i) n)
+mkHsNegApp (HsOverLit (HsFractional f n)) = HsOverLit (HsFractional (-f) n)
+
+mkHsNegApp expr = NegApp expr (prelQual varName SLIT("negate"))
+\end{code}
+
+\begin{code}
+mkHsIntegralLit :: Integer -> HsOverLit RdrName
+mkHsIntegralLit i = HsIntegral i (prelQual varName SLIT("fromInteger"))
+
+mkHsFractionalLit :: Rational -> HsOverLit RdrName
+mkHsFractionalLit f = HsFractional f (prelQual varName SLIT("fromRational"))
+
+mkNPlusKPatIn :: RdrName -> HsOverLit RdrName -> RdrNamePat
+mkNPlusKPatIn n k = NPlusKPatIn n k (prelQual varName SLIT("-"))
+\end{code}
+
+A useful function for building @OpApps@.  The operator is always a
+variable, and we don't know the fixity yet.
+
+\begin{code}
+mkHsOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
+\end{code}
 
 \begin{code}
-mkOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
+-----------------------------------------------------------------------------
+-- Built-in names
+-- Qualified Prelude names are always in scope; so we can just say Prelude.[]
+-- for the list type constructor, say.   But it's not so easy when we say
+-- -fno-implicit-prelude.   Then you just get whatever "[]" happens to be in scope.
+
+unitCon_RDR, unitTyCon_RDR, nilCon_RDR, listTyCon_RDR :: RdrName
+tupleCon_RDR, tupleTyCon_RDR           :: Int -> RdrName
+ubxTupleCon_RDR, ubxTupleTyCon_RDR     :: Int -> RdrName
+
+unitCon_RDR            = prelQual dataName SLIT("()")
+unitTyCon_RDR          = prelQual tcName   SLIT("()")
+nilCon_RDR             = prelQual dataName SLIT("[]")
+listTyCon_RDR          = prelQual tcName   SLIT("[]")
+funTyCon_RDR           = prelQual tcName   SLIT("(->)")
+tupleCon_RDR arity      = prelQual dataName (snd (mkTupNameStr Boxed arity))
+tupleTyCon_RDR arity    = prelQual tcName   (snd (mkTupNameStr Boxed arity))
+ubxTupleCon_RDR arity   = prelQual dataName (snd (mkTupNameStr Unboxed arity))
+ubxTupleTyCon_RDR arity = prelQual tcName   (snd (mkTupNameStr Unboxed arity))
+
+prelQual ns occ | opt_NoImplicitPrelude = mkSrcUnqual   ns occ
+               | otherwise             = mkPreludeQual ns pRELUDE_Name occ
 \end{code}
 
 %************************************************************************