[Haskell-cafe] Binary constants in Haskell
John Meacham
john at repetae.net
Thu Oct 25 18:34:29 EDT 2007
On Thu, Oct 25, 2007 at 09:52:27AM -0700, Don Stewart wrote:
> 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
This would have some decidedly weird consequences
fromIntegral (6::Int) :: Binary
Binary *** Exception: Invalid character in binary literal
and that constant 6 can be somewhere far removed from the actual binary
cast.
also,
fromInteger (toInteger x + toInteger y ) :: Binary /= x + y
all sorts of oddness will result.
John
--
John Meacham - ⑆repetae.net⑆john⑈
More information about the Haskell-Cafe
mailing list