WIP: merge linear-dest back into linear-base

Current status: build successfully using stock ghc version

.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-702220602b/bin/ghc
+  ghc-name: ghc-dps-compact-702220602b
+  ghc-internal-name: ghc-9.11.20240917-x86_64-unknown-linux
 
 jobs:
   cabal-test:
@@ -13,7 +17,9 @@ 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 }}"
@@ -52,11 +58,50 @@ jobs:
           benchmark_ghc${{ matrix.ghc-version }}.txt
         retention-days: 90
 
+  cabal-test-ghc-dps-compact:
+    name: cabal test - ${{ env.ghc-name }}
+    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 installHls 'false' --pure --run "cabal build -w ${{ env.ghc-exe }}"
+    - name: Haddock
+      run: nix-shell --arg installHls 'false' --pure --run "cabal haddock -w ${{ env.ghc-exe }}"
+    - name: cabal-docspec
+      run: nix-shell --arg installHls 'false' --pure --run "cabal-docspec -w ${{ env.ghc-exe }}"
+    - name: Build benchmarks
+      run: nix-shell --arg installHls 'false' --pure --run "cabal build linear-base:bench:bench"
+    - name: Run benchmarks
+      run: nix-shell --arg installHls 'false' --pure --run "cabal bench 2>&1 | tee benchmark_${{ env.ghc-name }}.txt"
+    - name: Upload benchmark results
+      uses: actions/upload-artifact@v3
+      with:
+        name: linear-base_benchmarks_${{ env.ghc-name }}
+        path: |
+          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 }}"
@@ -75,7 +120,9 @@ 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 }}"

.gitignore

@@ -22,3 +22,5 @@ cabal.sandbox.config
 .stack-work/
 cabal.project.local
 .HTF/
+
+ghc-dps-compact-702220602b

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

@@ -0,0 +1,20 @@
+module Bench.Compact where
+
+import Test.Tasty.Bench
+
+import Bench.Compact.BFTraversal (bftraversalBenchgroup)
+import Bench.Compact.Map (mapBenchgroup)
+import Bench.Compact.DList (dlistBenchgroup)
+import Bench.Compact.Queue (queueBenchgroup)
+import Bench.Compact.SExpr (sexprBenchgroup)
+
+benchmarks :: Benchmark
+benchmarks =
+  bgroup
+    "DPS interface for compact regions"
+    [ bftraversalBenchgroup
+    , mapBenchgroup
+    , dlistBenchgroup
+    , queueBenchgroup
+    , sexprBenchgroup
+    ]

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

@@ -0,0 +1,24 @@
+module Bench.Compact.BFTraversal where
+
+import Compact.BFTraversal as BFTraversal
+import Bench.Compact.Utils as Utils
+import Control.Exception (evaluate)
+import Control.DeepSeq (force)
+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")
+  ]
+  where
+      go :: Int -> Int -> BinTree ()
+      go currentDepth maxDepth =
+        if currentDepth >= maxDepth
+          then Nil
+          else Node () (go (currentDepth + 1) maxDepth) (go (currentDepth + 1) maxDepth)
+
+bftraversalBenchgroup = Utils.benchImpls BFTraversal.impls dataSets

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

@@ -0,0 +1,18 @@
+module Bench.Compact.DList where
+
+import Compact.DList as DList
+import Bench.Compact.Utils as Utils
+import Control.Exception (evaluate)
+import Control.DeepSeq (force)
+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")
+  ]
+
+dlistBenchgroup = benchImpls DList.impls dataSets

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

