FIX: add missing case to OccName.isSymOcc
[ghc.git] / compiler / basicTypes / OccName.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 \begin{code}
7 {-# OPTIONS -w #-}
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and fix
10 -- any warnings in the module. See
11 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
12 -- for details
13
14 module OccName (
15         -- * The NameSpace type; abstact
16         NameSpace, tcName, clsName, tcClsName, dataName, varName, 
17         tvName, srcDataName,
18
19         -- ** Printing
20         pprNameSpace, pprNonVarNameSpace, pprNameSpaceBrief,
21
22         -- * The OccName type
23         OccName,        -- Abstract, instance of Outputable
24         pprOccName, 
25
26         -- ** Construction      
27         mkOccName, mkOccNameFS, 
28         mkVarOcc, mkVarOccFS,
29         mkTyVarOcc,
30         mkDFunOcc,
31         mkTupleOcc, 
32         setOccNameSpace,
33
34         -- ** Derived OccNames
35         mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc,
36         mkDerivedTyConOcc, mkNewTyCoOcc,
37         mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, 
38         mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
39         mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
40         mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
41         mkInstTyCoOcc, mkEqPredCoOcc,
42         mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
43         mkPArrayTyConOcc, mkPArrayDataConOcc,
44         mkPReprTyConOcc,
45         mkPADFunOcc,
46
47         -- ** Deconstruction
48         occNameFS, occNameString, occNameSpace, 
49
50         isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
51         parenSymOcc, reportIfUnused, isTcClsName, isVarName,
52
53         isTupleOcc_maybe,
54
55         -- The OccEnv type
56         OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
57         lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
58         occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
59
60         -- The OccSet type
61         OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet, 
62         extendOccSetList,
63         unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, occSetElts, 
64         foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet,
65
66         -- Tidying up
67         TidyOccEnv, emptyTidyOccEnv, tidyOccName, initTidyOccEnv,
68
69         -- The basic form of names
70         isLexCon, isLexVar, isLexId, isLexSym,
71         isLexConId, isLexConSym, isLexVarId, isLexVarSym,
72         startsVarSym, startsVarId, startsConSym, startsConId
73     ) where
74
75 #include "HsVersions.h"
76
77 import Util
78 import Unique
79 import BasicTypes
80 import StaticFlags
81 import UniqFM
82 import UniqSet
83 import FastString
84 import Outputable
85 import Binary
86
87 import GHC.Exts
88 import Data.Char
89
90 -- Unicode TODO: put isSymbol in libcompat
91 #if __GLASGOW_HASKELL__ > 604
92 #else
93 isSymbol = const False
94 #endif
95
96 \end{code}
97
98 %************************************************************************
99 %*                                                                      *
100 \subsection{Name space}
101 %*                                                                      *
102 %************************************************************************
103
104 \begin{code}
105 data NameSpace = VarName        -- Variables, including "real" data constructors
106                | DataName       -- "Source" data constructors 
107                | TvName         -- Type variables
108                | TcClsName      -- Type constructors and classes; Haskell has them
109                                 -- in the same name space for now.
110                deriving( Eq, Ord )
111    {-! derive: Binary !-}
112
113 -- Note [Data Constructors]  
114 -- see also: Note [Data Constructor Naming] in DataCon.lhs
115 -- 
116 --      "Source" data constructors are the data constructors mentioned
117 --      in Haskell source code
118 --
119 --      "Real" data constructors are the data constructors of the
120 --      representation type, which may not be the same as the source
121 --      type
122
123 -- Example:
124 --      data T = T !(Int,Int)
125 --
126 -- The source datacon has type (Int,Int) -> T
127 -- The real   datacon has type Int -> Int -> T
128 -- GHC chooses a representation based on the strictness etc.
129
130
131 -- Though type constructors and classes are in the same name space now,
132 -- the NameSpace type is abstract, so we can easily separate them later
133 tcName    = TcClsName           -- Type constructors
134 clsName   = TcClsName           -- Classes
135 tcClsName = TcClsName           -- Not sure which!
136
137 dataName    = DataName
138 srcDataName = DataName  -- Haskell-source data constructors should be
139                         -- in the Data name space
140
141 tvName      = TvName
142 varName     = VarName
143
144 isTcClsName :: NameSpace -> Bool
145 isTcClsName TcClsName = True
146 isTcClsName _         = False
147
148 isVarName :: NameSpace -> Bool  -- Variables or type variables, but not constructors
149 isVarName TvName  = True
150 isVarName VarName = True
151 isVarName other   = False
152
153 pprNameSpace :: NameSpace -> SDoc
154 pprNameSpace DataName  = ptext SLIT("data constructor")
155 pprNameSpace VarName   = ptext SLIT("variable")
156 pprNameSpace TvName    = ptext SLIT("type variable")
157 pprNameSpace TcClsName = ptext SLIT("type constructor or class")
158
159 pprNonVarNameSpace :: NameSpace -> SDoc
160 pprNonVarNameSpace VarName = empty
161 pprNonVarNameSpace ns = pprNameSpace ns
162
163 pprNameSpaceBrief DataName  = char 'd'
164 pprNameSpaceBrief VarName   = char 'v'
165 pprNameSpaceBrief TvName    = ptext SLIT("tv")
166 pprNameSpaceBrief TcClsName = ptext SLIT("tc")
167 \end{code}
168
169
170 %************************************************************************
171 %*                                                                      *
172 \subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
173 %*                                                                      *
174 %************************************************************************
175
176 \begin{code}
177 data OccName = OccName 
178     { occNameSpace  :: !NameSpace
179     , occNameFS     :: !FastString
180     }
181 \end{code}
182
183
184 \begin{code}
185 instance Eq OccName where
186     (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
187
188 instance Ord OccName where
189         -- Compares lexicographically, *not* by Unique of the string
190     compare (OccName sp1 s1) (OccName sp2 s2) 
191         = (s1  `compare` s2) `thenCmp` (sp1 `compare` sp2)
192 \end{code}
193
194
195 %************************************************************************
196 %*                                                                      *
197 \subsection{Printing}
198 %*                                                                      *
199 %************************************************************************
200  
201 \begin{code}
202 instance Outputable OccName where
203     ppr = pprOccName
204
205 pprOccName :: OccName -> SDoc
206 pprOccName (OccName sp occ) 
207   = getPprStyle $ \ sty ->
208     if codeStyle sty 
209         then ftext (zEncodeFS occ)
210         else ftext occ <> if debugStyle sty 
211                             then braces (pprNameSpaceBrief sp)
212                             else empty
213 \end{code}
214
215
216 %************************************************************************
217 %*                                                                      *
218 \subsection{Construction}
219 %*                                                                      *
220 %************************************************************************
221
222 \begin{code}
223 mkOccName :: NameSpace -> String -> OccName
224 mkOccName occ_sp str = OccName occ_sp (mkFastString str)
225
226 mkOccNameFS :: NameSpace -> FastString -> OccName
227 mkOccNameFS occ_sp fs = OccName occ_sp fs
228
229 mkVarOcc :: String -> OccName
230 mkVarOcc s = mkOccName varName s
231
232 mkVarOccFS :: FastString -> OccName
233 mkVarOccFS fs = mkOccNameFS varName fs
234
235 mkTyVarOcc :: FastString -> OccName
236 mkTyVarOcc fs = mkOccNameFS tvName fs
237 \end{code}
238
239
240 %************************************************************************
241 %*                                                                      *
242                 Environments
243 %*                                                                      *
244 %************************************************************************
245
246 OccEnvs are used mainly for the envts in ModIfaces.
247
248 They are efficient, because FastStrings have unique Int# keys.  We assume
249 this key is less than 2^24, so we can make a Unique using
250         mkUnique ns key  :: Unique
251 where 'ns' is a Char reprsenting the name space.  This in turn makes it
252 easy to build an OccEnv.
253
254 \begin{code}
255 instance Uniquable OccName where
256   getUnique (OccName ns fs)
257       = mkUnique char (I# (uniqueOfFS fs))
258       where     -- See notes above about this getUnique function
259         char = case ns of
260                 VarName   -> 'i'
261                 DataName  -> 'd'
262                 TvName    -> 'v'
263                 TcClsName -> 't'
264
265 type OccEnv a = UniqFM a
266
267 emptyOccEnv :: OccEnv a
268 unitOccEnv  :: OccName -> a -> OccEnv a
269 extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
270 extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
271 lookupOccEnv :: OccEnv a -> OccName -> Maybe a
272 mkOccEnv     :: [(OccName,a)] -> OccEnv a
273 mkOccEnv_C   :: (a -> a -> a) -> [(OccName,a)] -> OccEnv a
274 elemOccEnv   :: OccName -> OccEnv a -> Bool
275 foldOccEnv   :: (a -> b -> b) -> b -> OccEnv a -> b
276 occEnvElts   :: OccEnv a -> [a]
277 extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
278 plusOccEnv     :: OccEnv a -> OccEnv a -> OccEnv a
279 plusOccEnv_C   :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
280 mapOccEnv      :: (a->b) -> OccEnv a -> OccEnv b
281
282 emptyOccEnv      = emptyUFM
283 unitOccEnv       = unitUFM
284 extendOccEnv     = addToUFM
285 extendOccEnvList = addListToUFM
286 lookupOccEnv     = lookupUFM
287 mkOccEnv         = listToUFM
288 elemOccEnv       = elemUFM
289 foldOccEnv       = foldUFM
290 occEnvElts       = eltsUFM
291 plusOccEnv       = plusUFM
292 plusOccEnv_C     = plusUFM_C
293 extendOccEnv_C   = addToUFM_C
294 mapOccEnv        = mapUFM
295
296 mkOccEnv_C comb l = addListToUFM_C comb emptyOccEnv l
297
298 type OccSet = UniqFM OccName
299
300 emptyOccSet       :: OccSet
301 unitOccSet        :: OccName -> OccSet
302 mkOccSet          :: [OccName] -> OccSet
303 extendOccSet      :: OccSet -> OccName -> OccSet
304 extendOccSetList  :: OccSet -> [OccName] -> OccSet
305 unionOccSets      :: OccSet -> OccSet -> OccSet
306 unionManyOccSets  :: [OccSet] -> OccSet
307 minusOccSet       :: OccSet -> OccSet -> OccSet
308 elemOccSet        :: OccName -> OccSet -> Bool
309 occSetElts        :: OccSet -> [OccName]
310 foldOccSet        :: (OccName -> b -> b) -> b -> OccSet -> b
311 isEmptyOccSet     :: OccSet -> Bool
312 intersectOccSet   :: OccSet -> OccSet -> OccSet
313 intersectsOccSet  :: OccSet -> OccSet -> Bool
314
315 emptyOccSet       = emptyUniqSet
316 unitOccSet        = unitUniqSet
317 mkOccSet          = mkUniqSet
318 extendOccSet      = addOneToUniqSet
319 extendOccSetList  = addListToUniqSet
320 unionOccSets      = unionUniqSets
321 unionManyOccSets  = unionManyUniqSets
322 minusOccSet       = minusUniqSet
323 elemOccSet        = elementOfUniqSet
324 occSetElts        = uniqSetToList
325 foldOccSet        = foldUniqSet
326 isEmptyOccSet     = isEmptyUniqSet
327 intersectOccSet   = intersectUniqSets
328 intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
329 \end{code}
330
331
332 %************************************************************************
333 %*                                                                      *
334 \subsection{Predicates and taking them apart}
335 %*                                                                      *
336 %************************************************************************
337
338 \begin{code}
339 occNameString :: OccName -> String
340 occNameString (OccName _ s) = unpackFS s
341
342 setOccNameSpace :: NameSpace -> OccName -> OccName
343 setOccNameSpace sp (OccName _ occ) = OccName sp occ
344
345 isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
346
347 isVarOcc (OccName VarName _) = True
348 isVarOcc other               = False
349
350 isTvOcc (OccName TvName _) = True
351 isTvOcc other              = False
352
353 isTcOcc (OccName TcClsName _) = True
354 isTcOcc other                 = False
355
356 isValOcc (OccName VarName  _) = True
357 isValOcc (OccName DataName _) = True
358 isValOcc other                = False
359
360 -- Data constructor operator (starts with ':', or '[]')
361 -- Pretty inefficient!
362 isDataSymOcc (OccName DataName s) = isLexConSym s
363 isDataSymOcc (OccName VarName s)  
364   | isLexConSym s = pprPanic "isDataSymOcc: check me" (ppr s)
365                 -- Jan06: I don't think this should happen
366 isDataSymOcc other                = False
367
368 isDataOcc (OccName DataName _) = True
369 isDataOcc (OccName VarName s)  
370   | isLexCon s = pprPanic "isDataOcc: check me" (ppr s)
371                 -- Jan06: I don't think this should happen
372 isDataOcc other                = False
373
374 -- Any operator (data constructor or variable)
375 -- Pretty inefficient!
376 isSymOcc (OccName DataName s)  = isLexConSym s
377 isSymOcc (OccName TcClsName s) = isLexConSym s
378 isSymOcc (OccName VarName s)   = isLexSym s
379 isSymOcc (OccName TvName s)    = isLexSym s
380
381 parenSymOcc :: OccName -> SDoc -> SDoc
382 -- Wrap parens around an operator
383 parenSymOcc occ doc | isSymOcc occ = parens doc
384                     | otherwise    = doc
385 \end{code}
386
387
388 \begin{code}
389 reportIfUnused :: OccName -> Bool
390   -- Haskell 98 encourages compilers to suppress warnings about
391   -- unused names in a pattern if they start with "_".
392 reportIfUnused occ = case occNameString occ of
393                         ('_' : _) -> False
394                         _other    -> True
395 \end{code}
396
397
398 %************************************************************************
399 %*                                                                      *
400 \subsection{Making system names}
401 %*                                                                      *
402 %************************************************************************
403
404 Here's our convention for splitting up the interface file name space:
405
406         d...            dictionary identifiers
407                         (local variables, so no name-clash worries)
408
409         $f...           dict-fun identifiers (from inst decls)
410         $dm...          default methods
411         $p...           superclass selectors
412         $w...           workers
413         :T...           compiler-generated tycons for dictionaries
414         :D...           ...ditto data cons
415         :Co...          ...ditto coercions
416         $sf..           specialised version of f
417
418         in encoded form these appear as Zdfxxx etc
419
420         :...            keywords (export:, letrec: etc.)
421 --- I THINK THIS IS WRONG!
422
423 This knowledge is encoded in the following functions.
424
425
426 @mk_deriv@ generates an @OccName@ from the prefix and a string.
427 NB: The string must already be encoded!
428
429 \begin{code}
430 mk_deriv :: NameSpace 
431          -> String              -- Distinguishes one sort of derived name from another
432          -> String
433          -> OccName
434
435 mk_deriv occ_sp sys_prefix str = mkOccName occ_sp (sys_prefix ++ str)
436 \end{code}
437
438 \begin{code}
439 mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
440         mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, 
441         mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
442         mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc
443    :: OccName -> OccName
444
445 -- These derived variables have a prefix that no Haskell value could have
446 mkDataConWrapperOcc = mk_simple_deriv varName  "$W"
447 mkWorkerOcc         = mk_simple_deriv varName  "$w"
448 mkDefaultMethodOcc  = mk_simple_deriv varName  "$dm"
449 mkDerivedTyConOcc   = mk_simple_deriv tcName   ":"      -- The : prefix makes sure it classifies
450 mkClassTyConOcc     = mk_simple_deriv tcName   ":T"     -- as a tycon/datacon
451 mkClassDataConOcc   = mk_simple_deriv dataName ":D"     -- We go straight to the "real" data con
452                                                         -- for datacons from classes
453 mkDictOcc           = mk_simple_deriv varName  "$d"
454 mkIPOcc             = mk_simple_deriv varName  "$i"
455 mkSpecOcc           = mk_simple_deriv varName  "$s"
456 mkForeignExportOcc  = mk_simple_deriv varName  "$f"
457 mkNewTyCoOcc        = mk_simple_deriv tcName  ":Co"
458 mkInstTyCoOcc       = mk_simple_deriv tcName  ":CoF"     -- derived from rep ty
459 mkEqPredCoOcc       = mk_simple_deriv tcName  "$co"
460
461 -- Generic derivable classes
462 mkGenOcc1           = mk_simple_deriv varName  "$gfrom"
463 mkGenOcc2           = mk_simple_deriv varName  "$gto" 
464
465 -- data T = MkT ... deriving( Data ) needs defintions for 
466 --      $tT   :: Data.Generics.Basics.DataType
467 --      $cMkT :: Data.Generics.Basics.Constr
468 mkDataTOcc = mk_simple_deriv varName  "$t"
469 mkDataCOcc = mk_simple_deriv varName  "$c"
470
471 -- Vectorisation
472 mkVectOcc          = mk_simple_deriv varName  "$v_"
473 mkVectTyConOcc     = mk_simple_deriv tcName   ":V_"
474 mkVectDataConOcc   = mk_simple_deriv dataName ":VD_"
475 mkVectIsoOcc       = mk_simple_deriv varName  "$VI_"
476 mkPArrayTyConOcc   = mk_simple_deriv tcName   ":VP_"
477 mkPArrayDataConOcc = mk_simple_deriv dataName ":VPD_"
478 mkPReprTyConOcc    = mk_simple_deriv tcName   ":VR_"
479 mkPADFunOcc        = mk_simple_deriv varName  "$PA_"
480
481 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
482
483 -- Data constructor workers are made by setting the name space
484 -- of the data constructor OccName (which should be a DataName)
485 -- to VarName
486 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ 
487 \end{code}
488
489 \begin{code}
490 mkSuperDictSelOcc :: Int        -- Index of superclass, eg 3
491                   -> OccName    -- Class, eg "Ord"
492                   -> OccName    -- eg "$p3Ord"
493 mkSuperDictSelOcc index cls_occ
494   = mk_deriv varName "$p" (show index ++ occNameString cls_occ)
495
496 mkLocalOcc :: Unique            -- Unique
497            -> OccName           -- Local name (e.g. "sat")
498            -> OccName           -- Nice unique version ("$L23sat")
499 mkLocalOcc uniq occ
500    = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
501         -- The Unique might print with characters 
502         -- that need encoding (e.g. 'z'!)
503 \end{code}
504
505 Derive a name for the representation type constructor of a data/newtype
506 instance.
507
508 \begin{code}
509 mkInstTyTcOcc :: Int                    -- Index
510               -> OccName                -- Family name (e.g. "Map")
511               -> OccName                -- Nice unique version (":R23Map")
512 mkInstTyTcOcc index occ
513    = mk_deriv tcName (":R" ++ show index) (occNameString occ)
514 \end{code}
515
516 \begin{code}
517 mkDFunOcc :: String             -- Typically the class and type glommed together e.g. "OrdMaybe"
518                                 -- Only used in debug mode, for extra clarity
519           -> Bool               -- True <=> hs-boot instance dfun
520           -> Int                -- Unique index
521           -> OccName            -- "$f3OrdMaybe"
522
523 -- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real
524 -- thing when we compile the mother module. Reason: we don't know exactly
525 -- what the  mother module will call it.
526
527 mkDFunOcc info_str is_boot index 
528   = mk_deriv VarName prefix string
529   where
530     prefix | is_boot   = "$fx"
531            | otherwise = "$f"
532     string | opt_PprStyle_Debug = show index ++ info_str
533            | otherwise          = show index
534 \end{code}
535
536 We used to add a '$m' to indicate a method, but that gives rise to bad
537 error messages from the type checker when we print the function name or pattern
538 of an instance-decl binding.  Why? Because the binding is zapped
539 to use the method name in place of the selector name.
540 (See TcClassDcl.tcMethodBind)
541
542 The way it is now, -ddump-xx output may look confusing, but
543 you can always say -dppr-debug to get the uniques.
544
545 However, we *do* have to zap the first character to be lower case,
546 because overloaded constructors (blarg) generate methods too.
547 And convert to VarName space
548
549 e.g. a call to constructor MkFoo where
550         data (Ord a) => Foo a = MkFoo a
551
552 If this is necessary, we do it by prefixing '$m'.  These 
553 guys never show up in error messages.  What a hack.
554
555 \begin{code}
556 mkMethodOcc :: OccName -> OccName
557 mkMethodOcc occ@(OccName VarName fs) = occ
558 mkMethodOcc occ                      = mk_simple_deriv varName "$m" occ
559 \end{code}
560
561
562 %************************************************************************
563 %*                                                                      *
564 \subsection{Tidying them up}
565 %*                                                                      *
566 %************************************************************************
567
568 Before we print chunks of code we like to rename it so that
569 we don't have to print lots of silly uniques in it.  But we mustn't
570 accidentally introduce name clashes!  So the idea is that we leave the
571 OccName alone unless it accidentally clashes with one that is already
572 in scope; if so, we tack on '1' at the end and try again, then '2', and
573 so on till we find a unique one.
574
575 There's a wrinkle for operators.  Consider '>>='.  We can't use '>>=1' 
576 because that isn't a single lexeme.  So we encode it to 'lle' and *then*
577 tack on the '1', if necessary.
578
579 \begin{code}
580 type TidyOccEnv = OccEnv Int    -- The in-scope OccNames
581         -- Range gives a plausible starting point for new guesses
582
583 emptyTidyOccEnv = emptyOccEnv
584
585 initTidyOccEnv :: [OccName] -> TidyOccEnv       -- Initialise with names to avoid!
586 initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv
587
588 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
589
590 tidyOccName in_scope occ@(OccName occ_sp fs)
591   = case lookupOccEnv in_scope occ of
592         Nothing ->      -- Not already used: make it used
593                    (extendOccEnv in_scope occ 1, occ)
594
595         Just n  ->      -- Already used: make a new guess, 
596                         -- change the guess base, and try again
597                    tidyOccName  (extendOccEnv in_scope occ (n+1))
598                                 (mkOccName occ_sp (unpackFS fs ++ show n))
599 \end{code}
600
601 %************************************************************************
602 %*                                                                      *
603                 Stuff for dealing with tuples
604 %*                                                                      *
605 %************************************************************************
606
607 \begin{code}
608 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
609 mkTupleOcc ns bx ar = OccName ns (mkFastString str)
610   where
611         -- no need to cache these, the caching is done in the caller
612         -- (TysWiredIn.mk_tuple)
613     str = case bx of
614                 Boxed   -> '(' : commas ++ ")"
615                 Unboxed -> '(' : '#' : commas ++ "#)"
616
617     commas = take (ar-1) (repeat ',')
618
619 isTupleOcc_maybe :: OccName -> Maybe (NameSpace, Boxity, Arity)
620 -- Tuples are special, because there are so many of them!
621 isTupleOcc_maybe (OccName ns fs)
622   = case unpackFS fs of
623         '(':'#':',':rest -> Just (ns, Unboxed, 2 + count_commas rest)
624         '(':',':rest     -> Just (ns, Boxed,   2 + count_commas rest)
625         _other           -> Nothing
626   where
627     count_commas (',':rest) = 1 + count_commas rest
628     count_commas _          = 0
629 \end{code}
630
631 %************************************************************************
632 %*                                                                      *
633 \subsection{Lexical categories}
634 %*                                                                      *
635 %************************************************************************
636
637 These functions test strings to see if they fit the lexical categories
638 defined in the Haskell report.
639
640 \begin{code}
641 isLexCon,   isLexVar,    isLexId,    isLexSym    :: FastString -> Bool
642 isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
643
644 isLexCon cs = isLexConId  cs || isLexConSym cs
645 isLexVar cs = isLexVarId  cs || isLexVarSym cs
646
647 isLexId  cs = isLexConId  cs || isLexVarId  cs
648 isLexSym cs = isLexConSym cs || isLexVarSym cs
649
650 -------------
651
652 isLexConId cs                           -- Prefix type or data constructors
653   | nullFS cs         = False           --      e.g. "Foo", "[]", "(,)" 
654   | cs == FSLIT("[]") = True
655   | otherwise         = startsConId (headFS cs)
656
657 isLexVarId cs                           -- Ordinary prefix identifiers
658   | nullFS cs         = False           --      e.g. "x", "_x"
659   | otherwise         = startsVarId (headFS cs)
660
661 isLexConSym cs                          -- Infix type or data constructors
662   | nullFS cs         = False           --      e.g. ":-:", ":", "->"
663   | cs == FSLIT("->") = True
664   | otherwise         = startsConSym (headFS cs)
665
666 isLexVarSym cs                          -- Infix identifiers
667   | nullFS cs         = False           --      e.g. "+"
668   | otherwise         = startsVarSym (headFS cs)
669
670 -------------
671 startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
672 startsVarSym c = isSymbolASCII c || (ord c > 0x7f && isSymbol c) -- Infix Ids
673 startsConSym c = c == ':'                               -- Infix data constructors
674 startsVarId c  = isLower c || c == '_'  -- Ordinary Ids
675 startsConId c  = isUpper c || c == '('  -- Ordinary type constructors and data constructors
676
677 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
678 \end{code}
679
680 %************************************************************************
681 %*                                                                      *
682                 Binary instance
683     Here rather than BinIface because OccName is abstract
684 %*                                                                      *
685 %************************************************************************
686
687 \begin{code}
688 instance Binary NameSpace where
689     put_ bh VarName = do
690             putByte bh 0
691     put_ bh DataName = do
692             putByte bh 1
693     put_ bh TvName = do
694             putByte bh 2
695     put_ bh TcClsName = do
696             putByte bh 3
697     get bh = do
698             h <- getByte bh
699             case h of
700               0 -> do return VarName
701               1 -> do return DataName
702               2 -> do return TvName
703               _ -> do return TcClsName
704
705 instance Binary OccName where
706     put_ bh (OccName aa ab) = do
707             put_ bh aa
708             put_ bh ab
709     get bh = do
710           aa <- get bh
711           ab <- get bh
712           return (OccName aa ab)
713 \end{code}