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 ( InPat(..), HsExpr(..), MonoBinds(..),
30 Match(..), GRHSs(..), Stmt(..), HsLit(..),
31 HsBinds(..), StmtCtxt(..),
32 unguardedRHS, mkSimpleMatch
34 import RdrHsSyn ( mkOpApp, RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat )
35 import RdrName ( RdrName, mkSrcUnqual )
36 import RnMonad ( Fixities )
37 import BasicTypes ( RecFlag(..), Fixity(..), FixityDirection(..) )
38 import FieldLabel ( fieldLabelName )
39 import DataCon ( isNullaryDataCon, dataConTag,
40 dataConRawArgTys, fIRST_TAG,
43 import Name ( getOccString, getOccName, getSrcLoc, occNameString,
44 occNameUserString, nameRdrName, varName,
45 OccName, Name, NamedThing(..), NameSpace
48 import PrimOp ( PrimOp(..) )
49 import PrelInfo -- Lots of RdrNames
50 import SrcLoc ( mkGeneratedSrcLoc, SrcLoc )
51 import TyCon ( TyCon, isNewTyCon, tyConDataCons, isEnumerationTyCon,
52 maybeTyConSingleCon, tyConFamilySize
54 import Type ( isUnLiftedType, isUnboxedType, Type )
55 import TysPrim ( charPrimTy, intPrimTy, wordPrimTy, addrPrimTy,
56 floatPrimTy, doublePrimTy
58 import Util ( mapAccumL, zipEqual, zipWithEqual,
59 zipWith3Equal, nOfThem )
60 import Panic ( panic, assertPanic )
61 import Maybes ( maybeToBool, assocMaybe )
63 import List ( partition, intersperse )
66 %************************************************************************
68 \subsection{Generating code, by derivable class}
70 %************************************************************************
72 %************************************************************************
74 \subsubsection{Generating @Eq@ instance declarations}
76 %************************************************************************
78 Here are the heuristics for the code we generate for @Eq@:
81 Let's assume we have a data type with some (possibly zero) nullary
82 data constructors and some ordinary, non-nullary ones (the rest,
83 also possibly zero of them). Here's an example, with both \tr{N}ullary
84 and \tr{O}rdinary data cons.
86 data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
90 For the ordinary constructors (if any), we emit clauses to do The
94 (==) (O1 a1 b1) (O1 a2 b2) = a1 == a2 && b1 == b2
95 (==) (O2 a1) (O2 a2) = a1 == a2
96 (==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
99 Note: if we're comparing unboxed things, e.g., if \tr{a1} and
100 \tr{a2} are \tr{Float#}s, then we have to generate
102 case (a1 `eqFloat#` a2) of
105 for that particular test.
108 If there are any nullary constructors, we emit a catch-all clause of
112 (==) a b = case (con2tag_Foo a) of { a# ->
113 case (con2tag_Foo b) of { b# ->
114 case (a# ==# b#) of {
119 If there aren't any nullary constructors, we emit a simpler
126 For the @(/=)@ method, we normally just use the default method.
128 If the type is an enumeration type, we could/may/should? generate
129 special code that calls @con2tag_Foo@, much like for @(==)@ shown
133 We thought about doing this: If we're also deriving @Ord@ for this
136 instance ... Eq (Foo ...) where
137 (==) a b = case (compare a b) of { _LT -> False; _EQ -> True ; _GT -> False}
138 (/=) a b = case (compare a b) of { _LT -> True ; _EQ -> False; _GT -> True }
140 However, that requires that \tr{Ord <whatever>} was put in the context
141 for the instance decl, which it probably wasn't, so the decls
142 produced don't get through the typechecker.
146 deriveEq :: RdrName -- Class
147 -> RdrName -- Type constructor
148 -> [ (RdrName, [RdrType]) ] -- Constructors
149 -> (RdrContext, -- Context for the inst decl
150 [RdrBind], -- Binds in the inst decl
151 [RdrBind]) -- Extra value bindings outside
153 deriveEq clas tycon constrs
154 = (context, [eq_bind, ne_bind], [])
156 context = [(clas, [ty]) | (_, tys) <- constrs, ty <- tys]
159 (nullary_cons, non_nullary_cons) = partition is_nullary constrs
160 is_nullary (_, args) = null args
163 gen_Eq_binds :: TyCon -> RdrNameMonoBinds
167 tycon_loc = getSrcLoc tycon
168 (nullary_cons, nonnullary_cons)
169 | isNewTyCon tycon = ([], tyConDataCons tycon)
170 | otherwise = partition isNullaryDataCon (tyConDataCons tycon)
173 = if (null nullary_cons) then
174 case maybeTyConSingleCon tycon of
176 Nothing -> -- if cons don't match, then False
177 [([a_Pat, b_Pat], false_Expr)]
178 else -- calc. and compare the tags
180 untag_Expr tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
181 (cmp_tags_Expr eqH_Int_RDR ah_RDR bh_RDR true_Expr false_Expr))]
183 mk_FunMonoBind tycon_loc eq_RDR ((map pats_etc nonnullary_cons) ++ rest)
185 mk_easy_FunMonoBind tycon_loc ne_RDR [a_Pat, b_Pat] [] (
186 HsApp (HsVar not_RDR) (HsPar (mk_easy_App eq_RDR [a_RDR, b_RDR])))
188 ------------------------------------------------------------------
191 con1_pat = ConPatIn data_con_RDR (map VarPatIn as_needed)
192 con2_pat = ConPatIn data_con_RDR (map VarPatIn bs_needed)
194 data_con_RDR = qual_orig_name data_con
195 con_arity = length tys_needed
196 as_needed = take con_arity as_RDRs
197 bs_needed = take con_arity bs_RDRs
198 tys_needed = dataConRawArgTys data_con
200 ([con1_pat, con2_pat], nested_eq_expr tys_needed as_needed bs_needed)
202 nested_eq_expr [] [] [] = true_Expr
203 nested_eq_expr tys as bs
204 = foldl1 and_Expr (zipWith3Equal "nested_eq" nested_eq tys as bs)
206 nested_eq ty a b = HsPar (eq_Expr ty (HsVar a) (HsVar b))
209 %************************************************************************
211 \subsubsection{Generating @Ord@ instance declarations}
213 %************************************************************************
215 For a derived @Ord@, we concentrate our attentions on @compare@
217 compare :: a -> a -> Ordering
218 data Ordering = LT | EQ | GT deriving ()
221 We will use the same example data type as above:
223 data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
228 We do all the other @Ord@ methods with calls to @compare@:
230 instance ... (Ord <wurble> <wurble>) where
231 a < b = case (compare a b) of { LT -> True; EQ -> False; GT -> False }
232 a <= b = case (compare a b) of { LT -> True; EQ -> True; GT -> False }
233 a >= b = case (compare a b) of { LT -> False; EQ -> True; GT -> True }
234 a > b = case (compare a b) of { LT -> False; EQ -> False; GT -> True }
236 max a b = case (compare a b) of { LT -> b; EQ -> a; GT -> a }
237 min a b = case (compare a b) of { LT -> a; EQ -> b; GT -> b }
239 -- compare to come...
243 @compare@ always has two parts. First, we use the compared
244 data-constructors' tags to deal with the case of different
247 compare a b = case (con2tag_Foo a) of { a# ->
248 case (con2tag_Foo b) of { b# ->
249 case (a# ==# b#) of {
251 False -> case (a# <# b#) of
256 cmp_eq = ... to come ...
260 We are only left with the ``help'' function @cmp_eq@, to deal with
261 comparing data constructors with the same tag.
263 For the ordinary constructors (if any), we emit the sorta-obvious
264 compare-style stuff; for our example:
266 cmp_eq (O1 a1 b1) (O1 a2 b2)
267 = case (compare a1 a2) of { LT -> LT; EQ -> compare b1 b2; GT -> GT }
269 cmp_eq (O2 a1) (O2 a2)
272 cmp_eq (O3 a1 b1 c1) (O3 a2 b2 c2)
273 = case (compare a1 a2) of {
276 EQ -> case compare b1 b2 of {
284 Again, we must be careful about unboxed comparisons. For example,
285 if \tr{a1} and \tr{a2} were \tr{Int#}s in the 2nd example above, we'd need to
289 cmp_eq lt eq gt (O2 a1) (O2 a2)
291 -- or maybe the unfolded equivalent
295 For the remaining nullary constructors, we already know that the
302 If there is only one constructor in the Data Type we don't need the WildCard Pattern.
306 gen_Ord_binds :: TyCon -> RdrNameMonoBinds
309 = defaulted `AndMonoBinds` compare
311 tycon_loc = getSrcLoc tycon
312 --------------------------------------------------------------------
313 compare = mk_easy_FunMonoBind tycon_loc compare_RDR
316 (if maybeToBool (maybeTyConSingleCon tycon) then
318 -- cmp_eq_Expr ltTag_Expr eqTag_Expr gtTag_Expr a_Expr b_Expr
319 -- Wierd. Was: case (cmp a b) of { LT -> LT; EQ -> EQ; GT -> GT }
321 cmp_eq_Expr a_Expr b_Expr
323 untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)]
324 (cmp_tags_Expr eqH_Int_RDR ah_RDR bh_RDR
325 -- True case; they are equal
326 -- If an enumeration type we are done; else
327 -- recursively compare their components
328 (if isEnumerationTyCon tycon then
331 -- cmp_eq_Expr ltTag_Expr eqTag_Expr gtTag_Expr a_Expr b_Expr
333 cmp_eq_Expr a_Expr b_Expr
335 -- False case; they aren't equal
336 -- So we need to do a less-than comparison on the tags
337 (cmp_tags_Expr ltH_Int_RDR ah_RDR bh_RDR ltTag_Expr gtTag_Expr)))
339 tycon_data_cons = tyConDataCons tycon
340 (nullary_cons, nonnullary_cons)
341 | isNewTyCon tycon = ([], tyConDataCons tycon)
342 | otherwise = partition isNullaryDataCon tycon_data_cons
345 mk_FunMonoBind tycon_loc
347 (if null nonnullary_cons && (length nullary_cons == 1) then
348 -- catch this specially to avoid warnings
349 -- about overlapping patterns from the desugarer.
351 data_con = head nullary_cons
352 data_con_RDR = qual_orig_name data_con
353 pat = ConPatIn data_con_RDR []
355 [([pat,pat], eqTag_Expr)]
357 map pats_etc nonnullary_cons ++
358 -- leave out wildcards to silence desugarer.
359 (if length tycon_data_cons == 1 then
362 [([WildPatIn, WildPatIn], default_rhs)]))
365 = ([con1_pat, con2_pat],
366 nested_compare_expr tys_needed as_needed bs_needed)
368 con1_pat = ConPatIn data_con_RDR (map VarPatIn as_needed)
369 con2_pat = ConPatIn data_con_RDR (map VarPatIn bs_needed)
371 data_con_RDR = qual_orig_name data_con
372 con_arity = length tys_needed
373 as_needed = take con_arity as_RDRs
374 bs_needed = take con_arity bs_RDRs
375 tys_needed = dataConRawArgTys data_con
377 nested_compare_expr [ty] [a] [b]
378 = careful_compare_Case ty ltTag_Expr eqTag_Expr gtTag_Expr (HsVar a) (HsVar b)
380 nested_compare_expr (ty:tys) (a:as) (b:bs)
381 = let eq_expr = nested_compare_expr tys as bs
382 in careful_compare_Case ty ltTag_Expr eq_expr gtTag_Expr (HsVar a) (HsVar b)
384 default_rhs | null nullary_cons = impossible_Expr -- Keep desugarer from complaining about
385 -- inexhaustive patterns
386 | otherwise = eqTag_Expr -- Some nullary constructors;
387 -- Tags are equal, no args => return EQ
388 --------------------------------------------------------------------
390 defaulted = foldr1 AndMonoBinds [lt, le, ge, gt, max_, min_]
392 lt = mk_easy_FunMonoBind mkGeneratedSrcLoc lt_RDR [a_Pat, b_Pat] [] (
393 compare_Case true_Expr false_Expr false_Expr a_Expr b_Expr)
394 le = mk_easy_FunMonoBind mkGeneratedSrcLoc le_RDR [a_Pat, b_Pat] [] (
395 compare_Case true_Expr true_Expr false_Expr a_Expr b_Expr)
396 ge = mk_easy_FunMonoBind mkGeneratedSrcLoc ge_RDR [a_Pat, b_Pat] [] (
397 compare_Case false_Expr true_Expr true_Expr a_Expr b_Expr)
398 gt = mk_easy_FunMonoBind mkGeneratedSrcLoc gt_RDR [a_Pat, b_Pat] [] (
399 compare_Case false_Expr false_Expr true_Expr a_Expr b_Expr)
401 max_ = mk_easy_FunMonoBind mkGeneratedSrcLoc max_RDR [a_Pat, b_Pat] [] (
402 compare_Case b_Expr a_Expr a_Expr a_Expr b_Expr)
403 min_ = mk_easy_FunMonoBind mkGeneratedSrcLoc min_RDR [a_Pat, b_Pat] [] (
404 compare_Case a_Expr b_Expr b_Expr a_Expr b_Expr)
407 %************************************************************************
409 \subsubsection{Generating @Enum@ instance declarations}
411 %************************************************************************
413 @Enum@ can only be derived for enumeration types. For a type
415 data Foo ... = N1 | N2 | ... | Nn
418 we use both @con2tag_Foo@ and @tag2con_Foo@ functions, as well as a
419 @maxtag_Foo@ variable (all generated by @gen_tag_n_con_binds@).
422 instance ... Enum (Foo ...) where
423 succ x = toEnum (1 + fromEnum x)
424 pred x = toEnum (fromEnum x - 1)
426 toEnum i = tag2con_Foo i
428 enumFrom a = map tag2con_Foo [con2tag_Foo a .. maxtag_Foo]
432 = case con2tag_Foo a of
433 a# -> map tag2con_Foo (enumFromTo (I# a#) maxtag_Foo)
436 = map tag2con_Foo [con2tag_Foo a, con2tag_Foo b .. maxtag_Foo]
440 = case con2tag_Foo a of { a# ->
441 case con2tag_Foo b of { b# ->
442 map tag2con_Foo (enumFromThenTo (I# a#) (I# b#) maxtag_Foo)
446 For @enumFromTo@ and @enumFromThenTo@, we use the default methods.
449 gen_Enum_binds :: TyCon -> RdrNameMonoBinds
452 = succ_enum `AndMonoBinds`
453 pred_enum `AndMonoBinds`
454 to_enum `AndMonoBinds`
455 enum_from `AndMonoBinds`
456 enum_from_then `AndMonoBinds`
459 tycon_loc = getSrcLoc tycon
460 occ_nm = getOccString tycon
463 = mk_easy_FunMonoBind tycon_loc succ_RDR [a_Pat] [] $
464 untag_Expr tycon [(a_RDR, ah_RDR)] $
465 HsIf (HsApp (HsApp (HsVar eq_RDR)
466 (HsVar (maxtag_RDR tycon)))
467 (mk_easy_App mkInt_RDR [ah_RDR]))
468 (illegal_Expr "succ" occ_nm "tried to take `succ' of last tag in enumeration")
469 (HsApp (HsVar (tag2con_RDR tycon))
470 (HsApp (HsApp (HsVar plus_RDR)
471 (mk_easy_App mkInt_RDR [ah_RDR]))
476 = mk_easy_FunMonoBind tycon_loc pred_RDR [a_Pat] [] $
477 untag_Expr tycon [(a_RDR, ah_RDR)] $
478 HsIf (HsApp (HsApp (HsVar eq_RDR) (HsLit (HsInt 0)))
479 (mk_easy_App mkInt_RDR [ah_RDR]))
480 (illegal_Expr "pred" occ_nm "tried to take `pred' of first tag in enumeration")
481 (HsApp (HsVar (tag2con_RDR tycon))
482 (HsApp (HsApp (HsVar plus_RDR)
483 (mk_easy_App mkInt_RDR [ah_RDR]))
484 (HsLit (HsInt (-1)))))
488 = mk_easy_FunMonoBind tycon_loc toEnum_RDR [a_Pat] [] $
491 (HsApp (HsApp (HsVar ge_RDR)
494 (HsApp (HsApp (HsVar le_RDR)
496 (HsVar (maxtag_RDR tycon))))
497 (mk_easy_App (tag2con_RDR tycon) [a_RDR])
498 (illegal_toEnum_tag occ_nm (maxtag_RDR tycon))
502 = mk_easy_FunMonoBind tycon_loc enumFrom_RDR [a_Pat] [] $
503 untag_Expr tycon [(a_RDR, ah_RDR)] $
504 HsApp (mk_easy_App map_RDR [tag2con_RDR tycon]) $
505 HsPar (enum_from_to_Expr
506 (mk_easy_App mkInt_RDR [ah_RDR])
507 (HsVar (maxtag_RDR tycon)))
510 = mk_easy_FunMonoBind tycon_loc enumFromThen_RDR [a_Pat, b_Pat] [] $
511 untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)] $
512 HsApp (mk_easy_App map_RDR [tag2con_RDR tycon]) $
513 HsPar (enum_from_then_to_Expr
514 (mk_easy_App mkInt_RDR [ah_RDR])
515 (mk_easy_App mkInt_RDR [bh_RDR])
516 (HsIf (HsApp (HsApp (HsVar gt_RDR)
517 (mk_easy_App mkInt_RDR [ah_RDR]))
518 (mk_easy_App mkInt_RDR [bh_RDR]))
520 (HsVar (maxtag_RDR tycon))
524 = mk_easy_FunMonoBind tycon_loc fromEnum_RDR [a_Pat] [] $
525 untag_Expr tycon [(a_RDR, ah_RDR)] $
526 (mk_easy_App mkInt_RDR [ah_RDR])
529 %************************************************************************
531 \subsubsection{Generating @Bounded@ instance declarations}
533 %************************************************************************
536 gen_Bounded_binds tycon
537 = if isEnumerationTyCon tycon then
538 min_bound_enum `AndMonoBinds` max_bound_enum
540 ASSERT(length data_cons == 1)
541 min_bound_1con `AndMonoBinds` max_bound_1con
543 data_cons = tyConDataCons tycon
544 tycon_loc = getSrcLoc tycon
546 ----- enum-flavored: ---------------------------
547 min_bound_enum = mk_easy_FunMonoBind tycon_loc minBound_RDR [] [] (HsVar data_con_1_RDR)
548 max_bound_enum = mk_easy_FunMonoBind tycon_loc maxBound_RDR [] [] (HsVar data_con_N_RDR)
550 data_con_1 = head data_cons
551 data_con_N = last data_cons
552 data_con_1_RDR = qual_orig_name data_con_1
553 data_con_N_RDR = qual_orig_name data_con_N
555 ----- single-constructor-flavored: -------------
556 arity = argFieldCount data_con_1
558 min_bound_1con = mk_easy_FunMonoBind tycon_loc minBound_RDR [] [] $
559 mk_easy_App data_con_1_RDR (nOfThem arity minBound_RDR)
560 max_bound_1con = mk_easy_FunMonoBind tycon_loc maxBound_RDR [] [] $
561 mk_easy_App data_con_1_RDR (nOfThem arity maxBound_RDR)
564 %************************************************************************
566 \subsubsection{Generating @Ix@ instance declarations}
568 %************************************************************************
570 Deriving @Ix@ is only possible for enumeration types and
571 single-constructor types. We deal with them in turn.
573 For an enumeration type, e.g.,
575 data Foo ... = N1 | N2 | ... | Nn
577 things go not too differently from @Enum@:
579 instance ... Ix (Foo ...) where
581 = map tag2con_Foo [con2tag_Foo a .. con2tag_Foo b]
585 = case (con2tag_Foo a) of { a# ->
586 case (con2tag_Foo b) of { b# ->
587 map tag2con_Foo (enumFromTo (I# a#) (I# b#))
592 then case (con2tag_Foo d -# con2tag_Foo a) of
594 else error "Ix.Foo.index: out of range"
598 p_tag = con2tag_Foo c
600 p_tag >= con2tag_Foo a && p_tag <= con2tag_Foo b
604 = case (con2tag_Foo a) of { a_tag ->
605 case (con2tag_Foo b) of { b_tag ->
606 case (con2tag_Foo c) of { c_tag ->
607 if (c_tag >=# a_tag) then
613 (modulo suitable case-ification to handle the unboxed tags)
615 For a single-constructor type (NB: this includes all tuples), e.g.,
617 data Foo ... = MkFoo a b Int Double c c
619 we follow the scheme given in Figure~19 of the Haskell~1.2 report
623 gen_Ix_binds :: TyCon -> RdrNameMonoBinds
626 = if isEnumerationTyCon tycon
630 tycon_str = getOccString tycon
631 tycon_loc = getSrcLoc tycon
633 --------------------------------------------------------------
634 enum_ixes = enum_range `AndMonoBinds`
635 enum_index `AndMonoBinds` enum_inRange
638 = mk_easy_FunMonoBind tycon_loc range_RDR
639 [TuplePatIn [a_Pat, b_Pat] True{-boxed-}] [] $
640 untag_Expr tycon [(a_RDR, ah_RDR)] $
641 untag_Expr tycon [(b_RDR, bh_RDR)] $
642 HsApp (mk_easy_App map_RDR [tag2con_RDR tycon]) $
643 HsPar (enum_from_to_Expr
644 (mk_easy_App mkInt_RDR [ah_RDR])
645 (mk_easy_App mkInt_RDR [bh_RDR]))
648 = mk_easy_FunMonoBind tycon_loc index_RDR
649 [AsPatIn c_RDR (TuplePatIn [a_Pat, b_Pat] True{-boxed-}),
651 HsIf (HsPar (mk_easy_App inRange_RDR [c_RDR, d_RDR])) (
652 untag_Expr tycon [(a_RDR, ah_RDR)] (
653 untag_Expr tycon [(d_RDR, dh_RDR)] (
655 rhs = mk_easy_App mkInt_RDR [c_RDR]
658 (genOpApp (HsVar dh_RDR) minusH_RDR (HsVar ah_RDR))
659 [mkSimpleMatch [VarPatIn c_RDR] rhs Nothing tycon_loc]
663 HsApp (HsVar error_RDR) (HsLit (HsString (_PK_ ("Ix."++tycon_str++".index: out of range\n"))))
668 = mk_easy_FunMonoBind tycon_loc inRange_RDR
669 [TuplePatIn [a_Pat, b_Pat] True{-boxed-}, c_Pat] [] (
670 untag_Expr tycon [(a_RDR, ah_RDR)] (
671 untag_Expr tycon [(b_RDR, bh_RDR)] (
672 untag_Expr tycon [(c_RDR, ch_RDR)] (
673 HsIf (genOpApp (HsVar ch_RDR) geH_RDR (HsVar ah_RDR)) (
674 (genOpApp (HsVar ch_RDR) leH_RDR (HsVar bh_RDR))
679 --------------------------------------------------------------
681 = single_con_range `AndMonoBinds`
682 single_con_index `AndMonoBinds`
686 = case maybeTyConSingleCon tycon of -- just checking...
687 Nothing -> panic "get_Ix_binds"
688 Just dc -> if (any isUnLiftedType (dataConRawArgTys dc)) then
689 error ("ERROR: Can't derive Ix for a single-constructor type with primitive argument types: "++tycon_str)
693 con_arity = argFieldCount data_con
694 data_con_RDR = qual_orig_name data_con
696 as_needed = take con_arity as_RDRs
697 bs_needed = take con_arity bs_RDRs
698 cs_needed = take con_arity cs_RDRs
700 con_pat xs = ConPatIn data_con_RDR (map VarPatIn xs)
701 con_expr = mk_easy_App data_con_RDR cs_needed
703 --------------------------------------------------------------
705 = mk_easy_FunMonoBind tycon_loc range_RDR
706 [TuplePatIn [con_pat as_needed, con_pat bs_needed] True{-boxed-}] [] $
707 HsDo ListComp stmts tycon_loc
709 stmts = zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed
711 [ReturnStmt con_expr]
713 mk_qual a b c = BindStmt (VarPatIn c)
714 (HsApp (HsVar range_RDR)
715 (ExplicitTuple [HsVar a, HsVar b] True))
720 = mk_easy_FunMonoBind tycon_loc index_RDR
721 [TuplePatIn [con_pat as_needed, con_pat bs_needed] True,
722 con_pat cs_needed] [range_size] (
723 foldl mk_index (HsLit (HsInt 0)) (zip3 as_needed bs_needed cs_needed))
725 mk_index multiply_by (l, u, i)
727 (HsApp (HsApp (HsVar index_RDR)
728 (ExplicitTuple [HsVar l, HsVar u] True)) (HsVar i))
731 (HsApp (HsVar rangeSize_RDR)
732 (ExplicitTuple [HsVar l, HsVar u] True))
733 ) times_RDR multiply_by
737 = mk_easy_FunMonoBind tycon_loc rangeSize_RDR
738 [TuplePatIn [a_Pat, b_Pat] True] [] (
740 (HsApp (HsApp (HsVar index_RDR)
741 (ExplicitTuple [a_Expr, b_Expr] True)) b_Expr)
742 ) plus_RDR (HsLit (HsInt 1)))
746 = mk_easy_FunMonoBind tycon_loc inRange_RDR
747 [TuplePatIn [con_pat as_needed, con_pat bs_needed] True,
750 foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range as_needed bs_needed cs_needed))
752 in_range a b c = HsApp (HsApp (HsVar inRange_RDR)
753 (ExplicitTuple [HsVar a, HsVar b] True))
757 %************************************************************************
759 \subsubsection{Generating @Read@ instance declarations}
761 %************************************************************************
764 gen_Read_binds :: Fixities -> TyCon -> RdrNameMonoBinds
766 gen_Read_binds fixities tycon
767 = reads_prec `AndMonoBinds` read_list
769 tycon_loc = getSrcLoc tycon
770 -----------------------------------------------------------------------
771 read_list = mk_easy_FunMonoBind tycon_loc readList_RDR [] []
772 (HsApp (HsVar readList___RDR) (HsPar (HsApp (HsVar readsPrec_RDR) (HsLit (HsInt 0)))))
773 -----------------------------------------------------------------------
776 read_con_comprehensions
777 = map read_con (tyConDataCons tycon)
779 mk_easy_FunMonoBind tycon_loc readsPrec_RDR [a_Pat, b_Pat] [] (
780 foldr1 append_Expr read_con_comprehensions
783 read_con data_con -- note: "b" is the string being "read"
785 readParen_Expr read_paren_arg $ HsPar $
786 HsLam (mk_easy_Match tycon_loc [c_Pat] [] $
787 HsDo ListComp stmts tycon_loc)
790 data_con_RDR = qual_orig_name data_con
791 data_con_str = occNameUserString (getOccName data_con)
792 con_arity = argFieldCount data_con
793 con_expr = mk_easy_App data_con_RDR as_needed
794 nullary_con = con_arity == 0
795 labels = dataConFieldLabels data_con
796 lab_fields = length labels
797 dc_nm = getName data_con
798 is_infix = isInfixOccName data_con_str
800 as_needed = take con_arity as_RDRs
802 | is_infix = take (1 + con_arity) bs_RDRs
803 | lab_fields == 0 = take con_arity bs_RDRs
804 | otherwise = take (4*lab_fields + 1) bs_RDRs
805 -- (label, '=' and field)*n, (n-1)*',' + '{' + '}'
807 (as1:as2:_) = as_needed
808 (bs1:bs2:bs3:_) = bs_needed
813 (TuplePatIn [LitPatIn (mkHsString data_con_str), d_Pat] True)
814 (HsApp (HsVar lex_RDR) c_Expr)
818 (TuplePatIn [LitPatIn (mkHsString data_con_str), VarPatIn bs2] True)
819 (HsApp (HsVar lex_RDR) (HsVar bs1))
823 str_qual str res draw_from =
825 (TuplePatIn [LitPatIn (mkHsString str), VarPatIn res] True)
826 (HsApp (HsVar lex_RDR) draw_from)
829 read_label f = [str_qual nm, str_qual "="]
830 -- There might be spaces between the label and '='
832 nm = occNameUserString (getOccName (fieldLabelName f))
836 snd (mapAccumL mk_qual_infix
838 [ (mk_read_qual lp as1, bs1, bs2)
839 , (mk_read_qual rp as2, bs3, bs3)
841 | lab_fields == 0 = -- common case.
842 snd (mapAccumL mk_qual
844 (zipWithEqual "as_needed"
845 (\ con_field draw_from -> (mk_read_qual 10 con_field,
847 as_needed bs_needed))
850 mapAccumL mk_qual c_Expr
851 (zipEqual "bs_needed"
854 intersperse [str_qual ","] $
857 (\ as b -> as ++ [b])
859 (map read_label labels)
861 (map (mk_read_qual 10) as_needed))) ++ [str_qual "}"])
864 mk_qual_infix draw_from (f, str_left, str_left2) =
865 (HsVar str_left2, -- what to draw from down the line...
866 f str_left draw_from)
868 mk_qual draw_from (f, str_left) =
869 (HsVar str_left, -- what to draw from down the line...
870 f str_left draw_from)
872 mk_read_qual p con_field res draw_from =
874 (TuplePatIn [VarPatIn con_field, VarPatIn res] True)
875 (HsApp (HsApp (HsVar readsPrec_RDR) (HsLit (HsInt p))) draw_from)
878 result_expr = ExplicitTuple [con_expr, if null bs_needed
880 else HsVar (last bs_needed)] True
882 [lp,rp] = getLRPrecs fixities dc_nm
885 | is_infix = let (h:t) = field_quals in (h:con_qual:t)
886 | otherwise = con_qual:field_quals
888 stmts = quals ++ [ReturnStmt result_expr]
892 | otherwise = getFixity fixities dc_nm
894 read_paren_arg = -- parens depend on precedence...
895 HsPar (genOpApp a_Expr gt_RDR (HsLit (HsInt paren_prec_limit)))
899 %************************************************************************
901 \subsubsection{Generating @Show@ instance declarations}
903 %************************************************************************
906 gen_Show_binds :: Fixities -> TyCon -> RdrNameMonoBinds
908 gen_Show_binds fixs_assoc tycon
909 = shows_prec `AndMonoBinds` show_list
911 tycon_loc = getSrcLoc tycon
912 -----------------------------------------------------------------------
913 show_list = mk_easy_FunMonoBind tycon_loc showList_RDR [] []
914 (HsApp (HsVar showList___RDR) (HsPar (HsApp (HsVar showsPrec_RDR) (HsLit (HsInt 0)))))
915 -----------------------------------------------------------------------
916 shows_prec = mk_FunMonoBind tycon_loc showsPrec_RDR (map pats_etc (tyConDataCons tycon))
919 | nullary_con = -- skip the showParen junk...
920 ASSERT(null bs_needed)
921 ([a_Pat, con_pat], show_con)
924 showParen_Expr (HsPar (genOpApp a_Expr gt_RDR (HsLit (HsInt paren_prec_limit))))
925 (HsPar (nested_compose_Expr show_thingies)))
927 data_con_RDR = qual_orig_name data_con
928 con_arity = argFieldCount data_con
929 bs_needed = take con_arity bs_RDRs
930 con_pat = ConPatIn data_con_RDR (map VarPatIn bs_needed)
931 nullary_con = con_arity == 0
932 labels = dataConFieldLabels data_con
933 lab_fields = length labels
935 dc_occ_nm = occNameUserString (getOccName data_con)
936 dc_nm = getName data_con
938 is_infix = isInfixOccName dc_occ_nm
942 | is_infix = mk_showString_app (' ':dc_occ_nm)
947 | lab_fields == 0 = " "
950 mk_showString_app (dc_occ_nm ++ space_ocurly_maybe)
952 show_all con fs@(x:xs)
953 | is_infix = x:con:xs
957 | lab_fields > 0 = [mk_showString_app "}"]
960 con:fs ++ ccurly_maybe
962 show_thingies = show_all show_con real_show_thingies_with_labs
964 show_label l = mk_showString_app (nm ++ "=")
966 nm = occNameUserString (getOccName (fieldLabelName l))
969 mk_showString_app str = HsApp (HsVar showString_RDR)
970 (HsLit (mkHsString str))
972 prec_cons = getLRPrecs fixs_assoc dc_nm
976 [ HsApp (HsApp (HsVar showsPrec_RDR) (HsLit (HsInt p))) (HsVar b)
977 | (p,b) <- zip prec_cons bs_needed ]
979 [ HsApp (HsApp (HsVar showsPrec_RDR) (HsLit (HsInt 10))) (HsVar b)
982 real_show_thingies_with_labs
983 | lab_fields == 0 = intersperse (HsVar showSpace_RDR) real_show_thingies
984 | otherwise = --Assumption: no of fields == no of labelled fields
985 -- (and in same order)
987 intersperse ([mk_showString_app ","]) $ -- Using SLIT()s containing ,s spells trouble.
988 zipWithEqual "gen_Show_binds"
990 (map show_label labels)
993 (con_left_assoc, con_right_assoc) = isLRAssoc fixs_assoc dc_nm
997 | otherwise = getFixity fixs_assoc dc_nm
1002 getLRPrecs :: Fixities -> Name -> [Integer]
1003 getLRPrecs fixs_assoc nm = [lp, rp]
1005 ( con_left_assoc, con_right_assoc) = isLRAssoc fixs_assoc nm
1006 paren_prec_limit = 9
1009 | con_left_assoc = paren_prec_limit
1010 | otherwise = paren_prec_limit + 1
1013 | con_right_assoc = paren_prec_limit
1014 | otherwise = paren_prec_limit + 1
1017 getFixity :: Fixities -> Name -> Integer
1018 getFixity fixs_assoc nm =
1019 case assocMaybe fixs_assoc nm of
1021 Just (Fixity x _) -> fromInt x + 1
1023 isLRAssoc :: Fixities -> Name -> (Bool, Bool)
1024 isLRAssoc fixs_assoc nm =
1025 case assocMaybe fixs_assoc nm of
1026 Just (Fixity _ InfixL) -> (True, False)
1027 Just (Fixity _ InfixR) -> (False, True)
1030 isInfixOccName :: String -> Bool
1031 isInfixOccName str =
1039 %************************************************************************
1041 \subsection{Generating extra binds (@con2tag@ and @tag2con@)}
1043 %************************************************************************
1048 con2tag_Foo :: Foo ... -> Int#
1049 tag2con_Foo :: Int -> Foo ... -- easier if Int, not Int#
1050 maxtag_Foo :: Int -- ditto (NB: not unboxed)
1053 The `tags' here start at zero, hence the @fIRST_TAG@ (currently one)
1058 = GenCon2Tag | GenTag2Con | GenMaxTag
1060 gen_tag_n_con_monobind
1061 :: (RdrName, -- (proto)Name for the thing in question
1062 TyCon, -- tycon in question
1066 gen_tag_n_con_monobind (rdr_name, tycon, GenCon2Tag)
1067 | lots_of_constructors
1068 = mk_FunMonoBind (getSrcLoc tycon) rdr_name
1069 [([VarPatIn a_RDR], HsApp getTag_Expr a_Expr)]
1072 = mk_FunMonoBind (getSrcLoc tycon) rdr_name (map mk_stuff (tyConDataCons tycon))
1075 lots_of_constructors = tyConFamilySize tycon > mAX_FAMILY_SIZE_FOR_VEC_RETURNS
1077 mk_stuff :: DataCon -> ([RdrNamePat], RdrNameHsExpr)
1079 = ([pat], HsLit (HsIntPrim (toInteger ((dataConTag var) - fIRST_TAG))))
1081 pat = ConPatIn var_RDR (nOfThem (argFieldCount var) WildPatIn)
1082 var_RDR = qual_orig_name var
1086 gen_tag_n_con_monobind (rdr_name, tycon, GenTag2Con)
1087 = mk_FunMonoBind (getSrcLoc tycon) rdr_name (map mk_stuff (tyConDataCons tycon) ++
1088 [([WildPatIn], impossible_Expr)])
1090 mk_stuff :: DataCon -> ([RdrNamePat], RdrNameHsExpr)
1091 mk_stuff var = ([lit_pat], HsVar var_RDR)
1093 lit_pat = ConPatIn mkInt_RDR [LitPatIn (HsIntPrim (toInteger ((dataConTag var) - fIRST_TAG)))]
1094 var_RDR = qual_orig_name var
1096 gen_tag_n_con_monobind (rdr_name, tycon, GenMaxTag)
1097 = mk_easy_FunMonoBind (getSrcLoc tycon)
1098 rdr_name [] [] (HsApp (HsVar mkInt_RDR) (HsLit (HsIntPrim max_tag)))
1100 max_tag = case (tyConDataCons tycon) of
1101 data_cons -> toInteger ((length data_cons) - fIRST_TAG)
1105 %************************************************************************
1107 \subsection{Utility bits for generating bindings}
1109 %************************************************************************
1111 @mk_easy_FunMonoBind fun pats binds expr@ generates:
1113 fun pat1 pat2 ... patN = expr where binds
1116 @mk_FunMonoBind fun [([p1a, p1b, ...], e1), ...]@ is for
1117 multi-clause definitions; it generates:
1119 fun p1a p1b ... p1N = e1
1120 fun p2a p2b ... p2N = e2
1122 fun pMa pMb ... pMN = eM
1126 mk_easy_FunMonoBind :: SrcLoc -> RdrName -> [RdrNamePat]
1127 -> [RdrNameMonoBinds] -> RdrNameHsExpr
1130 mk_easy_FunMonoBind loc fun pats binds expr
1131 = FunMonoBind fun False{-not infix-} [mk_easy_Match loc pats binds expr] loc
1133 mk_easy_Match loc pats binds expr
1134 = mk_match loc pats expr (mkbind binds)
1136 mkbind [] = EmptyBinds
1137 mkbind bs = MonoBind (foldr1 AndMonoBinds bs) [] Recursive
1138 -- The renamer expects everything in its input to be a
1139 -- "recursive" MonoBinds, and it is its job to sort things out
1142 mk_FunMonoBind :: SrcLoc -> RdrName
1143 -> [([RdrNamePat], RdrNameHsExpr)]
1146 mk_FunMonoBind loc fun [] = panic "TcGenDeriv:mk_FunMonoBind"
1147 mk_FunMonoBind loc fun pats_and_exprs
1148 = FunMonoBind fun False{-not infix-}
1149 [ mk_match loc p e EmptyBinds | (p,e) <-pats_and_exprs ]
1152 mk_match loc pats expr binds
1153 = Match [] (map paren pats) Nothing
1154 (GRHSs (unguardedRHS expr loc) binds Nothing)
1156 paren p@(VarPatIn _) = p
1157 paren other_p = ParPatIn other_p
1161 mk_easy_App f xs = foldl HsApp (HsVar f) (map HsVar xs)
1164 ToDo: Better SrcLocs.
1168 RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
1169 -> RdrNameHsExpr -> RdrNameHsExpr
1173 -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
1174 -> RdrNameHsExpr -> RdrNameHsExpr
1176 careful_compare_Case :: -- checks for primitive types...
1178 -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
1179 -> RdrNameHsExpr -> RdrNameHsExpr
1182 compare_Case = compare_gen_Case compare_RDR
1183 cmp_eq_Expr a b = HsApp (HsApp (HsVar cmp_eq_RDR) a) b
1184 -- Was: compare_gen_Case cmp_eq_RDR
1186 compare_gen_Case fun lt eq gt a b
1187 = HsCase (HsPar (HsApp (HsApp (HsVar fun) a) b)) {-of-}
1188 [mkSimpleMatch [ConPatIn ltTag_RDR []] lt Nothing mkGeneratedSrcLoc,
1189 mkSimpleMatch [ConPatIn eqTag_RDR []] eq Nothing mkGeneratedSrcLoc,
1190 mkSimpleMatch [ConPatIn gtTag_RDR []] gt Nothing mkGeneratedSrcLoc]
1193 careful_compare_Case ty lt eq gt a b
1194 = if not (isUnboxedType ty) then
1195 compare_gen_Case compare_RDR lt eq gt a b
1197 else -- we have to do something special for primitive things...
1198 HsIf (genOpApp a relevant_eq_op b)
1200 (HsIf (genOpApp a relevant_lt_op b) lt gt mkGeneratedSrcLoc)
1203 relevant_eq_op = assoc_ty_id eq_op_tbl ty
1204 relevant_lt_op = assoc_ty_id lt_op_tbl ty
1206 assoc_ty_id tyids ty
1207 = if null res then panic "assoc_ty"
1210 res = [id | (ty',id) <- tyids, ty == ty']
1213 [(charPrimTy, eqH_Char_RDR)
1214 ,(intPrimTy, eqH_Int_RDR)
1215 ,(wordPrimTy, eqH_Word_RDR)
1216 ,(addrPrimTy, eqH_Addr_RDR)
1217 ,(floatPrimTy, eqH_Float_RDR)
1218 ,(doublePrimTy, eqH_Double_RDR)
1222 [(charPrimTy, ltH_Char_RDR)
1223 ,(intPrimTy, ltH_Int_RDR)
1224 ,(wordPrimTy, ltH_Word_RDR)
1225 ,(addrPrimTy, ltH_Addr_RDR)
1226 ,(floatPrimTy, ltH_Float_RDR)
1227 ,(doublePrimTy, ltH_Double_RDR)
1230 -----------------------------------------------------------------------
1232 and_Expr, append_Expr :: RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
1234 and_Expr a b = genOpApp a and_RDR b
1235 append_Expr a b = genOpApp a append_RDR b
1237 -----------------------------------------------------------------------
1239 eq_Expr :: Type -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
1241 = if not (isUnboxedType ty) then
1243 else -- we have to do something special for primitive things...
1244 genOpApp a relevant_eq_op b
1246 relevant_eq_op = assoc_ty_id eq_op_tbl ty
1250 argFieldCount :: DataCon -> Int -- Works on data and newtype constructors
1251 argFieldCount con = length (dataConRawArgTys con)
1255 untag_Expr :: TyCon -> [(RdrName, RdrName)] -> RdrNameHsExpr -> RdrNameHsExpr
1256 untag_Expr tycon [] expr = expr
1257 untag_Expr tycon ((untag_this, put_tag_here) : more) expr
1258 = HsCase (HsPar (HsApp (con2tag_Expr tycon) (HsVar untag_this))) {-of-}
1259 [mkSimpleMatch [VarPatIn put_tag_here] (untag_Expr tycon more expr) Nothing mkGeneratedSrcLoc]
1262 cmp_tags_Expr :: RdrName -- Comparison op
1263 -> RdrName -> RdrName -- Things to compare
1264 -> RdrNameHsExpr -- What to return if true
1265 -> RdrNameHsExpr -- What to return if false
1268 cmp_tags_Expr op a b true_case false_case
1269 = HsIf (genOpApp (HsVar a) op (HsVar b)) true_case false_case mkGeneratedSrcLoc
1272 :: RdrNameHsExpr -> RdrNameHsExpr
1274 enum_from_then_to_Expr
1275 :: RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
1278 enum_from_to_Expr f t2 = HsApp (HsApp (HsVar enumFromTo_RDR) f) t2
1279 enum_from_then_to_Expr f t t2 = HsApp (HsApp (HsApp (HsVar enumFromThenTo_RDR) f) t) t2
1281 showParen_Expr, readParen_Expr
1282 :: RdrNameHsExpr -> RdrNameHsExpr
1285 showParen_Expr e1 e2 = HsApp (HsApp (HsVar showParen_RDR) e1) e2
1286 readParen_Expr e1 e2 = HsApp (HsApp (HsVar readParen_RDR) e1) e2
1288 nested_compose_Expr :: [RdrNameHsExpr] -> RdrNameHsExpr
1290 nested_compose_Expr [e] = parenify e
1291 nested_compose_Expr (e:es)
1292 = HsApp (HsApp (HsVar compose_RDR) (parenify e)) (nested_compose_Expr es)
1294 -- impossible_Expr is used in case RHSs that should never happen.
1295 -- We generate these to keep the desugarer from complaining that they *might* happen!
1296 impossible_Expr = HsApp (HsVar error_RDR) (HsLit (HsString (_PK_ "Urk! in TcGenDeriv")))
1298 -- illegal_Expr is used when signalling error conditions in the RHS of a derived
1299 -- method. It is currently only used by Enum.{succ,pred}
1300 illegal_Expr meth tp msg =
1301 HsApp (HsVar error_RDR) (HsLit (HsString (_PK_ (meth ++ '{':tp ++ "}: " ++ msg))))
1303 -- illegal_toEnum_tag is an extended version of illegal_Expr, which also allows you
1304 -- to include the value of a_RDR in the error string.
1305 illegal_toEnum_tag tp maxtag =
1306 HsApp (HsVar error_RDR)
1307 (HsApp (HsApp (HsVar append_RDR)
1308 (HsLit (HsString (_PK_ ("toEnum{" ++ tp ++ "}: tag (")))))
1309 (HsApp (HsApp (HsApp
1310 (HsVar showsPrec_RDR)
1315 (HsLit (HsString (_PK_ ") is outside of enumeration's range (0,"))))
1316 (HsApp (HsApp (HsApp
1317 (HsVar showsPrec_RDR)
1320 (HsLit (HsString (_PK_ ")")))))))
1322 parenify e@(HsVar _) = e
1323 parenify e = HsPar e
1325 -- genOpApp wraps brackets round the operator application, so that the
1326 -- renamer won't subsequently try to re-associate it.
1327 -- For some reason the renamer doesn't reassociate it right, and I can't
1328 -- be bothered to find out why just now.
1330 genOpApp e1 op e2 = mkOpApp e1 op e2
1334 qual_orig_name n = nameRdrName (getName n)
1335 varUnqual n = mkSrcUnqual varName n
1337 a_RDR = varUnqual SLIT("a")
1338 b_RDR = varUnqual SLIT("b")
1339 c_RDR = varUnqual SLIT("c")
1340 d_RDR = varUnqual SLIT("d")
1341 ah_RDR = varUnqual SLIT("a#")
1342 bh_RDR = varUnqual SLIT("b#")
1343 ch_RDR = varUnqual SLIT("c#")
1344 dh_RDR = varUnqual SLIT("d#")
1345 cmp_eq_RDR = varUnqual SLIT("cmp_eq")
1346 rangeSize_RDR = varUnqual SLIT("rangeSize")
1348 as_RDRs = [ varUnqual (_PK_ ("a"++show i)) | i <- [(1::Int) .. ] ]
1349 bs_RDRs = [ varUnqual (_PK_ ("b"++show i)) | i <- [(1::Int) .. ] ]
1350 cs_RDRs = [ varUnqual (_PK_ ("c"++show i)) | i <- [(1::Int) .. ] ]
1352 mkHsString s = HsString (_PK_ s)
1354 a_Expr = HsVar a_RDR
1355 b_Expr = HsVar b_RDR
1356 c_Expr = HsVar c_RDR
1357 d_Expr = HsVar d_RDR
1358 ltTag_Expr = HsVar ltTag_RDR
1359 eqTag_Expr = HsVar eqTag_RDR
1360 gtTag_Expr = HsVar gtTag_RDR
1361 false_Expr = HsVar false_RDR
1362 true_Expr = HsVar true_RDR
1364 getTag_Expr = HsVar getTag_RDR
1365 con2tag_Expr tycon = HsVar (con2tag_RDR tycon)
1367 a_Pat = VarPatIn a_RDR
1368 b_Pat = VarPatIn b_RDR
1369 c_Pat = VarPatIn c_RDR
1370 d_Pat = VarPatIn d_RDR
1372 tag2con_RDR, maxtag_RDR :: TyCon -> RdrName
1374 con2tag_RDR tycon = varUnqual (_PK_ ("con2tag_" ++ occNameString (getOccName tycon) ++ "#"))
1375 tag2con_RDR tycon = varUnqual (_PK_ ("tag2con_" ++ occNameString (getOccName tycon) ++ "#"))
1376 maxtag_RDR tycon = varUnqual (_PK_ ("maxtag_" ++ occNameString (getOccName tycon) ++ "#"))