[WIP] Write data to compact regions through destination "filling"

.ghcid

@@ -0,0 +1 @@
+--command "cabal repl --enable-multi-repl"

.gitattributes

@@ -0,0 +1 @@
+ghc*.tar.xz filter=lfs diff=lfs merge=lfs -text

.github/workflows/ci.yaml

@@ -4,6 +4,10 @@ env:
   # Bump this number to invalidate the Github-actions cache
   cache-invalidation-key: 0
   nixpkgs-url: https://github.com/NixOS/nixpkgs/archive/574d1eac1c200690e27b8eb4e24887f8df7ac27c.tar.gz
+  NIX_PATH: https://github.com/NixOS/nixpkgs/archive/574d1eac1c200690e27b8eb4e24887f8df7ac27c.tar.gz
+  ghc-exe: $(pwd)/ghc-dps-compact-95615577d7/bin/ghc
+  ghc-name: ghc-dps-compact-95615577d7
+  ghc-internal-name: ghc-9.11.20241002-x86_64-unknown-linux
 
 jobs:
   cabal-test:
@@ -13,12 +17,14 @@ jobs:
         ghc-version: [96, 98, 910]
     runs-on: ubuntu-latest
     steps:
-    - uses: actions/checkout@v2
+    - uses: actions/checkout@v3
+      with:
+        lfs: false
     - uses: cachix/install-nix-action@v15
       with:
         nix_path: "${{ env.nixpkgs-url }}"
     - name: Cache Cabal dependencies
-      uses: actions/cache@v2
+      uses: actions/cache@v4
       with:
         path: |
           ~/.cabal/packages
@@ -33,24 +39,76 @@ jobs:
     - name: Update Cabal's database
       run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal update"
     - name: Build Cabal's dependencies
-      run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal build --allow-newer --disable-tests --disable-benchmarks --dependencies-only"
+      run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal build --dependencies-only"
+    - name: Build
+      run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal build --run-tests"
+    - name: Haddock
+      run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal haddock"
+    - name: cabal-docspec
+      run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal-docspec"
+    - name: Build benchmarks
+      run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal build linear-base:bench:bench"
+    - name: Run benchmarks in isolation
+      run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "echo $'=== Benchmarks (isolation) ===\n\n' > benchmark_ghc${{ matrix.ghc-version }}.txt && cabal run -v0 linear-base:bench:bench -- -l | while read -r name; do cabal run -v0 linear-base:bench:bench -- -p '"'$'"0 == \"'\""'$'"name\"'\"' 2>&1 | tee -a benchmark_ghc${{ matrix.ghc-version }}.txt; done"
+    - name: Upload benchmark results
+      uses: actions/upload-artifact@v4
+      with:
+        name: linear-base_benchmarks_ghc${{ matrix.ghc-version }}
+        path: |
+          **/*.dump-simpl
+          benchmark_ghc${{ matrix.ghc-version }}.txt
+        retention-days: 90
+
+  cabal-test-ghc-dps-compact:
+    name: cabal test - ghc-dps-compact
+    runs-on: [self-hosted, Linux, X64]
+    steps:
+    - uses: actions/checkout@v3
+      with:
+        lfs: true
+    - name: Checkout LFS objects
+      run: git lfs checkout
+    - name: Build Nix dependencies
+      run: nix-shell --arg installHls 'false' --pure --run "echo '=== Nix dependencies installed ==='"
+    - name: Install custom GHC
+      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 }}"
+    - name: Init Cabal's config file
+      run: nix-shell --arg installHls 'false' --pure --run "cabal --config-file=$HOME/.cabal/config user-config -f init"
+    - name: Update Cabal's database
+      run: nix-shell --arg installHls 'false' --pure --run "cabal update"
+    - name: Build Cabal's dependencies
+      run: nix-shell --arg installHls 'false' --pure --run "cabal build -w ${{ env.ghc-exe }} --dependencies-only"
     - name: Build
-      run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal build --allow-newer --disable-tests --disable-benchmarks"
+      run: nix-shell --arg installHls 'false' --pure --run "cabal build -w ${{ env.ghc-exe }} --run-tests"
     - name: Haddock
-      run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal --allow-newer haddock"
+      run: nix-shell --arg installHls 'false' --pure --run "cabal haddock -w ${{ env.ghc-exe }}"
     - name: cabal-docspec
-      run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run cabal-docspec
+      run: nix-shell --arg installHls 'false' --pure --run "echo '# [DISABLED because of https://github.com/phadej/cabal-extras/issues/160]' cabal-docspec -w ${{ env.ghc-exe }}"
+    - name: Build benchmarks
+      run: nix-shell --arg installHls 'false' --pure --run "cabal build -w ${{ env.ghc-exe }} linear-base:bench:bench"
+    - name: Run benchmarks in isolation
+      run: nix-shell --arg installHls 'false' --pure --run "echo $'=== Benchmarks (isolation) ===\n\n' > benchmark_${{ env.ghc-name }}.txt && cabal run -w ${{ env.ghc-exe }} -v0 linear-base:bench:bench -- -l | while read -r name; do cabal run -w ${{ env.ghc-exe }} -v0 linear-base:bench:bench -- --timeout 1200 --stdev 10 -p '"'$'"0 == \"'\""'$'"name\"'\"' 2>&1 | tee -a benchmark_${{ env.ghc-name }}.txt; done"
+    - name: Upload benchmark results
+      uses: actions/upload-artifact@v4
+      with:
+        name: linear-base_benchmarks_${{ env.ghc-name }}
+        path: |
+          **/*.dump-simpl
+          benchmark_${{ env.ghc-name }}.txt
+        retention-days: 90
 
   ormolu:
     name: check formatting with ormolu
     runs-on: ubuntu-latest
     steps:
