Fix performance regression

Revert to 7850891

* Switch to ormolu
* Run ormolu
* Add benchmark script
* Clean up .cabal file
* Fix warnings in tests. Disable QuantifierLifting.
* Add ghc-debug and nothunks instrumentation
* Add HasMap type class (#332)
* Refactoring printing to use `Contextualised` to eliminate duplicate strategies (#337)
* Change CI test component to 'all'
* Force CI to run Tasty tests sequentially (#342)
* Change CI install component to vehicle:exe:vehicle

.github/workflows/build-vehicle.yml

@@ -15,6 +15,11 @@ on:
         description: "The Cabal version to run the job with."
         required: true
         type: string
+      cabal-extra-args:
+        description: "Extra arguments to pass to Cabal."
+        required: false
+        type: string
+        default: ""
 
 env:
   CABAL_PROJECT_FILE: cabal.project.ghc-${{ inputs.ghc-version }}
@@ -38,16 +43,18 @@ jobs:
 
       - name: Test Vehicle
         run: |
-          cabal test all                     \
-            --test-option=--color=always     \
-            --test-show-details=always       \
-            --project-file=${{ env.CABAL_PROJECT_FILE }}
+          cabal test all                  \
+            --test-option=--color=always  \
+            --test-option=--num-threads=1 \
+            --test-show-details=always    \
+            --project-file=${{ env.CABAL_PROJECT_FILE }} \
+            ${{ inputs.cabal-extra-args }}
         shell: sh
 
       - name: Build Vehicle
         run: |
           mkdir -p bin
-          cabal install exe:vehicle          \
+          cabal install vehicle:exe:vehicle  \
             --overwrite-policy=always        \
             --install-method=copy            \
             --installdir=bin                 \

.github/workflows/build.yml

@@ -17,13 +17,14 @@ jobs:
       - uses: mrkkrp/ormolu-action@v8
 
   build-vehicle:
-    name: ${{ matrix.os_and_name[1] }} / GHC ${{ matrix.ghc-version }}
+    name: ${{ matrix.os_and_name[1] }} / GHC ${{ matrix.ghc-version }} ${{ matrix.cabal-extra-args }}
     needs: [ormolu]
     uses: ./.github/workflows/build-vehicle.yml
     with:
       runs-on: ${{ matrix.os_and_name[0] }}
       ghc-version: ${{ matrix.ghc-version }}
       cabal-version: ${{ matrix.cabal-version }}
+      cabal-extra-args: ${{ matrix.cabal-extra-args }}
     strategy:
       matrix:
         os_and_name:
@@ -37,6 +38,23 @@ jobs:
           - [windows-latest, Windows]
         ghc-version: ["8.10.7", "9.0.2", "9.2.4", "9.4.2"]
         cabal-version: ["3.8"]
+        cabal-extra-args: [""]
+        include:
+          # Build with -fghc-debug:
+          - os_and_name: [ubuntu-latest, Linux]
+            ghc-version: "9.2.4"
+            cabal-version: "3.8"
+            cabal-extra-args: "-fghc-debug"
+          # Build with -fnothunks:
+          - os_and_name: [ubuntu-latest, Linux]
+            ghc-version: "9.2.4"
+            cabal-version: "3.8"
+            cabal-extra-args: "-fnothunks"
+          # Build with -fghc-debug and -fnothunks:
+          - os_and_name: [ubuntu-latest, Linux]
+            ghc-version: "9.2.4"
+            cabal-version: "3.8"
+            cabal-extra-args: "-fghc-debug -fnothunks"
 
   build-vehicle-python:
     name: ${{ matrix.os_and_name[1] }} / Python ${{ matrix.python-version }}
@@ -56,47 +74,3 @@ jobs:
           - # Earliest supported version:
             os_and_name: [ubuntu-20.04, Linux]
             python-version: "3.8.0"
-
-  # NOTE: This is a temporary workaround, because our tests fail with +nothunks.
-  #       Once fixed, we should call build-vehicle with cabal.project.nothunks.
-  build-vehicle-nothunks:
-    name: Linux / GHC 9.2.4 / +nothunks
-    needs: [ormolu]
-    runs-on: ubuntu-22.04
-    steps:
-      - name: Checkout
-        uses: actions/checkout@v3
-
-      - name: Setup Haskell
-        uses: ./.github/actions/setup-haskell
-        with:
-          ghc-version: "9.2.4"
-          cabal-version: "3.8"
-          cabal-project-file: cabal.project.nothunks.ghc-9.2.4
-          cabal-project-freeze-file: cabal.project.nothunks.ghc-9.2.4.freeze
-
-      - name: Build Vehicle
-        run: cabal --project-file=cabal.project.nothunks.ghc-9.2.4 build vehicle:exe:vehicle
-        shell: sh
-
-  # NOTE: This is a temporary workaround, because our tests fail with +nothunks.
-  #       Once fixed, we should call build-vehicle with cabal.project.nothunks.
-  build-vehicle-ghc-debug:
-    name: Linux / GHC 9.2.4 / +ghc-debug
-    needs: [ormolu]
-    runs-on: ubuntu-22.04
-    steps:
-      - name: Checkout
-        uses: actions/checkout@v3
-
-      - name: Setup Haskell
-        uses: ./.github/actions/setup-haskell
-        with:
-          ghc-version: "9.2.4"
-          cabal-version: "3.8"
-          cabal-project-file: cabal.project.ghc-debug.ghc-9.2.4
-          cabal-project-freeze-file: cabal.project.ghc-debug.ghc-9.2.4.freeze
-
-      - name: Build Vehicle
-        run: cabal --project-file=cabal.project.ghc-debug.ghc-9.2.4 build vehicle:exe:vehicle
-        shell: sh

.gitignore

@@ -47,3 +47,7 @@ __pycache__/
 examples/**/*.vclp
 examples/**/*.vclo
 examples/windController/agdaProof/WindControllerSpec.agda
+
+# Benchmarks
+.benchmarks/
+benchmarks.json

.pre-commit-config.yaml

@@ -66,7 +66,7 @@ repos:
         entry: ./scripts/ormolu
         language: script
         types: [haskell]
-        args: [--mode inplace] # Disabled: --check-idempotence
+        args: [--mode inplace, --check-idempotence]
 
 # Do not run local hooks on pre-commit CI:
 ci:

cabal.project.ghc-debug

@@ -1,32 +1,28 @@
 -- Cabal project configuration file for DEBUGGING
 --
--- Use `cabal` with `--project-file=cabal.project.ghc-debug`
--- or run vehicle via `./scripts/vehicle-ghc-debug`.
+-- Use this configuration in one of two ways:
+-- * pass `--project-file=cabal.project.ghc-debug` to Cabal
+-- * run Vehicle via `./scripts/vehicle-ghc-debug`
 
-import: cabal.project
+
+import: cabal.project.nothunks
 
 package vehicle-syntax
   flags:
-    -- Necessary for Vehicle AST to implement NoThunks
-    +nothunks
+    -- Necessary for Vehicle.Syntax.Debug to reexport ghc-debug-stub
+    +ghc-debug
 
 package vehicle
   flags:
-    -- Necessary for Vehicle to be a ghc-debug debuggee
+    -- Necessary for Vehicle.Debug to reexport ghc-debug-stub,
+    -- and for vehicle:exe:vehicle to be a GHC debuggee
     +ghc-debug
 
-    -- Necessary for Vehicle Debug to implement unsafeCheckThunks
-    +nothunks
-
   ghc-options:
-    -- Necessary for eventlog support
+    -- Necessary for vehicle:exe:vehicle to support creating an eventlog,
+    -- which is used by scripts/vehicle-profile
     -eventlog
 
-    -- Necessary for -h* RTS options
-    -rtsopts
-
-    -- Necessary for info table profiling
+    -- Necessary for vehicle:exe:vehicle to support info table profiling,
+    -- which is used by scripts/vehicle-profile if HEAP_PROFILE_TYPE=-hi
     -finfo-table-map -fdistinct-constructor-tables
-
-    -- Necessary for our program to be a ghc-debug debuggee
-    -threaded

cabal.project.ghc-debug.ghc-9.2.4.freeze

@@ -140,7 +140,7 @@ constraints: any.BNFC ==2.9.4,
              any.vector ==0.12.3.1,
              vector +boundschecks -internalchecks -unsafechecks -wall,
              vehicle +ghc-debug +nothunks,
-             vehicle-syntax +nothunks,
+             vehicle-syntax +ghc-debug +nothunks,
              any.wcwidth ==0.0.2,
              wcwidth -cli +split-base,
              any.witherable ==0.4.2

cabal.project.nothunks

@@ -1,15 +1,18 @@
 -- Cabal project configuration file for TESTING with +nothunks
 --
--- Use `cabal` with `--project-file=cabal.project.nothunks`
+-- Use this configuration in one of two ways:
+-- * pass `--project-file=cabal.project.nothunks` to Cabal
+-- * run Vehicle via `./scripts/vehicle-nothunks`
 
 import: cabal.project
 
 package vehicle-syntax
   flags:
-    -- Necessary for Vehicle AST to implement NoThunks
+    -- Necessary for Vehicle.Syntax.AST to derive instances of NoThunks,
+    -- and for Vehicle.Syntax.Debug to implement unsafeCheckThunks
     +nothunks
 
 package vehicle
   flags:
-    -- Necessary for Vehicle Debug to implement unsafeCheckThunks
+    -- Necessary for Vehicle.Debug to implement unsafeCheckThunks
     +nothunks

cabal.project.nothunks.ghc-9.2.4.freeze

@@ -137,7 +137,7 @@ constraints: any.BNFC ==2.9.4,
              any.vector ==0.12.3.1,
              vector +boundschecks -internalchecks -unsafechecks -wall,
              vehicle -ghc-debug +nothunks,
-             vehicle-syntax +nothunks,
+             vehicle-syntax -ghc-debug +nothunks,
              any.wcwidth ==0.0.2,
              wcwidth -cli +split-base,
              any.witherable ==0.4.2

scripts/benchmark

@@ -4,14 +4,46 @@
 cabal build all --enable-tests
 
 # get the current commit hash
-commit_hash=$(git rev-parse HEAD)
+commit_hash=$(git rev-parse --short HEAD)
 
-# create .benchmark directory
-mkdir -p .benchmark
+# get the current GHC version
+ghc_version=$(ghc --numeric-version)
 
+# get the current operating system
+system=$(uname -s | cut -d- -f1)
+if [ "$system" = "CYGWIN_NT" \
+  -o "$system" = "MINGW32_NT" \
+  -o "$system" = "MINGW64_NT" \
+  -o "$system" = "MSYS_NT" ]; then
+  platform="Windows"
+elif [ "$system" = "Darwin" ]; then
+  platform="macOS"
+elif [ "$system" = "Linux" ]; then
+  platform="Linux"
+else
+  echo "Unsupported system '$system'"
+  exit 1
+fi
+
+# set the benchmark name
+name="vehicle-$commit_hash-$platform-ghc-$ghc_version"
+
+# create the benchmark filename and directory
+benchmark_database="benchmarks.json"
+benchmark_dir=".benchmarks"
+mkdir -p "$benchmark_dir"
+benchmark_file="$benchmark_dir/$name.json"
+
+# Run the benchmark
 hyperfine \
+  --command-name "$name" \
   --warmup 3 \
   --runs 10 \
-  --export-json ".benchmark/benchmark-$commit_hash.json" \
-  --export-markdown ".benchmark/benchmark-$commit_hash.md" \
+  --export-json "$benchmark_file" \
   'cabal test all'
+
+# Merge the new benchmark into the benchmarks database
+[ -f "$benchmark_database" ] || echo "[]" > "$benchmark_database"
+cp "$benchmark_database" "$benchmark_database.bak"
+jq -s '.[0] + [.[1]]' "$benchmark_database.bak" "$benchmark_file" > "$benchmark_database"
+rm -f "$benchmark_database.bak"

scripts/vehicle-profile

@@ -45,27 +45,22 @@ else
   rm "$fail"
 fi
 
+# Get the current platform
+SYSTEM=$(uname -s | cut -d- -f1)
+if [ "$SYSTEM" = "CYGWIN_NT" \
+  -o "$SYSTEM" = "MINGW32_NT" \
+  -o "$SYSTEM" = "MINGW64_NT" \
+  -o "$SYSTEM" = "MSYS_NT" ]; then
+  PLATFORM="Windows"
+elif [ "$SYSTEM" = "Darwin" ]; then
+  PLATFORM="macOS"
+elif [ "$SYSTEM" = "Linux" ]; then
+  PLATFORM="Linux"
+else
+  echo "WARNING: Could not determine platform" >&2
+fi
+
 # Open the eventlog in a browser
-# See: https://en.wikipedia.org/wiki/Uname#Examples
-OPERATING_SYSTEM=$(uname -s)
-if [ "$OPERATING_SYSTEM" = "Darwin" ]
-then
+if [ "$PLATFORM" = "macOS" ]; then
   open "$EVENTLOG_HTML"
-elif [ "$OPERATING_SYSTEM" = "Linux" ]
-then
-  # Use BROWSER environment variable?
-  # [ "$BROWSER" = "" ] || $BROWSER "$EVENTLOG_HTML"
-  :
-else
-  OPERATING_SYSTEM="$(echo "$OPERATING_SYSTEM" | cut -d - -f 1)"
-  if [ "$OPERATING_SYSTEM" = "CYGWIN_NT" \
-    -o "$OPERATING_SYSTEM" = "MINGW64_NT" \
-    -o "$OPERATING_SYSTEM" = "MSYS_NT" ]; then
-    # Use default browser on Windows? Open via PowerShell?
-    # start "" "$EVENTLOG_HTML"
-    :
-  else
-    # Unsupported operating system?
-    :
-  fi
 fi

vehicle-syntax/src/Vehicle/Syntax/AST/Arg.hs

@@ -1,18 +1,12 @@
-{-# LANGUAGE StrictData #-}
-
 module Vehicle.Syntax.AST.Arg where
 
 import Control.DeepSeq (NFData)
 import Data.Aeson (FromJSON, ToJSON)
 import GHC.Generics (Generic)
-import Vehicle.Syntax.AST.Binder (GenericBinder (Binder))
-import Vehicle.Syntax.AST.Provenance (HasProvenance (..), Provenance)
-import Vehicle.Syntax.AST.Relevance (HasRelevance (..), Relevance (..))
+import Vehicle.Syntax.AST.Binder
+import Vehicle.Syntax.AST.Provenance
+import Vehicle.Syntax.AST.Relevance
 import Vehicle.Syntax.AST.Visibility
-  ( HasVisibility (..),
-    Visibility (..),
-    isInstance,
-  )
 
 --------------------------------------------------------------------------------
 -- Function arguments

vehicle-syntax/src/Vehicle/Syntax/AST/Binder.hs

@@ -1,15 +1,13 @@
-{-# LANGUAGE StrictData #-}
-
 module Vehicle.Syntax.AST.Binder where
 
 import Control.DeepSeq (NFData)
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Hashable (Hashable)
 import GHC.Generics (Generic)
-import Vehicle.Syntax.AST.Name (HasName (..))
-import Vehicle.Syntax.AST.Provenance (HasProvenance (..), Provenance)
-import Vehicle.Syntax.AST.Relevance (HasRelevance (..), Relevance (..))
-import Vehicle.Syntax.AST.Visibility (HasVisibility (..), Visibility (..))
+import Vehicle.Syntax.AST.Name
+import Vehicle.Syntax.AST.Provenance
+import Vehicle.Syntax.AST.Relevance
+import Vehicle.Syntax.AST.Visibility
 
 --------------------------------------------------------------------------------
 -- Binders
@@ -77,19 +75,15 @@ instance (ToJSON binder, ToJSON expr) => ToJSON (GenericBinder binder expr)
 instance (FromJSON binder, FromJSON expr) => FromJSON (GenericBinder binder expr)
 
 instance HasProvenance (GenericBinder binder expr) where
-  provenanceOf :: GenericBinder binder expr -> Provenance
   provenanceOf = binderProvenance
 
 instance HasVisibility (GenericBinder binder expr) where
-  visibilityOf :: GenericBinder binder expr -> Visibility
   visibilityOf = binderVisibility
 
 instance HasRelevance (GenericBinder binder expr) where
-  relevanceOf :: GenericBinder binder expr -> Relevance
   relevanceOf = binderRelevance
 
 instance HasName (GenericBinder binder expr) binder where
-  nameOf :: GenericBinder binder expr -> binder
   nameOf = binderRepresentation
 
 --------------------------------------------------------------------------------