@@ -0,0 +1,19 @@
+{-# LANGUAGE LinearTypes #-}
+module Bench.Compact.Map where
+
+import Compact.Map as Map
+import Bench.Compact.Utils as Utils
+import Control.Exception (evaluate)
+import Control.DeepSeq (force)
+import Test.Tasty.Bench (Benchmark)
+
+dataSets :: [(IO (Int %1 -> Int, [Int]), String)]
+dataSets =
+  [ ((\x -> 2 * x + 1,) <$> (evaluate $ force [1 .. 2^10]), "2^10")
+  , ((\x -> 2 * x + 1,) <$> (evaluate $ force [1 .. 2^13]), "2^13")
+  , ((\x -> 2 * x + 1,) <$> (evaluate $ force [1 .. 2^16]), "2^16")
+  , ((\x -> 2 * x + 1,) <$> (evaluate $ force [1 .. 2^19]), "2^19")
+  , ((\x -> 2 * x + 1,) <$> (evaluate $ force [1 .. 2^22]), "2^22")
+  ]
+
+mapBenchgroup = benchImpls Map.impls dataSets

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

@@ -0,0 +1,18 @@
+module Bench.Compact.Queue where
+
+import Compact.Queue as Queue
+import Bench.Compact.Utils as Utils
+import Control.Exception (evaluate)
+import Control.DeepSeq (force)
+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")
+  ]
+
+queueBenchgroup = benchImpls Queue.impls dataSets

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

@@ -0,0 +1,22 @@
+module Bench.Compact.SExpr where
+
+import Compact.SExpr as SExpr
+import Bench.Compact.Utils as Utils
+import Control.Exception (evaluate)
+import Control.DeepSeq (force)
+import qualified Data.ByteString.Char8 as BSC
+import Test.Tasty.Bench (Benchmark)
+
+dataSetDir :: String
+dataSetDir = "bench-version-changes/ghc-dps-compact/after/datasets/"
+
+dataSets :: [(IO ByteString, String)]
+dataSets =
+  [ (evaluate . force =<< BSC.readFile (dataSetDir ++ "data_2_10.sexpr"), "2^10")
+  , (evaluate . force =<< BSC.readFile (dataSetDir ++ "data_2_13.sexpr"), "2^13")
+  , (evaluate . force =<< BSC.readFile (dataSetDir ++ "data_2_16.sexpr"), "2^16")
+  , (evaluate . force =<< BSC.readFile (dataSetDir ++ "data_2_19.sexpr"), "2^19")
+  , (evaluate . force =<< BSC.readFile (dataSetDir ++ "data_2_22.sexpr"), "2^22")
+  ]
+
+sexprBenchgroup = Utils.benchImpls SExpr.impls dataSets

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

