feat[core]: Function Property: Argument modification

This commit is contained in:
vegowotenks 2025-08-17 18:19:00 +02:00
parent a38a20a546
commit c78ed4ac90
12 changed files with 138 additions and 3 deletions

View file

@ -29,6 +29,7 @@ default-extensions:
dependencies: dependencies:
- base - base
- containers - containers
- leancheck
- text - text
- vector - vector
- QuickCheck - QuickCheck
@ -64,3 +65,5 @@ tests:
- scalie - scalie
- tasty - tasty
- tasty-quickcheck - tasty-quickcheck
- tasty-leancheck
- template-haskell

View file

@ -19,6 +19,7 @@ extra-source-files:
library library
exposed-modules: exposed-modules:
Data.Enum.Util
Data.Map.Implicit Data.Map.Implicit
Language.Scalie.Bytecode.Instruction Language.Scalie.Bytecode.Instruction
Language.Scalie.Bytecode.Object Language.Scalie.Bytecode.Object
@ -39,6 +40,8 @@ library
Language.Scalie.Core.Provenance Language.Scalie.Core.Provenance
Language.Scalie.Core.Provenance.SourceLocation Language.Scalie.Core.Provenance.SourceLocation
Language.Scalie.Domain.Type Language.Scalie.Domain.Type
Language.Scalie.Domain.Type.Function
Language.Scalie.Domain.Type.Function.ArgumentModification
other-modules: other-modules:
Paths_scalie Paths_scalie
hs-source-dirs: hs-source-dirs:
@ -55,6 +58,7 @@ library
QuickCheck QuickCheck
, base , base
, containers , containers
, leancheck
, text , text
, vector , vector
default-language: Haskell2010 default-language: Haskell2010
@ -77,6 +81,7 @@ executable scalie-exe
QuickCheck QuickCheck
, base , base
, containers , containers
, leancheck
, scalie , scalie
, text , text
, vector , vector
@ -87,7 +92,10 @@ test-suite scalie-test
main-is: Spec.hs main-is: Spec.hs
other-modules: other-modules:
Test.Data.Map.Implicit Test.Data.Map.Implicit
Test.Language.Scalie.Domain.Type.Function.ArgumentModification
Test.QuickCheck.Isomorphic
Test.QuickCheck.Roundtrip Test.QuickCheck.Roundtrip
Test.Tasty.TH
Paths_scalie Paths_scalie
hs-source-dirs: hs-source-dirs:
test test
@ -103,9 +111,12 @@ test-suite scalie-test
QuickCheck QuickCheck
, base , base
, containers , containers
, leancheck
, scalie , scalie
, tasty , tasty
, tasty-leancheck
, tasty-quickcheck , tasty-quickcheck
, template-haskell
, text , text
, vector , vector
default-language: Haskell2010 default-language: Haskell2010

5
src/Data/Enum/Util.hs Normal file
View file

