2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TcGenDeriv]{Generating derived instance declarations}
6 This module is nominally ``subordinate'' to @TcDeriv@, which is the
7 ``official'' interface to deriving-related things.
9 This is where we do all the grimy bindings' generation.
20 gen_tag_n_con_monobind,
22 con2tag_RDR, tag2con_RDR, maxtag_RDR,
27 #include "HsVersions.h"
29 import HsSyn ( Pat(..), HsConDetails(..), HsExpr(..), MonoBinds(..),
30 Match(..), GRHSs(..), Stmt(..), HsLit(..),
31 HsBinds(..), HsType(..), HsDoContext(..),
32 unguardedRHS, mkSimpleMatch, mkMonoBind, andMonoBindList, placeHolderType
34 import RdrName ( RdrName, mkUnqual, nameRdrName, getRdrName )
35 import RdrHsSyn ( mkHsOpApp, RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat, mkHsDo )
36 import BasicTypes ( RecFlag(..), Fixity(..), FixityDirection(..)
40 import FieldLabel ( fieldLabelName )
41 import DataCon ( isNullaryDataCon, dataConTag,
42 dataConOrigArgTys, dataConSourceArity, fIRST_TAG,
45 import Name ( getOccString, getOccName, getSrcLoc, occNameString,
46 occNameUserString, varName,
48 isDataSymOcc, isSymOcc
51 import HscTypes ( FixityEnv, lookupFixity )
52 import PrelInfo -- Lots of Names
53 import PrimOp -- Lots of Names
54 import SrcLoc ( generatedSrcLoc, SrcLoc )
55 import TyCon ( TyCon, isNewTyCon, tyConDataCons, isEnumerationTyCon,
56 maybeTyConSingleCon, tyConFamilySize
58 import TcType ( isUnLiftedType, tcEqType, Type )
59 import TysPrim ( charPrimTy, intPrimTy, wordPrimTy, addrPrimTy,
60 floatPrimTy, doublePrimTy
62 import Util ( zipWithEqual, isSingleton,
63 zipWith3Equal, nOfThem, zipEqual )
64 import Panic ( panic, assertPanic )
65 import Maybes ( maybeToBool )
66 import Char ( ord, isAlpha )
68 import List ( partition, intersperse )
73 %************************************************************************
75 \subsection{Generating code, by derivable class}
77 %************************************************************************
79 %************************************************************************
81 \subsubsection{Generating @Eq@ instance declarations}
83 %************************************************************************
85 Here are the heuristics for the code we generate for @Eq@:
88 Let's assume we have a data type with some (possibly zero) nullary
89 data constructors and some ordinary, non-nullary ones (the rest,
90 also possibly zero of them). Here's an example, with both \tr{N}ullary
91 and \tr{O}rdinary data cons.
93 data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
97 For the ordinary constructors (if any), we emit clauses to do The
101 (==) (O1 a1 b1) (O1 a2 b2) = a1 == a2 && b1 == b2
102 (==) (O2 a1) (O2 a2) = a1 == a2
103 (==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
106 Note: if we're comparing unlifted things, e.g., if \tr{a1} and
107 \tr{a2} are \tr{Float#}s, then we have to generate
109 case (a1 `eqFloat#` a2) of
112 for that particular test.
115 If there are any nullary constructors, we emit a catch-all clause of
119 (==) a b = case (con2tag_Foo a) of { a# ->
120 case (con2tag_Foo b) of { b# ->
121 case (a# ==# b#) of {
126 If there aren't any nullary constructors, we emit a simpler
133 For the @(/=)@ method, we normally just use the default method.
135 If the type is an enumeration type, we could/may/should? generate
136 special code that calls @con2tag_Foo@, much like for @(==)@ shown
140 We thought about doing this: If we're also deriving @Ord@ for this
143 instance ... Eq (Foo ...) where
144 (==) a b = case (compare a b) of { _LT -> False; _EQ -> True ; _GT -> False}
145 (/=) a b = case (compare a b) of { _LT -> True ; _EQ -> False; _GT -> True }
147 However, that requires that \tr{Ord <whatever>} was put in the context
148 for the instance decl, which it probably wasn't, so the decls
149 produced don't get through the typechecker.
153 deriveEq :: RdrName -- Class
154 -> RdrName -- Type constructor
155 -> [ (RdrName, [RdrType]) ] -- Constructors
156 -> (RdrContext, -- Context for the inst decl
157 [RdrBind], -- Binds in the inst decl
158 [RdrBind]) -- Extra value bindings outside
160 deriveEq clas tycon constrs
161 = (context, [eq_bind, ne_bind], [])
163 context = [(clas, [ty]) | (_, tys) <- constrs, ty <- tys]
166 (nullary_cons, non_nullary_cons) = partition is_nullary constrs
167 is_nullary (_, args) = null args
170 gen_Eq_binds :: TyCon -> RdrNameMonoBinds
174 tycon_loc = getSrcLoc tycon
175 (nullary_cons, nonnullary_cons)
176 | isNewTyCon tycon = ([], tyConDataCons tycon)
177 | otherwise = partition isNullaryDataCon (tyConDataCons tycon)
180 = if (null nullary_cons) then
181 case maybeTyConSingleCon tycon of
183 Nothing -> -- if cons don't match, then False
184 [([wildPat, wildPat], false_Expr)]
185 else -- calc. and compare the tags
187 untag_Expr tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
188 (genOpApp (HsVar ah_RDR) eqInt_RDR (HsVar bh_RDR)))]
190 mk_FunMonoBind tycon_loc eq_RDR ((map pats_etc nonnullary_cons) ++ rest)
192 mk_easy_FunMonoBind tycon_loc ne_RDR [a_Pat, b_Pat] [] (
193 HsApp (HsVar not_RDR) (HsPar (mkHsVarApps eq_RDR [a_RDR, b_RDR])))
195 ------------------------------------------------------------------
198 con1_pat = mkConPat data_con_RDR as_needed
199 con2_pat = mkConPat data_con_RDR bs_needed
201 data_con_RDR = getRdrName data_con
202 con_arity = length tys_needed
203 as_needed = take con_arity as_RDRs
204 bs_needed = take con_arity bs_RDRs
205 tys_needed = dataConOrigArgTys data_con
207 ([con1_pat, con2_pat], nested_eq_expr tys_needed as_needed bs_needed)
209 nested_eq_expr [] [] [] = true_Expr
210 nested_eq_expr tys as bs
211 = foldl1 and_Expr (zipWith3Equal "nested_eq" nested_eq tys as bs)
213 nested_eq ty a b = HsPar (eq_Expr ty (HsVar a) (HsVar b))
216 %************************************************************************
218 \subsubsection{Generating @Ord@ instance declarations}
220 %************************************************************************
222 For a derived @Ord@, we concentrate our attentions on @compare@
224 compare :: a -> a -> Ordering
225 data Ordering = LT | EQ | GT deriving ()
228 We will use the same example data type as above:
230 data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
235 We do all the other @Ord@ methods with calls to @compare@:
237 instance ... (Ord <wurble> <wurble>) where
238 a < b = case (compare a b) of { LT -> True; EQ -> False; GT -> False }
239 a <= b = case (compare a b) of { LT -> True; EQ -> True; GT -> False }
240 a >= b = case (compare a b) of { LT -> False; EQ -> True; GT -> True }
241 a > b = case (compare a b) of { LT -> False; EQ -> False; GT -> True }
243 max a b = case (compare a b) of { LT -> b; EQ -> a; GT -> a }
244 min a b = case (compare a b) of { LT -> a; EQ -> b; GT -> b }
246 -- compare to come...
250 @compare@ always has two parts. First, we use the compared
251 data-constructors' tags to deal with the case of different
254 compare a b = case (con2tag_Foo a) of { a# ->
255 case (con2tag_Foo b) of { b# ->
256 case (a# ==# b#) of {
258 False -> case (a# <# b#) of
263 cmp_eq = ... to come ...
267 We are only left with the ``help'' function @cmp_eq@, to deal with
268 comparing data constructors with the same tag.
270 For the ordinary constructors (if any), we emit the sorta-obvious
271 compare-style stuff; for our example:
273 cmp_eq (O1 a1 b1) (O1 a2 b2)
274 = case (compare a1 a2) of { LT -> LT; EQ -> compare b1 b2; GT -> GT }
276 cmp_eq (O2 a1) (O2 a2)
279 cmp_eq (O3 a1 b1 c1) (O3 a2 b2 c2)
280 = case (compare a1 a2) of {
283 EQ -> case compare b1 b2 of {
291 Again, we must be careful about unlifted comparisons. For example,
292 if \tr{a1} and \tr{a2} were \tr{Int#}s in the 2nd example above, we'd need to
296 cmp_eq lt eq gt (O2 a1) (O2 a2)
298 -- or maybe the unfolded equivalent
302 For the remaining nullary constructors, we already know that the
309 If there is only one constructor in the Data Type we don't need the WildCard Pattern.
313 gen_Ord_binds :: TyCon -> RdrNameMonoBinds
316 = compare -- `AndMonoBinds` compare
317 -- The default declaration in PrelBase handles this
319 tycon_loc = getSrcLoc tycon
320 --------------------------------------------------------------------
321 compare = mk_easy_FunMonoBind tycon_loc compare_RDR
324 (if maybeToBool (maybeTyConSingleCon tycon) then
326 -- cmp_eq_Expr ltTag_Expr eqTag_Expr gtTag_Expr a_Expr b_Expr
327 -- Weird. Was: case (cmp a b) of { LT -> LT; EQ -> EQ; GT -> GT }
329 cmp_eq_Expr a_Expr b_Expr
331 untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)]
332 (cmp_tags_Expr eqInt_RDR ah_RDR bh_RDR
333 -- True case; they are equal
334 -- If an enumeration type we are done; else
335 -- recursively compare their components
336 (if isEnumerationTyCon tycon then
339 -- cmp_eq_Expr ltTag_Expr eqTag_Expr gtTag_Expr a_Expr b_Expr
341 cmp_eq_Expr a_Expr b_Expr
343 -- False case; they aren't equal
344 -- So we need to do a less-than comparison on the tags
345 (cmp_tags_Expr ltInt_RDR ah_RDR bh_RDR ltTag_Expr gtTag_Expr)))
347 tycon_data_cons = tyConDataCons tycon
348 (nullary_cons, nonnullary_cons)
349 | isNewTyCon tycon = ([], tyConDataCons tycon)
350 | otherwise = partition isNullaryDataCon tycon_data_cons
353 mk_FunMonoBind tycon_loc
355 (if null nonnullary_cons && isSingleton nullary_cons then
356 -- catch this specially to avoid warnings
357 -- about overlapping patterns from the desugarer.
359 data_con = head nullary_cons
360 data_con_RDR = getRdrName data_con
361 pat = mkNullaryConPat data_con_RDR
363 [([pat,pat], eqTag_Expr)]
365 map pats_etc nonnullary_cons ++
366 -- leave out wildcards to silence desugarer.
367 (if isSingleton tycon_data_cons then
370 [([wildPat, wildPat], default_rhs)]))
373 = ([con1_pat, con2_pat],
374 nested_compare_expr tys_needed as_needed bs_needed)
376 con1_pat = mkConPat data_con_RDR as_needed
377 con2_pat = mkConPat data_con_RDR bs_needed
379 data_con_RDR = getRdrName data_con
380 con_arity = length tys_needed
381 as_needed = take con_arity as_RDRs
382 bs_needed = take con_arity bs_RDRs
383 tys_needed = dataConOrigArgTys data_con
385 nested_compare_expr [ty] [a] [b]
386 = careful_compare_Case ty ltTag_Expr eqTag_Expr gtTag_Expr (HsVar a) (HsVar b)
388 nested_compare_expr (ty:tys) (a:as) (b:bs)
389 = let eq_expr = nested_compare_expr tys as bs
390 in careful_compare_Case ty ltTag_Expr eq_expr gtTag_Expr (HsVar a) (HsVar b)
392 default_rhs | null nullary_cons = impossible_Expr -- Keep desugarer from complaining about
393 -- inexhaustive patterns
394 | otherwise = eqTag_Expr -- Some nullary constructors;
395 -- Tags are equal, no args => return EQ
398 %************************************************************************
400 \subsubsection{Generating @Enum@ instance declarations}
402 %************************************************************************
404 @Enum@ can only be derived for enumeration types. For a type
406 data Foo ... = N1 | N2 | ... | Nn
409 we use both @con2tag_Foo@ and @tag2con_Foo@ functions, as well as a
410 @maxtag_Foo@ variable (all generated by @gen_tag_n_con_binds@).
413 instance ... Enum (Foo ...) where
414 succ x = toEnum (1 + fromEnum x)
415 pred x = toEnum (fromEnum x - 1)
417 toEnum i = tag2con_Foo i
419 enumFrom a = map tag2con_Foo [con2tag_Foo a .. maxtag_Foo]
423 = case con2tag_Foo a of
424 a# -> map tag2con_Foo (enumFromTo (I# a#) maxtag_Foo)
427 = map tag2con_Foo [con2tag_Foo a, con2tag_Foo b .. maxtag_Foo]
431 = case con2tag_Foo a of { a# ->
432 case con2tag_Foo b of { b# ->
433 map tag2con_Foo (enumFromThenTo (I# a#) (I# b#) maxtag_Foo)
437 For @enumFromTo@ and @enumFromThenTo@, we use the default methods.
440 gen_Enum_binds :: TyCon -> RdrNameMonoBinds
443 = succ_enum `AndMonoBinds`
444 pred_enum `AndMonoBinds`
445 to_enum `AndMonoBinds`
446 enum_from `AndMonoBinds`
447 enum_from_then `AndMonoBinds`
450 tycon_loc = getSrcLoc tycon
451 occ_nm = getOccString tycon
454 = mk_easy_FunMonoBind tycon_loc succ_RDR [a_Pat] [] $
455 untag_Expr tycon [(a_RDR, ah_RDR)] $
456 HsIf (mkHsApps eq_RDR [HsVar (maxtag_RDR tycon),
457 mkHsVarApps mkInt_RDR [ah_RDR]])
458 (illegal_Expr "succ" occ_nm "tried to take `succ' of last tag in enumeration")
459 (HsApp (HsVar (tag2con_RDR tycon))
460 (mkHsApps plus_RDR [mkHsVarApps mkInt_RDR [ah_RDR],
465 = mk_easy_FunMonoBind tycon_loc pred_RDR [a_Pat] [] $
466 untag_Expr tycon [(a_RDR, ah_RDR)] $
467 HsIf (mkHsApps eq_RDR [mkHsIntLit 0,
468 mkHsVarApps mkInt_RDR [ah_RDR]])
469 (illegal_Expr "pred" occ_nm "tried to take `pred' of first tag in enumeration")
470 (HsApp (HsVar (tag2con_RDR tycon))
471 (mkHsApps plus_RDR [mkHsVarApps mkInt_RDR [ah_RDR],
472 HsLit (HsInt (-1))]))
476 = mk_easy_FunMonoBind tycon_loc toEnum_RDR [a_Pat] [] $
477 HsIf (mkHsApps and_RDR
478 [mkHsApps ge_RDR [HsVar a_RDR, mkHsIntLit 0],
479 mkHsApps le_RDR [HsVar a_RDR, HsVar (maxtag_RDR tycon)]])
480 (mkHsVarApps (tag2con_RDR tycon) [a_RDR])
481 (illegal_toEnum_tag occ_nm (maxtag_RDR tycon))
485 = mk_easy_FunMonoBind tycon_loc enumFrom_RDR [a_Pat] [] $
486 untag_Expr tycon [(a_RDR, ah_RDR)] $
488 [HsVar (tag2con_RDR tycon),
489 HsPar (enum_from_to_Expr
490 (mkHsVarApps mkInt_RDR [ah_RDR])
491 (HsVar (maxtag_RDR tycon)))]
494 = mk_easy_FunMonoBind tycon_loc enumFromThen_RDR [a_Pat, b_Pat] [] $
495 untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)] $
496 HsApp (mkHsVarApps map_RDR [tag2con_RDR tycon]) $
497 HsPar (enum_from_then_to_Expr
498 (mkHsVarApps mkInt_RDR [ah_RDR])
499 (mkHsVarApps mkInt_RDR [bh_RDR])
500 (HsIf (mkHsApps gt_RDR [mkHsVarApps mkInt_RDR [ah_RDR],
501 mkHsVarApps mkInt_RDR [bh_RDR]])
503 (HsVar (maxtag_RDR tycon))
507 = mk_easy_FunMonoBind tycon_loc fromEnum_RDR [a_Pat] [] $
508 untag_Expr tycon [(a_RDR, ah_RDR)] $
509 (mkHsVarApps mkInt_RDR [ah_RDR])
512 %************************************************************************
514 \subsubsection{Generating @Bounded@ instance declarations}
516 %************************************************************************
519 gen_Bounded_binds tycon
520 = if isEnumerationTyCon tycon then
521 min_bound_enum `AndMonoBinds` max_bound_enum
523 ASSERT(isSingleton data_cons)
524 min_bound_1con `AndMonoBinds` max_bound_1con
526 data_cons = tyConDataCons tycon
527 tycon_loc = getSrcLoc tycon
529 ----- enum-flavored: ---------------------------
530 min_bound_enum = mk_easy_FunMonoBind tycon_loc minBound_RDR [] [] (HsVar data_con_1_RDR)
531 max_bound_enum = mk_easy_FunMonoBind tycon_loc maxBound_RDR [] [] (HsVar data_con_N_RDR)
533 data_con_1 = head data_cons
534 data_con_N = last data_cons
535 data_con_1_RDR = getRdrName data_con_1
536 data_con_N_RDR = getRdrName data_con_N
538 ----- single-constructor-flavored: -------------
539 arity = dataConSourceArity data_con_1
541 min_bound_1con = mk_easy_FunMonoBind tycon_loc minBound_RDR [] [] $
542 mkHsVarApps data_con_1_RDR (nOfThem arity minBound_RDR)
543 max_bound_1con = mk_easy_FunMonoBind tycon_loc maxBound_RDR [] [] $
544 mkHsVarApps data_con_1_RDR (nOfThem arity maxBound_RDR)
547 %************************************************************************
549 \subsubsection{Generating @Ix@ instance declarations}
551 %************************************************************************
553 Deriving @Ix@ is only possible for enumeration types and
554 single-constructor types. We deal with them in turn.
556 For an enumeration type, e.g.,
558 data Foo ... = N1 | N2 | ... | Nn
560 things go not too differently from @Enum@:
562 instance ... Ix (Foo ...) where
564 = map tag2con_Foo [con2tag_Foo a .. con2tag_Foo b]
568 = case (con2tag_Foo a) of { a# ->
569 case (con2tag_Foo b) of { b# ->
570 map tag2con_Foo (enumFromTo (I# a#) (I# b#))
575 then case (con2tag_Foo d -# con2tag_Foo a) of
577 else error "Ix.Foo.index: out of range"
581 p_tag = con2tag_Foo c
583 p_tag >= con2tag_Foo a && p_tag <= con2tag_Foo b
587 = case (con2tag_Foo a) of { a_tag ->
588 case (con2tag_Foo b) of { b_tag ->
589 case (con2tag_Foo c) of { c_tag ->
590 if (c_tag >=# a_tag) then
596 (modulo suitable case-ification to handle the unlifted tags)
598 For a single-constructor type (NB: this includes all tuples), e.g.,
600 data Foo ... = MkFoo a b Int Double c c
602 we follow the scheme given in Figure~19 of the Haskell~1.2 report
606 gen_Ix_binds :: TyCon -> RdrNameMonoBinds
609 = if isEnumerationTyCon tycon
613 tycon_str = getOccString tycon
614 tycon_loc = getSrcLoc tycon
616 --------------------------------------------------------------
617 enum_ixes = enum_range `AndMonoBinds`
618 enum_index `AndMonoBinds` enum_inRange
621 = mk_easy_FunMonoBind tycon_loc range_RDR
622 [TuplePat [a_Pat, b_Pat] Boxed] [] $
623 untag_Expr tycon [(a_RDR, ah_RDR)] $
624 untag_Expr tycon [(b_RDR, bh_RDR)] $
625 HsApp (mkHsVarApps map_RDR [tag2con_RDR tycon]) $
626 HsPar (enum_from_to_Expr
627 (mkHsVarApps mkInt_RDR [ah_RDR])
628 (mkHsVarApps mkInt_RDR [bh_RDR]))
631 = mk_easy_FunMonoBind tycon_loc index_RDR
632 [AsPat c_RDR (TuplePat [a_Pat, wildPat] Boxed),
634 HsIf (HsPar (mkHsVarApps inRange_RDR [c_RDR, d_RDR])) (
635 untag_Expr tycon [(a_RDR, ah_RDR)] (
636 untag_Expr tycon [(d_RDR, dh_RDR)] (
638 rhs = mkHsVarApps mkInt_RDR [c_RDR]
641 (genOpApp (HsVar dh_RDR) minusInt_RDR (HsVar ah_RDR))
642 [mkSimpleMatch [VarPat c_RDR] rhs placeHolderType tycon_loc]
646 HsApp (HsVar error_RDR) (HsLit (HsString (mkFastString ("Ix."++tycon_str++".index: out of range\n"))))
651 = mk_easy_FunMonoBind tycon_loc inRange_RDR
652 [TuplePat [a_Pat, b_Pat] Boxed, c_Pat] [] (
653 untag_Expr tycon [(a_RDR, ah_RDR)] (
654 untag_Expr tycon [(b_RDR, bh_RDR)] (
655 untag_Expr tycon [(c_RDR, ch_RDR)] (
656 HsIf (genOpApp (HsVar ch_RDR) geInt_RDR (HsVar ah_RDR)) (
657 (genOpApp (HsVar ch_RDR) leInt_RDR (HsVar bh_RDR))
662 --------------------------------------------------------------
664 = single_con_range `AndMonoBinds`
665 single_con_index `AndMonoBinds`
669 = case maybeTyConSingleCon tycon of -- just checking...
670 Nothing -> panic "get_Ix_binds"
671 Just dc -> if (any isUnLiftedType (dataConOrigArgTys dc)) then
672 error ("ERROR: Can't derive Ix for a single-constructor type with primitive argument types: "++tycon_str)
676 con_arity = dataConSourceArity data_con
677 data_con_RDR = getRdrName data_con
679 as_needed = take con_arity as_RDRs
680 bs_needed = take con_arity bs_RDRs
681 cs_needed = take con_arity cs_RDRs
683 con_pat xs = mkConPat data_con_RDR xs
684 con_expr = mkHsVarApps data_con_RDR cs_needed
686 --------------------------------------------------------------
688 = mk_easy_FunMonoBind tycon_loc range_RDR
689 [TuplePat [con_pat as_needed, con_pat bs_needed] Boxed] [] $
690 mkHsDo ListComp stmts tycon_loc
692 stmts = zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed
694 [ResultStmt con_expr tycon_loc]
696 mk_qual a b c = BindStmt (VarPat c)
697 (HsApp (HsVar range_RDR)
698 (ExplicitTuple [HsVar a, HsVar b] Boxed))
703 = mk_easy_FunMonoBind tycon_loc index_RDR
704 [TuplePat [con_pat as_needed, con_pat bs_needed] Boxed,
705 con_pat cs_needed] [range_size] (
706 foldl mk_index (mkHsIntLit 0) (zip3 as_needed bs_needed cs_needed))
708 mk_index multiply_by (l, u, i)
710 (mkHsApps index_RDR [ExplicitTuple [HsVar l, HsVar u] Boxed,
714 (HsApp (HsVar rangeSize_RDR)
715 (ExplicitTuple [HsVar l, HsVar u] Boxed))
716 ) times_RDR multiply_by
720 = mk_easy_FunMonoBind tycon_loc rangeSize_RDR
721 [TuplePat [a_Pat, b_Pat] Boxed] [] (
723 (mkHsApps index_RDR [ExplicitTuple [a_Expr, b_Expr] Boxed,
725 ) plus_RDR (mkHsIntLit 1))
729 = mk_easy_FunMonoBind tycon_loc inRange_RDR
730 [TuplePat [con_pat as_needed, con_pat bs_needed] Boxed,
733 foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range as_needed bs_needed cs_needed))
735 in_range a b c = mkHsApps inRange_RDR [ExplicitTuple [HsVar a, HsVar b] Boxed,
739 %************************************************************************
741 \subsubsection{Generating @Read@ instance declarations}
743 %************************************************************************
753 instance Read T where
757 do x <- ReadP.step Read.readPrec
758 Symbol "%%" <- Lex.lex
759 y <- ReadP.step Read.readPrec
763 do Ident "T1" <- Lex.lex
765 Ident "f1" <- Lex.lex
767 x <- ReadP.reset Read.readPrec
769 return (T1 { f1 = x }))
772 do Ident "T2" <- Lex.lexP
773 x <- ReadP.step Read.readPrec
777 readListPrec = readListPrecDefault
778 readList = readListDefault
782 gen_Read_binds :: FixityEnv -> TyCon -> RdrNameMonoBinds
784 gen_Read_binds get_fixity tycon
785 = read_prec `AndMonoBinds` default_binds
787 -----------------------------------------------------------------------
789 = mk_easy_FunMonoBind loc readList_RDR [] [] (HsVar readListDefault_RDR)
791 mk_easy_FunMonoBind loc readListPrec_RDR [] [] (HsVar readListPrecDefault_RDR)
792 -----------------------------------------------------------------------
794 loc = getSrcLoc tycon
795 data_cons = tyConDataCons tycon
796 (nullary_cons, non_nullary_cons) = partition isNullaryDataCon data_cons
798 read_prec = mk_easy_FunMonoBind loc readPrec_RDR [] []
799 (HsApp (HsVar parens_RDR) read_cons)
801 read_cons = foldr1 mk_alt (read_nullary_cons ++ read_non_nullary_cons)
802 read_non_nullary_cons = map read_non_nullary_con non_nullary_cons
805 = case nullary_cons of
807 [con] -> [mkHsDo DoExpr [bindLex (ident_pat (data_con_str con)),
808 result_stmt con []] loc]
809 _ -> [HsApp (HsVar choose_RDR)
810 (ExplicitList placeHolderType (map mk_pair nullary_cons))]
812 mk_pair con = ExplicitTuple [HsLit (data_con_str con),
813 HsApp (HsVar returnM_RDR) (HsVar (getRdrName con))]
816 read_non_nullary_con data_con
817 = mkHsApps prec_RDR [mkHsIntLit prec, mkHsDo DoExpr stmts loc]
819 stmts | is_infix = infix_stmts
820 | length labels > 0 = lbl_stmts
821 | otherwise = prefix_stmts
823 prefix_stmts -- T a b c
824 = [bindLex (ident_pat (data_con_str data_con))]
825 ++ map read_arg as_needed
826 ++ [result_stmt data_con as_needed]
828 infix_stmts -- a %% b
830 bindLex (symbol_pat (data_con_str data_con)),
832 result_stmt data_con [a1,a2]]
834 lbl_stmts -- T { f1 = a, f2 = b }
835 = [bindLex (ident_pat (data_con_str data_con)),
837 ++ concat (intersperse [read_punc ","] field_stmts)
838 ++ [read_punc "}", result_stmt data_con as_needed]
840 field_stmts = zipWithEqual "lbl_stmts" read_field labels as_needed
842 con_arity = dataConSourceArity data_con
843 nullary_con = con_arity == 0
844 labels = dataConFieldLabels data_con
845 lab_fields = length labels
846 dc_nm = getName data_con
847 is_infix = isDataSymOcc (getOccName dc_nm)
848 as_needed = take con_arity as_RDRs
849 (a1:a2:_) = as_needed
850 prec = getPrec is_infix get_fixity dc_nm
852 ------------------------------------------------------------------------
854 ------------------------------------------------------------------------
855 mk_alt e1 e2 = genOpApp e1 alt_RDR e2
856 bindLex pat = BindStmt pat (HsVar lexP_RDR) loc
857 result_stmt c as = ResultStmt (HsApp (HsVar returnM_RDR) (con_app c as)) loc
858 con_app c as = mkHsVarApps (getRdrName c) as
860 punc_pat s = ConPatIn punc_RDR (PrefixCon [LitPat (mkHsString s)]) -- Punc 'c'
861 ident_pat s = ConPatIn ident_RDR (PrefixCon [LitPat s]) -- Ident "foo"
862 symbol_pat s = ConPatIn symbol_RDR (PrefixCon [LitPat s]) -- Symbol ">>"
864 data_con_str con = mkHsString (occNameUserString (getOccName con))
866 read_punc c = bindLex (punc_pat c)
867 read_arg a = BindStmt (VarPat a) (mkHsVarApps step_RDR [readPrec_RDR]) loc
869 read_field lbl a = read_lbl lbl ++
871 BindStmt (VarPat a) (mkHsVarApps reset_RDR [readPrec_RDR]) loc]
873 -- When reading field labels we might encounter
877 read_lbl lbl | isAlpha (head lbl_str)
878 = [bindLex (ident_pat lbl_lit)]
881 bindLex (symbol_pat lbl_lit),
884 lbl_str = occNameUserString (getOccName (fieldLabelName lbl))
885 lbl_lit = mkHsString lbl_str
889 %************************************************************************
891 \subsubsection{Generating @Show@ instance declarations}
893 %************************************************************************
899 data Tree a = Leaf a | Tree a :^: Tree a
901 instance (Show a) => Show (Tree a) where
903 showsPrec d (Leaf m) = showParen (d > app_prec) showStr
905 showStr = showString "Leaf " . showsPrec (app_prec+1) m
907 showsPrec d (u :^: v) = showParen (d > up_prec) showStr
909 showStr = showsPrec (up_prec+1) u .
911 showsPrec (up_prec+1) v
912 -- Note: right-associativity of :^: ignored
914 up_prec = 5 -- Precedence of :^:
915 app_prec = 10 -- Application has precedence one more than
916 -- the most tightly-binding operator
919 gen_Show_binds :: FixityEnv -> TyCon -> RdrNameMonoBinds
921 gen_Show_binds get_fixity tycon
922 = shows_prec `AndMonoBinds` show_list
924 tycon_loc = getSrcLoc tycon
925 -----------------------------------------------------------------------
926 show_list = mk_easy_FunMonoBind tycon_loc showList_RDR [] []
927 (HsApp (HsVar showList___RDR) (HsPar (HsApp (HsVar showsPrec_RDR) (mkHsIntLit 0))))
928 -----------------------------------------------------------------------
929 shows_prec = mk_FunMonoBind tycon_loc showsPrec_RDR (map pats_etc (tyConDataCons tycon))
932 | nullary_con = -- skip the showParen junk...
933 ASSERT(null bs_needed)
934 ([wildPat, con_pat], mk_showString_app con_str)
937 showParen_Expr (HsPar (genOpApp a_Expr ge_RDR (HsLit (HsInt con_prec_plus_one))))
938 (HsPar (nested_compose_Expr show_thingies)))
940 data_con_RDR = getRdrName data_con
941 con_arity = dataConSourceArity data_con
942 bs_needed = take con_arity bs_RDRs
943 con_pat = mkConPat data_con_RDR bs_needed
944 nullary_con = con_arity == 0
945 labels = dataConFieldLabels data_con
946 lab_fields = length labels
947 record_syntax = lab_fields > 0
949 dc_nm = getName data_con
950 dc_occ_nm = getOccName data_con
951 con_str = occNameUserString dc_occ_nm
954 | is_infix = [show_arg1, mk_showString_app (" " ++ con_str ++ " "), show_arg2]
955 | record_syntax = mk_showString_app (con_str ++ " {") :
956 show_record_args ++ [mk_showString_app "}"]
957 | otherwise = mk_showString_app (con_str ++ " ") : show_prefix_args
959 show_label l = mk_showString_app (the_name ++ " = ")
960 -- Note the spaces around the "=" sign. If we don't have them
961 -- then we get Foo { x=-1 } and the "=-" parses as a single
962 -- lexeme. Only the space after the '=' is necessary, but
963 -- it seems tidier to have them both sides.
965 occ_nm = getOccName (fieldLabelName l)
966 nm = occNameUserString occ_nm
968 is_op = isSymOcc occ_nm -- Legal, but rare.
970 | is_op = '(':nm ++ ")"
973 show_args = [ mkHsApps showsPrec_RDR [HsLit (HsInt arg_prec), HsVar b]
975 (show_arg1:show_arg2:_) = show_args
976 show_prefix_args = intersperse (HsVar showSpace_RDR) show_args
978 -- Assumption for record syntax: no of fields == no of labelled fields
979 -- (and in same order)
980 show_record_args = concat $
981 intersperse [mk_showString_app ", "] $
982 [ [show_label lbl, arg]
983 | (lbl,arg) <- zipEqual "gen_Show_binds"
987 is_infix = isDataSymOcc dc_occ_nm
988 con_prec_plus_one = 1 + getPrec is_infix get_fixity dc_nm
989 arg_prec | record_syntax = 0 -- Record fields don't need parens
990 | otherwise = con_prec_plus_one
992 mk_showString_app str = HsApp (HsVar showString_RDR) (HsLit (mkHsString str))
996 getPrec :: Bool -> FixityEnv -> Name -> Integer
997 getPrec is_infix get_fixity nm
998 | not is_infix = appPrecedence
999 | otherwise = getPrecedence get_fixity nm
1001 appPrecedence :: Integer
1002 appPrecedence = fromIntegral maxPrecedence + 1
1003 -- One more than the precedence of the most
1004 -- tightly-binding operator
1006 getPrecedence :: FixityEnv -> Name -> Integer
1007 getPrecedence get_fixity nm
1008 = case lookupFixity get_fixity nm of
1009 Fixity x _ -> fromIntegral x
1011 isLRAssoc :: FixityEnv -> Name -> (Bool, Bool)
1012 isLRAssoc get_fixity nm =
1013 case lookupFixity get_fixity nm of
1014 Fixity _ InfixN -> (False, False)
1015 Fixity _ InfixR -> (False, True)
1016 Fixity _ InfixL -> (True, False)
1020 %************************************************************************
1022 \subsection{Generating extra binds (@con2tag@ and @tag2con@)}
1024 %************************************************************************
1029 con2tag_Foo :: Foo ... -> Int#
1030 tag2con_Foo :: Int -> Foo ... -- easier if Int, not Int#
1031 maxtag_Foo :: Int -- ditto (NB: not unlifted)
1034 The `tags' here start at zero, hence the @fIRST_TAG@ (currently one)
1039 = GenCon2Tag | GenTag2Con | GenMaxTag
1041 gen_tag_n_con_monobind
1042 :: (RdrName, -- (proto)Name for the thing in question
1043 TyCon, -- tycon in question
1047 gen_tag_n_con_monobind (rdr_name, tycon, GenCon2Tag)
1048 | lots_of_constructors
1049 = mk_FunMonoBind (getSrcLoc tycon) rdr_name
1050 [([VarPat a_RDR], HsApp getTag_Expr a_Expr)]
1053 = mk_FunMonoBind (getSrcLoc tycon) rdr_name (map mk_stuff (tyConDataCons tycon))
1056 lots_of_constructors = tyConFamilySize tycon > mAX_FAMILY_SIZE_FOR_VEC_RETURNS
1058 mk_stuff :: DataCon -> ([RdrNamePat], RdrNameHsExpr)
1060 = ([pat], HsLit (HsIntPrim (toInteger ((dataConTag var) - fIRST_TAG))))
1062 pat = ConPatIn var_RDR (PrefixCon (nOfThem (dataConSourceArity var) wildPat))
1063 var_RDR = getRdrName var
1065 gen_tag_n_con_monobind (rdr_name, tycon, GenTag2Con)
1066 = mk_FunMonoBind (getSrcLoc tycon) rdr_name
1067 [([mkConPat mkInt_RDR [a_RDR]],
1068 ExprWithTySig (HsApp tagToEnum_Expr a_Expr)
1069 (HsTyVar (getRdrName tycon)))]
1071 gen_tag_n_con_monobind (rdr_name, tycon, GenMaxTag)
1072 = mk_easy_FunMonoBind (getSrcLoc tycon)
1073 rdr_name [] [] (HsApp (HsVar mkInt_RDR) (HsLit (HsIntPrim max_tag)))
1075 max_tag = case (tyConDataCons tycon) of
1076 data_cons -> toInteger ((length data_cons) - fIRST_TAG)
1080 %************************************************************************
1082 \subsection{Utility bits for generating bindings}
1084 %************************************************************************
1086 @mk_easy_FunMonoBind fun pats binds expr@ generates:
1088 fun pat1 pat2 ... patN = expr where binds
1091 @mk_FunMonoBind fun [([p1a, p1b, ...], e1), ...]@ is for
1092 multi-clause definitions; it generates:
1094 fun p1a p1b ... p1N = e1
1095 fun p2a p2b ... p2N = e2
1097 fun pMa pMb ... pMN = eM
1101 mk_easy_FunMonoBind :: SrcLoc -> RdrName -> [RdrNamePat]
1102 -> [RdrNameMonoBinds] -> RdrNameHsExpr
1105 mk_easy_FunMonoBind loc fun pats binds expr
1106 = FunMonoBind fun False{-not infix-} [mk_easy_Match loc pats binds expr] loc
1108 mk_easy_Match loc pats binds expr
1109 = mk_match loc pats expr (mkMonoBind (andMonoBindList binds) [] Recursive)
1110 -- The renamer expects everything in its input to be a
1111 -- "recursive" MonoBinds, and it is its job to sort things out
1114 mk_FunMonoBind :: SrcLoc -> RdrName
1115 -> [([RdrNamePat], RdrNameHsExpr)]
1118 mk_FunMonoBind loc fun [] = panic "TcGenDeriv:mk_FunMonoBind"
1119 mk_FunMonoBind loc fun pats_and_exprs
1120 = FunMonoBind fun False{-not infix-}
1121 [ mk_match loc p e EmptyBinds | (p,e) <-pats_and_exprs ]
1124 mk_match loc pats expr binds
1125 = Match (map paren pats) Nothing
1126 (GRHSs (unguardedRHS expr loc) binds placeHolderType)
1128 paren p@(VarPat _) = p
1129 paren other_p = ParPat other_p
1133 mkHsApps f xs = foldl HsApp (HsVar f) xs
1134 mkHsVarApps f xs = foldl HsApp (HsVar f) (map HsVar xs)
1136 mkHsIntLit n = HsLit (HsInt n)
1137 mkHsString s = HsString (mkFastString s)
1138 mkHsChar c = HsChar (ord c)
1140 mkConPat con vars = ConPatIn con (PrefixCon (map VarPat vars))
1141 mkNullaryConPat con = ConPatIn con (PrefixCon [])
1144 ToDo: Better SrcLocs.
1149 -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
1150 -> RdrNameHsExpr -> RdrNameHsExpr
1152 careful_compare_Case :: -- checks for primitive types...
1154 -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
1155 -> RdrNameHsExpr -> RdrNameHsExpr
1158 cmp_eq_Expr a b = HsApp (HsApp (HsVar cmp_eq_RDR) a) b
1159 -- Was: compare_gen_Case cmp_eq_RDR
1161 compare_gen_Case fun lt eq gt a b
1162 = HsCase (HsPar (HsApp (HsApp (HsVar fun) a) b)) {-of-}
1163 [mkSimpleMatch [mkNullaryConPat ltTag_RDR] lt placeHolderType generatedSrcLoc,
1164 mkSimpleMatch [mkNullaryConPat eqTag_RDR] eq placeHolderType generatedSrcLoc,
1165 mkSimpleMatch [mkNullaryConPat gtTag_RDR] gt placeHolderType generatedSrcLoc]
1168 careful_compare_Case ty lt eq gt a b
1169 | not (isUnLiftedType ty) =
1170 compare_gen_Case compare_RDR lt eq gt a b
1172 -- we have to do something special for primitive things...
1173 HsIf (genOpApp a relevant_eq_op b)
1175 (HsIf (genOpApp a relevant_lt_op b) lt gt generatedSrcLoc)
1178 relevant_eq_op = assoc_ty_id eq_op_tbl ty
1179 relevant_lt_op = assoc_ty_id lt_op_tbl ty
1181 assoc_ty_id tyids ty
1182 = if null res then panic "assoc_ty"
1185 res = [id | (ty',id) <- tyids, ty `tcEqType` ty']
1188 [(charPrimTy, eqChar_RDR)
1189 ,(intPrimTy, eqInt_RDR)
1190 ,(wordPrimTy, eqWord_RDR)
1191 ,(addrPrimTy, eqAddr_RDR)
1192 ,(floatPrimTy, eqFloat_RDR)
1193 ,(doublePrimTy, eqDouble_RDR)
1197 [(charPrimTy, ltChar_RDR)
1198 ,(intPrimTy, ltInt_RDR)
1199 ,(wordPrimTy, ltWord_RDR)
1200 ,(addrPrimTy, ltAddr_RDR)
1201 ,(floatPrimTy, ltFloat_RDR)
1202 ,(doublePrimTy, ltDouble_RDR)
1205 -----------------------------------------------------------------------
1207 and_Expr, append_Expr :: RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
1209 and_Expr a b = genOpApp a and_RDR b
1210 append_Expr a b = genOpApp a append_RDR b
1212 -----------------------------------------------------------------------
1214 eq_Expr :: Type -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
1215 eq_Expr ty a b = genOpApp a eq_op b
1218 | not (isUnLiftedType ty) = eq_RDR
1220 -- we have to do something special for primitive things...
1221 assoc_ty_id eq_op_tbl ty
1226 untag_Expr :: TyCon -> [(RdrName, RdrName)] -> RdrNameHsExpr -> RdrNameHsExpr
1227 untag_Expr tycon [] expr = expr
1228 untag_Expr tycon ((untag_this, put_tag_here) : more) expr
1229 = HsCase (HsPar (HsApp (con2tag_Expr tycon) (HsVar untag_this))) {-of-}
1230 [mkSimpleMatch [VarPat put_tag_here] (untag_Expr tycon more expr) placeHolderType generatedSrcLoc]
1233 cmp_tags_Expr :: RdrName -- Comparison op
1234 -> RdrName -> RdrName -- Things to compare
1235 -> RdrNameHsExpr -- What to return if true
1236 -> RdrNameHsExpr -- What to return if false
1239 cmp_tags_Expr op a b true_case false_case
1240 = HsIf (genOpApp (HsVar a) op (HsVar b)) true_case false_case generatedSrcLoc
1243 :: RdrNameHsExpr -> RdrNameHsExpr
1245 enum_from_then_to_Expr
1246 :: RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
1249 enum_from_to_Expr f t2 = HsApp (HsApp (HsVar enumFromTo_RDR) f) t2
1250 enum_from_then_to_Expr f t t2 = HsApp (HsApp (HsApp (HsVar enumFromThenTo_RDR) f) t) t2
1253 :: RdrNameHsExpr -> RdrNameHsExpr
1256 showParen_Expr e1 e2 = HsApp (HsApp (HsVar showParen_RDR) e1) e2
1258 nested_compose_Expr :: [RdrNameHsExpr] -> RdrNameHsExpr
1260 nested_compose_Expr [e] = parenify e
1261 nested_compose_Expr (e:es)
1262 = HsApp (HsApp (HsVar compose_RDR) (parenify e)) (nested_compose_Expr es)
1264 -- impossible_Expr is used in case RHSs that should never happen.
1265 -- We generate these to keep the desugarer from complaining that they *might* happen!
1266 impossible_Expr = HsApp (HsVar error_RDR) (HsLit (HsString (mkFastString "Urk! in TcGenDeriv")))
1268 -- illegal_Expr is used when signalling error conditions in the RHS of a derived
1269 -- method. It is currently only used by Enum.{succ,pred}
1270 illegal_Expr meth tp msg =
1271 HsApp (HsVar error_RDR) (HsLit (HsString (mkFastString (meth ++ '{':tp ++ "}: " ++ msg))))
1273 -- illegal_toEnum_tag is an extended version of illegal_Expr, which also allows you
1274 -- to include the value of a_RDR in the error string.
1275 illegal_toEnum_tag tp maxtag =
1276 HsApp (HsVar error_RDR)
1277 (HsApp (HsApp (HsVar append_RDR)
1278 (HsLit (HsString (mkFastString ("toEnum{" ++ tp ++ "}: tag (")))))
1279 (HsApp (HsApp (HsApp
1280 (HsVar showsPrec_RDR)
1285 (HsLit (HsString (mkFastString ") is outside of enumeration's range (0,"))))
1286 (HsApp (HsApp (HsApp
1287 (HsVar showsPrec_RDR)
1290 (HsLit (HsString (mkFastString ")")))))))
1292 parenify e@(HsVar _) = e
1293 parenify e = HsPar e
1295 -- genOpApp wraps brackets round the operator application, so that the
1296 -- renamer won't subsequently try to re-associate it.
1297 -- For some reason the renamer doesn't reassociate it right, and I can't
1298 -- be bothered to find out why just now.
1300 genOpApp e1 op e2 = mkHsOpApp e1 op e2
1304 varUnqual n = mkUnqual OccName.varName n
1306 zz_a_RDR = varUnqual FSLIT("_a")
1307 a_RDR = varUnqual FSLIT("a")
1308 b_RDR = varUnqual FSLIT("b")
1309 c_RDR = varUnqual FSLIT("c")
1310 d_RDR = varUnqual FSLIT("d")
1311 ah_RDR = varUnqual FSLIT("a#")
1312 bh_RDR = varUnqual FSLIT("b#")
1313 ch_RDR = varUnqual FSLIT("c#")
1314 dh_RDR = varUnqual FSLIT("d#")
1315 cmp_eq_RDR = varUnqual FSLIT("cmp_eq")
1316 rangeSize_RDR = varUnqual FSLIT("rangeSize")
1318 as_RDRs = [ varUnqual (mkFastString ("a"++show i)) | i <- [(1::Int) .. ] ]
1319 bs_RDRs = [ varUnqual (mkFastString ("b"++show i)) | i <- [(1::Int) .. ] ]
1320 cs_RDRs = [ varUnqual (mkFastString ("c"++show i)) | i <- [(1::Int) .. ] ]
1322 zz_a_Expr = HsVar zz_a_RDR
1323 a_Expr = HsVar a_RDR
1324 b_Expr = HsVar b_RDR
1325 c_Expr = HsVar c_RDR
1326 d_Expr = HsVar d_RDR
1327 ltTag_Expr = HsVar ltTag_RDR
1328 eqTag_Expr = HsVar eqTag_RDR
1329 gtTag_Expr = HsVar gtTag_RDR
1330 false_Expr = HsVar false_RDR
1331 true_Expr = HsVar true_RDR
1333 getTag_Expr = HsVar getTag_RDR
1334 tagToEnum_Expr = HsVar tagToEnum_RDR
1335 con2tag_Expr tycon = HsVar (con2tag_RDR tycon)
1337 wildPat = WildPat placeHolderType
1338 zz_a_Pat = VarPat zz_a_RDR
1339 a_Pat = VarPat a_RDR
1340 b_Pat = VarPat b_RDR
1341 c_Pat = VarPat c_RDR
1342 d_Pat = VarPat d_RDR
1344 con2tag_RDR, tag2con_RDR, maxtag_RDR :: TyCon -> RdrName
1346 con2tag_RDR tycon = varUnqual (mkFastString ("con2tag_" ++ occNameString (getOccName tycon) ++ "#"))
1347 tag2con_RDR tycon = varUnqual (mkFastString ("tag2con_" ++ occNameString (getOccName tycon) ++ "#"))
1348 maxtag_RDR tycon = varUnqual (mkFastString ("maxtag_" ++ occNameString (getOccName tycon) ++ "#"))
1351 RdrNames for PrimOps. Can't be done in PrelNames, because PrimOp imports
1352 PrelNames, so PrelNames can't import PrimOp.
1355 minusInt_RDR = nameRdrName minusIntName
1356 eqInt_RDR = nameRdrName eqIntName
1357 ltInt_RDR = nameRdrName ltIntName
1358 geInt_RDR = nameRdrName geIntName
1359 leInt_RDR = nameRdrName leIntName
1360 eqChar_RDR = nameRdrName eqCharName
1361 eqWord_RDR = nameRdrName eqWordName
1362 eqAddr_RDR = nameRdrName eqAddrName
1363 eqFloat_RDR = nameRdrName eqFloatName
1364 eqDouble_RDR = nameRdrName eqDoubleName
1365 ltChar_RDR = nameRdrName ltCharName
1366 ltWord_RDR = nameRdrName ltWordName
1367 ltAddr_RDR = nameRdrName ltAddrName
1368 ltFloat_RDR = nameRdrName ltFloatName
1369 ltDouble_RDR = nameRdrName ltDoubleName
1370 tagToEnum_RDR = nameRdrName tagToEnumName