Home > Blockchain >  Putting a type in the Read typeclass doesn't work in the REPL
Putting a type in the Read typeclass doesn't work in the REPL

Time:04-27

I'm defining a type GosperInteger, representing the Eisenstein integers in a complex base, and I'd like to enter these numbers in the REPL and do operations on them. So I put the type in the Read and Show typeclasses. Here's the code (there's also an Internals module, see https://github.com/phma/gosperbase to run it):

module Data.GosperBase where
import Data.Array.Unboxed
import Data.Word
import Data.GosperBase.Internals
import qualified Data.Sequence as Seq
import Data.Sequence ((><), (<|), (|>), Seq((:<|)), Seq((:|>)))
import Data.Char
import Data.List
import Data.Maybe

{- This computes complex numbers in base 2.5-√(-3/4), called the Gosper base
   because it is the scale factor from one Gosper island to the next bigger one.
   The digits are cyclotomic:
    2 3
   6 0 1
    4 5
   For layout of all numbers up to 3 digits, see doc/GosperBase.ps .
-}

newtype GosperInteger = GosperInteger (Seq.Seq Word)

chunkDigitsInt :: Seq.Seq Char -> Maybe (Seq.Seq (Seq.Seq Char))
-- ^If the string ends in 'G', reverses the rest of the characters
-- and groups them into chunks of digitsPerLimb.
chunkDigitsInt (as:|>'G') = Just (Seq.reverse (Seq.chunksOf (fromIntegral digitsPerLimb) (Seq.reverse as)))
chunkDigitsInt as = Nothing

parseChunkRjust :: Seq.Seq Char -> Maybe Word
parseChunkRjust Seq.Empty = Just 0
parseChunkRjust (n:<|ns) =
  let ms = parseChunkRjust ns
  in case ms of
    Just num -> if (n >= '0' && n < '7')
           then Just (7 * num   fromIntegral (ord n - ord '0'))
           else Nothing
    Nothing -> Nothing

showLimb :: Word -> Word -> String
showLimb _ 0 = ""
showLimb val ndig = chr (fromIntegral ((val `div` 7 ^ (ndig-1)) `mod` 7)   ord '0') : (showLimb val (ndig-1))

parseRjust :: Seq.Seq Char -> Maybe (Seq.Seq Word)
parseRjust as =
  let ns = chunkDigitsInt as
  in case ns of
    Just chunks -> traverse parseChunkRjust chunks
    Nothing -> Nothing

showRjust' :: Seq.Seq Word -> String
showRjust' Seq.Empty = ""
showRjust' (a:<|as) = (showLimb a digitsPerLimb)    (showRjust' as)

showRjust :: Seq.Seq Word -> String
showRjust Seq.Empty = "0"
showRjust (a:<|as) = (showLimb a (snd (msdPosLimb a)))    (showRjust' as)

parse1InitTail :: (String, String) -> Maybe (GosperInteger, String)
parse1InitTail (a,b) =
  let aParse = parseRjust (Seq.fromList a)
  in case aParse of
    Just mant -> Just (GosperInteger mant,b)
    Nothing -> Nothing

parseGosperInteger :: String -> [(GosperInteger, String)]
parseGosperInteger str =
  let its = zip (inits str) (tails str) -- TODO stop on invalid char
  in catMaybes (fmap parse1InitTail its)

instance Read GosperInteger where
  readsPrec _ str = parseGosperInteger str

instance Show GosperInteger where
  show (GosperInteger m) = showRjust m    "G"

iAdd :: GosperInteger -> GosperInteger -> GosperInteger
iAdd (GosperInteger a) (GosperInteger b) =
  GosperInteger (stripLeading0 (addRjust a b))

iMult :: GosperInteger -> GosperInteger -> GosperInteger
iMult (GosperInteger a) (GosperInteger b) =
  GosperInteger (stripLeading0 (mulMant a b))

I'd like to do

> 425G * 256301G
16061525G

which requires putting GosperInteger in the Num typeclass, which I haven't done yet.

Showing a number works, and calling read on a string works, but reading a number typed into the REPL does not. Why?

> read "45G" :: GosperInteger
45G
> 45G

<interactive>:2:3: error: Data constructor not in scope: G

CodePudding user response:

It is not possible to do that in a proper way (you can probably bodge this by writing an odd Num instance).

I think a better approach would be to just write that num instance, then you can write:

ghci> 425 * 256301 :: GosperInteger
16061525

If you don't want to have to write that :: GosperInteger signature you can do a few things:

  1. Use ghci> default (GosperInteger, Double) that will mean it will automatically pick your GosperInteger type if there is ambiguity. You can also use this in normal source files.

  2. Define a function g :: GosperInteger -> GosperInteger; g = id which you can use to disambiguate manually with less syntactic overhead:

    ghci> g (425 * 256301)
    16061525
    

CodePudding user response:

The GHCi repl doesn't simply call read on the text that you type in. Instead, it has a much more complicated parser that separates your text into various tokens. One type of token is numeric: any integral number you type in will get "read" as an Integer. Of course, if you type 32 and want it to be an Int, not an Integer, this would be a problem, so the Num type class has a super convenient fromInteger function. With this, an Integer token can be converted into any instance of the Num class.

But, you want something slightly different: you want the parser to group together the numeric token along with the G token and treat them as one unit. For full support, you'd need to make an extension to the GHC parser, much like how if you type 2e7 into the prompt, you correctly get a floating point number. This isn't a simple change you can address in your source file or GHCi settings.


With all that said, there are some hacks we can play with. As Noughtmare mentions, "you can probably bodge this by writing an odd Num instance", and indeed you can! Fair warning: you probably don't want to do this, but let's explore it anyway.

The problem is that the parser returned two tokens, one that's numeric and the other that's G. Since it's uppercase, that G token is being interpreted as a data constructor (your error message pointed that out too: " Data constructor not in scope: G"). The key is to use this to our advantage. Consider the following:

data G = G
  deriving Show

instance Num (G -> GosperInteger) where
  fromInteger i G = integerToGosperInteger i

Now, assuming you wrote that function integerToGosperInteger, this instance would let you type, e.g., 45G and produce a GosperInteger 45G. Hurrah! You can even do 425G * 256301G and it will work as expected. Furthermore, if you cleverly omit a fromInteger definition from your Num GosperInteger class, then you'll get a runtime error if you try to simply use a number like 425 as as GosperInteger (that is, you'll get an error for implicit coercions that don't have the G).

There are some problems.

  • If you try this, you'll find that type inference is pretty terrible. It probably won't work right at the prompt unless you set default (GosperInteger, Double), and you'll probably want to use lots of type annotations in your source files.
  • If you leave out the G, you'll get terrible type error messages or, even worse, runtime errors.
  • You'll get a warning that your Num instance for G -> GosperInteger is incomplete. It is incomplete, but there's no sensible definitions for anything else. You could suppress the warning or set all of the missing methods to error "This isn't how this is supposed to be used" or something, but it's still a bit of a blemish in the code.

But, if you can deal with the problems and you squint hard enough, it sorta kinda gets you what you want.

  • Related