Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, StandaloneDeriving,             MagicHash, UnboxedTuples #-}{-# OPTIONS_HADDOCK hide #-}#include "MachDeps.h"#if SIZEOF_HSWORD == 4#define DIGITS       9#define BASE         1000000000#elif SIZEOF_HSWORD == 8#define DIGITS       18#define BASE         1000000000000000000#else#error Please define DIGITS and BASE-- DIGITS should be the largest integer such that--     10^DIGITS < 2^(SIZEOF_HSWORD * 8 - 1)-- BASE should be 10^DIGITS. Note that ^ is not available yet.#endif------------------------------------------------------------------------------- |-- Module      :  GHC.Show-- Copyright   :  (c) The University of Glasgow, 1992-2002-- License     :  see libraries/base/LICENSE---- Maintainer  :  cvs-ghc@haskell.org-- Stability   :  internal-- Portability :  non-portable (GHC Extensions)---- The 'Show' class, and related operations.-------------------------------------------------------------------------------moduleGHC.Show(Show(..),ShowS,-- Instances for Show: (), [], Bool, Ordering, Int, Char-- Show support codeshows,showChar,showString,showMultiLineString,showParen,showList__,showCommaSpace,showSpace,showLitChar,showLitString,protectEsc,intToDigit,showSignedInt,appPrec,appPrec1,-- Character operationsasciiTab,)whereimportGHC.BaseimportGHC.List((!!),foldr1,break)importGHC.NumimportGHC.Stack.TypesimportGHC.Types(TypeLitSort(..))-- | The @shows@ functions return a function that prepends the-- output 'String' to an existing 'String'.  This allows constant-time-- concatenation of results using function composition.typeShowS=String->String-- | Conversion of values to readable 'String's.---- Derived instances of 'Show' have the following properties, which-- are compatible with derived instances of 'Text.Read.Read':---- * The result of 'show' is a syntactically correct Haskell--   expression containing only constants, given the fixity--   declarations in force at the point where the type is declared.--   It contains only the constructor names defined in the data type,--   parentheses, and spaces.  When labelled constructor fields are--   used, braces, commas, field names, and equal signs are also used.---- * If the constructor is defined to be an infix operator, then--   'showsPrec' will produce infix applications of the constructor.---- * the representation will be enclosed in parentheses if the--   precedence of the top-level constructor in @x@ is less than @d@--   (associativity is ignored).  Thus, if @d@ is @0@ then the result--   is never surrounded in parentheses; if @d@ is @11@ it is always--   surrounded in parentheses, unless it is an atomic expression.---- * If the constructor is defined using record syntax, then 'show'--   will produce the record-syntax form, with the fields given in the--   same order as the original declaration.---- For example, given the declarations---- > infixr 5 :^:-- > data Tree a =  Leaf a  |  Tree a :^: Tree a---- the derived instance of 'Show' is equivalent to---- > instance (Show a) => Show (Tree a) where-- >-- >        showsPrec d (Leaf m) = showParen (d > app_prec) $-- >             showString "Leaf " . showsPrec (app_prec+1) m-- >          where app_prec = 10-- >-- >        showsPrec d (u :^: v) = showParen (d > up_prec) $-- >             showsPrec (up_prec+1) u .-- >             showString " :^: "      .-- >             showsPrec (up_prec+1) v-- >          where up_prec = 5---- Note that right-associativity of @:^:@ is ignored.  For example,---- * @'show' (Leaf 1 :^: Leaf 2 :^: Leaf 3)@ produces the string--   @\"Leaf 1 :^: (Leaf 2 :^: Leaf 3)\"@.classShowawhere{-# MINIMALshowsPrec|show#-}-- | Convert a value to a readable 'String'.---- 'showsPrec' should satisfy the law---- > showsPrec d x r ++ s  ==  showsPrec d x (r ++ s)---- Derived instances of 'Text.Read.Read' and 'Show' satisfy the following:---- * @(x,\"\")@ is an element of--   @('Text.Read.readsPrec' d ('showsPrec' d x \"\"))@.---- That is, 'Text.Read.readsPrec' parses the string produced by-- 'showsPrec', and delivers the value that 'showsPrec' started with.showsPrec::Int-- ^ the operator precedence of the enclosing-- context (a number from @0@ to @11@).-- Function application has precedence @10@.->a-- ^ the value to be converted to a 'String'->ShowS-- | A specialised variant of 'showsPrec', using precedence context-- zero, and returning an ordinary 'String'.show::a->String-- | The method 'showList' is provided to allow the programmer to-- give a specialised way of showing lists of values.-- For example, this is used by the predefined 'Show' instance of-- the 'Char' type, where values of type 'String' should be shown-- in double quotes, rather than between square brackets.showList::[a]->ShowSshowsPrec_xs=showx++sshowx=showsx""showListlss=showList__showslssshowList__::(a->ShowS)->[a]->ShowSshowList___[]s="[]"++sshowList__showx(x:xs)s='[':showxx(showlxs)whereshowl[]=']':sshowl(y:ys)=',':showxy(showlys)appPrec,appPrec1::Int-- Use unboxed stuff because we don't have overloaded numerics yetappPrec=I#10#-- Precedence of application:--   one more than the maximum operator precedence of 9appPrec1=I#11#-- appPrec + 1---------------------------------------------------------------- Simple Instances---------------------------------------------------------------- | @since 2.01derivinginstanceShow()-- | @since 2.01instanceShowa=>Show[a]where{-# SPECIALISEinstanceShow[String]#-}{-# SPECIALISEinstanceShow[Char]#-}{-# SPECIALISEinstanceShow[Int]#-}showsPrec_=showList-- | @since 2.01derivinginstanceShowBool-- | @since 2.01derivinginstanceShowOrdering-- | @since 2.01instanceShowCharwhereshowsPrec_'\''=showString"'\\''"showsPrec_c=showChar'\''.showLitCharc.showChar'\''showListcs=showChar'"'.showLitStringcs.showChar'"'-- | @since 2.01instanceShowIntwhereshowsPrec=showSignedInt-- | @since 2.01instanceShowWordwhereshowsPrec_(W#w)=showWordwshowWord::Word#->ShowSshowWordw#cs|isTrue#(w#`ltWord#`10##)=C#(chr#(ord#'0'#+#word2Int#w#)):cs|otherwise=casechr#(ord#'0'#+#word2Int#(w#`remWord#`10##))ofc#->showWord(w#`quotWord#`10##)(C#c#:cs)-- | @since 2.01derivinginstanceShowa=>Show(Maybea)-- | @since 4.11.0.0derivinginstanceShowa=>Show(NonEmptya)-- | @since 2.01instanceShowTyConwhereshowsPrecp(TyCon___tc_name__)=showsPrecptc_name-- | @since 4.9.0.0instanceShowTrNamewhereshowsPrec_(TrNameSs)=showString(unpackCStringUtf8#s)showsPrec_(TrNameDs)=showStrings-- | @since 4.9.0.0instanceShowModulewhereshowsPrec_(Modulepm)=showsp.(':':).showsm-- | @since 4.9.0.0instanceShowCallStackwhereshowsPrec_=shows.getCallStack-- | @since 4.9.0.0derivinginstanceShowSrcLoc---------------------------------------------------------------- Show instances for the first few tuple---------------------------------------------------------------- The explicit 's' parameters are important-- Otherwise GHC thinks that "shows x" might take a lot of work to compute-- and generates defns like--      showsPrec _ (x,y) = let sx = shows x; sy = shows y in--                          \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s))))-- | @since 2.01instance(Showa,Showb)=>Show(a,b)whereshowsPrec_(a,b)s=show_tuple[showsa,showsb]s-- | @since 2.01instance(Showa,Showb,Showc)=>Show(a,b,c)whereshowsPrec_(a,b,c)s=show_tuple[showsa,showsb,showsc]s-- | @since 2.01instance(Showa,Showb,Showc,Showd)=>Show(a,b,c,d)whereshowsPrec_(a,b,c,d)s=show_tuple[showsa,showsb,showsc,showsd]s-- | @since 2.01instance(Showa,Showb,Showc,Showd,Showe)=>Show(a,b,c,d,e)whereshowsPrec_(a,b,c,d,e)s=show_tuple[showsa,showsb,showsc,showsd,showse]s-- | @since 2.01instance(Showa,Showb,Showc,Showd,Showe,Showf)=>Show(a,b,c,d,e,f)whereshowsPrec_(a,b,c,d,e,f)s=show_tuple[showsa,showsb,showsc,showsd,showse,showsf]s-- | @since 2.01instance(Showa,Showb,Showc,Showd,Showe,Showf,Showg)=>Show(a,b,c,d,e,f,g)whereshowsPrec_(a,b,c,d,e,f,g)s=show_tuple[showsa,showsb,showsc,showsd,showse,showsf,showsg]s-- | @since 2.01instance(Showa,Showb,Showc,Showd,Showe,Showf,Showg,Showh)=>Show(a,b,c,d,e,f,g,h)whereshowsPrec_(a,b,c,d,e,f,g,h)s=show_tuple[showsa,showsb,showsc,showsd,showse,showsf,showsg,showsh]s-- | @since 2.01instance(Showa,Showb,Showc,Showd,Showe,Showf,Showg,Showh,Showi)=>Show(a,b,c,d,e,f,g,h,i)whereshowsPrec_(a,b,c,d,e,f,g,h,i)s=show_tuple[showsa,showsb,showsc,showsd,showse,showsf,showsg,showsh,showsi]s-- | @since 2.01instance(Showa,Showb,Showc,Showd,Showe,Showf,Showg,Showh,Showi,Showj)=>Show(a,b,c,d,e,f,g,h,i,j)whereshowsPrec_(a,b,c,d,e,f,g,h,i,j)s=show_tuple[showsa,showsb,showsc,showsd,showse,showsf,showsg,showsh,showsi,showsj]s-- | @since 2.01instance(Showa,Showb,Showc,Showd,Showe,Showf,Showg,Showh,Showi,Showj,Showk)=>Show(a,b,c,d,e,f,g,h,i,j,k)whereshowsPrec_(a,b,c,d,e,f,g,h,i,j,k)s=show_tuple[showsa,showsb,showsc,showsd,showse,showsf,showsg,showsh,showsi,showsj,showsk]s-- | @since 2.01instance(Showa,Showb,Showc,Showd,Showe,Showf,Showg,Showh,Showi,Showj,Showk,Showl)=>Show(a,b,c,d,e,f,g,h,i,j,k,l)whereshowsPrec_(a,b,c,d,e,f,g,h,i,j,k,l)s=show_tuple[showsa,showsb,showsc,showsd,showse,showsf,showsg,showsh,showsi,showsj,showsk,showsl]s-- | @since 2.01instance(Showa,Showb,Showc,Showd,Showe,Showf,Showg,Showh,Showi,Showj,Showk,Showl,Showm)=>Show(a,b,c,d,e,f,g,h,i,j,k,l,m)whereshowsPrec_(a,b,c,d,e,f,g,h,i,j,k,l,m)s=show_tuple[showsa,showsb,showsc,showsd,showse,showsf,showsg,showsh,showsi,showsj,showsk,showsl,showsm]s-- | @since 2.01instance(Showa,Showb,Showc,Showd,Showe,Showf,Showg,Showh,Showi,Showj,Showk,Showl,Showm,Shown)=>Show(a,b,c,d,e,f,g,h,i,j,k,l,m,n)whereshowsPrec_(a,b,c,d,e,f,g,h,i,j,k,l,m,n)s=show_tuple[showsa,showsb,showsc,showsd,showse,showsf,showsg,showsh,showsi,showsj,showsk,showsl,showsm,showsn]s-- | @since 2.01instance(Showa,Showb,Showc,Showd,Showe,Showf,Showg,Showh,Showi,Showj,Showk,Showl,Showm,Shown,Showo)=>Show(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)whereshowsPrec_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)s=show_tuple[showsa,showsb,showsc,showsd,showse,showsf,showsg,showsh,showsi,showsj,showsk,showsl,showsm,showsn,showso]sshow_tuple::[ShowS]->ShowSshow_tupless=showChar'('.foldr1(\sr->s.showChar','.r)ss.showChar')'---------------------------------------------------------------- Support code for Show---------------------------------------------------------------- | equivalent to 'showsPrec' with a precedence of 0.shows::(Showa)=>a->ShowSshows=showsPrec0-- | utility function converting a 'Char' to a show function that-- simply prepends the character unchanged.showChar::Char->ShowSshowChar=(:)-- | utility function converting a 'String' to a show function that-- simply prepends the string unchanged.showString::String->ShowSshowString=(++)-- | utility function that surrounds the inner show function with-- parentheses when the 'Bool' parameter is 'True'.showParen::Bool->ShowS->ShowSshowParenbp=ifbthenshowChar'('.p.showChar')'elsepshowSpace::ShowSshowSpace={-showChar ' '-}\xs->' ':xsshowCommaSpace::ShowSshowCommaSpace=showString", "-- Code specific for characters-- | Convert a character to a string using only printable characters,-- using Haskell source-language escape conventions.  For example:---- > showLitChar '\n' s  =  "\\n" ++ s--showLitChar::Char->ShowSshowLitCharcs|c>'\DEL'=showChar'\\'(protectEscisDec(shows(ordc))s)showLitChar'\DEL's=showString"\\DEL"sshowLitChar'\\'s=showString"\\\\"sshowLitCharcs|c>=' '=showCharcsshowLitChar'\a's=showString"\\a"sshowLitChar'\b's=showString"\\b"sshowLitChar'\f's=showString"\\f"sshowLitChar'\n's=showString"\\n"sshowLitChar'\r's=showString"\\r"sshowLitChar'\t's=showString"\\t"sshowLitChar'\v's=showString"\\v"sshowLitChar'\SO's=protectEsc(=='H')(showString"\\SO")sshowLitCharcs=showString('\\':asciiTab!!ordc)s-- I've done manual eta-expansion here, because otherwise it's-- impossible to stop (asciiTab!!ord) getting floated out as an MFEshowLitString::String->ShowS-- | Same as 'showLitChar', but for strings-- It converts the string to a string using Haskell escape conventions-- for non-printable characters. Does not add double-quotes around the-- whole thing; the caller should do that.-- The main difference from showLitChar (apart from the fact that the-- argument is a string not a list) is that we must escape double-quotesshowLitString[]s=sshowLitString('"':cs)s=showString"\\\""(showLitStringcss)showLitString(c:cs)s=showLitCharc(showLitStringcss)-- Making 's' an explicit parameter makes it clear to GHC that-- showLitString has arity 2, which avoids it allocating an extra lambda-- The sticking point is the recursive call to (showLitString cs), which-- it can't figure out would be ok with arity 2.showMultiLineString::String->[String]-- | Like 'showLitString' (expand escape characters using Haskell-- escape conventions), but--   * break the string into multiple lines--   * wrap the entire thing in double quotes-- Example:  @showMultiLineString "hello\ngoodbye\nblah"@-- returns   @["\"hello\\n\\", "\\goodbye\n\\", "\\blah\""]@showMultiLineStringstr=go'\"'strwheregochs=casebreak(=='\n')sof(l,_:s'@(_:_))->(ch:showLitStringl"\\n\\"):go'\\'s'(l,"\n")->[ch:showLitStringl"\\n\""](l,_)->[ch:showLitStringl"\""]isDec::Char->BoolisDecc=c>='0'&&c<='9'protectEsc::(Char->Bool)->ShowS->ShowSprotectEscpf=f.contwhereconts@(c:_)|pc="\\&"++sconts=sasciiTab::[String]asciiTab=-- Using an array drags in the array module.  listArray ('\NUL', ' ')["NUL","SOH","STX","ETX","EOT","ENQ","ACK","BEL","BS","HT","LF","VT","FF","CR","SO","SI","DLE","DC1","DC2","DC3","DC4","NAK","SYN","ETB","CAN","EM","SUB","ESC","FS","GS","RS","US","SP"]-- Code specific for Ints.-- | Convert an 'Int' in the range @0@..@15@ to the corresponding single-- digit 'Char'.  This function fails on other inputs, and generates-- lower-case hexadecimal digits.intToDigit::Int->CharintToDigit(I#i)|isTrue#(i>=#0#)&&isTrue#(i<=#9#)=unsafeChr(ord'0'+I#i)|isTrue#(i>=#10#)&&isTrue#(i<=#15#)=unsafeChr(ord'a'+I#i-10)|otherwise=errorWithoutStackTrace("Char.intToDigit: not a digit "++show(I#i))showSignedInt::Int->Int->ShowSshowSignedInt(I#p)(I#n)r|isTrue#(n<#0#)&&isTrue#(p>#6#)='(':itosn(')':r)|otherwise=itosnritos::Int#->String->Stringitosn#cs|isTrue#(n#<#0#)=let!(I#minInt#)=minIntinifisTrue#(n#==#minInt#)-- negateInt# minInt overflows, so we can't do that:then'-':(casen#`quotRemInt#`10#of(#q,r#)->itos'(negateInt#q)(itos'(negateInt#r)cs))else'-':itos'(negateInt#n#)cs|otherwise=itos'n#cswhereitos'::Int#->String->Stringitos'x#cs'|isTrue#(x#<#10#)=C#(chr#(ord#'0'#+#x#)):cs'|otherwise=casex#`quotRemInt#`10#of(#q,r#)->casechr#(ord#'0'#+#r)ofc#->itos'q(C#c#:cs')---------------------------------------------------------------- The Integer instances for Show---------------------------------------------------------------- | @since 2.01instanceShowIntegerwhereshowsPrecpnr|p>6&&n<0='(':integerToStringn(')':r)-- Minor point: testing p first gives better code-- in the not-uncommon case where the p argument-- is a constant|otherwise=integerToStringnrshowList=showList__(showsPrec0)-- | @since 4.8.0.0instanceShowNaturalwhere#if defined(MIN_VERSION_integer_gmp)showsPrecp(NatS#w#)=showsPrecp(W#w#)#endifshowsPrecpi=showsPrecp(naturalToIntegeri)-- Divide and conquer implementation of string conversionintegerToString::Integer->String->StringintegerToStringn0cs0|n0<0='-':integerToString'(-n0)cs0|otherwise=integerToString'n0cs0whereintegerToString'::Integer->String->StringintegerToString'ncs|n<BASE=jhead(fromIntegern)cs|otherwise=jprinth(jsplitf(BASE*BASE)n)cs-- Split n into digits in base p. We first split n into digits-- in base p*p and then split each of these digits into two.-- Note that the first 'digit' modulo p*p may have a leading zero-- in base p that we need to drop - this is what jsplith takes care of.-- jsplitb the handles the remaining digits.jsplitf::Integer->Integer->[Integer]jsplitfpn|p>n=[n]|otherwise=jsplithp(jsplitf(p*p)n)jsplith::Integer->[Integer]->[Integer]jsplithp(n:ns)=casen`quotRemInteger`pof(#q,r#)->ifq>0thenq:r:jsplitbpnselser:jsplitbpnsjsplith_[]=errorWithoutStackTrace"jsplith: []"jsplitb::Integer->[Integer]->[Integer]jsplitb_[]=[]jsplitbp(n:ns)=casen`quotRemInteger`pof(#q,r#)->q:r:jsplitbpns-- Convert a number that has been split into digits in base BASE^2-- this includes a last splitting step and then conversion of digits-- that all fit into a machine word.jprinth::[Integer]->String->Stringjprinth(n:ns)cs=casen`quotRemInteger`BASEof(#q',r'#)->letq=fromIntegerq'r=fromIntegerr'inifq>0thenjheadq$jblockr$jprintbnscselsejheadr$jprintbnscsjprinth[]_=errorWithoutStackTrace"jprinth []"jprintb::[Integer]->String->Stringjprintb[]cs=csjprintb(n:ns)cs=casen`quotRemInteger`BASEof(#q',r'#)->letq=fromIntegerq'r=fromIntegerr'injblockq$jblockr$jprintbnscs-- Convert an integer that fits into a machine word. Again, we have two-- functions, one that drops leading zeros (jhead) and one that doesn't-- (jblock)jhead::Int->String->Stringjheadncs|n<10=caseunsafeChr(ord'0'+n)ofc@(C#_)->c:cs|otherwise=caseunsafeChr(ord'0'+r)ofc@(C#_)->jheadq(c:cs)where(q,r)=n`quotRemInt`10jblock=jblock'{- ' -}DIGITSjblock'::Int->Int->String->Stringjblock'dncs|d==1=caseunsafeChr(ord'0'+n)ofc@(C#_)->c:cs|otherwise=caseunsafeChr(ord'0'+r)ofc@(C#_)->jblock'(d-1)q(c:cs)where(q,r)=n`quotRemInt`10instanceShowKindRepwhereshowsPrecd(KindRepVarv)=showParen(d>10)$showString"KindRepVar ".showsPrec11vshowsPrecd(KindRepTyConApppq)=showParen(d>10)$showString"KindRepTyConApp ".showsPrec11p.showString" ".showsPrec11qshowsPrecd(KindRepApppq)=showParen(d>10)$showString"KindRepApp ".showsPrec11p.showString" ".showsPrec11qshowsPrecd(KindRepFunpq)=showParen(d>10)$showString"KindRepFun ".showsPrec11p.showString" ".showsPrec11qshowsPrecd(KindRepTYPErep)=showParen(d>10)$showString"KindRepTYPE ".showsPrec11repshowsPrecd(KindRepTypeLitSpq)=showParen(d>10)$showString"KindRepTypeLitS ".showsPrec11p.showString" ".showsPrec11(unpackCString#q)showsPrecd(KindRepTypeLitDpq)=showParen(d>10)$showString"KindRepTypeLitD ".showsPrec11p.showString" ".showsPrec11q-- | @since 4.11.0.0derivinginstanceShowRuntimeRep-- | @since 4.11.0.0derivinginstanceShowVecCount-- | @since 4.11.0.0derivinginstanceShowVecElem-- | @since 4.11.0.0derivinginstanceShowTypeLitSort