Skip to content
Snippets Groups Projects
Commit 3416f138 authored by Matt Walker's avatar Matt Walker
Browse files

Rename

parent 3ccb70d6
No related branches found
No related tags found
No related merge requests found
{
# inspired by: https://serokell.io/blog/practical-nix-flakes#packaging-existing-applications
description = "A Hello World in Haskell with a dependency and a devShell";
description = "A package for using property-based tests (PBTs) on GHC.";
inputs.nixpkgs.url = "nixpkgs";
outputs = { self, nixpkgs }:
let
......@@ -13,18 +13,18 @@
in
{
overlay = (final: prev: {
ghc-tests = final.haskell.packages.ghc94.callCabal2nix "ghc-tests" ./. { };
ghc-pbts = final.haskell.packages.ghc94.callCabal2nix "ghc-pbts" ./. { };
});
packages = forAllSystems (system: {
ghc-tests = nixpkgsFor.${system}.ghc-tests;
ghc-pbts = nixpkgsFor.${system}.ghc-pbts;
});
defaultPackage = forAllSystems (system: self.packages.${system}.ghc-tests);
defaultPackage = forAllSystems (system: self.packages.${system}.ghc-pbts);
checks = self.packages;
devShell = forAllSystems (system:
let haskellPackages = nixpkgsFor.${system}.haskell.packages.ghc94;
in
haskellPackages.shellFor {
packages = p: [ self.packages.${system}.ghc-tests ];
packages = p: [ self.packages.${system}.ghc-pbts ];
withHoogle = true;
buildInputs = with haskellPackages; [
haskell-language-server
......
......@@ -25,8 +25,6 @@ test-suite ghc-pbts
type: exitcode-stdio-1.0
build-depends: base,
falsify,
ghc-prim,
ghc,
mtl,
process,
tasty,
......@@ -41,7 +39,7 @@ test-suite ghc-pbts
build-depends: base >=4.14.1.0 && <5
hs-source-dirs: tests
default-language: Haskell2010
ghc-options: -threaded "-with-rtsopts=-qg -N" -dcore-lint
ghc-options: -threaded "-with-rtsopts=-qg -N" -O2
if arch(i386)
-- For reliable floating point results on i386
......
......@@ -2,8 +2,6 @@
module Main where
import System.Exit
import Pbt.Main qualified as Pbt
import Test.Tasty (
......
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Pbt.Expr.Utility where
import Data.Ratio ((%))
import Pbt.Expr
import Pbt.Expr (
Binder (..),
Context (..),
Expr (..),
Id (..),
Size,
SomeScopedId,
SomeTypeProxy,
)
import Test.Falsify.Generator (Gen)
import Type.Reflection (Typeable, eqTypeRep, typeRep, type (:~~:) (HRefl))
import Type.Reflection (
Typeable,
eqTypeRep,
typeRep,
type (:~~:) (..),
)
-- * Utility Functions over @Expr@
......@@ -37,6 +48,7 @@ occurs ident@(Id name _) (Var (Id name' _)) = name == name'
occurs _ (Lit _) = False
occurs ident (App f x) = occurs ident f || occurs ident x
-- FIXME: make invariant under beta-reduction!
isConstantFunction :: Expr a -> Bool
isConstantFunction (Lam (Wild ident) body) = not $ occurs ident body
isConstantFunction e = False
......@@ -81,16 +93,18 @@ countUsedLocalVars (App f x) =
countUsedLocalVars f + countUsedLocalVars x
countUsedLocalVars _ = 0
-- TODO: Implement
-- FIXME: Implement
countUsedGlobalVars :: Expr a -> Int
countUsedGlobalVars e = undefined
-- @True@ iff the result of @betaReduce e@ is a @Lit@.
reducesToLiteral :: Expr a -> Bool
reducesToLiteral e =
case betaReduce e of
Lit _ -> True
_ -> False
-- | Replace @ident@ with @replacee@ in @e@.
replace :: (Typeable a, Typeable b) => Id a -> Expr a -> Expr b -> Expr b
replace (Id ident _ :: Id a) (replacee :: Expr a) e@(Var (Id var _) :: Expr b)
| ident == var =
......
......@@ -5,7 +5,6 @@
module Pbt.Main (main) where
import Control.Concurrent (threadDelay)
import Control.Monad (replicateM)
import Data.Proxy (Proxy (..))
import Data.Text.IO qualified as Text
......@@ -108,10 +107,11 @@ guardBy p g = do
x <- g
if p x then pure x else guardBy p g
averageBy :: (a -> Double) -> [a] -> Double
averageBy f xs = sum (f <$> xs) / fromIntegral (length xs)
main :: IO ()
main = do
threadDelay 10000
putStrLn ""
let functions1 =
[ SomeScopedId iadd
, SomeScopedId isucc
......@@ -169,4 +169,4 @@ main = do
}
writeModuleFile True s
writeModuleFile False s{expressions = betaReduce <$> take 100 examples}
putStrLn ("Average utility was: " <> show (sum (utility1 <$> examples) / fromIntegral (length examples)))
\ No newline at end of file
putStrLn ("Average utility was: " <> show (averageBy utility1 examples))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment