/usr/share/doc/libghc-text-doc/html/src/Data-Text-Lazy-Builder-RealFloat.html is in libghc-text-doc 0.11.1.13-1build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 | <?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->
<title>Data/Text/Lazy/Builder/RealFloat.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>{-# LANGUAGE OverloadedStrings #-}</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-comment'>-- |</span>
<a name="line-4"></a><span class='hs-comment'>-- Module: Data.Text.Lazy.Builder.RealFloat</span>
<a name="line-5"></a><span class='hs-comment'>-- Copyright: (c) The University of Glasgow 1994-2002</span>
<a name="line-6"></a><span class='hs-comment'>-- License: see libraries/base/LICENSE</span>
<a name="line-7"></a><span class='hs-comment'>--</span>
<a name="line-8"></a><span class='hs-comment'>-- Write a floating point value to a 'Builder'.</span>
<a name="line-9"></a>
<a name="line-10"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Text</span><span class='hs-varop'>.</span><span class='hs-conid'>Lazy</span><span class='hs-varop'>.</span><span class='hs-conid'>Builder</span><span class='hs-varop'>.</span><span class='hs-conid'>RealFloat</span>
<a name="line-11"></a> <span class='hs-layout'>(</span>
<a name="line-12"></a> <span class='hs-conid'>FPFormat</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span>
<a name="line-13"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>realFloat</span>
<a name="line-14"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>formatRealFloat</span>
<a name="line-15"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-16"></a>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Array</span><span class='hs-varop'>.</span><span class='hs-conid'>Base</span> <span class='hs-layout'>(</span><span class='hs-varid'>unsafeAt</span><span class='hs-layout'>)</span>
<a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Array</span><span class='hs-varop'>.</span><span class='hs-conid'>IArray</span>
<a name="line-19"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Text</span><span class='hs-varop'>.</span><span class='hs-conid'>Lazy</span><span class='hs-varop'>.</span><span class='hs-conid'>Builder</span><span class='hs-varop'>.</span><span class='hs-conid'>Functions</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varop'><></span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>i2d</span><span class='hs-layout'>)</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Text</span><span class='hs-varop'>.</span><span class='hs-conid'>Lazy</span><span class='hs-varop'>.</span><span class='hs-conid'>Builder</span><span class='hs-varop'>.</span><span class='hs-conid'>Int</span> <span class='hs-layout'>(</span><span class='hs-varid'>decimal</span><span class='hs-layout'>)</span>
<a name="line-21"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Text</span><span class='hs-varop'>.</span><span class='hs-conid'>Lazy</span><span class='hs-varop'>.</span><span class='hs-conid'>Builder</span><span class='hs-varop'>.</span><span class='hs-conid'>RealFloat</span><span class='hs-varop'>.</span><span class='hs-conid'>Functions</span> <span class='hs-layout'>(</span><span class='hs-varid'>roundTo</span><span class='hs-layout'>)</span>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Text</span><span class='hs-varop'>.</span><span class='hs-conid'>Lazy</span><span class='hs-varop'>.</span><span class='hs-conid'>Builder</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Text</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>T</span>
<a name="line-24"></a>
<a name="line-25"></a><a name="FPFormat"></a><span class='hs-comment'>-- | Control the rendering of floating point numbers.</span>
<a name="line-26"></a><a name="FPFormat"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>FPFormat</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Exponent</span>
<a name="line-27"></a> <span class='hs-comment'>-- ^ Scientific notation (e.g. @2.3e123@).</span>
<a name="line-28"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Fixed</span>
<a name="line-29"></a> <span class='hs-comment'>-- ^ Standard decimal notation.</span>
<a name="line-30"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Generic</span>
<a name="line-31"></a> <span class='hs-comment'>-- ^ Use decimal notation for values between @0.1@ and</span>
<a name="line-32"></a> <span class='hs-comment'>-- @9,999,999@, and scientific notation otherwise.</span>
<a name="line-33"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Enum</span><span class='hs-layout'>,</span> <span class='hs-conid'>Read</span><span class='hs-layout'>,</span> <span class='hs-conid'>Show</span><span class='hs-layout'>)</span>
<a name="line-34"></a>
<a name="line-35"></a><a name="realFloat"></a><span class='hs-comment'>-- | Show a signed 'RealFloat' value to full precision,</span>
<a name="line-36"></a><span class='hs-comment'>-- using standard decimal notation for arguments whose absolute value lies</span>
<a name="line-37"></a><span class='hs-comment'>-- between @0.1@ and @9,999,999@, and scientific notation otherwise.</span>
<a name="line-38"></a><span class='hs-definition'>realFloat</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>RealFloat</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Builder</span>
<a name="line-39"></a><span class='hs-comment'>{-# SPECIALIZE realFloat :: Float -> Builder #-}</span>
<a name="line-40"></a><span class='hs-comment'>{-# SPECIALIZE realFloat :: Double -> Builder #-}</span>
<a name="line-41"></a><span class='hs-definition'>realFloat</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>formatRealFloat</span> <span class='hs-conid'>Generic</span> <span class='hs-conid'>Nothing</span> <span class='hs-varid'>x</span>
<a name="line-42"></a>
<a name="line-43"></a><a name="formatRealFloat"></a><span class='hs-definition'>formatRealFloat</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>RealFloat</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span>
<a name="line-44"></a> <span class='hs-conid'>FPFormat</span>
<a name="line-45"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Int</span> <span class='hs-comment'>-- ^ Number of decimal places to render.</span>
<a name="line-46"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span>
<a name="line-47"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Builder</span>
<a name="line-48"></a><span class='hs-comment'>{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}</span>
<a name="line-49"></a><span class='hs-comment'>{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}</span>
<a name="line-50"></a><span class='hs-definition'>formatRealFloat</span> <span class='hs-varid'>fmt</span> <span class='hs-varid'>decs</span> <span class='hs-varid'>x</span>
<a name="line-51"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isNaN</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"NaN"</span>
<a name="line-52"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isInfinite</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>x</span> <span class='hs-varop'><</span> <span class='hs-num'>0</span> <span class='hs-keyword'>then</span> <span class='hs-str'>"-Infinity"</span> <span class='hs-keyword'>else</span> <span class='hs-str'>"Infinity"</span>
<a name="line-53"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>x</span> <span class='hs-varop'><</span> <span class='hs-num'>0</span> <span class='hs-varop'>||</span> <span class='hs-varid'>isNegativeZero</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>singleton</span> <span class='hs-chr'>'-'</span> <span class='hs-varop'><></span> <span class='hs-varid'>doFmt</span> <span class='hs-varid'>fmt</span> <span class='hs-layout'>(</span><span class='hs-varid'>floatToDigits</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-varid'>x</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-54"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>doFmt</span> <span class='hs-varid'>fmt</span> <span class='hs-layout'>(</span><span class='hs-varid'>floatToDigits</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-55"></a> <span class='hs-keyword'>where</span>
<a name="line-56"></a> <span class='hs-varid'>doFmt</span> <span class='hs-varid'>format</span> <span class='hs-layout'>(</span><span class='hs-varid'>is</span><span class='hs-layout'>,</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-57"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>ds</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>i2d</span> <span class='hs-varid'>is</span> <span class='hs-keyword'>in</span>
<a name="line-58"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>format</span> <span class='hs-keyword'>of</span>
<a name="line-59"></a> <span class='hs-conid'>Generic</span> <span class='hs-keyglyph'>-></span>
<a name="line-60"></a> <span class='hs-varid'>doFmt</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>e</span> <span class='hs-varop'><</span> <span class='hs-num'>0</span> <span class='hs-varop'>||</span> <span class='hs-varid'>e</span> <span class='hs-varop'>></span> <span class='hs-num'>7</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>Exponent</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>Fixed</span><span class='hs-layout'>)</span>
<a name="line-61"></a> <span class='hs-layout'>(</span><span class='hs-varid'>is</span><span class='hs-layout'>,</span><span class='hs-varid'>e</span><span class='hs-layout'>)</span>
<a name="line-62"></a> <span class='hs-conid'>Exponent</span> <span class='hs-keyglyph'>-></span>
<a name="line-63"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>decs</span> <span class='hs-keyword'>of</span>
<a name="line-64"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span>
<a name="line-65"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>show_e'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>decimal</span> <span class='hs-layout'>(</span><span class='hs-varid'>e</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-keyword'>in</span>
<a name="line-66"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>ds</span> <span class='hs-keyword'>of</span>
<a name="line-67"></a> <span class='hs-str'>"0"</span> <span class='hs-keyglyph'>-></span> <span class='hs-str'>"0.0e0"</span>
<a name="line-68"></a> <span class='hs-keyglyph'>[</span><span class='hs-varid'>d</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>singleton</span> <span class='hs-varid'>d</span> <span class='hs-varop'><></span> <span class='hs-str'>".0e"</span> <span class='hs-varop'><></span> <span class='hs-varid'>show_e'</span>
<a name="line-69"></a> <span class='hs-layout'>(</span><span class='hs-varid'>d</span><span class='hs-conop'>:</span><span class='hs-varid'>ds'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>singleton</span> <span class='hs-varid'>d</span> <span class='hs-varop'><></span> <span class='hs-varid'>singleton</span> <span class='hs-chr'>'.'</span> <span class='hs-varop'><></span> <span class='hs-varid'>fromString</span> <span class='hs-varid'>ds'</span> <span class='hs-varop'><></span> <span class='hs-varid'>singleton</span> <span class='hs-chr'>'e'</span> <span class='hs-varop'><></span> <span class='hs-varid'>show_e'</span>
<a name="line-70"></a> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>error</span> <span class='hs-str'>"formatRealFloat/doFmt/Exponent: []"</span>
<a name="line-71"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>dec</span> <span class='hs-keyglyph'>-></span>
<a name="line-72"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>dec'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>max</span> <span class='hs-varid'>dec</span> <span class='hs-num'>1</span> <span class='hs-keyword'>in</span>
<a name="line-73"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>is</span> <span class='hs-keyword'>of</span>
<a name="line-74"></a> <span class='hs-keyglyph'>[</span><span class='hs-num'>0</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-str'>"0."</span> <span class='hs-varop'><></span> <span class='hs-varid'>fromText</span> <span class='hs-layout'>(</span><span class='hs-conid'>T</span><span class='hs-varop'>.</span><span class='hs-varid'>replicate</span> <span class='hs-varid'>dec'</span> <span class='hs-str'>"0"</span><span class='hs-layout'>)</span> <span class='hs-varop'><></span> <span class='hs-str'>"e0"</span>
<a name="line-75"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span>
<a name="line-76"></a> <span class='hs-keyword'>let</span>
<a name="line-77"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ei</span><span class='hs-layout'>,</span><span class='hs-varid'>is'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>roundTo</span> <span class='hs-layout'>(</span><span class='hs-varid'>dec'</span><span class='hs-varop'>+</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-varid'>is</span>
<a name="line-78"></a> <span class='hs-layout'>(</span><span class='hs-varid'>d</span><span class='hs-conop'>:</span><span class='hs-varid'>ds'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>i2d</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>ei</span> <span class='hs-varop'>></span> <span class='hs-num'>0</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>init</span> <span class='hs-varid'>is'</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>is'</span><span class='hs-layout'>)</span>
<a name="line-79"></a> <span class='hs-keyword'>in</span>
<a name="line-80"></a> <span class='hs-varid'>singleton</span> <span class='hs-varid'>d</span> <span class='hs-varop'><></span> <span class='hs-varid'>singleton</span> <span class='hs-chr'>'.'</span> <span class='hs-varop'><></span> <span class='hs-varid'>fromString</span> <span class='hs-varid'>ds'</span> <span class='hs-varop'><></span> <span class='hs-varid'>singleton</span> <span class='hs-chr'>'e'</span> <span class='hs-varop'><></span> <span class='hs-varid'>decimal</span> <span class='hs-layout'>(</span><span class='hs-varid'>e</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-varop'>+</span><span class='hs-varid'>ei</span><span class='hs-layout'>)</span>
<a name="line-81"></a> <span class='hs-conid'>Fixed</span> <span class='hs-keyglyph'>-></span>
<a name="line-82"></a> <span class='hs-keyword'>let</span>
<a name="line-83"></a> <span class='hs-varid'>mk0</span> <span class='hs-varid'>ls</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>ls</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-str'>""</span> <span class='hs-keyglyph'>-></span> <span class='hs-str'>"0"</span> <span class='hs-layout'>;</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>fromString</span> <span class='hs-varid'>ls</span><span class='hs-layout'>}</span>
<a name="line-84"></a> <span class='hs-keyword'>in</span>
<a name="line-85"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>decs</span> <span class='hs-keyword'>of</span>
<a name="line-86"></a> <span class='hs-conid'>Nothing</span>
<a name="line-87"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>e</span> <span class='hs-varop'><=</span> <span class='hs-num'>0</span> <span class='hs-keyglyph'>-></span> <span class='hs-str'>"0."</span> <span class='hs-varop'><></span> <span class='hs-varid'>fromText</span> <span class='hs-layout'>(</span><span class='hs-conid'>T</span><span class='hs-varop'>.</span><span class='hs-varid'>replicate</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-str'>"0"</span><span class='hs-layout'>)</span> <span class='hs-varop'><></span> <span class='hs-varid'>fromString</span> <span class='hs-varid'>ds</span>
<a name="line-88"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span>
<a name="line-89"></a> <span class='hs-keyword'>let</span>
<a name="line-90"></a> <span class='hs-varid'>f</span> <span class='hs-num'>0</span> <span class='hs-varid'>s</span> <span class='hs-varid'>rs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mk0</span> <span class='hs-layout'>(</span><span class='hs-varid'>reverse</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-varop'><></span> <span class='hs-varid'>singleton</span> <span class='hs-chr'>'.'</span> <span class='hs-varop'><></span> <span class='hs-varid'>mk0</span> <span class='hs-varid'>rs</span>
<a name="line-91"></a> <span class='hs-varid'>f</span> <span class='hs-varid'>n</span> <span class='hs-varid'>s</span> <span class='hs-str'>""</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-chr'>'0'</span><span class='hs-conop'>:</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-str'>""</span>
<a name="line-92"></a> <span class='hs-varid'>f</span> <span class='hs-varid'>n</span> <span class='hs-varid'>s</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-conop'>:</span><span class='hs-varid'>rs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-conop'>:</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-varid'>rs</span>
<a name="line-93"></a> <span class='hs-keyword'>in</span>
<a name="line-94"></a> <span class='hs-varid'>f</span> <span class='hs-varid'>e</span> <span class='hs-str'>""</span> <span class='hs-varid'>ds</span>
<a name="line-95"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>dec</span> <span class='hs-keyglyph'>-></span>
<a name="line-96"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>dec'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>max</span> <span class='hs-varid'>dec</span> <span class='hs-num'>0</span> <span class='hs-keyword'>in</span>
<a name="line-97"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>e</span> <span class='hs-varop'>>=</span> <span class='hs-num'>0</span> <span class='hs-keyword'>then</span>
<a name="line-98"></a> <span class='hs-keyword'>let</span>
<a name="line-99"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ei</span><span class='hs-layout'>,</span><span class='hs-varid'>is'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>roundTo</span> <span class='hs-layout'>(</span><span class='hs-varid'>dec'</span> <span class='hs-varop'>+</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-varid'>is</span>
<a name="line-100"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ls</span><span class='hs-layout'>,</span><span class='hs-varid'>rs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>splitAt</span> <span class='hs-layout'>(</span><span class='hs-varid'>e</span><span class='hs-varop'>+</span><span class='hs-varid'>ei</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>i2d</span> <span class='hs-varid'>is'</span><span class='hs-layout'>)</span>
<a name="line-101"></a> <span class='hs-keyword'>in</span>
<a name="line-102"></a> <span class='hs-varid'>mk0</span> <span class='hs-varid'>ls</span> <span class='hs-varop'><></span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>null</span> <span class='hs-varid'>rs</span> <span class='hs-keyword'>then</span> <span class='hs-str'>""</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>singleton</span> <span class='hs-chr'>'.'</span> <span class='hs-varop'><></span> <span class='hs-varid'>fromString</span> <span class='hs-varid'>rs</span><span class='hs-layout'>)</span>
<a name="line-103"></a> <span class='hs-keyword'>else</span>
<a name="line-104"></a> <span class='hs-keyword'>let</span>
<a name="line-105"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ei</span><span class='hs-layout'>,</span><span class='hs-varid'>is'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>roundTo</span> <span class='hs-varid'>dec'</span> <span class='hs-layout'>(</span><span class='hs-varid'>replicate</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-num'>0</span> <span class='hs-varop'>++</span> <span class='hs-varid'>is</span><span class='hs-layout'>)</span>
<a name="line-106"></a> <span class='hs-varid'>d</span><span class='hs-conop'>:</span><span class='hs-varid'>ds'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>i2d</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>ei</span> <span class='hs-varop'>></span> <span class='hs-num'>0</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>is'</span> <span class='hs-keyword'>else</span> <span class='hs-num'>0</span><span class='hs-conop'>:</span><span class='hs-varid'>is'</span><span class='hs-layout'>)</span>
<a name="line-107"></a> <span class='hs-keyword'>in</span>
<a name="line-108"></a> <span class='hs-varid'>singleton</span> <span class='hs-varid'>d</span> <span class='hs-varop'><></span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>null</span> <span class='hs-varid'>ds'</span> <span class='hs-keyword'>then</span> <span class='hs-str'>""</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>singleton</span> <span class='hs-chr'>'.'</span> <span class='hs-varop'><></span> <span class='hs-varid'>fromString</span> <span class='hs-varid'>ds'</span><span class='hs-layout'>)</span>
<a name="line-109"></a>
<a name="line-110"></a>
<a name="line-111"></a><span class='hs-comment'>-- Based on "Printing Floating-Point Numbers Quickly and Accurately"</span>
<a name="line-112"></a><span class='hs-comment'>-- by R.G. Burger and R.K. Dybvig in PLDI 96.</span>
<a name="line-113"></a><span class='hs-comment'>-- This version uses a much slower logarithm estimator. It should be improved.</span>
<a name="line-114"></a>
<a name="line-115"></a><span class='hs-comment'>-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,</span>
<a name="line-116"></a><span class='hs-comment'>-- and returns a list of digits and an exponent.</span>
<a name="line-117"></a><span class='hs-comment'>-- In particular, if @x>=0@, and</span>
<a name="line-118"></a><span class='hs-comment'>--</span>
<a name="line-119"></a><span class='hs-comment'>-- > floatToDigits base x = ([d1,d2,...,dn], e)</span>
<a name="line-120"></a><span class='hs-comment'>--</span>
<a name="line-121"></a><span class='hs-comment'>-- then</span>
<a name="line-122"></a><span class='hs-comment'>--</span>
<a name="line-123"></a><span class='hs-comment'>-- (1) @n >= 1@</span>
<a name="line-124"></a><span class='hs-comment'>--</span>
<a name="line-125"></a><span class='hs-comment'>-- (2) @x = 0.d1d2...dn * (base**e)@</span>
<a name="line-126"></a><span class='hs-comment'>--</span>
<a name="line-127"></a><span class='hs-comment'>-- (3) @0 <= di <= base-1@</span>
<a name="line-128"></a>
<a name="line-129"></a><a name="floatToDigits"></a><span class='hs-definition'>floatToDigits</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>RealFloat</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Int</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-conid'>Int</span><span class='hs-layout'>)</span>
<a name="line-130"></a><span class='hs-comment'>{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}</span>
<a name="line-131"></a><span class='hs-comment'>{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}</span>
<a name="line-132"></a><span class='hs-definition'>floatToDigits</span> <span class='hs-num'>0</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-num'>0</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-133"></a><span class='hs-definition'>floatToDigits</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span>
<a name="line-134"></a> <span class='hs-keyword'>let</span>
<a name="line-135"></a> <span class='hs-layout'>(</span><span class='hs-varid'>f0</span><span class='hs-layout'>,</span> <span class='hs-varid'>e0</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>decodeFloat</span> <span class='hs-varid'>x</span>
<a name="line-136"></a> <span class='hs-layout'>(</span><span class='hs-varid'>minExp0</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>floatRange</span> <span class='hs-varid'>x</span>
<a name="line-137"></a> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>floatDigits</span> <span class='hs-varid'>x</span>
<a name="line-138"></a> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>floatRadix</span> <span class='hs-varid'>x</span>
<a name="line-139"></a> <span class='hs-varid'>minExp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>minExp0</span> <span class='hs-comment'>-</span> <span class='hs-varid'>p</span> <span class='hs-comment'>-- the real minimum exponent</span>
<a name="line-140"></a> <span class='hs-comment'>-- Haskell requires that f be adjusted so denormalized numbers</span>
<a name="line-141"></a> <span class='hs-comment'>-- will have an impossibly low exponent. Adjust for this.</span>
<a name="line-142"></a> <span class='hs-layout'>(</span><span class='hs-varid'>f</span><span class='hs-layout'>,</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-143"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>minExp</span> <span class='hs-comment'>-</span> <span class='hs-varid'>e0</span> <span class='hs-keyword'>in</span>
<a name="line-144"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>n</span> <span class='hs-varop'>></span> <span class='hs-num'>0</span> <span class='hs-keyword'>then</span> <span class='hs-layout'>(</span><span class='hs-varid'>f0</span> <span class='hs-varop'>`quot`</span> <span class='hs-layout'>(</span><span class='hs-varid'>expt</span> <span class='hs-varid'>b</span> <span class='hs-varid'>n</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>e0</span><span class='hs-varop'>+</span><span class='hs-varid'>n</span><span class='hs-layout'>)</span> <span class='hs-keyword'>else</span> <span class='hs-layout'>(</span><span class='hs-varid'>f0</span><span class='hs-layout'>,</span> <span class='hs-varid'>e0</span><span class='hs-layout'>)</span>
<a name="line-145"></a> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>,</span> <span class='hs-varid'>mUp</span><span class='hs-layout'>,</span> <span class='hs-varid'>mDn</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-146"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>e</span> <span class='hs-varop'>>=</span> <span class='hs-num'>0</span> <span class='hs-keyword'>then</span>
<a name="line-147"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>be</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>expt</span> <span class='hs-varid'>b</span> <span class='hs-varid'>e</span> <span class='hs-keyword'>in</span>
<a name="line-148"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>f</span> <span class='hs-varop'>==</span> <span class='hs-varid'>expt</span> <span class='hs-varid'>b</span> <span class='hs-layout'>(</span><span class='hs-varid'>p</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-keyword'>then</span>
<a name="line-149"></a> <span class='hs-layout'>(</span><span class='hs-varid'>f</span><span class='hs-varop'>*</span><span class='hs-varid'>be</span><span class='hs-varop'>*</span><span class='hs-varid'>b</span><span class='hs-varop'>*</span><span class='hs-num'>2</span><span class='hs-layout'>,</span> <span class='hs-num'>2</span><span class='hs-varop'>*</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>be</span><span class='hs-varop'>*</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>be</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- according to Burger and Dybvig</span>
<a name="line-150"></a> <span class='hs-keyword'>else</span>
<a name="line-151"></a> <span class='hs-layout'>(</span><span class='hs-varid'>f</span><span class='hs-varop'>*</span><span class='hs-varid'>be</span><span class='hs-varop'>*</span><span class='hs-num'>2</span><span class='hs-layout'>,</span> <span class='hs-num'>2</span><span class='hs-layout'>,</span> <span class='hs-varid'>be</span><span class='hs-layout'>,</span> <span class='hs-varid'>be</span><span class='hs-layout'>)</span>
<a name="line-152"></a> <span class='hs-keyword'>else</span>
<a name="line-153"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>e</span> <span class='hs-varop'>></span> <span class='hs-varid'>minExp</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>f</span> <span class='hs-varop'>==</span> <span class='hs-varid'>expt</span> <span class='hs-varid'>b</span> <span class='hs-layout'>(</span><span class='hs-varid'>p</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-keyword'>then</span>
<a name="line-154"></a> <span class='hs-layout'>(</span><span class='hs-varid'>f</span><span class='hs-varop'>*</span><span class='hs-varid'>b</span><span class='hs-varop'>*</span><span class='hs-num'>2</span><span class='hs-layout'>,</span> <span class='hs-varid'>expt</span> <span class='hs-varid'>b</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-varid'>e</span><span class='hs-varop'>+</span><span class='hs-num'>1</span><span class='hs-layout'>)</span><span class='hs-varop'>*</span><span class='hs-num'>2</span><span class='hs-layout'>,</span> <span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-155"></a> <span class='hs-keyword'>else</span>
<a name="line-156"></a> <span class='hs-layout'>(</span><span class='hs-varid'>f</span><span class='hs-varop'>*</span><span class='hs-num'>2</span><span class='hs-layout'>,</span> <span class='hs-varid'>expt</span> <span class='hs-varid'>b</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-varid'>e</span><span class='hs-layout'>)</span><span class='hs-varop'>*</span><span class='hs-num'>2</span><span class='hs-layout'>,</span> <span class='hs-num'>1</span><span class='hs-layout'>,</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-157"></a> <span class='hs-varid'>k</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span>
<a name="line-158"></a> <span class='hs-varid'>k</span> <span class='hs-keyglyph'>=</span>
<a name="line-159"></a> <span class='hs-keyword'>let</span>
<a name="line-160"></a> <span class='hs-varid'>k0</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span>
<a name="line-161"></a> <span class='hs-varid'>k0</span> <span class='hs-keyglyph'>=</span>
<a name="line-162"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>b</span> <span class='hs-varop'>==</span> <span class='hs-num'>2</span> <span class='hs-keyword'>then</span>
<a name="line-163"></a> <span class='hs-comment'>-- logBase 10 2 is very slightly larger than 8651/28738</span>
<a name="line-164"></a> <span class='hs-comment'>-- (about 5.3558e-10), so if log x >= 0, the approximation</span>
<a name="line-165"></a> <span class='hs-comment'>-- k1 is too small, hence we add one and need one fixup step less.</span>
<a name="line-166"></a> <span class='hs-comment'>-- If log x < 0, the approximation errs rather on the high side.</span>
<a name="line-167"></a> <span class='hs-comment'>-- That is usually more than compensated for by ignoring the</span>
<a name="line-168"></a> <span class='hs-comment'>-- fractional part of logBase 2 x, but when x is a power of 1/2</span>
<a name="line-169"></a> <span class='hs-comment'>-- or slightly larger and the exponent is a multiple of the</span>
<a name="line-170"></a> <span class='hs-comment'>-- denominator of the rational approximation to logBase 10 2,</span>
<a name="line-171"></a> <span class='hs-comment'>-- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,</span>
<a name="line-172"></a> <span class='hs-comment'>-- we get a leading zero-digit we don't want.</span>
<a name="line-173"></a> <span class='hs-comment'>-- With the approximation 3/10, this happened for</span>
<a name="line-174"></a> <span class='hs-comment'>-- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.</span>
<a name="line-175"></a> <span class='hs-comment'>-- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x</span>
<a name="line-176"></a> <span class='hs-comment'>-- for IEEE-ish floating point types with exponent fields</span>
<a name="line-177"></a> <span class='hs-comment'>-- <= 17 bits and mantissae of several thousand bits, earlier</span>
<a name="line-178"></a> <span class='hs-comment'>-- convergents to logBase 10 2 would fail for long double.</span>
<a name="line-179"></a> <span class='hs-comment'>-- Using quot instead of div is a little faster and requires</span>
<a name="line-180"></a> <span class='hs-comment'>-- fewer fixup steps for negative lx.</span>
<a name="line-181"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>lx</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>p</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span> <span class='hs-varop'>+</span> <span class='hs-varid'>e0</span>
<a name="line-182"></a> <span class='hs-varid'>k1</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>lx</span> <span class='hs-varop'>*</span> <span class='hs-num'>8651</span><span class='hs-layout'>)</span> <span class='hs-varop'>`quot`</span> <span class='hs-num'>28738</span>
<a name="line-183"></a> <span class='hs-keyword'>in</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>lx</span> <span class='hs-varop'>>=</span> <span class='hs-num'>0</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>k1</span> <span class='hs-varop'>+</span> <span class='hs-num'>1</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>k1</span>
<a name="line-184"></a> <span class='hs-keyword'>else</span>
<a name="line-185"></a> <span class='hs-comment'>-- f :: Integer, log :: Float -> Float,</span>
<a name="line-186"></a> <span class='hs-comment'>-- ceiling :: Float -> Int</span>
<a name="line-187"></a> <span class='hs-varid'>ceiling</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>log</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromInteger</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span><span class='hs-varop'>+</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Float</span><span class='hs-layout'>)</span> <span class='hs-varop'>+</span>
<a name="line-188"></a> <span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>e</span> <span class='hs-varop'>*</span> <span class='hs-varid'>log</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromInteger</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>/</span>
<a name="line-189"></a> <span class='hs-varid'>log</span> <span class='hs-num'>10</span><span class='hs-layout'>)</span>
<a name="line-190"></a><span class='hs-comment'>--WAS: fromInt e * log (fromInteger b))</span>
<a name="line-191"></a>
<a name="line-192"></a> <span class='hs-varid'>fixup</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>=</span>
<a name="line-193"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>n</span> <span class='hs-varop'>>=</span> <span class='hs-num'>0</span> <span class='hs-keyword'>then</span>
<a name="line-194"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>r</span> <span class='hs-varop'>+</span> <span class='hs-varid'>mUp</span> <span class='hs-varop'><=</span> <span class='hs-varid'>expt</span> <span class='hs-num'>10</span> <span class='hs-varid'>n</span> <span class='hs-varop'>*</span> <span class='hs-varid'>s</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>n</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>fixup</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-varop'>+</span><span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-195"></a> <span class='hs-keyword'>else</span>
<a name="line-196"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>expt</span> <span class='hs-num'>10</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-varid'>n</span><span class='hs-layout'>)</span> <span class='hs-varop'>*</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span> <span class='hs-varop'>+</span> <span class='hs-varid'>mUp</span><span class='hs-layout'>)</span> <span class='hs-varop'><=</span> <span class='hs-varid'>s</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>n</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>fixup</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-varop'>+</span><span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-197"></a> <span class='hs-keyword'>in</span>
<a name="line-198"></a> <span class='hs-varid'>fixup</span> <span class='hs-varid'>k0</span>
<a name="line-199"></a>
<a name="line-200"></a> <span class='hs-varid'>gen</span> <span class='hs-varid'>ds</span> <span class='hs-varid'>rn</span> <span class='hs-varid'>sN</span> <span class='hs-varid'>mUpN</span> <span class='hs-varid'>mDnN</span> <span class='hs-keyglyph'>=</span>
<a name="line-201"></a> <span class='hs-keyword'>let</span>
<a name="line-202"></a> <span class='hs-layout'>(</span><span class='hs-varid'>dn</span><span class='hs-layout'>,</span> <span class='hs-varid'>rn'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>rn</span> <span class='hs-varop'>*</span> <span class='hs-num'>10</span><span class='hs-layout'>)</span> <span class='hs-varop'>`quotRem`</span> <span class='hs-varid'>sN</span>
<a name="line-203"></a> <span class='hs-varid'>mUpN'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mUpN</span> <span class='hs-varop'>*</span> <span class='hs-num'>10</span>
<a name="line-204"></a> <span class='hs-varid'>mDnN'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mDnN</span> <span class='hs-varop'>*</span> <span class='hs-num'>10</span>
<a name="line-205"></a> <span class='hs-keyword'>in</span>
<a name="line-206"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>rn'</span> <span class='hs-varop'><</span> <span class='hs-varid'>mDnN'</span><span class='hs-layout'>,</span> <span class='hs-varid'>rn'</span> <span class='hs-varop'>+</span> <span class='hs-varid'>mUpN'</span> <span class='hs-varop'>></span> <span class='hs-varid'>sN</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-207"></a> <span class='hs-layout'>(</span><span class='hs-conid'>True</span><span class='hs-layout'>,</span> <span class='hs-conid'>False</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>dn</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ds</span>
<a name="line-208"></a> <span class='hs-layout'>(</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span> <span class='hs-conid'>True</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>dn</span><span class='hs-varop'>+</span><span class='hs-num'>1</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ds</span>
<a name="line-209"></a> <span class='hs-layout'>(</span><span class='hs-conid'>True</span><span class='hs-layout'>,</span> <span class='hs-conid'>True</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>if</span> <span class='hs-varid'>rn'</span> <span class='hs-varop'>*</span> <span class='hs-num'>2</span> <span class='hs-varop'><</span> <span class='hs-varid'>sN</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>dn</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ds</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>dn</span><span class='hs-varop'>+</span><span class='hs-num'>1</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ds</span>
<a name="line-210"></a> <span class='hs-layout'>(</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span> <span class='hs-conid'>False</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>gen</span> <span class='hs-layout'>(</span><span class='hs-varid'>dn</span><span class='hs-conop'>:</span><span class='hs-varid'>ds</span><span class='hs-layout'>)</span> <span class='hs-varid'>rn'</span> <span class='hs-varid'>sN</span> <span class='hs-varid'>mUpN'</span> <span class='hs-varid'>mDnN'</span>
<a name="line-211"></a>
<a name="line-212"></a> <span class='hs-varid'>rds</span> <span class='hs-keyglyph'>=</span>
<a name="line-213"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>k</span> <span class='hs-varop'>>=</span> <span class='hs-num'>0</span> <span class='hs-keyword'>then</span>
<a name="line-214"></a> <span class='hs-varid'>gen</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>r</span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span> <span class='hs-varop'>*</span> <span class='hs-varid'>expt</span> <span class='hs-num'>10</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span> <span class='hs-varid'>mUp</span> <span class='hs-varid'>mDn</span>
<a name="line-215"></a> <span class='hs-keyword'>else</span>
<a name="line-216"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>bk</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>expt</span> <span class='hs-num'>10</span> <span class='hs-layout'>(</span><span class='hs-comment'>-</span><span class='hs-varid'>k</span><span class='hs-layout'>)</span> <span class='hs-keyword'>in</span>
<a name="line-217"></a> <span class='hs-varid'>gen</span> <span class='hs-conid'>[]</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span> <span class='hs-varop'>*</span> <span class='hs-varid'>bk</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span> <span class='hs-layout'>(</span><span class='hs-varid'>mUp</span> <span class='hs-varop'>*</span> <span class='hs-varid'>bk</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>mDn</span> <span class='hs-varop'>*</span> <span class='hs-varid'>bk</span><span class='hs-layout'>)</span>
<a name="line-218"></a> <span class='hs-keyword'>in</span>
<a name="line-219"></a> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>fromIntegral</span> <span class='hs-layout'>(</span><span class='hs-varid'>reverse</span> <span class='hs-varid'>rds</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span>
<a name="line-220"></a>
<a name="line-221"></a><a name="minExpt"></a><span class='hs-comment'>-- Exponentiation with a cache for the most common numbers.</span>
<a name="line-222"></a><span class='hs-definition'>minExpt</span><span class='hs-layout'>,</span> <span class='hs-varid'>maxExpt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span>
<a name="line-223"></a><span class='hs-definition'>minExpt</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0</span>
<a name="line-224"></a><a name="maxExpt"></a><span class='hs-definition'>maxExpt</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>1100</span>
<a name="line-225"></a>
<a name="line-226"></a><a name="expt"></a><span class='hs-definition'>expt</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Integer</span>
<a name="line-227"></a><span class='hs-definition'>expt</span> <span class='hs-varid'>base</span> <span class='hs-varid'>n</span>
<a name="line-228"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>base</span> <span class='hs-varop'>==</span> <span class='hs-num'>2</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>n</span> <span class='hs-varop'>>=</span> <span class='hs-varid'>minExpt</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>n</span> <span class='hs-varop'><=</span> <span class='hs-varid'>maxExpt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>expts</span> <span class='hs-varop'>`unsafeAt`</span> <span class='hs-varid'>n</span>
<a name="line-229"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>base</span> <span class='hs-varop'>==</span> <span class='hs-num'>10</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>n</span> <span class='hs-varop'><=</span> <span class='hs-varid'>maxExpt10</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>expts10</span> <span class='hs-varop'>`unsafeAt`</span> <span class='hs-varid'>n</span>
<a name="line-230"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>base</span><span class='hs-varop'>^</span><span class='hs-varid'>n</span>
<a name="line-231"></a>
<a name="line-232"></a><a name="expts"></a><span class='hs-definition'>expts</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Array</span> <span class='hs-conid'>Int</span> <span class='hs-conid'>Integer</span>
<a name="line-233"></a><span class='hs-definition'>expts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>array</span> <span class='hs-layout'>(</span><span class='hs-varid'>minExpt</span><span class='hs-layout'>,</span><span class='hs-varid'>maxExpt</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-layout'>,</span><span class='hs-num'>2</span><span class='hs-varop'>^</span><span class='hs-varid'>n</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>minExpt</span> <span class='hs-keyglyph'>..</span> <span class='hs-varid'>maxExpt</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span>
<a name="line-234"></a>
<a name="line-235"></a><a name="maxExpt10"></a><span class='hs-definition'>maxExpt10</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span>
<a name="line-236"></a><span class='hs-definition'>maxExpt10</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>324</span>
<a name="line-237"></a>
<a name="line-238"></a><a name="expts10"></a><span class='hs-definition'>expts10</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Array</span> <span class='hs-conid'>Int</span> <span class='hs-conid'>Integer</span>
<a name="line-239"></a><span class='hs-definition'>expts10</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>array</span> <span class='hs-layout'>(</span><span class='hs-varid'>minExpt</span><span class='hs-layout'>,</span><span class='hs-varid'>maxExpt10</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-layout'>,</span><span class='hs-num'>10</span><span class='hs-varop'>^</span><span class='hs-varid'>n</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>minExpt</span> <span class='hs-keyglyph'>..</span> <span class='hs-varid'>maxExpt10</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span>
</pre></body>
</html>
|