Support MicroHs

.github/workflows/haskell-ci.yaml

@@ -5,7 +5,7 @@ on:
   - pull_request
 
 jobs:
-  build:
+  ghc:
     runs-on: ubuntu-latest
     strategy:
       fail-fast: false
@@ -39,7 +39,7 @@ jobs:
       - name: Haddock
         run: cabal haddock
 
-  build-i386:
+  ghc-i386:
     runs-on: ubuntu-latest
     container:
       image: i386/ubuntu
@@ -59,3 +59,24 @@ jobs:
         run: cabal build
       - name: Test
         run: cabal test --enable-tests
+
+  mhs:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v6
+        with:
+          path: binary
+      - name: Checkout MicroHs repository
+        uses: actions/checkout@v6
+        with:
+          repository: augustss/MicroHs
+          path: mhs
+      - name: Install MicroHs
+        run: |
+          cd mhs
+          make minstall
+          echo "$HOME/.mcabal/bin" >> $GITHUB_PATH
+      - name: Install binary
+        run: |
+          cd binary
+          mcabal -r install

.gitignore

@@ -12,6 +12,7 @@
 GNUmakefile
 dist-boot
 dist-install
+dist-mcabal
 dist-newstyle
 ghc.mk
 .cabal-sandbox

README.md

@@ -6,23 +6,18 @@
 
 The ``binary`` package provides Data.Binary, containing the Binary class,
 and associated methods, for serialising values to and from lazy
-ByteStrings. 
-A key feature of ``binary`` is that the interface is both pure, and 
+ByteStrings.
+A key feature of ``binary`` is that the interface is both pure, and
 moderately efficient.
-The ``binary`` package is portable to GHC and Hugs.
+The ``binary`` package is portable to GHC and MicroHs.
 
 ## Installing binary from Hackage ##
 
 ``binary`` is part of The Glasgow Haskell Compiler (GHC) and therefore if you
