[Haskell-cafe] Binary constants in Haskell
Don Stewart
dons at galois.com
Thu Oct 25 12:52:27 EDT 2007
dons:
> claus.reinke:
> > >>> From my point of view, the difference between 0b10111011 and
> > >>> (bin[1,0,1,1,1,0,1,1]) is 22-10 that is 12 characters.
> >
> > how about using ghc's new overloaded strings for this?
> >
> > "10111011"::Binary
> >
> > there used to be a way to link to ghc head's docs, but
> > i can't find it right now. the test is
> >
> > http://darcs.haskell.org/testsuite/tests/ghc-regress/typecheck/should_compile/tc224.hs
> >
> > and the xml docs would be
> >
> > http://darcs.haskell.org/ghc/docs/users_guide/glasgow_exts.xml
>
> Why not use a Num instance for Binary, with fromInteger :: Integer -> a,
> Yielding,
>
> 10111011 :: Binary
>
> Overloaded numeric literals seem better here than strings :)
Something like this:
import Data.List
import Data.Bits
newtype Binary = Binary Integer deriving (Eq, Show)
instance Num Binary where
fromInteger n = Binary . roll . map (read.return) . show $ n
where
roll = foldl' unstep 0
unstep a 1 = a `shiftL` 1 .|. fromIntegral 1
unstep a 0 = a `shiftL` 1
unstep a _ = error "Invalid character in binary literal"
Yielding,
*A> 0 :: Binary
Binary 0
*A> 101 :: Binary
Binary 5
*A> 1111 :: Binary
Binary 15
*A> 1010101011010111 :: Binary
Binary 43735
*A> 42 :: Binary
Binary *** Exception: Invalid character in binary literal
More information about the Haskell-Cafe
mailing list