-    - uses: actions/checkout@v2
+    - uses: actions/checkout@v3
+      with:
+        lfs: false
     - uses: cachix/install-nix-action@v15
       with:
         nix_path: "${{ env.nixpkgs-url }}"
     - name: Cache Stack dependencies
-      uses: actions/cache@v2
+      uses: actions/cache@v4
       with:
         path: ~/.stack
         key: stack-deps-ormolu-${{ runner.os }}-${{ hashFiles('nix/sources.json') }}-v${{ env.cache-invalidation-key }}-${{ hashFiles('stack.yaml.lock') }}-${{ github.sha }}
@@ -64,12 +122,14 @@ jobs:
     name: stack build
     runs-on: ubuntu-latest
     steps:
-    - uses: actions/checkout@v2
+    - uses: actions/checkout@v3
+      with:
+        lfs: false
     - uses: cachix/install-nix-action@v15
       with:
         nix_path: "${{ env.nixpkgs-url }}"
     - name: Cache Stack dependencies
-      uses: actions/cache@v2
+      uses: actions/cache@v4
       with:
         path: ~/.stack
         key: stack-deps-${{ runner.os }}-${{ hashFiles('nix/sources.json') }}-v${{ env.cache-invalidation-key }}-${{ hashFiles('stack.yaml.lock', 'linear-base.cabal') }}-${{ github.sha }}

.gitignore

@@ -22,3 +22,9 @@ cabal.sandbox.config
 .stack-work/
 cabal.project.local
 .HTF/
