Skip to content

Commit 868b732

Browse files
committed
WIP: merge linear-dest back into linear-base
Current status: build successfully using stock ghc version
1 parent a78d659 commit 868b732

File tree

58 files changed

+203881
-5
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

58 files changed

+203881
-5
lines changed

.gitattributes

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
ghc*.tar.xz filter=lfs diff=lfs merge=lfs -text

.github/workflows/ci.yaml

Lines changed: 50 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,10 @@ env:
44
# Bump this number to invalidate the Github-actions cache
55
cache-invalidation-key: 0
66
nixpkgs-url: https://github.com/NixOS/nixpkgs/archive/574d1eac1c200690e27b8eb4e24887f8df7ac27c.tar.gz
7+
NIX_PATH: https://github.com/NixOS/nixpkgs/archive/574d1eac1c200690e27b8eb4e24887f8df7ac27c.tar.gz
8+
ghc-exe: $(pwd)/ghc-dps-compact-702220602b/bin/ghc
9+
ghc-name: ghc-dps-compact-702220602b
10+
ghc-internal-name: ghc-9.11.20240917-x86_64-unknown-linux
711

812
jobs:
913
cabal-test:
@@ -13,7 +17,9 @@ jobs:
1317
ghc-version: [96, 98, 910]
1418
runs-on: ubuntu-latest
1519
steps:
16-
- uses: actions/checkout@v2
20+
- uses: actions/checkout@v3
21+
with:
22+
lfs: false
1723
- uses: cachix/install-nix-action@v15
1824
with:
1925
nix_path: "${{ env.nixpkgs-url }}"
@@ -52,11 +58,50 @@ jobs:
5258
benchmark_ghc${{ matrix.ghc-version }}.txt
5359
retention-days: 90
5460

61+
cabal-test-ghc-dps-compact:
62+
name: cabal test - ${{ env.ghc-name }}
63+
runs-on: [self-hosted, Linux, X64]
64+
steps:
65+
- uses: actions/checkout@v3
66+
with:
67+
lfs: true
68+
- name: Checkout LFS objects
69+
run: git lfs checkout
70+
- name: Build Nix dependencies
71+
run: nix-shell --arg installHls 'false' --pure --run "echo '=== Nix dependencies installed ==='"
72+
- name: Install custom GHC
73+
run: nix-shell --pure --run "rm -rf ${{ env.ghc-name }} ${{ env.ghc-internal-name }} && tar xJf ${{ env.ghc-name }}.tar.xz && mv ${{ env.ghc-internal-name }} ${{ env.ghc-name }}"
74+
- name: Init Cabal's config file
75+
run: nix-shell --arg installHls 'false' --pure --run "cabal --config-file=$HOME/.cabal/config user-config -f init"
76+
- name: Update Cabal's database
77+
run: nix-shell --arg installHls 'false' --pure --run "cabal update"
78+
- name: Build Cabal's dependencies
79+
run: nix-shell --arg installHls 'false' --pure --run "cabal build -w ${{ env.ghc-exe }} --dependencies-only"
80+
- name: Build
81+
run: nix-shell --arg installHls 'false' --pure --run "cabal build -w ${{ env.ghc-exe }}"
82+
- name: Haddock
83+
run: nix-shell --arg installHls 'false' --pure --run "cabal haddock -w ${{ env.ghc-exe }}"
84+
- name: cabal-docspec
85+
run: nix-shell --arg installHls 'false' --pure --run "cabal-docspec -w ${{ env.ghc-exe }}"
86+
- name: Build benchmarks
87+
run: nix-shell --arg installHls 'false' --pure --run "cabal build linear-base:bench:bench"
88+
- name: Run benchmarks
89+
run: nix-shell --arg installHls 'false' --pure --run "cabal bench 2>&1 | tee benchmark_${{ env.ghc-name }}.txt"
90+
- name: Upload benchmark results
91+
uses: actions/upload-artifact@v3
92+
with:
93+
name: linear-base_benchmarks_${{ env.ghc-name }}
94+
path: |
95+
benchmark_${{ env.ghc-name }}.txt
96+
retention-days: 90
97+
5598
ormolu:
5699
name: check formatting with ormolu
57100
runs-on: ubuntu-latest
58101
steps:
59-
- uses: actions/checkout@v2
102+
- uses: actions/checkout@v3
103+
with:
104+
lfs: false
60105
- uses: cachix/install-nix-action@v15
61106
with:
62107
nix_path: "${{ env.nixpkgs-url }}"
@@ -75,7 +120,9 @@ jobs:
75120
name: stack build
76121
runs-on: ubuntu-latest
77122
steps:
78-
- uses: actions/checkout@v2
123+
- uses: actions/checkout@v3
124+
with:
125+
lfs: false
79126
- uses: cachix/install-nix-action@v15
80127
with:
81128
nix_path: "${{ env.nixpkgs-url }}"

