Skip to content

Commit

Permalink
Add support for ghc-bignum
Browse files Browse the repository at this point in the history 
GHC 9 moved bignum (`Integer` and `Natural`) implementations to a new library,
which exposes new operations. Previously, instances were derived. These new
operations need explicit Categorifier support.
  • Loading branch information
@sellout
sellout committed Jan 14, 2024
1 parent b4a5ba6 commit 620f5b6
Show file tree
Hide file tree
Showing 8 changed files with 749 additions and 1 deletion.
2 changes: 2 additions & 0 deletions cabal.project
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,5 +64,7 @@ packages:
./th/categorifier-th.cabal
if impl(ghc >= 9.0.0)
packages:
./integrations/ghc-bignum/integration/categorifier-ghc-bignum-integration.cabal
./integrations/ghc-bignum/integration-test/categorifier-ghc-bignum-integration-test.cabal
./integrations/linear-base/integration/categorifier-linear-base-integration.cabal
./integrations/linear-base/integration-test/categorifier-linear-base-integration-test.cabal
21 changes: 21 additions & 0 deletions hedgehog/Categorifier/Hedgehog.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,10 @@
module Categorifier.Hedgehog
( floatingEq,
genFloating,
genInteger,
genIntegralBounded,
genNatural,
genNaturalFrom,
)
where

Expand All @@ -11,6 +14,7 @@ import GHC.Stack (HasCallStack, withFrozenCallStack)
import qualified Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Numeric.Natural (Natural)

-- | A variant on `Hedgehog.===` that identifies NaNs as equals. It still works for non-FP types.
floatingEq :: (Hedgehog.MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m ()
Expand Down Expand Up @@ -57,7 +61,24 @@ genFloating =
aroundPosNeg :: a -> a -> [Range.Range a]
aroundPosNeg float size = [aroundFloat float size, aroundFloat (negate float) size]

-- | Generate an arbitrary, potentially quite large, integer.
genInteger :: (Hedgehog.MonadGen m) => m Integer
genInteger = Gen.integral $ Range.linearFrom 0 (-maxUnbounded) maxUnbounded

-- | Like `Gen.enumBounded`, but safe for integral types larger than `Int`
-- (which can vary based on the platform).
genIntegralBounded :: (Hedgehog.MonadGen m, Bounded a, Integral a) => m a
genIntegralBounded = Gen.integral Range.linearBounded

-- | Arbitrary large value for bounding unbounded integral types.
maxUnbounded :: (Integral a) => a
maxUnbounded = 10 ^ (100 :: Natural)

-- | Like `genNatural`, but takes a lower bound. This is useful for eliminating invalid cases for
-- things like subtraction.
genNaturalFrom :: (Hedgehog.MonadGen m) => Natural -> m Natural
genNaturalFrom lowerBound = Gen.integral $ Range.linear lowerBound maxUnbounded

-- | Generate an arbitrary, potentially quite large, non-negative number.
genNatural :: (Hedgehog.MonadGen m) => m Natural
genNatural = genNaturalFrom 0
179 changes: 179 additions & 0 deletions integrations/ghc-bignum/integration-test/Categorifier/Test/GhcBignum.hs
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,179 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE MagicHash #-}
-- To avoid having to specify massive HList types.
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TupleSections #-}
-- To avoid having to specify massive HList types.
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}

module Categorifier.Test.GhcBignum
( testTerms,
)
where

import Categorifier.Test.HList (HMap1 (..))
import Categorifier.Test.TH (mkBinaryTestConfig, mkUnaryTestConfig)
import Categorifier.Test.Tests (TestTerms, insertTest)
import Data.Proxy (Proxy (..))
import GHC.Num.Integer (Integer)
import qualified GHC.Num.Integer
import GHC.Num.Natural (Natural)
import qualified GHC.Num.Natural

testTerms :: TestTerms _
testTerms =
insertTest
(Proxy @"EqualInteger")
mkBinaryTestConfig
(\() -> ([t|Integer|], [t|Integer -> Bool|]))
[|GHC.Num.Integer.integerEq|]
. insertTest
(Proxy @"NotEqualInteger")
mkBinaryTestConfig
(\() -> ([t|Integer|], [t|Integer -> Bool|]))
[|GHC.Num.Integer.integerNe|]
. insertTest
(Proxy @"GeInteger")
mkBinaryTestConfig
(\() -> ([t|Integer|], [t|Integer -> Bool|]))
[|GHC.Num.Integer.integerGe|]
. insertTest
(Proxy @"GtInteger")
mkBinaryTestConfig
(\() -> ([t|Integer|], [t|Integer -> Bool|]))
[|GHC.Num.Integer.integerGt|]
. insertTest
(Proxy @"LeInteger")
mkBinaryTestConfig
(\() -> ([t|Integer|], [t|Integer -> Bool|]))
[|GHC.Num.Integer.integerLe|]
. insertTest
(Proxy @"LtInteger")
mkBinaryTestConfig
(\() -> ([t|Integer|], [t|Integer -> Bool|]))
[|GHC.Num.Integer.integerLt|]
. insertTest
(Proxy @"CompareInteger")
mkBinaryTestConfig
(\() -> ([t|Integer|], [t|Integer -> Ordering|]))
[|GHC.Num.Integer.integerCompare|]
. insertTest
(Proxy @"PlusInteger")
mkBinaryTestConfig
(\() -> ([t|Integer|], [t|Integer -> Integer|]))
[|GHC.Num.Integer.integerAdd|]
. insertTest
(Proxy @"MinusInteger")
mkBinaryTestConfig
(\() -> ([t|Integer|], [t|Integer -> Integer|]))
[|GHC.Num.Integer.integerSub|]
. insertTest
(Proxy @"TimesInteger")
mkBinaryTestConfig
(\() -> ([t|Integer|], [t|Integer -> Integer|]))
[|GHC.Num.Integer.integerMul|]
. insertTest
(Proxy @"NegateInteger")
mkUnaryTestConfig
(\() -> ([t|Integer|], [t|Integer|]))
[|GHC.Num.Integer.integerNegate|]
. insertTest
(Proxy @"AbsInteger")
mkUnaryTestConfig
(\() -> ([t|Integer|], [t|Integer|]))
[|GHC.Num.Integer.integerNegate|]
. insertTest
(Proxy @"SignumInteger")
mkUnaryTestConfig
(\() -> ([t|Integer|], [t|Integer|]))
[|GHC.Num.Integer.integerSignum|]
. insertTest
(Proxy @"QuotInteger")
mkBinaryTestConfig
(\() -> ([t|Integer|], [t|Integer -> Integer|]))
[|GHC.Num.Integer.integerQuot|]
. insertTest
(Proxy @"RemInteger")
mkBinaryTestConfig
(\() -> ([t|Integer|], [t|Integer -> Integer|]))
[|GHC.Num.Integer.integerRem|]
. insertTest
(Proxy @"EqualNatural")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Bool|]))
[|GHC.Num.Natural.naturalEq|]
. insertTest
(Proxy @"NotEqualNatural")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Bool|]))
[|GHC.Num.Natural.naturalNe|]
. insertTest
(Proxy @"GeNatural")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Bool|]))
[|GHC.Num.Natural.naturalGe|]
. insertTest
(Proxy @"GtNatural")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Bool|]))
[|GHC.Num.Natural.naturalGt|]
. insertTest
(Proxy @"LeNatural")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Bool|]))
[|GHC.Num.Natural.naturalLe|]
. insertTest
(Proxy @"LtNatural")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Bool|]))
[|GHC.Num.Natural.naturalLt|]
. insertTest
(Proxy @"CompareNatural")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Ordering|]))
[|GHC.Num.Natural.naturalCompare|]
. insertTest
(Proxy @"PlusNatural")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Natural|]))
[|GHC.Num.Natural.naturalAdd|]
. insertTest
(Proxy @"MinusNaturalThrow")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Natural|]))
[|GHC.Num.Natural.naturalSubThrow|]
. insertTest
(Proxy @"MinusNaturalUnsafe")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Natural|]))
[|GHC.Num.Natural.naturalSubUnsafe|]
. insertTest
(Proxy @"TimesNatural")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Natural|]))
[|GHC.Num.Natural.naturalMul|]
. insertTest
(Proxy @"SignumNatural")
mkUnaryTestConfig
(\() -> ([t|Natural|], [t|Natural|]))
[|GHC.Num.Natural.naturalSignum|]
. insertTest
(Proxy @"NegateNatural")
mkUnaryTestConfig
(\() -> ([t|Natural|], [t|Natural|]))
[|GHC.Num.Natural.naturalNegate|]
. insertTest
(Proxy @"QuotNatural")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Natural|]))
[|GHC.Num.Natural.naturalQuot|]
. insertTest
(Proxy @"RemNatural")
mkBinaryTestConfig
(\() -> ([t|Natural|], [t|Natural -> Natural|]))
[|GHC.Num.Natural.naturalRem|]
$ HEmpty1
118 changes: 118 additions & 0 deletions integrations/ghc-bignum/integration-test/categorifier-ghc-bignum-integration-test.cabal
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,118 @@
cabal-version: 2.4

