From 3990e36dac177060165ccbf202bfe11a0ceea224 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 27 Jan 1999 15:05:07 +0000
Subject: [PATCH] [project @ 1999-01-27 15:05:07 by simonpj] Add RdrName.lhs

---
 ghc/compiler/basicTypes/RdrName.lhs |  155 +++++++++++++++++++++++++++++++++++
 1 file changed, 155 insertions(+)
 create mode 100644 ghc/compiler/basicTypes/RdrName.lhs

diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs
new file mode 100644
index 0000000..006bfea
--- /dev/null
+++ b/ghc/compiler/basicTypes/RdrName.lhs
@@ -0,0 +1,155 @@
+
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+
+\section[RdrName]{@RdrName@}
+
+\begin{code}
+module RdrName (
+	RdrName,
+
+	-- Construction
+	mkRdrUnqual, mkRdrQual,
+	mkSrcUnqual, mkSrcQual, 
+	mkSysUnqual, mkSysQual,
+	mkPreludeQual, qualifyRdrName,
+	dummyRdrVarName, dummyRdrTcName,
+
+	-- Destruction
+	rdrNameModule, rdrNameOcc, 
+	isRdrDataCon, isRdrTyVar, isQual, isUnqual
+  ) where 
+
+#include "HsVersions.h"
+
+import OccName	( NameSpace, tcName,
+		  OccName, Module, IfaceFlavour,
+		  mkSysModuleFS, mkSysOccFS,
+		  mkSrcModuleFS, mkSrcOccFS, mkSrcVarOcc,
+		  isDataOcc, isTvOcc,
+		  pprModuleSep
+		)
+
+import PrelMods	( pRELUDE )
+import Outputable
+import Util	( thenCmp )
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{The main data type}
+%*									*
+%************************************************************************
+
+\begin{code}
+data RdrName = RdrName Qual OccName
+
+data Qual = Unqual
+	  | Qual Module
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Simple functions}
+%*									*
+%************************************************************************
+
+\begin{code}
+rdrNameModule :: RdrName -> Module
+rdrNameModule (RdrName (Qual m) _) = m
+
+rdrNameOcc :: RdrName -> OccName
+rdrNameOcc (RdrName _ occ) = occ
+\end{code}
+
+\begin{code}
+	-- These two are the basic constructors
+mkRdrUnqual :: OccName -> RdrName
+mkRdrUnqual occ = RdrName Unqual occ
+
+mkRdrQual :: Module -> OccName -> RdrName
+mkRdrQual mod occ = RdrName (Qual mod) occ
+
+	-- These two are used when parsing source files
+	-- They do encode the module and occurrence names
+mkSrcUnqual :: NameSpace -> FAST_STRING -> RdrName
+mkSrcUnqual sp n   = RdrName Unqual (mkSrcOccFS sp n)
+
+mkSrcQual :: NameSpace -> FAST_STRING -> FAST_STRING -> RdrName
+mkSrcQual sp m n = RdrName (Qual (mkSrcModuleFS m)) (mkSrcOccFS sp n)
+
+	-- These two are used when parsing interface files
+	-- They do not encode the module and occurrence name
+mkSysUnqual :: NameSpace -> FAST_STRING -> RdrName
+mkSysUnqual sp n         = RdrName Unqual (mkSysOccFS sp n)
+
+mkSysQual :: NameSpace -> (FAST_STRING, FAST_STRING, IfaceFlavour) -> RdrName
+mkSysQual sp (m,n,hif) = RdrName (Qual (mkSysModuleFS m hif)) (mkSysOccFS sp n)
+
+mkPreludeQual :: NameSpace -> Module -> FAST_STRING -> RdrName
+mkPreludeQual sp mod n = RdrName (Qual mod) (mkSrcOccFS sp n)
+
+qualifyRdrName :: Module -> RdrName -> RdrName
+qualifyRdrName mod (RdrName Unqual occ) = RdrName (Qual mod) occ
+qualifyRdrName mod rdr_name		= rdr_name 
+\end{code}
+
+\begin{code}
+	-- This guy is used by the reader when HsSyn has a slot for
+	-- an implicit name that's going to be filled in by
+	-- the renamer.  We can't just put "error..." because
+	-- we sometimes want to print out stuff after reading but
+	-- before renaming
+dummyRdrVarName = RdrName Unqual (mkSrcVarOcc SLIT("V-DUMMY"))
+dummyRdrTcName  = RdrName Unqual (mkSrcOccFS tcName SLIT("TC-DUMMY"))
+\end{code}
+
+
+\begin{code}
+isRdrDataCon (RdrName _ occ) = isDataOcc occ
+isRdrTyVar   (RdrName _ occ) = isTvOcc occ
+
+isUnqual (RdrName Unqual _) = True
+isUnqual other		    = False
+
+isQual rdr_name = not (isUnqual rdr_name)
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Instances}
+%*									*
+%************************************************************************
+
+\begin{code}
+instance Outputable RdrName where
+    ppr (RdrName qual occ) = pp_qual qual <> ppr occ
+			   where
+				pp_qual Unqual = empty
+				pp_qual (Qual mod) = ppr mod <> pprModuleSep mod
+
+instance Eq RdrName where
+    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
+    a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
+
+instance Ord RdrName where
+    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
+    a <	 b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
+    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
+    a >	 b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
+
+    compare (RdrName q1 o1) (RdrName q2 o2)
+	= (o1  `compare` o2) `thenCmp` 
+	  (q1  `cmpQual` q2) 
+
+cmpQual Unqual	  Unqual    = EQ
+cmpQual Unqual    (Qual _)  = LT
+cmpQual (Qual _)  Unqual    = GT
+cmpQual (Qual m1) (Qual m2) = m1 `compare` m2
+\end{code}
+
+
+
-- 
1.7.10.4