.gitignore

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,3 +22,5 @@ cabal.sandbox.config
2222
.stack-work/
2323
cabal.project.local
2424
.HTF/
25+
26+
ghc-dps-compact-702220602b
Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
module Bench.Compact where
2+
3+
import Test.Tasty.Bench
4+
5+
import Bench.Compact.BFTraversal (bftraversalBenchgroup)
6+
import Bench.Compact.Map (mapBenchgroup)
7+
import Bench.Compact.DList (dlistBenchgroup)
8+
import Bench.Compact.Queue (queueBenchgroup)
9+
import Bench.Compact.SExpr (sexprBenchgroup)
10+
11+
benchmarks :: Benchmark
12+
benchmarks =
13+
bgroup
14+
"DPS interface for compact regions"
15+
[ bftraversalBenchgroup
16+
, mapBenchgroup
17+
, dlistBenchgroup
18+
, queueBenchgroup
19+
, sexprBenchgroup
20+
]
Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
module Bench.Compact.BFTraversal where
2+
3+
import Compact.BFTraversal as BFTraversal
4+
import Bench.Compact.Utils as Utils
5+
import Control.Exception (evaluate)
6+
import Control.DeepSeq (force)
7+
import Test.Tasty.Bench (Benchmark)
8+
9+
dataSets :: [(IO (BinTree ()), String)]
10+
dataSets =
11+
[ (evaluate $ force (go 0 10), "2^10")
12+
, (evaluate $ force (go 0 13), "2^13")
13+
, (evaluate $ force (go 0 16), "2^16")
14+
, (evaluate $ force (go 0 19), "2^19")
15+
, (evaluate $ force (go 0 22), "2^22")
16+
]
17+
where
18+
go :: Int -> Int -> BinTree ()
19+
go currentDepth maxDepth =
20+
if currentDepth >= maxDepth
21+
then Nil
22+
else Node () (go (currentDepth + 1) maxDepth) (go (currentDepth + 1) maxDepth)
23+
24+
bftraversalBenchgroup = Utils.benchImpls BFTraversal.impls dataSets
Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
module Bench.Compact.DList where
2+
3+
import Compact.DList as DList
4+
import Bench.Compact.Utils as Utils
5+
import Control.Exception (evaluate)
6+
import Control.DeepSeq (force)
7+
import Test.Tasty.Bench (Benchmark)
8+
9+
dataSets :: [(IO [[Int]], String)]
10+
dataSets =
11+
[ (evaluate $ force (fmap (\i -> [(10 * i + 0)..(10 * i + 9)]) [0..(((2^10) `div` 10) - 1)]), "2^10")
12+
, (evaluate $ force (fmap (\i -> [(10 * i + 0)..(10 * i + 9)]) [0..(((2^13) `div` 10) - 1)]), "2^13")
13+
, (evaluate $ force (fmap (\i -> [(10 * i + 0)..(10 * i + 9)]) [0..(((2^16) `div` 10) - 1)]), "2^16")
14+
, (evaluate $ force (fmap (\i -> [(10 * i + 0)..(10 * i + 9)]) [0..(((2^19) `div` 10) - 1)]), "2^19")
15+
, (evaluate $ force (fmap (\i -> [(10 * i + 0)..(10 * i + 9)]) [0..(((2^22) `div` 10) - 1)]), "2^22")
16+
]
17+
18+
dlistBenchgroup = benchImpls DList.impls dataSets
Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
{-# LANGUAGE LinearTypes #-}
2+
module Bench.Compact.Map where
3+
4+
import Compact.Map as Map
5+
import Bench.Compact.Utils as Utils
6+
import Control.Exception (evaluate)
7+
import Control.DeepSeq (force)
8+
import Test.Tasty.Bench (Benchmark)
9+
10+
dataSets :: [(IO (Int %1 -> Int, [Int]), String)]
11+
dataSets =
12+
[ ((\x -> 2 * x + 1,) <$> (evaluate $ force [1 .. 2^10]), "2^10")
13+
, ((\x -> 2 * x + 1,) <$> (evaluate $ force [1 .. 2^13]), "2^13")
14+
, ((\x -> 2 * x + 1,) <$> (evaluate $ force [1 .. 2^16]), "2^16")
15+
, ((\x -> 2 * x + 1,) <$> (evaluate $ force [1 .. 2^19]), "2^19")
16+
, ((\x -> 2 * x + 1,) <$> (evaluate $ force [1 .. 2^22]), "2^22")
17+
]
18+
19+
mapBenchgroup = benchImpls Map.impls dataSets
Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
module Bench.Compact.Queue where
2+
3+
import Compact.Queue as Queue
4+
import Bench.Compact.Utils as Utils
5+
import Control.Exception (evaluate)
6+
import Control.DeepSeq (force)
7+
import Test.Tasty.Bench (Benchmark)
8+
9+
dataSets :: [(IO Word64, String)]
10+
dataSets =
11+
[ (return $ 2^10, "2^10")
12+
, (return $ 2^13, "2^13")
13+
, (return $ 2^16, "2^16")
14+
, (return $ 2^19, "2^19")
15+
, (return $ 2^22, "2^22")
16+
]
17+
18+
queueBenchgroup = benchImpls Queue.impls dataSets
Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
module Bench.Compact.SExpr where
2+
3+
import Compact.SExpr as SExpr
4+
import Bench.Compact.Utils as Utils
5+
import Control.Exception (evaluate)
6+
import Control.DeepSeq (force)
7+
import qualified Data.ByteString.Char8 as BSC
8+
import Test.Tasty.Bench (Benchmark)
9+
10+
dataSetDir :: String
11+
dataSetDir = "bench-version-changes/ghc-dps-compact/after/datasets/"
12+
13+
dataSets :: [(IO ByteString, String)]
14+
dataSets =
15+
[ (evaluate . force =<< BSC.readFile (dataSetDir ++ "data_2_10.sexpr"), "2^10")
16+
, (evaluate . force =<< BSC.readFile (dataSetDir ++ "data_2_13.sexpr"), "2^13")
17+
, (evaluate . force =<< BSC.readFile (dataSetDir ++ "data_2_16.sexpr"), "2^16")
18+
, (evaluate . force =<< BSC.readFile (dataSetDir ++ "data_2_19.sexpr"), "2^19")
19+
, (evaluate . force =<< BSC.readFile (dataSetDir ++ "data_2_22.sexpr"), "2^22")
20+
]
21+
22+
sexprBenchgroup = Utils.benchImpls SExpr.impls dataSets
Lines changed: 80 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,80 @@
1+
{-# LANGUAGE LinearTypes #-}
2+
{-# LANGUAGE AllowAmbiguousTypes #-}
3+
{-# LANGUAGE DataKinds #-}
4+
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE ImpredicativeTypes #-}
6+
{-# LANGUAGE KindSignatures #-}
7+
{-# LANGUAGE ScopedTypeVariables #-}
8+
9+
module Bench.Compact.Utils where
10+
11+
import Control.DeepSeq
12+
import Test.Tasty (TestTree, testGroup)
13+
import Test.Tasty.HUnit (testCaseInfo, assertEqual)
14+
import Test.Tasty.Bench
15+
import Control.Exception (evaluate)
16+
import Data.Functor ((<&>))
17+
import GHC.Compact (compact, getCompact)
18+
19+
import qualified Compact.Map as Map
20+
import qualified Compact.BFTraversal as BFTraversal
21+
import qualified Compact.DList as DList
22+
import qualified Compact.Queue as Queue
23+
import qualified Compact.SExpr as SExpr
24+
25+
import qualified Bench.Compact.Map as Map
26+
import qualified Bench.Compact.BFTraversal as BFTraversal
27+
import qualified Bench.Compact.DList as DList
28+
import qualified Bench.Compact.Queue as Queue
29+
import qualified Bench.Compact.SExpr as SExpr
30+
31+
benchImpls :: forall m a r. (NFData r) => String -> [(a %m -> r, String, Bool)] -> [(IO a, String)] -> Benchmark
32+
benchImpls name impls datasets = do
33+
bgroup name (
34+
datasets <&> \(loadSampleData, sizeName) -> env loadSampleData $ \sampleData ->
35+
testGroup sizeName $ concat $ impls <&> \(impl, implName, isLazy) -> if isLazy
36+
then
37+
[ bench (implName ++ ".force") $ (flip whnfAppIO) sampleData $ \sampleData -> evaluate $ force $ impl sampleData,
38+
bench (implName ++ ".copyIntoReg") $ (flip whnfAppIO) sampleData $ \sampleData -> do
39+
resInRegion <- compact $ impl sampleData
40+
evaluate $ getCompact $ resInRegion
41+
]
42+
else
43+
[ bench implName $ (flip whnfAppIO) sampleData $ \sampleData -> evaluate $ impl sampleData ])
44+
45+
launchImpl :: String -> IO ()
46+
launchImpl s =
47+
let (_all, dotModuleName) = span (/= '.') s
48+
(moduleName, dotBenchmark) = span (/= '.') (tail dotModuleName)
49+
(_benchmark, dotImplSizeSpec) = span (/= '.') (tail dotBenchmark)
50+
implSizeSpec = tail dotImplSizeSpec
51+
in case (_all ++ "." ++ moduleName ++ "." ++ _benchmark) of
52+
"All.Bench.Compact.Map.benchmark" -> Utils.launchImpl' implSizeSpec Map.impls Map.dataSets
53+
"All.Bench.Compact.BFTraversal.benchmark" -> Utils.launchImpl' implSizeSpec BFTraversal.impls BFTraversal.dataSets
54+
"All.Bench.Compact.DList.benchmark" -> Utils.launchImpl' implSizeSpec DList.impls DList.dataSets
55+
"All.Bench.Compact.Queue.benchmark" -> Utils.launchImpl' implSizeSpec Queue.impls Queue.dataSets
56+
"All.Bench.Compact.SExpr.benchmark" -> Utils.launchImpl' implSizeSpec SExpr.impls SExpr.dataSets
57+
s' -> error ("benchmark group '" ++ s' ++ "' not found")
58+
59+
launchImpl' :: forall m a r. (NFData r) => String -> [(a %m -> r, String, Bool)] -> [(IO a, String)] -> IO ()
60+
launchImpl' requestedImplDataSetspec impls datasets = go impls (go' datasets) where
61+
(requestedSize, dotRequestedImplSpec) = span (/= '.') requestedImplDataSetspec
62+
(requestedImplRadical, requestedImplVariant) = span (/= '.') (tail dotRequestedImplSpec)
63+
go [] _ = error ("requested implementation '" ++ requestedImplRadical ++ "' not found")
64+
go ((impl, implName, isLazy):_) loadSampleData | implName == requestedImplRadical = do
65+
sampleData <- loadSampleData
66+
if isLazy
67+
then case requestedImplVariant of
68+
".force" -> evaluate $ rwhnf $ force $ impl sampleData
69+
".copyIntoReg" -> do
70+
resInRegion <- compact $ impl sampleData
71+
evaluate $ rwhnf $ getCompact $ resInRegion
72+
_ -> error ("variant '" ++ requestedImplVariant ++ "' not found (required for lazy impl)")
73+
else
74+
evaluate $ rwhnf $ impl sampleData
75+
putStrLn "Done!"
76+
go (_:xs) loadSampleData = go xs loadSampleData
77+
78+
go' [] = error ("requested size '" ++ requestedSize ++ "' not found")
79+
go' ((loadSampleData, sizeName):_) | sizeName == requestedSize = loadSampleData
80+
go' (_:xs) = go' xs

0 commit comments

Comments
 (0)