-have either GHC or [The Haskell Platform](http://www.haskell.org/platform/)
-installed, you already have ``binary``.
+have GHC installed, you already have ``binary``.
 
 More recent versions of ``binary`` than you might have installed may be
-available. You can use ``cabal-install`` to install a later version from
-[Hackage](http://hackage.haskell.org/package/binary).
-
-    $ cabal update
-    $ cabal install binary
+available from [Hackage](https://hackage.haskell.org/package/binary).
 
 ## Building binary ##
 

binary.cabal

@@ -43,15 +43,15 @@ source-repository head
 library
   build-depends:   base >= 4.9 && < 5, bytestring >= 0.10.4, containers, array
   hs-source-dirs:  src
-  exposed-modules: Data.Binary,
-                   Data.Binary.Put,
-                   Data.Binary.Get,
-                   Data.Binary.Get.Internal,
+  exposed-modules: Data.Binary
+                   Data.Binary.Put
+                   Data.Binary.Get
+                   Data.Binary.Get.Internal
                    Data.Binary.Builder
 
-  other-modules:   Data.Binary.Class,
-                   Data.Binary.Internal,
-                   Data.Binary.Generic,
+  other-modules:   Data.Binary.Class
+                   Data.Binary.Internal
+                   Data.Binary.Generic
                    Data.Binary.FloatCast
 
   ghc-options:     -O2 -Wall -fliberate-case-threshold=1000

src/Data/Binary/Class.hs

@@ -6,7 +6,7 @@
 {-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE Trustworthy #-}
 
 #if MIN_VERSION_base(4,10,0)
 {-# LANGUAGE MultiWayIf #-}
@@ -88,12 +88,15 @@
 
 import Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as L
+#ifdef __GLASGOW_HASKELL__
 import qualified Data.ByteString.Builder.Prim as Prim
+#endif
 
 import Data.List    (unfoldr)
+import qualified Data.List as List
 
 -- And needed for the instances:
-#if MIN_VERSION_base(4,10,0)
+#if defined(__GLASGOW_HASKELL__) && MIN_VERSION_base(4,10,0)
 import Type.Reflection
 import Type.Reflection.Unsafe
 import Data.Kind (Type)
@@ -182,7 +185,7 @@
 
 {-# INLINE defaultPutList #-}
 defaultPutList :: Binary a => [a] -> Put
-defaultPutList xs = put (length xs) <> mapM_ put xs
+defaultPutList xs = put (List.length xs) <> mapM_ put xs
 
 #ifdef HAS_GENERICALLY
 instance (Generic a, GBinaryPut (Rep a), GBinaryGet (Rep a)) => Binary (Generically a) where
@@ -241,93 +244,113 @@
 -- Words8s are written as bytes
 instance Binary Word8 where
     put     = putWord8
+#ifdef __GLASGOW_HASKELL__
     {-# INLINE putList #-}
     putList xs =
         put (length xs)
         <> putBuilder (Prim.primMapListFixed Prim.word8 xs)
+#endif
     get     = getWord8
 
 -- Words16s are written as 2 bytes in big-endian (network) order
 instance Binary Word16 where
     put     = putWord16be
+#ifdef __GLASGOW_HASKELL__
     {-# INLINE putList #-}
     putList xs =
         put (length xs)
         <> putBuilder (Prim.primMapListFixed Prim.word16BE xs)
+#endif
     get     = getWord16be
 
 -- Words32s are written as 4 bytes in big-endian (network) order
 instance Binary Word32 where
     put     = putWord32be
+#ifdef __GLASGOW_HASKELL__
     {-# INLINE putList #-}
     putList xs =
         put (length xs)
         <> putBuilder (Prim.primMapListFixed Prim.word32BE xs)
+#endif
     get     = getWord32be
 
 -- Words64s are written as 8 bytes in big-endian (network) order
 instance Binary Word64 where
     put     = putWord64be
+#ifdef __GLASGOW_HASKELL__
     {-# INLINE putList #-}
     putList xs =
         put (length xs)
         <> putBuilder (Prim.primMapListFixed Prim.word64BE xs)
+#endif
     get     = getWord64be
 
 -- Int8s are written as a single byte.
 instance Binary Int8 where
     put     = putInt8
+#ifdef __GLASGOW_HASKELL__
     {-# INLINE putList #-}
     putList xs =
         put (length xs)
         <> putBuilder (Prim.primMapListFixed Prim.int8 xs)
+#endif
     get     = getInt8
 
 -- Int16s are written as a 2 bytes in big endian format
 instance Binary Int16 where
     put     = putInt16be
+#ifdef __GLASGOW_HASKELL__
     {-# INLINE putList #-}
     putList xs =
         put (length xs)
         <> putBuilder (Prim.primMapListFixed Prim.int16BE xs)
+#endif
     get     = getInt16be
 
 -- Int32s are written as a 4 bytes in big endian format
 instance Binary Int32 where
     put     = putInt32be
+#ifdef __GLASGOW_HASKELL__
     {-# INLINE putList #-}
     putList xs =
         put (length xs)
         <> putBuilder (Prim.primMapListFixed Prim.int32BE xs)
+#endif
     get     = getInt32be
 
 -- Int64s are written as a 8 bytes in big endian format
 instance Binary Int64 where
     put     = putInt64be
+#ifdef __GLASGOW_HASKELL__
     {-# INLINE putList #-}
     putList xs =
         put (length xs)
         <> putBuilder (Prim.primMapListFixed Prim.int64BE xs)
+#endif
     get     = getInt64be
 
 ------------------------------------------------------------------------
 
 -- Words are are written as Word64s, that is, 8 bytes in big endian format
 instance Binary Word where
     put     = putWord64be . fromIntegral
+#ifdef __GLASGOW_HASKELL__
     {-# INLINE putList #-}
     putList xs =
         put (length xs)
         <> putBuilder (Prim.primMapListFixed Prim.word64BE (map fromIntegral xs))
+#endif
     get     = liftM fromIntegral getWord64be
 
 -- Ints are are written as Int64s, that is, 8 bytes in big endian format
 instance Binary Int where
     put     = putInt64be . fromIntegral
+#ifdef __GLASGOW_HASKELL__
     {-# INLINE putList #-}
     putList xs =
         put (length xs)
         <> putBuilder (Prim.primMapListFixed Prim.int64BE (map fromIntegral xs))
+#endif
     get     = liftM fromIntegral getInt64be
 
 ------------------------------------------------------------------------
@@ -347,7 +370,11 @@
 
     {-# INLINE put #-}
     put n | n >= lo && n <= hi =
+#ifdef __GLASGOW_HASKELL__
         putBuilder (Prim.primFixed (Prim.word8 Prim.>*< Prim.int32BE) (0, fromIntegral n))
+#else
+        putWord8 0 <> putInt32be (fromIntegral n)
+#endif
      where
         lo = fromIntegral (minBound :: SmallInt) :: Integer
         hi = fromIntegral (maxBound :: SmallInt) :: Integer
@@ -502,7 +529,7 @@
 -- Char is serialised as UTF-8
 instance Binary Char where
     put = putCharUtf8
-    putList str = put (length str) <> putStringUtf8 str
+    putList str = put (List.length str) <> putStringUtf8 str
     get = do
         let getByte = liftM (fromIntegral :: Word8 -> Int) get
             shiftL6 = flip shiftL 6 :: Int -> Int
@@ -842,7 +869,7 @@
   get = fmap Semigroup.Last get
   put = put . Semigroup.getLast
 
-#if __GLASGOW_HASKELL__ < 901
+#if !MIN_VERSION_base(4,15,0)
 -- | @since 0.8.4.0
 instance Binary a => Binary (Semigroup.Option a) where
   get = fmap Semigroup.Option get
@@ -875,7 +902,7 @@
 ------------------------------------------------------------------------
 -- Typeable/Reflection
 
-#if MIN_VERSION_base(4,10,0)
+#if defined(__GLASGOW_HASKELL__) && MIN_VERSION_base(4,10,0)
 
 -- $typeable-instances
 --

src/Data/Binary/FloatCast.hs

@@ -20,7 +20,23 @@ module Data.Binary.FloatCast
 #if MIN_VERSION_base(4,11,0)
 
 import Data.Word (Word32, Word64)
+#if defined(__GLASGOW_HASKELL__)
 import GHC.Float (castWord32ToFloat, castFloatToWord32, castWord64ToDouble, castDoubleToWord64)
+#elif defined(__MHS__)
+import Primitives (primUnsafeCoerce, primWordToFloatRaw, primWordFromFloatRaw, primWord64ToDoubleRaw, primWord64FromDoubleRaw)
+
+castWord32ToFloat :: Word32 -> Float
+castWord32ToFloat = primWordToFloatRaw . primUnsafeCoerce
+
+castFloatToWord32 :: Float -> Word32
+castFloatToWord32 = primUnsafeCoerce . primWordFromFloatRaw
+
+castWord64ToDouble :: Word64 -> Double
+castWord64ToDouble = primWord64ToDoubleRaw
+
+castDoubleToWord64 :: Double -> Word64
+castDoubleToWord64 = primWord64FromDoubleRaw
+#endif
 
 floatToWord :: Float -> Word32
 floatToWord = castFloatToWord32

src/Data/Binary/Generic.hs

@@ -3,10 +3,6 @@
 {-# LANGUAGE Safe #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-#if __GLASGOW_HASKELL__ >= 800
-#define HAS_DATA_KIND
-#endif
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      : Data.Binary.Generic
@@ -34,9 +30,7 @@ import Data.Proxy
 #if !MIN_VERSION_base(4,11,0)
 import Data.Monoid ((<>))
 #endif
-#ifdef HAS_DATA_KIND
-import Data.Kind
-#endif
+import Data.Kind (Type)
 import GHC.Generics
 import Prelude -- Silence AMP warning.
 
@@ -151,11 +145,7 @@ instance GBinaryPut a => GSumPut (C1 c a) where
 class SumSize f where
     sumSize :: Tagged f Word64
 
-#ifdef HAS_DATA_KIND
 newtype Tagged (s :: Type -> Type) b = Tagged {unTagged :: b}
-#else
-newtype Tagged (s :: * -> *)       b = Tagged {unTagged :: b}
-#endif
 
 instance (SumSize a, SumSize b) => SumSize (a :+: b) where
     sumSize = Tagged $ unTagged (sumSize :: Tagged a Word64) +

src/Data/Binary/Get.hs

@@ -469,7 +469,7 @@ getInt8 = fromIntegral <$> getWord8
 -- force GHC to inline getWordXX
 {-# RULES
 "getWord8/readN" getWord8 = readN 1 B.unsafeHead
-#-}
+ #-}
 
 -- | Read a Word16 in big endian format
 getWord16be :: Get Word16

src/Data/Binary/Internal.hs

@@ -1,9 +1,14 @@
 {-# LANGUAGE CPP #-}
 
-module Data.Binary.Internal 
+module Data.Binary.Internal
  ( accursedUnutterablePerformIO ) where
 
-#if MIN_VERSION_bytestring(0,10,6)
+#if defined(__MHS__)
+import Primitives (primPerformIO)
+
+accursedUnutterablePerformIO :: IO a -> a
+accursedUnutterablePerformIO = primPerformIO
+#elif MIN_VERSION_bytestring(0,10,6)
 import Data.ByteString.Internal( accursedUnutterablePerformIO )
 #else
 import Data.ByteString.Internal( inlinePerformIO )