name: categorifier-ghc-bignum-integration-test
version: 0.1
description: Test utilities for Categorifier's `ghc-bignum` integration.
homepage: https://github.com/con-kitty/categorifier#readme
bug-reports: https://github.com/con-kitty/categorifier/issues
build-type: Simple
tested-with: GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8

source-repository head
type: git
location: https://github.com/con-kitty/categorifier

common options
ghc-options:
-- make it possible to inline almost anything
-fexpose-all-unfoldings
-- ensure unfoldings are available
-fno-omit-interface-pragmas
-Wall

library
exposed-modules:
Categorifier.Test.GhcBignum
build-depends:
, base >=4.13.0 && <4.17
, categorifier-plugin-test
, ghc-bignum >=1.0 && <1.4
default-language: Haskell2010
default-extensions:
InstanceSigs
, ScopedTypeVariables
, TypeApplications
, FlexibleContexts
, FlexibleInstances
, FunctionalDependencies
, LambdaCase
, TypeOperators
, BangPatterns
, StandaloneDeriving
, DeriveGeneric
, DeriveDataTypeable
, DeriveFunctor
, DeriveFoldable
, DeriveTraversable
, DerivingStrategies

test-suite ghc-bignum-hierarchy
import: options
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: GhcBignum/Main.hs
ghc-options:
-fplugin Categorifier
-fplugin-opt Categorifier:defer-failures
-fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCat.classHierarchy
-fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCatExtensions.hierarchy
-fplugin-opt Categorifier:lookup:Categorifier.GhcBignum.Integration.symbolLookup
-fplugin-opt Categorifier:lookup:Categorifier.Core.MakerMap.baseSymbolLookup
-fplugin-opt Categorifier:maker-map:Categorifier.GhcBignum.Integration.makerMapFun
-fplugin-opt Categorifier:maker-map:Categorifier.Core.MakerMap.baseMakerMapFun
-O0
build-depends:
, base >=4.13.0 && <4.17
, categorifier-category
, categorifier-client
, categorifier-concat-extensions-category
, categorifier-concat-extensions-integration
, categorifier-concat-extensions-integration-test
, categorifier-concat-integration
, categorifier-concat-integration-test
, categorifier-hedgehog
, categorifier-ghc-bignum-integration
, categorifier-ghc-bignum-integration-test
, categorifier-plugin
, categorifier-plugin-test
, concat-classes
, ghc-bignum >=1.0 && <1.4
, ghc-prim >=0.5.3 && <0.9
, hedgehog >=1.0.3 && <1.3
, template-haskell >=2.15.0 && <2.19

test-suite ghc-bignum-hierarchy-optimized
import: options
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: GhcBignum/Main.hs
ghc-options:
-fplugin Categorifier
-fplugin-opt Categorifier:defer-failures
-fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCat.classHierarchy
-fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCatExtensions.hierarchy
-fplugin-opt Categorifier:lookup:Categorifier.GhcBignum.Integration.symbolLookup
-fplugin-opt Categorifier:lookup:Categorifier.Core.MakerMap.baseSymbolLookup
-fplugin-opt Categorifier:maker-map:Categorifier.GhcBignum.Integration.makerMapFun
-fplugin-opt Categorifier:maker-map:Categorifier.Core.MakerMap.baseMakerMapFun
-O2
-fignore-interface-pragmas
build-depends:
, base >=4.13.0 && <4.17
, categorifier-category
, categorifier-client
, categorifier-concat-extensions-category
, categorifier-concat-extensions-integration
, categorifier-concat-extensions-integration-test
, categorifier-concat-integration
, categorifier-concat-integration-test
, categorifier-hedgehog
, categorifier-ghc-bignum-integration
, categorifier-ghc-bignum-integration-test
, categorifier-plugin
, categorifier-plugin-test
, concat-classes
, ghc-bignum >=1.0 && <1.4
, ghc-prim >=0.5.3 && <0.9
, hedgehog >=1.0.3 && <1.3
, template-haskell >=2.15.0 && <2.19
Loading

0 comments on commit 620f5b6

Please sign in to comment.