+
+**/*.dump-simpl
+ghc-dps-compact-95615577d7
+benchmark_*.txt
+benchmark*.csv
+plot_*.pdf

avg_manual_bench_and_patch.py

@@ -0,0 +1,97 @@
+import sys
+import pandas as pd
+from decimal import Decimal, getcontext
+
+def format_significant_decimal(x, digits=5):
+    if pd.isna(x):
+        return ''
+    if x == 0:
+        return "0"
+
+    getcontext().prec = digits + 5
+    d = Decimal(str(x))
+
+    exponent = d.adjusted()
+    shift = digits - exponent - 1
+    rounded = d.scaleb(shift).quantize(Decimal('1')).scaleb(-shift)
+    s = format(rounded.normalize(), 'f')
+    return s
+
+def format_dataframe_numbers(df, digits=5):
+    for col in df.select_dtypes(include=["number"]).columns:
+        df[col] = df[col].apply(lambda x: format_significant_decimal(x, digits))
+    return df
+
+def usage():
+    print("Usage:")
+    print("  python script.py manual_bench.csv averaged_manual_bench.csv")
+    print("  OR")
+    print("  python script.py manual_bench.csv averaged_manual_bench.csv auto_bench.csv updated_auto_bench.csv columns_to_patch")
+    print("    where columns_to_patch is a comma-separated list like: AutoCol1:ManualCol1,AutoCol2:ManualCol2 or just AutoCol1,AutoCol2 (for identity mapping)")
+    sys.exit(1)
+
+if not (4 <= len(sys.argv) <= 6):
+    usage()
+
+manual_path = sys.argv[1]
+averaged_manual_path = sys.argv[2]
+
+patching_enabled = False
+if len(sys.argv) == 6:
+    patching_enabled = True
+    auto_path = sys.argv[3]
+    updated_auto_path = sys.argv[4]
+    raw_column_mappings = sys.argv[5].split(",")
+
+    # Parse mappings like "A:B" or "A"
+    column_mappings = []
+    for entry in raw_column_mappings:
+        if ':' in entry:
+            auto_col, manual_col = entry.split(":", 1)
+        else:
+            auto_col = manual_col = entry
+        column_mappings.append((auto_col.strip(), manual_col.strip()))
+elif len(sys.argv) == 3:
+    column_mappings = []
+else:
+    usage()
+
+# Load and process manual benchmark
+manual_df = pd.read_csv(manual_path)
+if "Iteration" in manual_df.columns:
+    manual_df = manual_df.drop(columns=["Iteration"])
+
+aggregated = (
+    manual_df
+    .groupby(["Test Description", "Size", "Method"], as_index=False)
+    .mean(numeric_only=True)
+)
+
+aggregated = format_dataframe_numbers(aggregated, digits=5)
+aggregated.to_csv(averaged_manual_path, index=False)
+print(f"Averaged manual benchmark written to: {averaged_manual_path}")
+
+if patching_enabled:
+    auto_df = pd.read_csv(auto_path)
+
+    # Build lookup from aggregated benchmark
+    lookup = {}
+    for _, row in aggregated.iterrows():
+        key = (row["Test Description"], row["Size"], row["Method"])
+        lookup[key] = row
+
+    # Patch auto benchmark
+    for idx, row in auto_df.iterrows():
+        key = (row["Test Description"], row["Size"], row["Method"])
+        if key in lookup:
+            for auto_col, manual_col in column_mappings:
+                if manual_col in lookup[key]:
+                    auto_df.at[idx, auto_col] = lookup[key][manual_col]
+                else:
+                    print(f"Warning: Column '{manual_col}' not found for row {key}")
+        else:
+            print(f"Warning: No manual benchmark found for: {key}")
+
+    auto_df = format_dataframe_numbers(auto_df, digits=5)
+    auto_df.to_csv(updated_auto_path, index=False)
+    print(f"Patched auto benchmark written to: {updated_auto_path}")

bench-version-changes/ghc-dps-compact/after/Bench/Compact.hs

@@ -0,0 +1,43 @@
+module Bench.Compact where
+
+import Bench.Compact.BFTraversal (bftraversalBenchgroup, bftraversalLaunch)
+import Bench.Compact.DList (dlistBenchgroup, dlistLaunch)
+import Bench.Compact.Map (mapBenchgroup, mapLaunch)
+import Bench.Compact.Queue (queueBenchgroup, queueLaunch)
+import Bench.Compact.SExpr (sexprBenchgroup, sexprLaunch)
+import System.Exit (exitFailure)
+import Test.Tasty.Bench
+
+benchmarks :: Benchmark
+benchmarks =
+  bgroup
+    "DPS interface for compact regions"
+    [ bftraversalBenchgroup,
+      mapBenchgroup,
+      dlistBenchgroup,
+      queueBenchgroup,
+      sexprBenchgroup
+    ]
+
+launchImpl' :: [(String -> Maybe (IO ()))] -> String -> IO ()
+launchImpl' launchers request = do
+  let tryLaunch [] = Nothing
+      tryLaunch (l : ls) = case l request of
+        Just action -> Just action
+        Nothing -> tryLaunch ls
+  case tryLaunch launchers of
+    Just action -> do
+      action
+    Nothing -> do
+      putStrLn $ "Error"
+      exitFailure
+
+launchImpl :: String -> IO ()
+launchImpl =
+  launchImpl'
+    [ bftraversalLaunch,
+      mapLaunch,
+      dlistLaunch,
+      queueLaunch,
+      sexprLaunch
+    ]

bench-version-changes/ghc-dps-compact/after/Bench/Compact/BFTraversal.hs

@@ -0,0 +1,29 @@
+module Bench.Compact.BFTraversal where
+
+import Bench.Compact.Utils as Utils
+import Compact.BFTraversal as BFTraversal
+import Control.DeepSeq (force)
+import Control.Exception (evaluate)
+import Test.Tasty.Bench (Benchmark)
+
+dataSets :: [(IO (BinTree ()), String)]
+dataSets =
+  [ (evaluate $ force (go 0 10), "2^10"),
+    (evaluate $ force (go 0 13), "2^13"),
+    (evaluate $ force (go 0 16), "2^16"),
+    (evaluate $ force (go 0 19), "2^19"),
+    (evaluate $ force (go 0 22), "2^22"),
+    (evaluate $ force (go 0 25), "2^25")
+  ]
+  where
+    go :: Int -> Int -> BinTree ()
+    go currentDepth maxDepth =
+      if currentDepth >= maxDepth
+        then Nil
+        else Node () (go (currentDepth + 1) maxDepth) (go (currentDepth + 1) maxDepth)
+
+bftraversalBenchgroup :: Benchmark
+bftraversalBenchgroup = benchImpls "Breadth-first tree traversal" BFTraversal.impls dataSets
+
+bftraversalLaunch :: String -> Maybe (IO ())
+bftraversalLaunch = launchImpl "Breadth-first tree traversal" BFTraversal.impls dataSets

bench-version-changes/ghc-dps-compact/after/Bench/Compact/DList.hs

@@ -0,0 +1,25 @@
+{-# OPTIONS_GHC -Wno-type-defaults #-}
+
+module Bench.Compact.DList where
+
+import Bench.Compact.Utils as Utils
+import Compact.DList as DList
+import Control.DeepSeq (force)
+import Control.Exception (evaluate)
+import Test.Tasty.Bench (Benchmark)
+
+dataSets :: [(IO [[Int]], String)]
+dataSets =
+  [ (evaluate $ force (fmap (\i -> [(10 * i + 0) .. (10 * i + 9)]) [0 .. (((2 ^ 10) `div` 10) - 1)]), "2^10"),
+    (evaluate $ force (fmap (\i -> [(10 * i + 0) .. (10 * i + 9)]) [0 .. (((2 ^ 13) `div` 10) - 1)]), "2^13"),
+    (evaluate $ force (fmap (\i -> [(10 * i + 0) .. (10 * i + 9)]) [0 .. (((2 ^ 16) `div` 10) - 1)]), "2^16"),
+    (evaluate $ force (fmap (\i -> [(10 * i + 0) .. (10 * i + 9)]) [0 .. (((2 ^ 19) `div` 10) - 1)]), "2^19"),
+    (evaluate $ force (fmap (\i -> [(10 * i + 0) .. (10 * i + 9)]) [0 .. (((2 ^ 22) `div` 10) - 1)]), "2^22"),
+    (evaluate $ force (fmap (\i -> [(10 * i + 0) .. (10 * i + 9)]) [0 .. (((2 ^ 25) `div` 10) - 1)]), "2^25")
+  ]
+
+dlistBenchgroup :: Benchmark
+dlistBenchgroup = benchImpls "List and DList concatenation" DList.impls dataSets
+
+dlistLaunch :: String -> Maybe (IO ())
+dlistLaunch = launchImpl "List and DList concatenation" DList.impls dataSets

bench-version-changes/ghc-dps-compact/after/Bench/Compact/Map.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wno-type-defaults #-}
+
+module Bench.Compact.Map where
+
+import Bench.Compact.Utils as Utils
+import Compact.Map as Map
+import Control.DeepSeq (force)
+import Control.Exception (evaluate)
+import Test.Tasty.Bench (Benchmark)
+
+dataSets :: [(IO [Int], String)]
+dataSets =
+  [ ((evaluate $ force [1 .. 2 ^ 10]), "2^10"),
+    ((evaluate $ force [1 .. 2 ^ 13]), "2^13"),
+    ((evaluate $ force [1 .. 2 ^ 16]), "2^16"),
+    ((evaluate $ force [1 .. 2 ^ 19]), "2^19"),
+    ((evaluate $ force [1 .. 2 ^ 22]), "2^22"),
+    ((evaluate $ force [1 .. 2 ^ 25]), "2^25")
+  ]
+
+mapBenchgroup :: Benchmark
+mapBenchgroup = benchImpls "map on List" Map.impls dataSets
+
+mapLaunch :: String -> Maybe (IO ())
+mapLaunch = launchImpl "map on List" Map.impls dataSets

bench-version-changes/ghc-dps-compact/after/Bench/Compact/Queue.hs

@@ -0,0 +1,24 @@
+{-# OPTIONS_GHC -Wno-type-defaults #-}
+
+module Bench.Compact.Queue where
+
+import Bench.Compact.Utils as Utils
+import Compact.Queue as Queue
+import Data.Word (Word64)
+import Test.Tasty.Bench (Benchmark)
+
+dataSets :: [(IO Word64, String)]
+dataSets =
+  [ (return $ 2 ^ 10, "2^10"),
+    (return $ 2 ^ 13, "2^13"),
+    (return $ 2 ^ 16, "2^16"),
+    (return $ 2 ^ 19, "2^19"),
+    (return $ 2 ^ 22, "2^22"),
+    (return $ 2 ^ 25, "2^25")
+  ]
+
+queueBenchgroup :: Benchmark
+queueBenchgroup = benchImpls "Queue enqueue operations" Queue.impls dataSets
+
+queueLaunch :: String -> Maybe (IO ())
+queueLaunch = launchImpl "Queue enqueue operations" Queue.impls dataSets