@ -0,0 +1,5 @@
{-# LANGUAGE Safe #-}
module Data.Enum.Util (enumerate) where
enumerate :: (Enum a, Bounded a) => [a]
enumerate = [minBound .. maxBound]

View file

@ -4,17 +4,25 @@ module Language.Scalie.Domain.Type (Type(..)) where
import Data.Kind qualified import Data.Kind qualified
import Test.QuickCheck (Arbitrary (arbitrary), Gen, oneof) import Test.QuickCheck (Arbitrary (arbitrary), Gen, oneof)
import Language.Scalie.Domain.Type.Function qualified as Type
-- | The type of an expression in Scalie, not to be confused with the 'Type' provided by GHC -- | The type of an expression in Scalie, not to be confused with the 'Type' provided by GHC
type Type :: Data.Kind.Type type Type :: Data.Kind.Type
data Type data Type
= RawInt = RawInt
| RawRational
| RawString
| Function Type.Function
deriving stock (Show, Read, Eq) deriving stock (Show, Read, Eq)
-- add to the arbitrary instance when defining constructors -- add to the arbitrary instance when defining constructors
instance Arbitrary Type where instance Arbitrary Type where
arbitrary :: Gen Type arbitrary :: Gen Type
arbitrary = oneof [ pure RawInt ] arbitrary = oneof
[ pure RawInt
, pure RawRational
, pure RawString
]

View file

@ -0,0 +1,9 @@
{-# LANGUAGE Safe #-}
module Language.Scalie.Domain.Type (Type) where
import Data.Kind qualified
type Type :: Data.Kind.Type
data Type
instance Show Type
instance Read Type
instance Eq Type

View file

@ -0,0 +1,18 @@
{-# LANGUAGE Safe #-}
module Language.Scalie.Domain.Type.Function (Function(..)) where
-- meta
import Data.Kind qualified
-- scalie
import Language.Scalie.Domain.Type.Function.ArgumentModification (ArgumentModification)
import {-# SOURCE #-} Language.Scalie.Domain.Type qualified as Scalie.Domain
type Function :: Data.Kind.Type
data Function = Function
{ argument :: Scalie.Domain.Type
, result :: Scalie.Domain.Type
, argumentModification :: ArgumentModification
}
deriving stock (Show, Read, Eq)

View file

@ -0,0 +1,26 @@
{-# LANGUAGE Trustworthy #-} -- leancheck import somehow is not safe
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE InstanceSigs #-}
module Language.Scalie.Domain.Type.Function.ArgumentModification (ArgumentModification(..), toBool, fromBool) where
import Data.Kind qualified
import Test.LeanCheck (Listable (list))
import Data.Enum.Util (enumerate)
type ArgumentModification :: Data.Kind.Type
data ArgumentModification
= PureArguments
| LinearArguments
deriving stock (Show, Read, Eq, Ord, Enum, Bounded)
toBool :: ArgumentModification -> Bool
toBool = \case
PureArguments -> False
LinearArguments -> True
fromBool :: Bool -> ArgumentModification
fromBool = toEnum . fromEnum
instance Listable ArgumentModification where
list :: [ArgumentModification]
list = enumerate

View file

@ -1,10 +1,16 @@
{-# LANGUAGE Unsafe #-} -- unsafe: Uses functions imported from unsafe modules {-# LANGUAGE Unsafe #-} -- unsafe: Uses functions imported from unsafe modules
import Test.Data.Map.Implicit qualified
-- library
import Test.Tasty qualified as Tasty import Test.Tasty qualified as Tasty
-- test groups
import Test.Data.Map.Implicit qualified
import Test.Language.Scalie.Domain.Type.Function.ArgumentModification qualified
main :: IO () main :: IO ()
main = Tasty.defaultMain $ Tasty.testGroup "all" main = Tasty.defaultMain $ Tasty.testGroup "all"
[ Tasty.testGroup "Properties" [ Tasty.testGroup "Properties"
[ Test.Data.Map.Implicit.testGroup [ Test.Data.Map.Implicit.testGroup
, Test.Language.Scalie.Domain.Type.Function.ArgumentModification.testGroup
] ]
] ]

View file

@ -18,6 +18,7 @@ import Test.Tasty.QuickCheck (QuickCheckMaxSize(QuickCheckMaxSize))
import Test.Tasty qualified as Tasty import Test.Tasty qualified as Tasty
import Test.Tasty.QuickCheck qualified as Tasty.QuickCheck import Test.Tasty.QuickCheck qualified as Tasty.QuickCheck
import Test.Tasty.TH (moduleName)
-- | This is testworthy since I have somehow hand-hacked the read/show de/serialization of 'ImplicitMap' -- | This is testworthy since I have somehow hand-hacked the read/show de/serialization of 'ImplicitMap'
@ -33,4 +34,4 @@ allTests = $allProperties
testGroup :: TestTree testGroup :: TestTree
testGroup = Tasty.localOption (QuickCheckMaxSize 25) -- it is necessary to restrain the size because the generated core would get veeeeeery big otherwise testGroup = Tasty.localOption (QuickCheckMaxSize 25) -- it is necessary to restrain the size because the generated core would get veeeeeery big otherwise
$ Tasty.QuickCheck.testProperties "Data.Map.Implicit" allTests $ Tasty.QuickCheck.testProperties $moduleName allTests

View file

@ -0,0 +1,32 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TemplateHaskell #-}
module Test.Language.Scalie.Domain.Type.Function.ArgumentModification (testGroup) where
import Language.Scalie.Domain.Type.Function.ArgumentModification (ArgumentModification, toBool, fromBool)
-- library: QuickCheck
import Test.QuickCheck.Roundtrip (roundtrips)
import Test.QuickCheck.Isomorphic (isomorphic)
-- library: Tasty
import Test.Tasty (TestTree)
import Test.Tasty.TH (moduleName)
import Test.Tasty qualified as Tasty
import Test.Tasty.LeanCheck qualified as Tasty.LeanCheck
prop_toFromBoolRoundtrips :: Bool -> Bool
prop_toFromBoolRoundtrips = roundtrips toBool fromBool
prop_IsoToBoolEnumConversion :: ArgumentModification -> Bool
prop_IsoToBoolEnumConversion = isomorphic toBool (toEnum . fromEnum)
prop_IsoFromBoolEnumConversion :: Bool -> Bool
prop_IsoFromBoolEnumConversion = isomorphic fromBool (toEnum . fromEnum)
testGroup :: TestTree
testGroup = Tasty.testGroup $moduleName
[ Tasty.LeanCheck.testProperty "id ≡ toBool . fromBool" prop_toFromBoolRoundtrips
, Tasty.LeanCheck.testProperty "toBool ≡ toEnum . fromEnum" prop_IsoToBoolEnumConversion
, Tasty.LeanCheck.testProperty "fromBool ≡ toEnum . fromEnum" prop_IsoFromBoolEnumConversion
]

View file

@ -0,0 +1,5 @@
{-# LANGUAGE Safe #-}
module Test.QuickCheck.Isomorphic (isomorphic) where
isomorphic :: Eq a => (t -> a) -> (t -> a) -> t -> Bool
isomorphic f g x = f x == g x

11
test/Test/Tasty/TH.hs Normal file
View file

@ -0,0 +1,11 @@
{-# LANGUAGE Safe #-} -- does template haskell, but no IO inside it
module Test.Tasty.TH (moduleName) where
import Language.Haskell.TH.Lib (thisModule)
import Language.Haskell.TH.Syntax (Q, Exp(LitE), ModName(ModName), Lit(StringL), Module (Module))
moduleName :: Q Exp
moduleName = do
Module _ (ModName name) <- thisModule
pure . LitE . StringL $ name