@@ -0,0 +1,80 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Bench.Compact.Utils where
+
+import Control.DeepSeq
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCaseInfo, assertEqual)
+import Test.Tasty.Bench
+import Control.Exception (evaluate)
+import Data.Functor ((<&>))
+import GHC.Compact (compact, getCompact)
+
+import qualified Compact.Map as Map
+import qualified Compact.BFTraversal as BFTraversal
+import qualified Compact.DList as DList
+import qualified Compact.Queue as Queue
+import qualified Compact.SExpr as SExpr
+
+import qualified Bench.Compact.Map as Map
+import qualified Bench.Compact.BFTraversal as BFTraversal
+import qualified Bench.Compact.DList as DList
+import qualified Bench.Compact.Queue as Queue
+import qualified Bench.Compact.SExpr as SExpr
+
+benchImpls :: forall m a r. (NFData r) => String -> [(a %m -> r, String, Bool)] -> [(IO a, String)] -> Benchmark
+benchImpls name impls datasets = do
+  bgroup name (
+    datasets <&> \(loadSampleData, sizeName) -> env loadSampleData $ \sampleData ->
+      testGroup sizeName $ concat $ impls <&> \(impl, implName, isLazy) -> if isLazy
+          then
+            [ bench (implName ++ ".force") $ (flip whnfAppIO) sampleData $ \sampleData -> evaluate $ force $ impl sampleData,
+              bench (implName ++ ".copyIntoReg") $ (flip whnfAppIO) sampleData $ \sampleData -> do
+                    resInRegion <- compact $ impl sampleData
+                    evaluate $ getCompact $ resInRegion
+            ]
+          else
+            [ bench implName $ (flip whnfAppIO) sampleData $ \sampleData -> evaluate $ impl sampleData ])
+
+launchImpl :: String -> IO ()
+launchImpl s =
+  let (_all, dotModuleName) = span (/= '.') s
+      (moduleName, dotBenchmark) = span (/= '.') (tail dotModuleName)
+      (_benchmark, dotImplSizeSpec) = span (/= '.') (tail dotBenchmark)
+      implSizeSpec = tail dotImplSizeSpec
+   in case (_all ++ "." ++ moduleName ++ "." ++ _benchmark) of
+        "All.Bench.Compact.Map.benchmark" -> Utils.launchImpl' implSizeSpec Map.impls Map.dataSets
+        "All.Bench.Compact.BFTraversal.benchmark" -> Utils.launchImpl' implSizeSpec BFTraversal.impls BFTraversal.dataSets
+        "All.Bench.Compact.DList.benchmark" -> Utils.launchImpl' implSizeSpec DList.impls DList.dataSets
+        "All.Bench.Compact.Queue.benchmark" -> Utils.launchImpl' implSizeSpec Queue.impls Queue.dataSets
+        "All.Bench.Compact.SExpr.benchmark" -> Utils.launchImpl' implSizeSpec SExpr.impls SExpr.dataSets
+        s' -> error ("benchmark group '" ++ s' ++ "' not found")
+
+launchImpl' :: forall m a r. (NFData r) => String -> [(a %m -> r, String, Bool)] -> [(IO a, String)] -> IO ()
+launchImpl' requestedImplDataSetspec impls datasets = go impls (go' datasets) where
+  (requestedSize, dotRequestedImplSpec) = span (/= '.') requestedImplDataSetspec
+  (requestedImplRadical, requestedImplVariant) = span (/= '.') (tail dotRequestedImplSpec)
+  go [] _ = error ("requested implementation '" ++ requestedImplRadical ++ "' not found")
+  go ((impl, implName, isLazy):_) loadSampleData | implName == requestedImplRadical = do
+    sampleData <- loadSampleData
+    if isLazy
+      then case requestedImplVariant of
+        ".force" -> evaluate $ rwhnf $ force $ impl sampleData
+        ".copyIntoReg" -> do
+          resInRegion <- compact $ impl sampleData
+          evaluate $ rwhnf $ getCompact $ resInRegion
+        _ -> error ("variant '" ++ requestedImplVariant ++ "' not found (required for lazy impl)")
+    else
+      evaluate $ rwhnf $ impl sampleData
+    putStrLn "Done!"
+  go (_:xs) loadSampleData = go xs loadSampleData
+
+  go' [] = error ("requested size '" ++ requestedSize ++ "' not found")
+  go' ((loadSampleData, sizeName):_) | sizeName == requestedSize = loadSampleData
+  go' (_:xs) = go' xs

bench-version-changes/ghc-dps-compact/after/datasets/data_2_10.sexpr

@@ -0,0 +1,46 @@
+(
+(ert-deftest company-shows-keywords-alongside-completions-alphabetically ()
+  :tags '(company)
+  (switch-to-buffer "*TESTING COMPANY MODE ~ Python*")
+  (python-mode)
+
+
+  (erase-buffer)
+  (insert "\n def first(x): pass")
+  (insert "\n def fierce(a, b): pass")
+
+
+  (insert "\n fi")
+  (company-manual-begin)
+  (should (equal company-candidates '("fierce" "first" #("finally" 0 7 (company-backend company-keywords)))))
+
+
+  (execute-kbd-macro (kbd "C-g C-/ M-2")) 
+  (should (looking-back "finally"))
+
+  (kill-buffer))
+
+
+(ert-deftest company-shows-keywords-alongside-completions-alphabetically ()
+  :tags '(company)
+  (switch-to-buffer "*TESTING COMPANY MODE ~ Python*")
+  (python-mode)
+
+
+  (erase-buffer)
+  (insert "\n def first(x): pass")
+  (insert "\n def fierce(a, b): pass")
+
+
+  (insert "\n fi")
+  (company-manual-begin)
+  (should (equal company-candidates '("fierce" "first" #("finally" 0 7 (company-backend company-keywords)))))
+
+
+  (execute-kbd-macro (kbd "C-g C-/ M-2")) 
+  (should (looking-back "finally"))
+
+  (kill-buffer))
+
+
+)