Update src/Init/Data/Subtype.lean

closes #4983

.github/workflows/ci.yml

@@ -204,7 +204,7 @@ jobs:
                 "os": "macos-14",
                 "CMAKE_OPTIONS": "-DLEAN_INSTALL_SUFFIX=-darwin_aarch64",
                 "release": true,
-                "check-level": 1,
+                "check-level": 0,
                 "shell": "bash -euxo pipefail {0}",
                 "llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-aarch64-apple-darwin.tar.zst",
                 "prepare-llvm": "../script/prepare-llvm-macos.sh lean-llvm*",
@@ -238,7 +238,7 @@ jobs:
                 "name": "Linux 32bit",
                 "os": "ubuntu-latest",
                 // Use 32bit on stage0 and stage1 to keep oleans compatible
-                "CMAKE_OPTIONS": "-DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_MMAP=OFF -DUSE_GMP=OFF -DLEAN_EXTRA_CXX_FLAGS='-m32' -DLEANC_OPTS='-m32' -DMMAP=OFF -DLEAN_INSTALL_SUFFIX=-linux_x86 -DCMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/",
+                "CMAKE_OPTIONS": "-DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_MMAP=OFF -DUSE_GMP=OFF -DLEAN_EXTRA_CXX_FLAGS='-m32' -DLEANC_OPTS='-m32' -DMMAP=OFF -DLEAN_INSTALL_SUFFIX=-linux_x86 -DCMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DSTAGE0_CMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/",
                 "cmultilib": true,
                 "release": true,
                 "check-level": 2,
@@ -249,7 +249,7 @@ jobs:
                 "name": "Web Assembly",
                 "os": "ubuntu-latest",
                 // Build a native 32bit binary in stage0 and use it to compile the oleans and the wasm build
-                "CMAKE_OPTIONS": "-DCMAKE_C_COMPILER_WORKS=1 -DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_CMAKE_CXX_COMPILER=clang++ -DSTAGE0_CMAKE_C_COMPILER=clang -DSTAGE0_CMAKE_EXECUTABLE_SUFFIX=\"\" -DUSE_GMP=OFF -DMMAP=OFF -DSTAGE0_MMAP=OFF -DCMAKE_AR=../emsdk/emsdk-main/upstream/emscripten/emar -DCMAKE_TOOLCHAIN_FILE=../emsdk/emsdk-main/upstream/emscripten/cmake/Modules/Platform/Emscripten.cmake -DLEAN_INSTALL_SUFFIX=-linux_wasm32",
+                "CMAKE_OPTIONS": "-DCMAKE_C_COMPILER_WORKS=1 -DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_CMAKE_CXX_COMPILER=clang++ -DSTAGE0_CMAKE_C_COMPILER=clang -DSTAGE0_CMAKE_EXECUTABLE_SUFFIX=\"\" -DUSE_GMP=OFF -DMMAP=OFF -DSTAGE0_MMAP=OFF -DCMAKE_AR=../emsdk/emsdk-main/upstream/emscripten/emar -DCMAKE_TOOLCHAIN_FILE=../emsdk/emsdk-main/upstream/emscripten/cmake/Modules/Platform/Emscripten.cmake -DLEAN_INSTALL_SUFFIX=-linux_wasm32 -DSTAGE0_CMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/",
                 "wasm": true,
                 "cmultilib": true,
                 "release": true,
@@ -337,6 +337,7 @@ jobs:
           # fall back to (latest) previous cache
           restore-keys: |
             ${{ matrix.name }}-build-v3
+          save-always: true
       # open nix-shell once for initial setup
       - name: Setup
         run: |

.github/workflows/nix-ci.yml

@@ -62,6 +62,7 @@ jobs:
           # fall back to (latest) previous cache
           restore-keys: |
             ${{ matrix.name }}-nix-store-cache
+          save-always: true
       - name: Further Set Up Nix Cache
         shell: bash -euxo pipefail {0}
         run: |
@@ -85,6 +86,7 @@ jobs:
           # fall back to (latest) previous cache
           restore-keys: |
             ${{ matrix.name }}-nix-ccache
+          save-always: true
       - name: Further Set Up CCache Cache
         run: |
           sudo chown -R root:nixbld /nix/var/cache

.github/workflows/pr-release.yml

@@ -163,7 +163,8 @@ jobs:
             # so keep in sync
 
             # Use GitHub API to check if a comment already exists
-            existing_comment="$(curl -L -s -H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
+            existing_comment="$(curl --retry 3 --location --silent \
+                                    -H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
                                     -H "Accept: application/vnd.github.v3+json" \
                                     "https://api.github.com/repos/leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments" \
                                     | jq 'first(.[] | select(.body | test("^- . Mathlib") or startswith("Mathlib CI status")) | select(.user.login == "leanprover-community-mathlib4-bot"))')"
@@ -328,7 +329,7 @@ jobs:
             git switch -c lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }} "$BASE"
             echo "leanprover/lean4-pr-releases:pr-release-${{ steps.workflow-info.outputs.pullRequestNumber }}" > lean-toolchain
             git add lean-toolchain
-            sed -i 's,require "leanprover-community" / "batteries" @ ".\+",require "leanprover-community" / "batteries" @ "git#nightly-testing-'"${MOST_RECENT_NIGHTLY}"'",' lakefile.lean
+            sed -i 's,require "leanprover-community" / "batteries" @ git ".\+",require "leanprover-community" / "batteries" @ git "nightly-testing-'"${MOST_RECENT_NIGHTLY}"'",' lakefile.lean
             lake update batteries
             git add lakefile.lean lake-manifest.json
             git commit -m "Update lean-toolchain for testing https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"

.github/workflows/restart-on-label.yml

@@ -14,8 +14,9 @@ jobs:
         # (unfortunately cannot search by PR number, only base branch,
         # and that is't even unique given PRs from forks, but the risk
         # of confusion is low and the danger is mild)
-        run_id=$(gh run list -e pull_request -b "$head_ref" --workflow 'CI' --limit 1 \
-          --limit 1 --json databaseId --jq '.[0].databaseId')
+        echo "Trying to find a run with branch $head_ref and commit $head_sha"
+        run_id="$(gh run list -e pull_request -b "$head_ref" -c "$head_sha" \
+          --workflow 'CI' --limit 1 --json databaseId --jq '.[0].databaseId')"
         echo "Run id: ${run_id}"
         gh run view "$run_id"
         echo "Cancelling (just in case)"
@@ -29,5 +30,6 @@ jobs:
       shell: bash
       env:
         head_ref: ${{ github.head_ref }}
+        head_sha: ${{ github.event.pull_request.head.sha }}
         GH_TOKEN: ${{ github.token }}
         GH_REPO: ${{ github.repository }}

CMakeLists.txt

@@ -30,6 +30,32 @@ if(NOT (DEFINED STAGE0_CMAKE_EXECUTABLE_SUFFIX))
     set(STAGE0_CMAKE_EXECUTABLE_SUFFIX "${CMAKE_EXECUTABLE_SUFFIX}")
 endif()
 
+# On CI Linux, we source cadical from Nix instead; see flake.nix
+find_program(CADICAL cadical)
+if(NOT CADICAL)
+  set(CADICAL_CXX c++)
+  find_program(CCACHE ccache)
+  if(CCACHE)
+    set(CADICAL_CXX "${CCACHE} ${CADICAL_CXX}")
+  endif()
+  # missing stdio locking API on Windows
+  if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
+    string(APPEND CADICAL_CXXFLAGS " -DNUNLOCKED")
+  endif()
+  ExternalProject_add(cadical
+    PREFIX cadical
+    GIT_REPOSITORY https://github.com/arminbiere/cadical
+    GIT_TAG rel-1.9.5
+    CONFIGURE_COMMAND ""
+    # https://github.com/arminbiere/cadical/blob/master/BUILD.md#manual-build
+    BUILD_COMMAND $(MAKE) -f ${CMAKE_SOURCE_DIR}/src/cadical.mk CMAKE_EXECUTABLE_SUFFIX=${CMAKE_EXECUTABLE_SUFFIX} CXX=${CADICAL_CXX} CXXFLAGS=${CADICAL_CXXFLAGS}
+    BUILD_IN_SOURCE ON
+    INSTALL_COMMAND "")
+  set(CADICAL ${CMAKE_BINARY_DIR}/cadical/cadical${CMAKE_EXECUTABLE_SUFFIX} CACHE FILEPATH "path to cadical binary" FORCE)
+  set(EXTRA_DEPENDS "cadical")
+endif()
+list(APPEND CL_ARGS -DCADICAL=${CADICAL})
+
 ExternalProject_add(stage0
   SOURCE_DIR "${LEAN_SOURCE_DIR}/stage0"
   SOURCE_SUBDIR src

LICENSES

@@ -1341,3 +1341,33 @@ whether future versions of the GNU Lesser General Public License shall
 apply, that proxy's public statement of acceptance of any version is
 permanent authorization for you to choose that version for the
 Library.
+==============================================================================
+CaDiCaL is under the MIT License:
+==============================================================================
+MIT License
+
+Copyright (c) 2016-2021 Armin Biere, Johannes Kepler University Linz, Austria
+Copyright (c) 2020-2021 Mathias Fleury, Johannes Kepler University Linz, Austria
+Copyright (c) 2020-2021 Nils Froleyks, Johannes Kepler University Linz, Austria
+Copyright (c) 2022-2024 Katalin Fazekas, Vienna University of Technology, Austria
+Copyright (c) 2021-2024 Armin Biere, University of Freiburg, Germany
+Copyright (c) 2021-2024 Mathias Fleury, University of Freiburg, Germany
+Copyright (c) 2023-2024 Florian Pollitt, University of Freiburg, Germany
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

doc/examples/widgets.lean

@@ -4,15 +4,18 @@ open Lean Widget
 /-!
 # The user-widgets system
 
-Proving and programming are inherently interactive tasks. Lots of mathematical objects and data
-structures are visual in nature. *User widgets* let you associate custom interactive UIs with
-sections of a Lean document. User widgets are rendered in the Lean infoview.
+Proving and programming are inherently interactive tasks.
+Lots of mathematical objects and data structures are visual in nature.
+*User widgets* let you associate custom interactive UIs
+with sections of a Lean document.
+User widgets are rendered in the Lean infoview.
 
 ![Rubik's cube](../images/widgets_rubiks.png)
 
 ## Trying it out
 
-To try it out, simply type in the following code and place your cursor over the `#widget` command.
+To try it out, type in the following code and place your cursor over the `#widget` command.
+You can also [view this manual entry in the online editor](https://live.lean-lang.org/#url=https%3A%2F%2Fraw.githubusercontent.com%2Fleanprover%2Flean4%2Fmaster%2Fdoc%2Fexamples%2Fwidgets.lean).
 -/
 
 @[widget_module]
@@ -21,38 +24,37 @@ def helloWidget : Widget.Module where
     import * as React from 'react';
     export default function(props) {
       const name = props.name || 'world'
-      return React.createElement('p', {}, name + '!')
+      return React.createElement('p', {}, 'Hello ' + name + '!')
     }"
 
 #widget helloWidget
 
 /-!
 If you want to dive into a full sample right away, check out
-[`RubiksCube`](https://github.com/leanprover/lean4-samples/blob/main/RubiksCube/).
+[`Rubiks`](https://github.com/leanprover-community/ProofWidgets4/blob/main/ProofWidgets/Demos/Rubiks.lean).
+This sample uses higher-level widget components from the ProofWidgets library.
+
 Below, we'll explain the system piece by piece.
 
 ⚠️ WARNING: All of the user widget APIs are **unstable** and subject to breaking changes.
 
-## Widget sources and instances
+## Widget modules and instances
 
-A *widget source* is a valid JavaScript [ESModule](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Modules)
-which exports a [React component](https://reactjs.org/docs/components-and-props.html). To access
-React, the module must use `import * as React from 'react'`. Our first example of a widget source
-is of course the value of `helloWidget.javascript`.
+A [widget module](https://leanprover-community.github.io/mathlib4_docs/Lean/Widget/UserWidget.html#Lean.Widget.Module)
+is a valid JavaScript [ESModule](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Modules)
+that can execute in the Lean infoview.
+Most widget modules export a [React component](https://reactjs.org/docs/components-and-props.html)
+as the piece of user interface to be rendered.
+To access React, the module can use `import * as React from 'react'`.
+Our first example of a widget module is `helloWidget` above.
+Widget modules must be registered with the `@[widget_module]` attribute.
 
-We can register a widget source with the `@[widget]` attribute, giving it a friendlier name
-in the `name` field. This is bundled together in a `UserWidgetDefinition`.
-
-A *widget instance* is then the identifier of a `UserWidgetDefinition` (so `` `helloWidget ``,
-not `"Hello"`) associated with a range of positions in the Lean source code. Widget instances
-are stored in the *infotree* in the same manner as other information about the source file
-such as the type of every expression. In our example, the `#widget` command stores a widget instance
-with the entire line as its range. We can think of a widget instance as an instruction for the
-infoview: "when the user places their cursor here, please render the following widget".
-
-Every widget instance also contains a `props : Json` value. This value is passed as an argument
-to the React component. In our first invocation of `#widget`, we set it to `.null`. Try out what
-happens when you type in:
+A [widget instance](https://leanprover-community.github.io/mathlib4_docs/Lean/Widget/Types.html#Lean.Widget.WidgetInstance)
+is then the identifier of a widget module (e.g. `` `helloWidget ``)
+bundled with a value for its props.
+This value is passed as the argument to the React component.
+In our first invocation of `#widget`, we set it to `.null`.
+Try out what happens when you type in:
 -/
 
 structure HelloWidgetProps where
@@ -62,21 +64,37 @@ structure HelloWidgetProps where
 #widget helloWidget with { name? := "<your name here>" : HelloWidgetProps }
 
 /-!
-💡 NOTE: The RPC system presented below does not depend on JavaScript. However the primary use case
-is the web-based infoview in VSCode.
+Under the hood, widget instances are associated with a range of positions in the source file.
+Widget instances are stored in the *infotree*
+in the same manner as other information about the source file
+such as the type of every expression.
+In our example, the `#widget` command stores a widget instance
+with the entire line as its range.
+One can think of the infotree entry as an instruction for the infoview:
+"when the user places their cursor here, please render the following widget".
+-/
 
+/-!
 ## Querying the Lean server
 
-Besides enabling us to create cool client-side visualizations, user widgets come with the ability
-to communicate with the Lean server. Thanks to this, they have the same metaprogramming capabilities
-as custom elaborators or the tactic framework. To see this in action, let's implement a `#check`
-command as a web input form. This example assumes some familiarity with React.
+💡 NOTE: The RPC system presented below does not depend on JavaScript.
+However, the primary use case is the web-based infoview in VSCode.
 
-The first thing we'll need is to create an *RPC method*. Meaning "Remote Procedure Call", this
-is basically a Lean function callable from widget code (possibly remotely over the internet).
+Besides enabling us to create cool client-side visualizations,
+user widgets have the ability to communicate with the Lean server.
+Thanks to this, they have the same metaprogramming capabilities
+as custom elaborators or the tactic framework.
+To see this in action, let's implement a `#check` command as a web input form.
+This example assumes some familiarity with React.
+
+The first thing we'll need is to create an *RPC method*.
+Meaning "Remote Procedure Call",this is a Lean function callable from widget code
+(possibly remotely over the internet).
 Our method will take in the `name : Name` of a constant in the environment and return its type.
-By convention, we represent the input data as a `structure`. Since it will be sent over from JavaScript,
-we need `FromJson` and `ToJson`. We'll see below why the position field is needed.
+By convention, we represent the input data as a `structure`.
+Since it will be sent over from JavaScript,
+we need `FromJson` and `ToJson` instnace.
+We'll see why the position field is needed later.
 -/
 
 structure GetTypeParams where
@@ -87,25 +105,33 @@ structure GetTypeParams where
   deriving FromJson, ToJson
 
 /-!
-After its arguments, we define the `getType` method. Every RPC method executes in the `RequestM`
-monad and must return a `RequestTask α` where `α` is its "actual" return type. The `Task` is so
-that requests can be handled concurrently. A first guess for `α` might be `Expr`. However,
-expressions in general can be large objects which depend on an `Environment` and `LocalContext`.
-Thus we cannot directly serialize an `Expr` and send it to the widget. Instead, there are two
-options:
-- One is to send a *reference* which points to an object residing on the server. From JavaScript's
-  point of view, references are entirely opaque, but they can be sent back to other RPC methods for
-  further processing.
-- Two is to pretty-print the expression and send its textual representation called `CodeWithInfos`.
-  This representation contains extra data which the infoview uses for interactivity. We take this
-  strategy here.
+After its argument structure, we define the `getType` method.
+RPCs method execute in the `RequestM` monad and must return a `RequestTask α`
+where `α` is the "actual" return type.
+The `Task` is so that requests can be handled concurrently.
+As a first guess, we'd use `Expr` as `α`.
+However, expressions in general can be large objects
+which depend on an `Environment` and `LocalContext`.
+Thus we cannot directly serialize an `Expr` and send it to JavaScript.
+Instead, there are two options:
 
-RPC methods execute in the context of a file, but not any particular `Environment` so they don't
-know about the available `def`initions and `theorem`s. Thus, we need to pass in a position at which
-we want to use the local `Environment`. This is why we store it in `GetTypeParams`. The `withWaitFindSnapAtPos`
-method launches a concurrent computation whose job is to find such an `Environment` and a bit
-more information for us, in the form of a `snap : Snapshot`. With this in hand, we can call
-`MetaM` procedures to find out the type of `name` and pretty-print it.
+- One is to send a *reference* which points to an object residing on the server.
+  From JavaScript's point of view, references are entirely opaque,
+  but they can be sent back to other RPC methods for further processing.
+- The other is to pretty-print the expression and send its textual representation called `CodeWithInfos`.
+  This representation contains extra data which the infoview uses for interactivity.
+  We take this strategy here.
+
+RPC methods execute in the context of a file,
+but not of any particular `Environment`,
+so they don't know about the available `def`initions and `theorem`s.
+Thus, we need to pass in a position at which we want to use the local `Environment`.
+This is why we store it in `GetTypeParams`.
+The `withWaitFindSnapAtPos` method launches a concurrent computation
+whose job is to find such an `Environment` for us,
+in the form of a `snap : Snapshot`.
+With this in hand, we can call `MetaM` procedures
+to find out the type of `name` and pretty-print it.
 -/
 
 open Server RequestM in
@@ -121,18 +147,22 @@ def getType (params : GetTypeParams) : RequestM (RequestTask CodeWithInfos) :=
 /-!
 ## Using infoview components
 
-Now that we have all we need on the server side, let's write the widget source. By importing
-`@leanprover/infoview`, widgets can render UI components used to implement the infoview itself.
-For example, the `<InteractiveCode>` component displays expressions with `term : type` tooltips
-as seen in the goal view. We will use it to implement our custom `#check` display.
+Now that we have all we need on the server side, let's write the widget module.
+By importing `@leanprover/infoview`, widgets can render UI components used to implement the infoview itself.
+For example, the `<InteractiveCode>` component displays expressions
+with `term : type` tooltips as seen in the goal view.
+We will use it to implement our custom `#check` display.
 
 ⚠️ WARNING: Like the other widget APIs, the infoview JS API is **unstable** and subject to breaking changes.
 
-The code below demonstrates useful parts of the API. To make RPC method calls, we use the `RpcContext`.
-The `useAsync` helper packs the results of a call into an `AsyncState` structure which indicates
-whether the call has resolved successfully, has returned an error, or is still in-flight. Based
-on this we either display an `InteractiveCode` with the type, `mapRpcError` the error in order
-to turn it into a readable message, or show a `Loading..` message, respectively.
+The code below demonstrates useful parts of the API.
+To make RPC method calls, we invoke the `useRpcSession` hook.
+The `useAsync` helper packs the results of an RPC call into an `AsyncState` structure
+which indicates whether the call has resolved successfully,
+has returned an error, or is still in-flight.
+Based on this we either display an `InteractiveCode` component with the result,
+`mapRpcError` the error in order to turn it into a readable message,
+or show a `Loading..` message, respectively.
 -/
 
 @[widget_module]
@@ -140,10 +170,10 @@ def checkWidget : Widget.Module where
   javascript := "
 import * as React from 'react';
 const e = React.createElement;
-import { RpcContext, InteractiveCode, useAsync, mapRpcError } from '@leanprover/infoview';
+import { useRpcSession, InteractiveCode, useAsync, mapRpcError } from '@leanprover/infoview';
 
 export default function(props) {
-  const rs = React.useContext(RpcContext)
+  const rs = useRpcSession()
   const [name, setName] = React.useState('getType')
 
   const st = useAsync(() =>
@@ -159,7 +189,7 @@ export default function(props) {
 "
 
 /-!
-Finally we can try out the widget.
+We can now try out the widget.
 -/
 
 #widget checkWidget
@@ -169,30 +199,31 @@ Finally we can try out the widget.
 
 ## Building widget sources
 
-While typing JavaScript inline is fine for a simple example, for real developments we want to use
-packages from NPM, a proper build system, and JSX. Thus, most actual widget sources are built with
-Lake and NPM. They consist of multiple files and may import libraries which don't work as ESModules
-by default. On the other hand a widget source must be a single, self-contained ESModule in the form
-of a string. Readers familiar with web development may already have guessed that to obtain such a
-string, we need a *bundler*. Two popular choices are [`rollup.js`](https://rollupjs.org/guide/en/)
-and [`esbuild`](https://esbuild.github.io/). If we go with `rollup.js`, to make a widget work with
-the infoview we need to:
+While typing JavaScript inline is fine for a simple example,
+for real developments we want to use packages from NPM, a proper build system, and JSX.
+Thus, most actual widget sources are built with Lake and NPM.
+They consist of multiple files and may import libraries which don't work as ESModules by default.
+On the other hand a widget module must be a single, self-contained ESModule in the form of a string.
+Readers familiar with web development may already have guessed that to obtain such a string, we need a *bundler*.
+Two popular choices are [`rollup.js`](https://rollupjs.org/guide/en/)
+and [`esbuild`](https://esbuild.github.io/).
+If we go with `rollup.js`, to make a widget work with the infoview we need to:
 - Set [`output.format`](https://rollupjs.org/guide/en/#outputformat) to `'es'`.
 - [Externalize](https://rollupjs.org/guide/en/#external) `react`, `react-dom`, `@leanprover/infoview`.
   These libraries are already loaded by the infoview so they should not be bundled.
 
-In the RubiksCube sample, we provide a working `rollup.js` build configuration in
-[rollup.config.js](https://github.com/leanprover/lean4-samples/blob/main/RubiksCube/widget/rollup.config.js).
+ProofWidgets provides a working `rollup.js` build configuration in
+[rollup.config.js](https://github.com/leanprover-community/ProofWidgets4/blob/main/widget/rollup.config.js).
 
 ## Inserting text
 
-We can also instruct the editor to insert text, copy text to the clipboard, or
-reveal a certain location in the document.
-To do this, use the `React.useContext(EditorContext)` React context.
-This will return an `EditorConnection` whose `api` field contains a number of methods to
-interact with the text editor.
+Besides making RPC calls, widgets can instruct the editor to carry out certain actions.
+We can insert text, copy text to the clipboard, or highlight a certain location in the document.
+To do this, use the `EditorContext` React context.
+This will return an `EditorConnection`
+whose `api` field contains a number of methods that interact with the editor.
 
-You can see the full API for this [here](https://github.com/leanprover/vscode-lean4/blob/master/lean4-infoview-api/src/infoviewApi.ts#L52)
+The full API can be viewed [here](https://github.com/leanprover/vscode-lean4/blob/master/lean4-infoview-api/src/infoviewApi.ts#L52).
 -/
 
 @[widget_module]
@@ -212,6 +243,4 @@ export default function(props) {
 }
 "
 
-/-! Finally, we can try this out: -/
-
 #widget insertTextWidget

doc/make/osx-10.9.md

@@ -32,7 +32,7 @@ following to use `g++`.
 cmake -DCMAKE_CXX_COMPILER=g++ ...
 ```
 
-## Required Packages: CMake, GMP
+## Required Packages: CMake, GMP, libuv
 
 ```bash
 brew install cmake

flake.lock

@@ -34,6 +34,22 @@
         "type": "github"
       }
     },
+    "nixpkgs-cadical": {
+      "locked": {
+        "lastModified": 1722221733,
+        "narHash": "sha256-sga9SrrPb+pQJxG1ttJfMPheZvDOxApFfwXCFO0H9xw=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "12bf09802d77264e441f48e25459c10c93eada2e",
+        "type": "github"
+      },
+      "original": {
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "12bf09802d77264e441f48e25459c10c93eada2e",
+        "type": "github"
+      }
+    },
     "nixpkgs-old": {
       "flake": false,
       "locked": {
@@ -55,6 +71,7 @@
       "inputs": {
         "flake-utils": "flake-utils",
         "nixpkgs": "nixpkgs",
+        "nixpkgs-cadical": "nixpkgs-cadical",
         "nixpkgs-old": "nixpkgs-old"
       }
     },

flake.nix

@@ -5,6 +5,8 @@
   # old nixpkgs used for portable release with older glibc (2.27)
   inputs.nixpkgs-old.url = "github:NixOS/nixpkgs/nixos-19.03";
   inputs.nixpkgs-old.flake = false;
+  # for cadical 1.9.5; sync with CMakeLists.txt
+  inputs.nixpkgs-cadical.url = "github:NixOS/nixpkgs/12bf09802d77264e441f48e25459c10c93eada2e";
   inputs.flake-utils.url = "github:numtide/flake-utils";
 
   outputs = { self, nixpkgs, nixpkgs-old, flake-utils, ... }@inputs: flake-utils.lib.eachDefaultSystem (system:
@@ -14,6 +16,11 @@
       pkgsDist-old = import nixpkgs-old { inherit system; };
       # An old nixpkgs for creating releases with an old glibc
       pkgsDist-old-aarch = import nixpkgs-old { localSystem.config = "aarch64-unknown-linux-gnu"; };
+      pkgsCadical = import inputs.nixpkgs-cadical { inherit system; };
+      cadical = if pkgs.stdenv.isLinux then
+        # use statically-linked cadical on Linux to avoid glibc versioning troubles
+        pkgsCadical.pkgsStatic.cadical.overrideAttrs { doCheck = false; }
+      else pkgsCadical.cadical;
 
       lean-packages = pkgs.callPackage (./nix/packages.nix) { src = ./.; };
 
@@ -21,11 +28,9 @@
           stdenv = pkgs.overrideCC pkgs.stdenv lean-packages.llvmPackages.clang;
         } ({
           buildInputs = with pkgs; [
-            cmake gmp libuv ccache
+            cmake gmp libuv ccache cadical
             lean-packages.llvmPackages.llvm  # llvm-symbolizer for asan/lsan
             gdb
-            # TODO: only add when proven to not affect the flakification
-            #pkgs.python3
             tree  # for CI
           ];
           # https://github.com/NixOS/nixpkgs/issues/60919

nix/bootstrap.nix

@@ -1,5 +1,5 @@
 { src, debug ? false, stage0debug ? false, extraCMakeFlags ? [],
-  stdenv, lib, cmake, gmp, libuv, git, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
+  stdenv, lib, cmake, gmp, libuv, cadical, git, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
   ... } @ args:
 with builtins;
 lib.warn "The Nix-based build is deprecated" rec {
@@ -17,7 +17,7 @@ lib.warn "The Nix-based build is deprecated" rec {
     '';
   } // args // {
     src = args.realSrc or (sourceByRegex args.src [ "[a-z].*" "CMakeLists\.txt" ]);
-    cmakeFlags = (args.cmakeFlags or [ "-DSTAGE=1" "-DPREV_STAGE=./faux-prev-stage" "-DUSE_GITHASH=OFF" ]) ++ (args.extraCMakeFlags or extraCMakeFlags) ++ lib.optional (args.debug or debug) [ "-DCMAKE_BUILD_TYPE=Debug" ];
+    cmakeFlags = (args.cmakeFlags or [ "-DSTAGE=1" "-DPREV_STAGE=./faux-prev-stage" "-DUSE_GITHASH=OFF" "-DCADICAL=${cadical}/bin/cadical" ]) ++ (args.extraCMakeFlags or extraCMakeFlags) ++ lib.optional (args.debug or debug) [ "-DCMAKE_BUILD_TYPE=Debug" ];
     preConfigure = args.preConfigure or "" + ''
       # ignore absence of submodule
       sed -i 's!lake/Lake.lean!!' CMakeLists.txt

releases_drafts/hashmap.md

@@ -0,0 +1,3 @@
+* The `Lean` module has switched from `Lean.HashMap` and `Lean.HashSet` to `Std.HashMap` and `Std.HashSet`. `Lean.HashMap` and `Lean.HashSet` are now deprecated and will be removed in a future release. Users of `Lean` APIs that interact with hash maps, for example `Lean.Environment.const2ModIdx`, might encounter minor breakage due to the following breaking changes from `Lean.HashMap` to `Std.HashMap`:
+    * query functions use the term `get` instead of `find`,
+    * the notation `map[key]` no longer returns an optional value but expects a proof that the key is present in the map instead. The previous behavior is available via the `map[key]?` notation.

releases_drafts/libuv.md

@@ -0,0 +1 @@
+* #4963 [LibUV](https://libuv.org/) is now required to build Lean. This change only affects developers who compile Lean themselves instead of obtaining toolchains via `elan`. We have updated the official build instructions with information on how to obtain LibUV on our supported platforms.

releases_drafts/new-variable.md

@@ -0,0 +1,17 @@
+**breaking change**
+
+The effect of the `variable` command on proofs of `theorem`s has been changed. Whether such section variables are accessible in the proof now depends only on the theorem signature and other top-level commands, not on the proof itself.
+This change ensures that
+* the statement of a theorem is independent of its proof. In other words, changes in the proof cannot change the theorem statement.
+* tactics such as `induction` cannot accidentally include a section variable.
+* the proof can be elaborated in parallel to subsequent declarations in a future version of Lean.
+
+The effect of `variable`s on the theorem header as well as on other kinds of declarations is unchanged.
+
+Specifically, section variables are included if they
+* are directly referenced by the theorem header,
+* are included via the new `include` command in the current section and not subsequently mentioned in an `omit` statement,
+* are directly referenced by any variable included by these rules, OR
+* are instance-implicit variables that reference only variables included by these rules.
+
+For porting, a new option `deprecated.oldSectionVars` is included to locally switch back to the old behavior.

src/CMakeLists.txt

@@ -382,6 +382,7 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Linux")
 elseif(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
   string(APPEND CMAKE_CXX_FLAGS " -ftls-model=initial-exec")
   string(APPEND INIT_SHARED_LINKER_FLAGS " -install_name @rpath/libInit_shared.dylib")
+  string(APPEND LEANSHARED_1_LINKER_FLAGS " -install_name @rpath/libleanshared_1.dylib")
   string(APPEND LEANSHARED_LINKER_FLAGS " -install_name @rpath/libleanshared.dylib")
   string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,-rpath,@executable_path/../lib -Wl,-rpath,@executable_path/../lib/lean")
 elseif(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
@@ -632,6 +633,10 @@ file(COPY ${LEAN_SOURCE_DIR}/bin/leanmake DESTINATION ${CMAKE_BINARY_DIR}/bin)
 
 install(DIRECTORY "${CMAKE_BINARY_DIR}/bin/" USE_SOURCE_PERMISSIONS DESTINATION bin)
 
+if (${STAGE} GREATER 0)
+  install(PROGRAMS "${CADICAL}" DESTINATION bin)
+endif()
+
 add_custom_target(clean-stdlib
   COMMAND rm -rf "${CMAKE_BINARY_DIR}/lib" || true)
 

src/Init/Control/ExceptCps.lean

@@ -34,7 +34,7 @@ instance : Monad (ExceptCpsT ε m) where
   bind x f := fun _ k₁ k₂ => x _ (fun a => f a _ k₁ k₂) k₂
 
 instance : LawfulMonad (ExceptCpsT σ m) := by
-  refine' { .. } <;> intros <;> rfl
+  refine LawfulMonad.mk' _ ?_ ?_ ?_ <;> intros <;> rfl
 
 instance : MonadExceptOf ε (ExceptCpsT ε m) where
   throw e  := fun _ _ k => k e

src/Init/Control/Lawful/Basic.lean

@@ -153,7 +153,7 @@ namespace Id
 @[simp] theorem pure_eq (a : α) : (pure a : Id α) = a := rfl
 
 instance : LawfulMonad Id := by
-  refine' { .. } <;> intros <;> rfl
+  refine LawfulMonad.mk' _ ?_ ?_ ?_ <;> intros <;> rfl
 
 end Id
 

src/Init/Control/StateCps.lean

@@ -35,7 +35,7 @@ instance : Monad (StateCpsT σ m) where
   bind x f := fun δ s k => x δ s fun a s => f a δ s k
 
 instance : LawfulMonad (StateCpsT σ m) := by
-  refine' { .. } <;> intros <;> rfl
+  refine LawfulMonad.mk' _ ?_ ?_ ?_ <;> intros <;> rfl
 
 @[always_inline]
 instance : MonadStateOf σ (StateCpsT σ m) where

src/Init/Core.lean

@@ -36,6 +36,17 @@ and `flip (·<·)` is the greater-than relation.
 
 theorem Function.comp_def {α β δ} (f : β → δ) (g : α → β) : f ∘ g = fun x => f (g x) := rfl
 
+@[simp] theorem Function.const_comp {f : α → β} {c : γ} :
+    (Function.const β c ∘ f) = Function.const α c := by
+  rfl
+@[simp] theorem Function.comp_const {f : β → γ} {b : β} :
+    (f ∘ Function.const α b) = Function.const α (f b) := by
+  rfl
+@[simp] theorem Function.true_comp {f : α → β} : ((fun _ => true) ∘ f) = fun _ => true := by
+  rfl
+@[simp] theorem Function.false_comp {f : α → β} : ((fun _ => false) ∘ f) = fun _ => false := by
+  rfl
+
 attribute [simp] namedPattern
 
 /--

src/Init/Data.lean

@@ -37,3 +37,5 @@ import Init.Data.Cast
 import Init.Data.Sum
 import Init.Data.BEq
 import Init.Data.Subtype
+import Init.Data.ULift
+import Init.Data.PLift

src/Init/Data/AC.lean

@@ -6,7 +6,7 @@ Authors: Dany Fabian
 
 prelude
 import Init.Classical
-import Init.Data.List
+import Init.ByCases
 
 namespace Lean.Data.AC
 inductive Expr

src/Init/Data/Array/Mem.lean

@@ -38,8 +38,8 @@ macro "array_get_dec" : tactic =>
     -- subsumed by simp
     -- | with_reducible apply sizeOf_get
     -- | with_reducible apply sizeOf_getElem
-    | (with_reducible apply Nat.lt_trans (sizeOf_get ..)); simp_arith
-    | (with_reducible apply Nat.lt_trans (sizeOf_getElem ..)); simp_arith
+    | (with_reducible apply Nat.lt_of_lt_of_le (sizeOf_get ..)); simp_arith
+    | (with_reducible apply Nat.lt_of_lt_of_le (sizeOf_getElem ..)); simp_arith
     )
 
 macro_rules | `(tactic| decreasing_trivial) => `(tactic| array_get_dec)
@@ -52,7 +52,7 @@ macro "array_mem_dec" : tactic =>
   `(tactic| first
     | with_reducible apply Array.sizeOf_lt_of_mem; assumption; done
     | with_reducible
-        apply Nat.lt_trans (Array.sizeOf_lt_of_mem ?h)
+        apply Nat.lt_of_lt_of_le (Array.sizeOf_lt_of_mem ?h)
         case' h => assumption
       simp_arith)
 

src/Init/Data/BitVec/Lemmas.lean

@@ -413,11 +413,9 @@ theorem msb_truncate (x : BitVec w) : (x.truncate (k + 1)).msb = x.getLsb k := b
     (x.truncate l).truncate k = x.truncate k :=
   zeroExtend_zeroExtend_of_le x h
 
-/--Truncating by the bitwidth has no effect. -/
-@[simp]
-theorem truncate_eq_self {x : BitVec w} : x.truncate w = x := by
-  ext i
-  simp [getLsb_zeroExtend]
+/-- Truncating by the bitwidth has no effect. -/
+-- This doesn't need to be a `@[simp]` lemma, as `zeroExtend_eq` applies.
+theorem truncate_eq_self {x : BitVec w} : x.truncate w = x := zeroExtend_eq _
 
 @[simp] theorem truncate_cast {h : w = v} : (cast h x).truncate k = x.truncate k := by
   apply eq_of_getLsb_eq
@@ -472,10 +470,18 @@ protected theorem extractLsb_ofNat (x n : Nat) (hi lo : Nat) :
 @[simp] theorem extractLsb_toNat (hi lo : Nat) (x : BitVec n) :
   (extractLsb hi lo x).toNat = (x.toNat >>> lo) % 2^(hi-lo+1) := rfl
 
+@[simp] theorem getLsb_extractLsb' (start len : Nat) (x : BitVec n) (i : Nat) :
+    (extractLsb' start len x).getLsb i = (i < len && x.getLsb (start+i)) := by
+  simp [getLsb, Nat.lt_succ]
+
 @[simp] theorem getLsb_extract (hi lo : Nat) (x : BitVec n) (i : Nat) :
     getLsb (extractLsb hi lo x) i = (i ≤ (hi-lo) && getLsb x (lo+i)) := by
-  unfold getLsb
-  simp [Nat.lt_succ]
+  simp [getLsb, Nat.lt_succ]
+
+theorem extractLsb'_eq_extractLsb {w : Nat} (x : BitVec w) (start len : Nat) (h : len > 0) :
+    x.extractLsb' start len = (x.extractLsb (len - 1 + start) start).cast (by omega) := by
+  apply eq_of_toNat_eq
+  simp [extractLsb, show len - 1 + 1 = len by omega]
 
 /-! ### allOnes -/
 
@@ -768,7 +774,6 @@ theorem shiftLeft_shiftLeft {w : Nat} (x : BitVec w) (n m : Nat) :
 @[simp]
 theorem shiftLeft_eq' {x : BitVec w₁} {y : BitVec w₂} : x <<< y = x <<< y.toNat := by rfl
 
-@[simp]
 theorem shiftLeft_zero' {x : BitVec w₁} : x <<< 0#w₂ = x := by simp
 
 theorem shiftLeft_shiftLeft' {x : BitVec w₁} {y : BitVec w₂} {z : BitVec w₃} :
@@ -936,6 +941,31 @@ theorem sshiftRight_add {x : BitVec w} {m n : Nat} :
 @[simp]
 theorem sshiftRight_eq' (x : BitVec w) : x.sshiftRight' y = x.sshiftRight y.toNat := rfl
 
+/-! ### udiv -/
+
+theorem udiv_eq {x y : BitVec n} : x.udiv y = BitVec.ofNat n (x.toNat / y.toNat) := by
+  have h : x.toNat / y.toNat < 2 ^ n := Nat.lt_of_le_of_lt (Nat.div_le_self ..) (by omega)
+  simp [udiv, bv_toNat, h, Nat.mod_eq_of_lt]
+
+@[simp, bv_toNat]
+theorem toNat_udiv {x y : BitVec n} : (x.udiv y).toNat = x.toNat / y.toNat := by
+  simp only [udiv_eq]
+  by_cases h : y = 0
+  · simp [h]
+  · rw [toNat_ofNat, Nat.mod_eq_of_lt]
+    exact Nat.lt_of_le_of_lt (Nat.div_le_self ..) (by omega)
+
+/-! ### umod -/
+
+theorem umod_eq {x y : BitVec n} :
+    x.umod y = BitVec.ofNat n (x.toNat % y.toNat) := by
+  have h : x.toNat % y.toNat < 2 ^ n := Nat.lt_of_le_of_lt (Nat.mod_le _ _) x.isLt
+  simp [umod, bv_toNat, Nat.mod_eq_of_lt h]
+
+@[simp, bv_toNat]
+theorem toNat_umod {x y : BitVec n} :
+    (x.umod y).toNat = x.toNat % y.toNat := rfl
+
 /-! ### signExtend -/
 
 /-- Equation theorem for `Int.sub` when both arguments are `Int.ofNat` -/

src/Init/Data/Bool.lean

@@ -55,6 +55,12 @@ theorem eq_iff_iff {a b : Bool} : a = b ↔ (a ↔ b) := by cases b <;> simp
 theorem decide_true_eq  {b : Bool} [Decidable (true = b)]  : decide (true  = b) =  b := by cases b <;> simp
 theorem decide_false_eq {b : Bool} [Decidable (false = b)] : decide (false = b) = !b := by cases b <;> simp
 
+-- These lemmas assist with confluence.
+@[simp] theorem eq_false_imp_eq_true_iff :
+    ∀(a b : Bool), ((a = false → b = true) ↔ (b = false → a = true)) = True := by decide
+@[simp] theorem eq_true_imp_eq_false_iff :
+    ∀(a b : Bool), ((a = true → b = false) ↔ (b = true → a = false)) = True := by decide
+
 /-! ### and -/
 
 @[simp] theorem and_self_left  : ∀(a b : Bool), (a && (a && b)) = (a && b) := by decide
@@ -91,6 +97,11 @@ Needed for confluence of term `(a && b) ↔ a` which reduces to `(a && b) = a` v
 @[simp] theorem iff_self_and : ∀(a b : Bool), (a = (a && b)) ↔ (a → b) := by decide
 @[simp] theorem iff_and_self : ∀(a b : Bool), (b = (a && b)) ↔ (b → a) := by decide
 
+@[simp] theorem not_and_iff_left_iff_imp  : ∀ (a b : Bool), ((!a && b) = a) ↔ !a ∧ !b := by decide
+@[simp] theorem and_not_iff_right_iff_imp : ∀ (a b : Bool), ((a && !b) = b) ↔ !a ∧ !b := by decide
+@[simp] theorem iff_not_self_and : ∀ (a b : Bool), (a = (!a && b)) ↔ !a ∧ !b := by decide
+@[simp] theorem iff_and_not_self : ∀ (a b : Bool), (b = (a && !b)) ↔ !a ∧ !b := by decide
+
 /-! ### or -/
 
 @[simp] theorem or_self_left  : ∀(a b : Bool), (a || (a || b)) = (a || b) := by decide
@@ -120,6 +131,11 @@ Needed for confluence of term `(a || b) ↔ a` which reduces to `(a || b) = a` v
 @[simp] theorem iff_self_or : ∀(a b : Bool), (a = (a || b)) ↔ (b → a) := by decide
 @[simp] theorem iff_or_self : ∀(a b : Bool), (b = (a || b)) ↔ (a → b) := by decide
 
+@[simp] theorem not_or_iff_left_iff_imp  : ∀ (a b : Bool), ((!a || b) = a) ↔ a ∧ b := by decide
+@[simp] theorem or_not_iff_right_iff_imp : ∀ (a b : Bool), ((a || !b) = b) ↔ a ∧ b := by decide
+@[simp] theorem iff_not_self_or : ∀ (a b : Bool), (a = (!a || b)) ↔ a ∧ b := by decide
+@[simp] theorem iff_or_not_self : ∀ (a b : Bool), (b = (a || !b)) ↔ a ∧ b := by decide
+
 theorem or_comm : ∀ (x y : Bool), (x || y) = (y || x) := by decide
 instance : Std.Commutative (· || ·) := ⟨or_comm⟩
 
@@ -134,7 +150,7 @@ theorem and_or_distrib_right : ∀ (x y z : Bool), ((x || y) && z) = (x && z ||
 theorem or_and_distrib_left  : ∀ (x y z : Bool), (x || y && z) = ((x || y) && (x || z)) := by decide
 theorem or_and_distrib_right : ∀ (x y z : Bool), (x && y || z) = ((x || z) && (y || z)) := by decide
 
-theorem and_xor_distrib_left : ∀ (x y z : Bool), (x && xor y z) = xor (x && y) (x && z) := by decide
+theorem and_xor_distrib_left  : ∀ (x y z : Bool), (x && xor y z) = xor (x && y) (x && z) := by decide
 theorem and_xor_distrib_right : ∀ (x y z : Bool), (xor x y && z) = xor (x && z) (y && z) := by decide
 
 /-- De Morgan's law for boolean and -/
@@ -202,8 +218,11 @@ instance : Std.LawfulIdentity (· != ·) false where
 @[simp] theorem not_beq_self : ∀ (x : Bool), ((!x) == x) = false := by decide
 @[simp] theorem beq_not_self : ∀ (x : Bool), (x   == !x) = false := by decide
 
-@[simp] theorem not_bne_self : ∀ (x : Bool), ((!x) != x) = true := by decide
-@[simp] theorem bne_not_self : ∀ (x : Bool), (x   != !x) = true := by decide
+@[simp] theorem not_bne : ∀ (a b : Bool), ((!a) != b) = !(a != b) := by decide
+@[simp] theorem bne_not : ∀ (a b : Bool), (a != !b) = !(a != b) := by decide
+
+theorem not_bne_self : ∀ (x : Bool), ((!x) != x) = true := by decide
+theorem bne_not_self : ∀ (x : Bool), (x   != !x) = true := by decide
 
 /-
 Added for equivalence with `Bool.not_beq_self` and needed for confluence
@@ -235,8 +254,10 @@ theorem beq_eq_decide_eq [BEq α] [LawfulBEq α] [DecidableEq α] (a b : α) :
   · simp [ne_of_beq_false h]
   · simp [eq_of_beq h]
 
-@[simp] theorem not_eq_not : ∀ {a b : Bool}, ¬a = !b ↔ a = b := by decide
+theorem eq_not : ∀ (a b : Bool), (a = (!b)) ↔ (a ≠ b) := by decide
+theorem not_eq : ∀ (a b : Bool), ((!a) = b) ↔ (a ≠ b) := by decide
 
+@[simp] theorem not_eq_not : ∀ {a b : Bool}, ¬a = !b ↔ a = b := by decide
 @[simp] theorem not_not_eq : ∀ {a b : Bool}, ¬(!a) = b ↔ a = b := by decide
 
 @[simp] theorem coe_iff_coe : ∀(a b : Bool), (a ↔ b) ↔ a = b := by decide
@@ -427,16 +448,18 @@ theorem not_ite_eq_false_eq_true (p : Prop) [h : Decidable p] (b c : Bool) :
   cases h with | _ p => simp [p]
 
 /-
-Added for confluence between `if_true_left` and `ite_false_same` on
-`if b = true then True else b = true`
+It would be nice to have this for confluence between `if_true_left` and `ite_false_same` on
+`if b = true then True else b = true`.
+However the discrimination tree key is just `→`, so this is tried too often.
 -/
-@[simp] theorem eq_false_imp_eq_true : ∀(b:Bool), (b = false → b = true) ↔ (b = true) := by decide
+theorem eq_false_imp_eq_true : ∀(b:Bool), (b = false → b = true) ↔ (b = true) := by decide
 
 /-
-Added for confluence between `if_true_left` and `ite_false_same` on
-`if b = false then True else b = false`
+It would be nice to have this for confluence between `if_true_left` and `ite_false_same` on
+`if b = false then True else b = false`.
+However the discrimination tree key is just `→`, so this is tried too often.
 -/
-@[simp] theorem eq_true_imp_eq_false : ∀(b:Bool), (b = true → b = false) ↔ (b = false) := by decide
+theorem eq_true_imp_eq_false : ∀(b:Bool), (b = true → b = false) ↔ (b = false) := by decide
 
 /-! ### forall -/
 
@@ -509,6 +532,10 @@ protected theorem cond_false {α : Type u} {a b : α} : cond false a b = b := co
 @[simp] theorem cond_true_right  : ∀(c t : Bool), cond c t true  = (!c || t) := by decide
 @[simp] theorem cond_false_right : ∀(c t : Bool), cond c t false = ( c && t) := by decide
 
+-- These restore confluence between the above lemmas and `cond_not`.
+@[simp] theorem cond_true_not_same  : ∀ (c b : Bool), cond c (!c) b = (!c && b) := by decide
+@[simp] theorem cond_false_not_same : ∀ (c b : Bool), cond c b (!c) = (!c || b) := by decide
+
 @[simp] theorem cond_true_same  : ∀(c b : Bool), cond c c b = (c || b) := by decide
 @[simp] theorem cond_false_same : ∀(c b : Bool), cond c b c = (c && b) := by decide
 
@@ -549,3 +576,19 @@ export Bool (cond_eq_if)
 
 @[simp] theorem true_eq_decide_iff {p : Prop} [h : Decidable p] : true = decide p ↔ p := by
   cases h with | _ q => simp [q]
+
+/-! ### coercions -/
+
+/--
+This should not be turned on globally as an instance because it degrades performance in Mathlib,
+but may be used locally.
+-/
+def boolPredToPred : Coe (α → Bool) (α  → Prop) where
+  coe r := fun a => Eq (r a) true
+
+/--
+This should not be turned on globally as an instance because it degrades performance in Mathlib,
+but may be used locally.
+-/
+def boolRelToRel : Coe (α → α → Bool) (α → α → Prop) where
+  coe r := fun a b => Eq (r a b) true

src/Init/Data/Fin/Basic.lean

@@ -149,6 +149,9 @@ instance : Inhabited (Fin (no_index (n+1))) where
 
 @[simp] theorem zero_eta : (⟨0, Nat.zero_lt_succ _⟩ : Fin (n + 1)) = 0 := rfl
 
+theorem ne_of_val_ne {i j : Fin n} (h : val i ≠ val j) : i ≠ j :=
+  fun h' => absurd (val_eq_of_eq h') h
+
 theorem val_ne_of_ne {i j : Fin n} (h : i ≠ j) : val i ≠ val j :=
   fun h' => absurd (eq_of_val_eq h') h
 

src/Init/Data/Int/DivModLemmas.lean

@@ -57,7 +57,7 @@ protected theorem dvd_mul_right (a b : Int) : a ∣ a * b := ⟨_, rfl⟩
 
 protected theorem dvd_mul_left (a b : Int) : b ∣ a * b := ⟨_, Int.mul_comm ..⟩
 
-protected theorem neg_dvd {a b : Int} : -a ∣ b ↔ a ∣ b := by
+@[simp] protected theorem neg_dvd {a b : Int} : -a ∣ b ↔ a ∣ b := by
   constructor <;> exact fun ⟨k, e⟩ =>
     ⟨-k, by simp [e, Int.neg_mul, Int.mul_neg, Int.neg_neg]⟩
 
@@ -357,6 +357,7 @@ theorem add_ediv_of_dvd_left {a b c : Int} (H : c ∣ a) : (a + b) / c = a / c +
 @[simp] theorem mul_ediv_cancel_left (b : Int) (H : a ≠ 0) : (a * b) / a = b :=
   Int.mul_comm .. ▸ Int.mul_ediv_cancel _ H
 
+
 theorem div_nonneg_iff_of_pos {a b : Int} (h : 0 < b) : a / b ≥ 0 ↔ a ≥ 0 := by
   rw [Int.div_def]
   match b, h with
@@ -454,6 +455,12 @@ theorem lt_mul_ediv_self_add {x k : Int} (h : 0 < k) : x < k * (x / k) + k :=
 @[simp] theorem add_mul_emod_self_left (a b c : Int) : (a + b * c) % b = a % b := by
   rw [Int.mul_comm, Int.add_mul_emod_self]
 
+@[simp] theorem add_neg_mul_emod_self {a b c : Int} : (a + -(b * c)) % c = a % c := by
+  rw [Int.neg_mul_eq_neg_mul, add_mul_emod_self]
+
+@[simp] theorem add_neg_mul_emod_self_left {a b c : Int} : (a + -(b * c)) % b = a % b := by
+  rw [Int.neg_mul_eq_mul_neg, add_mul_emod_self_left]
+
 @[simp] theorem add_emod_self {a b : Int} : (a + b) % b = a % b := by
   have := add_mul_emod_self_left a b 1; rwa [Int.mul_one] at this
 
@@ -498,9 +505,12 @@ theorem mul_emod (a b n : Int) : (a * b) % n = (a % n) * (b % n) % n := by
     Int.mul_assoc, Int.mul_assoc, ← Int.mul_add n _ _, add_mul_emod_self_left,
     ← Int.mul_assoc, add_mul_emod_self]
 
-@[local simp] theorem emod_self {a : Int} : a % a = 0 := by
+@[simp] theorem emod_self {a : Int} : a % a = 0 := by
   have := mul_emod_left 1 a; rwa [Int.one_mul] at this
 
+@[simp] theorem neg_emod_self (a : Int) : -a % a = 0 := by
+  rw [neg_emod, Int.sub_self, zero_emod]
+
 @[simp] theorem emod_emod_of_dvd (n : Int) {m k : Int}
     (h : m ∣ k) : (n % k) % m = n % m := by
   conv => rhs; rw [← emod_add_ediv n k]
@@ -596,6 +606,14 @@ theorem emod_eq_zero_of_dvd : ∀ {a b : Int}, a ∣ b → b % a = 0
 theorem dvd_iff_emod_eq_zero (a b : Int) : a ∣ b ↔ b % a = 0 :=
   ⟨emod_eq_zero_of_dvd, dvd_of_emod_eq_zero⟩
 
+@[simp] theorem neg_mul_emod_left (a b : Int) : -(a * b) % b = 0 := by
+  rw [← dvd_iff_emod_eq_zero, Int.dvd_neg]
+  exact Int.dvd_mul_left a b
+
+@[simp] theorem neg_mul_emod_right (a b : Int) : -(a * b) % a = 0 := by
+  rw [← dvd_iff_emod_eq_zero, Int.dvd_neg]
+  exact Int.dvd_mul_right a b
+
 instance decidableDvd : DecidableRel (α := Int) (· ∣ ·) := fun _ _ =>
   decidable_of_decidable_of_iff (dvd_iff_emod_eq_zero ..).symm
 
@@ -620,6 +638,12 @@ theorem neg_ediv_of_dvd : ∀ {a b : Int}, b ∣ a → (-a) / b = -(a / b)
     · simp [bz]
     · rw [Int.neg_mul_eq_mul_neg, Int.mul_ediv_cancel_left _ bz, Int.mul_ediv_cancel_left _ bz]
 
+@[simp] theorem neg_mul_ediv_cancel (a b : Int) (h : b ≠ 0) : -(a * b) / b = -a := by
+  rw [neg_ediv_of_dvd (Int.dvd_mul_left a b), mul_ediv_cancel _ h]
+
+@[simp] theorem neg_mul_ediv_cancel_left (a b : Int) (h : a ≠ 0) : -(a * b) / a = -b := by
+  rw [neg_ediv_of_dvd (Int.dvd_mul_right a b), mul_ediv_cancel_left _ h]
+
 theorem sub_ediv_of_dvd (a : Int) {b c : Int}
     (hcb : c ∣ b) : (a - b) / c = a / c - b / c := by
   rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.add_ediv_of_dvd_right (Int.dvd_neg.2 hcb)]
@@ -635,13 +659,22 @@ theorem sub_ediv_of_dvd (a : Int) {b c : Int}
 @[simp] protected theorem ediv_self {a : Int} (H : a ≠ 0) : a / a = 1 := by
   have := Int.mul_ediv_cancel 1 H; rwa [Int.one_mul] at this
 
+@[simp] protected theorem neg_ediv_self (a : Int) (h : a ≠ 0) : (-a) / a = -1 := by
+  rw [neg_ediv_of_dvd (Int.dvd_refl a), Int.ediv_self h]
+
 @[simp]
-theorem emod_sub_cancel (x y : Int): (x - y)%y = x%y := by
+theorem emod_sub_cancel (x y : Int): (x - y) % y = x % y := by
   by_cases h : y = 0
   · simp [h]
   · simp only [Int.emod_def, Int.sub_ediv_of_dvd, Int.dvd_refl, Int.ediv_self h, Int.mul_sub]
     simp [Int.mul_one, Int.sub_sub, Int.add_comm y]
 
+@[simp] theorem add_neg_emod_self (a b : Int) : (a + -b) % b = a % b := by
+  rw [← Int.sub_eq_add_neg, emod_sub_cancel]
+
+@[simp] theorem neg_add_emod_self (a b : Int) : (-a + b) % a = b % a := by
+  rw [Int.add_comm, add_neg_emod_self]
+
 /-- If `a % b = c` then `b` divides `a - c`. -/
 theorem dvd_sub_of_emod_eq {a b c : Int} (h : a % b = c) : b ∣ a - c := by
   have hx : (a % b) % b = c % b := by
@@ -891,6 +924,14 @@ theorem mod_eq_zero_of_dvd : ∀ {a b : Int}, a ∣ b → mod b a = 0
 theorem dvd_iff_mod_eq_zero (a b : Int) : a ∣ b ↔ mod b a = 0 :=
   ⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩
 
+@[simp] theorem neg_mul_mod_right (a b : Int) : (-(a * b)).mod a = 0 := by
+  rw [← dvd_iff_mod_eq_zero, Int.dvd_neg]
+  exact Int.dvd_mul_right a b
+
+@[simp] theorem neg_mul_mod_left (a b : Int) : (-(a * b)).mod b = 0 := by
+  rw [← dvd_iff_mod_eq_zero, Int.dvd_neg]
+  exact Int.dvd_mul_left a b
+
 protected theorem div_mul_cancel {a b : Int} (H : b ∣ a) : a.div b * b = a :=
   div_mul_cancel_of_mod_eq_zero (mod_eq_zero_of_dvd H)
 
@@ -903,6 +944,10 @@ protected theorem eq_mul_of_div_eq_right {a b c : Int}
 @[simp] theorem mod_self {a : Int} : a.mod a = 0 := by
   have := mul_mod_left 1 a; rwa [Int.one_mul] at this
 
+@[simp] theorem neg_mod_self (a : Int) : (-a).mod a = 0 := by
+  rw [← dvd_iff_mod_eq_zero, Int.dvd_neg]
+  exact Int.dvd_refl a
+
 theorem lt_div_add_one_mul_self (a : Int) {b : Int} (H : 0 < b) : a < (a.div b + 1) * b := by
   rw [Int.add_mul, Int.one_mul, Int.mul_comm]
   exact Int.lt_add_of_sub_left_lt <| Int.mod_def .. ▸ mod_lt_of_pos _ H
@@ -1091,8 +1136,7 @@ theorem bmod_mul_bmod : Int.bmod (Int.bmod x n * y) n = Int.bmod (x * y) n := by
   next p =>
     simp
   next p =>
-    rw [Int.sub_mul, Int.sub_eq_add_neg, ← Int.mul_neg]
-    simp
+    rw [Int.sub_mul, Int.sub_eq_add_neg, ← Int.mul_neg, bmod_add_mul_cancel, emod_mul_bmod_congr]
 
 @[simp] theorem mul_bmod_bmod : Int.bmod (x * Int.bmod y n) n = Int.bmod (x * y) n := by
   rw [Int.mul_comm x, bmod_mul_bmod, Int.mul_comm x]

src/Init/Data/Int/Lemmas.lean

@@ -288,7 +288,7 @@ protected theorem neg_sub (a b : Int) : -(a - b) = b - a := by
 protected theorem sub_sub_self (a b : Int) : a - (a - b) = b := by
   simp [Int.sub_eq_add_neg, ← Int.add_assoc]
 
-protected theorem sub_neg (a b : Int) : a - -b = a + b := by simp [Int.sub_eq_add_neg]
+@[simp] protected theorem sub_neg (a b : Int) : a - -b = a + b := by simp [Int.sub_eq_add_neg]
 
 @[simp] protected theorem sub_add_cancel (a b : Int) : a - b + b = a :=
   Int.neg_add_cancel_right a b
@@ -444,10 +444,10 @@ protected theorem neg_mul_eq_neg_mul (a b : Int) : -(a * b) = -a * b :=
 protected theorem neg_mul_eq_mul_neg (a b : Int) : -(a * b) = a * -b :=
   Int.neg_eq_of_add_eq_zero <| by rw [← Int.mul_add, Int.add_right_neg, Int.mul_zero]
 
-@[local simp] protected theorem neg_mul (a b : Int) : -a * b = -(a * b) :=
+@[simp] protected theorem neg_mul (a b : Int) : -a * b = -(a * b) :=
   (Int.neg_mul_eq_neg_mul a b).symm
 
-@[local simp] protected theorem mul_neg (a b : Int) : a * -b = -(a * b) :=
+@[simp] protected theorem mul_neg (a b : Int) : a * -b = -(a * b) :=
   (Int.neg_mul_eq_mul_neg a b).symm
 
 protected theorem neg_mul_neg (a b : Int) : -a * -b = a * b := by simp

src/Init/Data/Int/Order.lean

@@ -1006,7 +1006,7 @@ theorem natAbs_mul_self : ∀ {a : Int}, ↑(natAbs a * natAbs a) = a * a
 theorem eq_nat_or_neg (a : Int) : ∃ n : Nat, a = n ∨ a = -↑n := ⟨_, natAbs_eq a⟩
 
 theorem natAbs_mul_natAbs_eq {a b : Int} {c : Nat}
-    (h : a * b = (c : Int)) : a.natAbs * b.natAbs = c := by rw [← natAbs_mul, h, natAbs]
+    (h : a * b = (c : Int)) : a.natAbs * b.natAbs = c := by rw [← natAbs_mul, h, natAbs.eq_def]
 
 @[simp] theorem natAbs_mul_self' (a : Int) : (natAbs a * natAbs a : Int) = a * a := by
   rw [← Int.ofNat_mul, natAbs_mul_self]

src/Init/Data/List.lean

@@ -21,3 +21,5 @@ import Init.Data.List.Pairwise
 import Init.Data.List.Sublist
 import Init.Data.List.TakeDrop
 import Init.Data.List.Zip
+import Init.Data.List.Perm
+import Init.Data.List.Sort

src/Init/Data/List/Attach.lean

@@ -73,6 +73,13 @@ theorem pmap_map {p : β → Prop} (g : ∀ b, p b → γ) (f : α → β) (l H)
   · rfl
   · simp only [*, pmap, map]
 
+@[simp] theorem attach_cons (x : α) (xs : List α) :
+    (x :: xs).attach = ⟨x, mem_cons_self x xs⟩ :: xs.attach.map fun ⟨y, h⟩ => ⟨y, mem_cons_of_mem x h⟩ := by
+  simp only [attach, attachWith, pmap, map_pmap, cons.injEq, true_and]
+  apply pmap_congr
+  intros a _ m' _
+  rfl
+
 theorem pmap_eq_map_attach {p : α → Prop} (f : ∀ a, p a → β) (l H) :
     pmap f l H = l.attach.map fun x => f x.1 (H _ x.2) := by
   rw [attach, attachWith, map_pmap]; exact pmap_congr l fun _ _ _ _ => rfl
@@ -86,7 +93,7 @@ theorem attach_map_val (l : List α) (f : α → β) : (l.attach.map fun i => f
 
 @[simp]
 theorem attach_map_subtype_val (l : List α) : l.attach.map Subtype.val = l :=
-  (attach_map_coe _ _).trans l.map_id
+  (attach_map_coe _ _).trans (List.map_id _)
 
 theorem countP_attach (l : List α) (p : α → Bool) : l.attach.countP (fun a : {x // x ∈ l} => p a) = l.countP p := by
   simp only [← Function.comp_apply (g := Subtype.val), ← countP_map, attach_map_subtype_val]
@@ -121,23 +128,14 @@ theorem length_attach (L : List α) : L.attach.length = L.length :=
 theorem pmap_eq_nil {p : α → Prop} {f : ∀ a, p a → β} {l H} : pmap f l H = [] ↔ l = [] := by
   rw [← length_eq_zero, length_pmap, length_eq_zero]
 
+theorem pmap_ne_nil {P : α → Prop} (f : (a : α) → P a → β) (xs : List α)
+    (H : ∀ (a : α), a ∈ xs → P a) : xs.pmap f H ≠ [] ↔ xs ≠ [] := by
+  simp
+
 @[simp]
 theorem attach_eq_nil (l : List α) : l.attach = [] ↔ l = [] :=
   pmap_eq_nil
 
-theorem getLast_pmap (p : α → Prop) (f : ∀ a, p a → β) (l : List α)
-    (hl₁ : ∀ a ∈ l, p a) (hl₂ : l ≠ []) :
-    (l.pmap f hl₁).getLast (mt List.pmap_eq_nil.1 hl₂) =
-      f (l.getLast hl₂) (hl₁ _ (List.getLast_mem hl₂)) := by
-  induction l with
-  | nil => apply (hl₂ rfl).elim
-  | cons l_hd l_tl l_ih =>
-    by_cases hl_tl : l_tl = []
-    · simp [hl_tl]
-    · simp only [pmap]
-      rw [getLast_cons, l_ih _ hl_tl]
-      simp only [getLast_cons hl_tl]
-
 theorem getElem?_pmap {p : α → Prop} (f : ∀ a, p a → β) {l : List α} (h : ∀ a ∈ l, p a) (n : Nat) :
     (pmap f l h)[n]? = Option.pmap f l[n]? fun x H => h x (getElem?_mem H) := by
   induction l generalizing n with
@@ -181,7 +179,22 @@ theorem get_pmap {p : α → Prop} (f : ∀ a, p a → β) {l : List α} (h :
   simp only [get_eq_getElem]
   simp [getElem_pmap]
 
-theorem pmap_append {p : ι → Prop} (f : ∀ a : ι, p a → α) (l₁ l₂ : List ι)
+@[simp] theorem head?_pmap {P : α → Prop} (f : (a : α) → P a → β) (xs : List α)
+    (H : ∀ (a : α), a ∈ xs → P a) : (xs.pmap f H).head? = xs.attach.head?.map fun ⟨a, m⟩ => f a (H a m) := by
+  induction xs with
+  | nil => simp
+  | cons x xs ih =>
+    simp at ih
+    simp [head?_pmap, ih]
+
+@[simp] theorem head_pmap {P : α → Prop} (f : (a : α) → P a → β) (xs : List α)
+    (H : ∀ (a : α), a ∈ xs → P a) (h : xs.pmap f H ≠ []) :
+    (xs.pmap f H).head h = f (xs.head (by simpa using h)) (H _ (head_mem _)) := by
+  induction xs with
+  | nil => simp at h
+  | cons x xs ih => simp [head_pmap, ih]
+
+@[simp] theorem pmap_append {p : ι → Prop} (f : ∀ a : ι, p a → α) (l₁ l₂ : List ι)
     (h : ∀ a ∈ l₁ ++ l₂, p a) :
     (l₁ ++ l₂).pmap f h =
       (l₁.pmap f fun a ha => h a (mem_append_left l₂ ha)) ++
@@ -197,3 +210,63 @@ theorem pmap_append' {p : α → Prop} (f : ∀ a : α, p a → β) (l₁ l₂ :
     ((l₁ ++ l₂).pmap f fun a ha => (List.mem_append.1 ha).elim (h₁ a) (h₂ a)) =
       l₁.pmap f h₁ ++ l₂.pmap f h₂ :=
   pmap_append f l₁ l₂ _
+
+@[simp] theorem pmap_reverse {P : α → Prop} (f : (a : α) → P a → β) (xs : List α)
+    (H : ∀ (a : α), a ∈ xs.reverse → P a) : xs.reverse.pmap f H = (xs.pmap f (fun a h => H a (by simpa using h))).reverse := by
+  induction xs <;> simp_all
+
+theorem reverse_pmap {P : α → Prop} (f : (a : α) → P a → β) (xs : List α)
+    (H : ∀ (a : α), a ∈ xs → P a) : (xs.pmap f H).reverse = xs.reverse.pmap f (fun a h => H a (by simpa using h)) := by
+  rw [pmap_reverse]
+
+@[simp] theorem attach_append (xs ys : List α) :
+    (xs ++ ys).attach = xs.attach.map (fun ⟨x, h⟩ => ⟨x, mem_append_of_mem_left ys h⟩) ++
+      ys.attach.map fun ⟨x, h⟩ => ⟨x, mem_append_of_mem_right xs h⟩ := by
+  simp only [attach, attachWith, pmap, map_pmap, pmap_append]
+  congr 1 <;>
+  exact pmap_congr _ fun _ _ _ _ => rfl
+
+@[simp] theorem attach_reverse (xs : List α) : xs.reverse.attach = xs.attach.reverse.map fun ⟨x, h⟩ => ⟨x, by simpa using h⟩ := by
+  simp only [attach, attachWith, reverse_pmap, map_pmap]
+  apply pmap_congr
+  intros
+  rfl
+
+theorem reverse_attach (xs : List α) : xs.attach.reverse = xs.reverse.attach.map fun ⟨x, h⟩ => ⟨x, by simpa using h⟩ := by
+  simp only [attach, attachWith, reverse_pmap, map_pmap]
+  apply pmap_congr
+  intros
+  rfl
+
+
+theorem getLast?_attach {xs : List α} :
+    xs.attach.getLast? = match h : xs.getLast? with | none => none | some a => some ⟨a, mem_of_getLast?_eq_some h⟩ := by
+  rw [getLast?_eq_head?_reverse, reverse_attach, head?_map]
+  split <;> rename_i h
+  · simp only [getLast?_eq_none_iff] at h
+    subst h
+    simp
+  · obtain ⟨ys, rfl⟩ := getLast?_eq_some_iff.mp h
+    simp
+
+@[simp] theorem getLast?_pmap {P : α → Prop} (f : (a : α) → P a → β) (xs : List α)
+    (H : ∀ (a : α), a ∈ xs → P a) : (xs.pmap f H).getLast? = xs.attach.getLast?.map fun ⟨a, m⟩ => f a (H a m) := by
+  simp only [getLast?_eq_head?_reverse]
+  rw [reverse_pmap, reverse_attach, head?_map, pmap_eq_map_attach, head?_map]
+  simp only [Option.map_map]
+  congr
+
+@[simp] theorem getLast_pmap {P : α → Prop} (f : (a : α) → P a → β) (xs : List α)
+    (H : ∀ (a : α), a ∈ xs → P a) (h : xs.pmap f H ≠ []) :
+    (xs.pmap f H).getLast h = f (xs.getLast (by simpa using h)) (H _ (getLast_mem _)) := by
+  simp only [getLast_eq_iff_getLast_eq_some, getLast?_pmap, Option.map_eq_some', Subtype.exists]
+  refine ⟨xs.getLast (by simpa using h), by simp, ?_⟩
+  simp only [getLast?_attach, and_true]
+  split <;> rename_i h'
+  · simp only [getLast?_eq_none_iff] at h'
+    subst h'
+    simp at h
+  · symm
+    simpa
+
+end List

src/Init/Data/List/Basic.lean

@@ -96,7 +96,7 @@ namespace List
 
 /-! ### concat -/
 
-@[simp high] theorem length_concat (as : List α) (a : α) : (concat as a).length = as.length + 1 := by
+theorem length_concat (as : List α) (a : α) : (concat as a).length = as.length + 1 := by
   induction as with
   | nil => rfl
   | cons _ xs ih => simp [concat, ih]
@@ -278,8 +278,9 @@ def getLastD : (as : List α) → (fallback : α) → α
   | [],   a₀ => a₀
   | a::as, _ => getLast (a::as) (fun h => List.noConfusion h)
 
-@[simp] theorem getLastD_nil (a) : @getLastD α [] a = a := rfl
-@[simp] theorem getLastD_cons (a b l) : @getLastD α (b::l) a = getLastD l b := by cases l <;> rfl
+-- These aren't `simp` lemmas since we always simplify `getLastD` in terms of `getLast?`.
+theorem getLastD_nil (a) : @getLastD α [] a = a := rfl
+theorem getLastD_cons (a b l) : @getLastD α (b::l) a = getLastD l b := by cases l <;> rfl
 
 /-! ## Head and tail -/
 
@@ -962,6 +963,26 @@ def IsInfix (l₁ : List α) (l₂ : List α) : Prop := Exists fun s => Exists f
 
 @[inherit_doc] infixl:50 " <:+: " => IsInfix
 
+/-! ### splitAt -/
+
+/--
+Split a list at an index.
+```
+splitAt 2 [a, b, c] = ([a, b], [c])
+```
+-/
+def splitAt (n : Nat) (l : List α) : List α × List α := go l n [] where
+  /--
+  Auxiliary for `splitAt`:
+  `splitAt.go l xs n acc = (acc.reverse ++ take n xs, drop n xs)` if `n < xs.length`,
+  and `(l, [])` otherwise.
+  -/
+  go : List α → Nat → List α → List α × List α
+  | [], _, _ => (l, []) -- This branch ensures the pointer equality of the result with the input
+                        -- without any runtime branching cost.
+  | x :: xs, n+1, acc => go xs n (x :: acc)
+  | xs, _, acc => (acc.reverse, xs)
+
 /-! ### rotateLeft -/
 
 /--
@@ -1223,6 +1244,36 @@ theorem lookup_cons [BEq α] {k : α} :
     ((k,b)::es).lookup a = match a == k with | true => some b | false => es.lookup a :=
   rfl
 
+/-! ## Permutations -/
+
+/-! ### Perm -/
+
+/--
+`Perm l₁ l₂` or `l₁ ~ l₂` asserts that `l₁` and `l₂` are permutations
+of each other. This is defined by induction using pairwise swaps.
+-/
+inductive Perm : List α → List α → Prop
+  /-- `[] ~ []` -/
+  | nil : Perm [] []
+  /-- `l₁ ~ l₂ → x::l₁ ~ x::l₂` -/
+  | cons (x : α) {l₁ l₂ : List α} : Perm l₁ l₂ → Perm (x :: l₁) (x :: l₂)
+  /-- `x::y::l ~ y::x::l` -/
+  | swap (x y : α) (l : List α) : Perm (y :: x :: l) (x :: y :: l)
+  /-- `Perm` is transitive. -/
+  | trans {l₁ l₂ l₃ : List α} : Perm l₁ l₂ → Perm l₂ l₃ → Perm l₁ l₃
+
+@[inherit_doc] scoped infixl:50 " ~ " => Perm
+
+/-! ### isPerm -/
+
+/--
+`O(|l₁| * |l₂|)`. Computes whether `l₁` is a permutation of `l₂`. See `isPerm_iff` for a
+characterization in terms of `List.Perm`.
+-/
+def isPerm [BEq α] : List α → List α → Bool
+  | [], l₂ => l₂.isEmpty
+  | a :: l₁, l₂ => l₂.contains a && l₁.isPerm (l₂.erase a)
+
 /-! ## Logical operations -/
 
 /-! ### any -/

src/Init/Data/List/BasicAux.lean

@@ -192,7 +192,7 @@ macro "sizeOf_list_dec" : tactic =>
   `(tactic| first
     | with_reducible apply sizeOf_lt_of_mem; assumption; done
     | with_reducible
-        apply Nat.lt_trans (sizeOf_lt_of_mem ?h)
+        apply Nat.lt_of_lt_of_le (sizeOf_lt_of_mem ?h)
         case' h => assumption
       simp_arith)
 
@@ -222,7 +222,7 @@ theorem append_cancel_right {as bs cs : List α} (h : as ++ bs = cs ++ bs) : as
   next => apply append_cancel_right
   next => intro h; simp [h]
 
-@[simp] theorem sizeOf_get [SizeOf α] (as : List α) (i : Fin as.length) : sizeOf (as.get i) < sizeOf as := by
+theorem sizeOf_get [SizeOf α] (as : List α) (i : Fin as.length) : sizeOf (as.get i) < sizeOf as := by
   match as, i with
   | a::as, ⟨0, _⟩  => simp_arith [get]
   | a::as, ⟨i+1, h⟩ =>

src/Init/Data/List/Count.lean

@@ -81,6 +81,10 @@ theorem Sublist.countP_le (s : l₁ <+ l₂) : countP p l₁ ≤ countP p l₂ :
   simp only [countP_eq_length_filter]
   apply s.filter _ |>.length_le
 
+theorem IsPrefix.countP_le (s : l₁ <+: l₂) : countP p l₁ ≤ countP p l₂ := s.sublist.countP_le _
+theorem IsSuffix.countP_le (s : l₁ <:+ l₂) : countP p l₁ ≤ countP p l₂ := s.sublist.countP_le _
+theorem IsInfix.countP_le (s : l₁ <:+: l₂) : countP p l₁ ≤ countP p l₂ := s.sublist.countP_le _
+
 theorem countP_filter (l : List α) :
     countP p (filter q l) = countP (fun a => p a ∧ q a) l := by
   simp only [countP_eq_length_filter, filter_filter]
@@ -140,6 +144,10 @@ theorem count_le_length (a : α) (l : List α) : count a l ≤ l.length := count
 
 theorem Sublist.count_le (h : l₁ <+ l₂) (a : α) : count a l₁ ≤ count a l₂ := h.countP_le _
 
+theorem IsPrefix.count_le (h : l₁ <+: l₂) (a : α) : count a l₁ ≤ count a l₂ := h.sublist.count_le _
+theorem IsSuffix.count_le (h : l₁ <:+ l₂) (a : α) : count a l₁ ≤ count a l₂ := h.sublist.count_le _
+theorem IsInfix.count_le (h : l₁ <:+: l₂) (a : α) : count a l₁ ≤ count a l₂ := h.sublist.count_le _
+
 theorem count_le_count_cons (a b : α) (l : List α) : count a l ≤ count a (b :: l) :=
   (sublist_cons_self _ _).count_le _
 

src/Init/Data/List/Erase.lean

@@ -33,6 +33,25 @@ theorem eraseP_of_forall_not {l : List α} (h : ∀ a, a ∈ l → ¬p a) : l.er
   | nil => rfl
   | cons _ _ ih => simp [h _ (.head ..), ih (forall_mem_cons.1 h).2]
 
+@[simp] theorem eraseP_eq_nil (xs : List α) (p : α → Bool) : xs.eraseP p = [] ↔ xs = [] ∨ ∃ x, p x ∧ xs = [x] := by
+  induction xs with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [eraseP_cons, cond_eq_if]
+    split <;> rename_i h
+    · simp only [false_or]
+      constructor
+      · rintro rfl
+        simpa
+      · rintro ⟨_, _, rfl, rfl⟩
+        rfl
+    · simp only [cons.injEq, false_or, false_iff, not_exists, not_and]
+      rintro x h' rfl
+      simp_all
+
+theorem eraseP_ne_nil (xs : List α) (p : α → Bool) : xs.eraseP p ≠ [] ↔ xs ≠ [] ∧ ∀ x, p x → xs ≠ [x] := by
+  simp
+
 theorem exists_of_eraseP : ∀ {l : List α} {a} (al : a ∈ l) (pa : p a),
     ∃ a l₁ l₂, (∀ b ∈ l₁, ¬p b) ∧ p a ∧ l = l₁ ++ a :: l₂ ∧ l.eraseP p = l₁ ++ l₂
   | b :: l, a, al, pa =>
@@ -159,6 +178,23 @@ theorem eraseP_append (l₁ l₂ : List α) :
     rw [eraseP_append_right _]
     simp_all
 
+theorem eraseP_replicate (n : Nat) (a : α) (p : α → Bool) :
+    (replicate n a).eraseP p = if p a then replicate (n - 1) a else replicate n a := by
+  induction n with
+  | zero => simp
+  | succ n ih =>
+    simp only [replicate_succ, eraseP_cons]
+    split <;> simp [*]
+
+protected theorem IsPrefix.eraseP (h : l₁ <+: l₂) : l₁.eraseP p <+: l₂.eraseP p := by
+  rw [IsPrefix] at h
+  obtain ⟨t, rfl⟩ := h
+  rw [eraseP_append]
+  split
+  · exact prefix_append (eraseP p l₁) t
+  · rw [eraseP_of_forall_not (by simp_all)]
+    exact prefix_append l₁ (eraseP p t)
+
 theorem eraseP_eq_iff {p} {l : List α} :
     l.eraseP p = l' ↔
       ((∀ a ∈ l, ¬ p a) ∧ l = l') ∨
@@ -221,6 +257,12 @@ theorem eraseP_comm {l : List α} (h : ∀ a ∈ l, ¬ p a ∨ ¬ q a) :
       · simp [h₁, h₂, ih (fun b m => h b (mem_cons_of_mem _ m))]
       · simp [h₁, h₂, ih (fun b m => h b (mem_cons_of_mem _ m))]
 
+theorem head_eraseP_mem (xs : List α) (p : α → Bool) (h) : (xs.eraseP p).head h ∈ xs :=
+  (eraseP_sublist xs).head_mem h
+
+theorem getLast_eraseP_mem (xs : List α) (p : α → Bool) (h) : (xs.eraseP p).getLast h ∈ xs :=
+  (eraseP_sublist xs).getLast_mem h
+
 /-! ### erase -/
 section erase
 variable [BEq α]
@@ -249,6 +291,16 @@ theorem erase_eq_eraseP [LawfulBEq α] (a : α) : ∀ l : List α,  l.erase a =
   | b :: l => by
     if h : a = b then simp [h] else simp [h, Ne.symm h, erase_eq_eraseP a l]
 
+@[simp] theorem erase_eq_nil [LawfulBEq α] (xs : List α) (a : α) :
+    xs.erase a = [] ↔ xs = [] ∨ xs = [a] := by
+  rw [erase_eq_eraseP]
+  simp
+
+theorem erase_ne_nil [LawfulBEq α] (xs : List α) (a : α) :
+    xs.erase a ≠ [] ↔ xs ≠ [] ∧ xs ≠ [a] := by
+  rw [erase_eq_eraseP]
+  simp
+
 theorem exists_erase_eq [LawfulBEq α] {a : α} {l : List α} (h : a ∈ l) :
     ∃ l₁ l₂, a ∉ l₁ ∧ l = l₁ ++ a :: l₂ ∧ l.erase a = l₁ ++ l₂ := by
   let ⟨_, l₁, l₂, h₁, e, h₂, h₃⟩ := exists_of_eraseP h (beq_self_eq_true _)
@@ -271,6 +323,9 @@ theorem erase_subset (a : α) (l : List α) : l.erase a ⊆ l := (erase_sublist
 theorem Sublist.erase (a : α) {l₁ l₂ : List α} (h : l₁ <+ l₂) : l₁.erase a <+ l₂.erase a := by
   simp only [erase_eq_eraseP']; exact h.eraseP
 
+theorem IsPrefix.erase (a : α) {l₁ l₂ : List α} (h : l₁ <+: l₂) : l₁.erase a <+: l₂.erase a := by
+  simp only [erase_eq_eraseP']; exact h.eraseP
+
 theorem length_erase_le (a : α) (l : List α) : (l.erase a).length ≤ l.length :=
   (erase_sublist a l).length_le
 
@@ -282,7 +337,7 @@ theorem mem_of_mem_erase {a b : α} {l : List α} (h : a ∈ l.erase b) : a ∈
 
 @[simp] theorem erase_eq_self_iff [LawfulBEq α] {l : List α} : l.erase a = l ↔ a ∉ l := by
   rw [erase_eq_eraseP', eraseP_eq_self_iff]
-  simp
+  simp [forall_mem_ne']
 
 theorem erase_filter [LawfulBEq α] (f : α → Bool) (l : List α) :
     (filter f l).erase a = filter f (l.erase a) := by
@@ -315,6 +370,11 @@ theorem erase_append [LawfulBEq α] {a : α} {l₁ l₂ : List α} :
     (l₁ ++ l₂).erase a = if a ∈ l₁ then l₁.erase a ++ l₂ else l₁ ++ l₂.erase a := by
   simp [erase_eq_eraseP, eraseP_append]
 
+theorem erase_replicate [LawfulBEq α] (n : Nat) (a b : α) :
+    (replicate n a).erase b = if b == a then replicate (n - 1) a else replicate n a := by
+  rw [erase_eq_eraseP]
+  simp [eraseP_replicate]
+
 theorem erase_comm [LawfulBEq α] (a b : α) (l : List α) :
     (l.erase a).erase b = (l.erase b).erase a := by
   if ab : a == b then rw [eq_of_beq ab] else ?_
@@ -376,6 +436,12 @@ theorem Nodup.not_mem_erase [LawfulBEq α] {a : α} (h : Nodup l) : a ∉ l.eras
 theorem Nodup.erase [LawfulBEq α] (a : α) : Nodup l → Nodup (l.erase a) :=
   Nodup.sublist <| erase_sublist _ _
 
+theorem head_erase_mem (xs : List α) (a : α) (h) : (xs.erase a).head h ∈ xs :=
+  (erase_sublist a xs).head_mem h
+
+theorem getLast_erase_mem (xs : List α) (a : α) (h) : (xs.erase a).getLast h ∈ xs :=
+  (erase_sublist a xs).getLast_mem h
+
 end erase
 
 /-! ### eraseIdx -/
@@ -396,11 +462,26 @@ theorem eraseIdx_eq_take_drop_succ :
   | a::l, 0 => by simp
   | a::l, i + 1 => by simp [eraseIdx_eq_take_drop_succ l i]
 
+@[simp] theorem eraseIdx_eq_nil {l : List α} {i : Nat} : eraseIdx l i = [] ↔ l = [] ∨ (length l = 1 ∧ i = 0) := by
+  match l, i with
+  | [], _
+  | a::l, 0
+  | a::l, i + 1 => simp [Nat.succ_inj']
+
+theorem eraseIdx_ne_nil {l : List α} {i : Nat} : eraseIdx l i ≠ [] ↔ 2 ≤ l.length ∨ (l.length = 1 ∧ i ≠ 0) := by
+  match l with
+  | []
+  | [a]
+  | a::b::l => simp [Nat.succ_inj']
+
 theorem eraseIdx_sublist : ∀ (l : List α) (k : Nat), eraseIdx l k <+ l
   | [], _ => by simp
   | a::l, 0 => by simp
   | a::l, k + 1 => by simp [eraseIdx_sublist l k]
 
+theorem mem_of_mem_eraseIdx {l : List α} {i : Nat} {a : α} (h : a ∈ l.eraseIdx i) : a ∈ l :=
+  (eraseIdx_sublist _ _).mem h
+
 theorem eraseIdx_subset (l : List α) (k : Nat) : eraseIdx l k ⊆ l := (eraseIdx_sublist l k).subset
 
 @[simp]
@@ -430,6 +511,17 @@ theorem eraseIdx_append_of_length_le {l : List α} {k : Nat} (hk : length l ≤
     | zero => simp_all
     | succ k => simp_all [eraseIdx_cons_succ, Nat.succ_sub_succ]
 
+theorem eraseIdx_replicate {n : Nat} {a : α} {k : Nat} :
+    (replicate n a).eraseIdx k = if k < n then replicate (n - 1) a else replicate n a := by
+  split <;> rename_i h
+  · rw [eq_replicate, length_eraseIdx (by simpa using h)]
+    simp only [length_replicate, true_and]
+    intro b m
+    replace m := mem_of_mem_eraseIdx m
+    simp only [mem_replicate] at m
+    exact m.2
+  · rw [eraseIdx_of_length_le (by simpa using h)]
+
 protected theorem IsPrefix.eraseIdx {l l' : List α} (h : l <+: l') (k : Nat) :
     eraseIdx l k <+: eraseIdx l' k := by
   rcases h with ⟨t, rfl⟩

src/Init/Data/List/Find.lean

@@ -6,67 +6,17 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M
 -/
 prelude
 import Init.Data.List.Lemmas
+import Init.Data.List.Sublist
+import Init.Data.List.Range
 
 /-!
-# Lemmas about `List.find?`, `List.findSome?`, `List.findIdx`, `List.findIdx?`, and `List.indexOf`.
+# Lemmas about `List.findSome?`, `List.find?`, `List.findIdx`, `List.findIdx?`, and `List.indexOf`.
 -/
 
 namespace List
 
 open Nat
 
-/-! ### find? -/
-
-@[simp] theorem find?_cons_of_pos (l) (h : p a) : find? p (a :: l) = some a := by
-  simp [find?, h]
-
-@[simp] theorem find?_cons_of_neg (l) (h : ¬p a) : find? p (a :: l) = find? p l := by
-  simp [find?, h]
-
-@[simp] theorem find?_eq_none : find? p l = none ↔ ∀ x ∈ l, ¬ p x := by
-  induction l <;> simp [find?_cons]; split <;> simp [*]
-
-theorem find?_some : ∀ {l}, find? p l = some a → p a
-  | b :: l, H => by
-    by_cases h : p b <;> simp [find?, h] at H
-    · exact H ▸ h
-    · exact find?_some H
-
-@[simp] theorem mem_of_find?_eq_some : ∀ {l}, find? p l = some a → a ∈ l
-  | b :: l, H => by
-    by_cases h : p b <;> simp [find?, h] at H
-    · exact H ▸ .head _
-    · exact .tail _ (mem_of_find?_eq_some H)
-
-@[simp] theorem find?_map (f : β → α) (l : List β) : find? p (l.map f) = (l.find? (p ∘ f)).map f := by
-  induction l with
-  | nil => simp
-  | cons x xs ih =>
-    simp only [map_cons, find?]
-    by_cases h : p (f x) <;> simp [h, ih]
-
-theorem find?_replicate : find? p (replicate n a) = if n = 0 then none else if p a then some a else none := by
-  cases n
-  · simp
-  · by_cases p a <;> simp_all [replicate_succ]
-
-@[simp] theorem find?_replicate_of_length_pos (h : 0 < n) : find? p (replicate n a) = if p a then some a else none := by
-  simp [find?_replicate, Nat.ne_of_gt h]
-
-@[simp] theorem find?_replicate_of_pos (h : p a) : find? p (replicate n a) = if n = 0 then none else some a := by
-  simp [find?_replicate, h]
-
-@[simp] theorem find?_replicate_of_neg (h : ¬ p a) : find? p (replicate n a) = none := by
-  simp [find?_replicate, h]
-
-theorem find?_isSome_of_sublist {l₁ l₂ : List α} (h : l₁ <+ l₂) : (l₁.find? p).isSome → (l₂.find? p).isSome := by
-  induction h with
-  | slnil => simp
-  | cons a h ih
-  | cons₂ a h ih =>
-    simp only [find?]
-    split <;> simp_all
-
 /-! ### findSome? -/
 
 @[simp] theorem findSome?_cons_of_isSome (l) (h : (f a).isSome) : findSome? f (a :: l) = f a := by
@@ -85,17 +35,70 @@ theorem exists_of_findSome?_eq_some {l : List α} {f : α → Option β} (w : l.
     simp_all only [findSome?_cons, mem_cons, exists_eq_or_imp]
     split at w <;> simp_all
 
-@[simp] theorem findSome?_map (f : β → γ) (l : List β) : findSome? p (l.map f) = l.findSome? (p ∘ f) := by
+@[simp] theorem findSome?_eq_none : findSome? p l = none ↔ ∀ x ∈ l, p x = none := by
+  induction l <;> simp [findSome?_cons]; split <;> simp [*]
+
+@[simp] theorem findSome?_isSome_iff (f : α → Option β) (l : List α) :
+    (l.findSome? f).isSome ↔ ∃ x, x ∈ l ∧ (f x).isSome := by
+  induction l with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [findSome?_cons]
+    split <;> simp_all
+
+@[simp] theorem findSome?_guard (l : List α) : findSome? (Option.guard fun x => p x) l = find? p l := by
+  induction l with
+  | nil => simp
+  | cons x xs ih =>
+    simp [guard, findSome?, find?]
+    split <;> rename_i h
+    · simp only [Option.guard_eq_some] at h
+      obtain ⟨rfl, h⟩ := h
+      simp [h]
+    · simp only [Option.guard_eq_none] at h
+      simp [ih, h]
+
+@[simp] theorem filterMap_head? (f : α → Option β) (l : List α) : (l.filterMap f).head? = l.findSome? f := by
+  induction l with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [filterMap_cons, findSome?_cons]
+    split <;> simp [*]
+
+@[simp] theorem filterMap_head (f : α → Option β) (l : List α) (h) :
+    (l.filterMap f).head h = (l.findSome? f).get (by simp_all [Option.isSome_iff_ne_none])  := by
+  simp
+
+@[simp] theorem filterMap_getLast? (f : α → Option β) (l : List α) : (l.filterMap f).getLast? = l.reverse.findSome? f := by
+  rw [getLast?_eq_head?_reverse]
+  simp [← filterMap_reverse]
+
+@[simp] theorem filterMap_getLast (f : α → Option β) (l : List α) (h) :
+    (l.filterMap f).getLast h = (l.reverse.findSome? f).get (by simp_all [Option.isSome_iff_ne_none]) := by
+  simp
+
+@[simp] theorem map_findSome? (f : α → Option β) (g : β → γ) (l : List α) :
+    (l.findSome? f).map g = l.findSome? (Option.map g ∘ f) := by
+  induction l <;> simp [findSome?_cons]; split <;> simp [*]
+
+theorem findSome?_map (f : β → γ) (l : List β) : findSome? p (l.map f) = l.findSome? (p ∘ f) := by
   induction l with
   | nil => simp
   | cons x xs ih =>
     simp only [map_cons, findSome?]
     split <;> simp_all
 
+theorem findSome?_append {l₁ l₂ : List α} : (l₁ ++ l₂).findSome? f = (l₁.findSome? f).or (l₂.findSome? f) := by
+  induction l₁ with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [cons_append, findSome?]
+    split <;> simp_all
+
 theorem findSome?_replicate : findSome? f (replicate n a) = if n = 0 then none else f a := by
-  induction n with
+  cases n with
   | zero => simp
-  | succ n ih =>
+  | succ n =>
     simp only [replicate_succ, findSome?_cons]
     split <;> simp_all
 
@@ -103,22 +106,304 @@ theorem findSome?_replicate : findSome? f (replicate n a) = if n = 0 then none e
   simp [findSome?_replicate, Nat.ne_of_gt h]
 
 -- Argument is unused, but used to decide whether `simp` should unfold.
-@[simp] theorem find?_replicate_of_isSome (_ : (f a).isSome) : findSome? f (replicate n a) = if n = 0 then none else f a := by
+@[simp] theorem findSome?_replicate_of_isSome (_ : (f a).isSome) : findSome? f (replicate n a) = if n = 0 then none else f a := by
   simp [findSome?_replicate]
 
-@[simp] theorem find?_replicate_of_isNone (h : (f a).isNone) : findSome? f (replicate n a) = none := by
+@[simp] theorem findSome?_replicate_of_isNone (h : (f a).isNone) : findSome? f (replicate n a) = none := by
   rw [Option.isNone_iff_eq_none] at h
   simp [findSome?_replicate, h]
 
-theorem findSome?_isSome_of_sublist {l₁ l₂ : List α} (h : l₁ <+ l₂) :
+theorem Sublist.findSome?_isSome {l₁ l₂ : List α} (h : l₁ <+ l₂) :
     (l₁.findSome? f).isSome → (l₂.findSome? f).isSome := by
   induction h with
   | slnil => simp
   | cons a h ih
   | cons₂ a h ih =>
     simp only [findSome?]
+    split
+    · simp_all
+    · exact ih
+
+theorem Sublist.findSome?_eq_none {l₁ l₂ : List α} (h : l₁ <+ l₂) :
+    l₂.findSome? f = none → l₁.findSome? f = none := by
+  simp only [List.findSome?_eq_none, Bool.not_eq_true]
+  exact fun w x m => w x (Sublist.mem m h)
+
+theorem IsPrefix.findSome?_eq_some {l₁ l₂ : List α} {f : α → Option β} (h : l₁ <+: l₂) :
+    List.findSome? f l₁ = some b → List.findSome? f l₂ = some b := by
+  rw [IsPrefix] at h
+  obtain ⟨t, rfl⟩ := h
+  simp (config := {contextual := true}) [findSome?_append]
+
+theorem IsPrefix.findSome?_eq_none {l₁ l₂ : List α} {f : α → Option β} (h : l₁ <+: l₂) :
+    List.findSome? f l₂ = none → List.findSome? f l₁ = none :=
+  h.sublist.findSome?_eq_none
+theorem IsSuffix.findSome?_eq_none {l₁ l₂ : List α} {f : α → Option β} (h : l₁ <:+ l₂) :
+    List.findSome? f l₂ = none → List.findSome? f l₁ = none :=
+  h.sublist.findSome?_eq_none
+theorem IsInfix.findSome?_eq_none {l₁ l₂ : List α} {f : α → Option β} (h : l₁ <:+: l₂) :
+    List.findSome? f l₂ = none → List.findSome? f l₁ = none :=
+  h.sublist.findSome?_eq_none
+
+/-! ### find? -/
+
+@[simp] theorem find?_singleton (a : α) (p : α → Bool) : [a].find? p = if p a then some a else none := by
+  simp only [find?]
+  split <;> simp_all
+
+@[simp] theorem find?_cons_of_pos (l) (h : p a) : find? p (a :: l) = some a := by
+  simp [find?, h]
+
+@[simp] theorem find?_cons_of_neg (l) (h : ¬p a) : find? p (a :: l) = find? p l := by
+  simp [find?, h]
+
+@[simp] theorem find?_eq_none : find? p l = none ↔ ∀ x ∈ l, ¬ p x := by
+  induction l <;> simp [find?_cons]; split <;> simp [*]
+
+theorem find?_eq_some : xs.find? p = some b ↔ p b ∧ ∃ as bs, xs = as ++ b :: bs ∧ ∀ a ∈ as, !p a := by
+  induction xs with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [find?_cons, exists_and_right]
+    split <;> rename_i h
+    · simp only [Option.some.injEq]
+      constructor
+      · rintro rfl
+        exact ⟨h, [], ⟨xs, rfl⟩, by simp⟩
+      · rintro ⟨-, ⟨as, ⟨⟨bs, h₁⟩, h₂⟩⟩⟩
+        cases as with
+        | nil => simp_all
+        | cons a as =>
+          specialize h₂ a (mem_cons_self _ _)
+          simp only [cons_append] at h₁
+          obtain ⟨rfl, -⟩ := h₁
+          simp_all
+    · simp only [ih, Bool.not_eq_true', exists_and_right, and_congr_right_iff]
+      intro pb
+      constructor
+      · rintro ⟨as, ⟨⟨bs, rfl⟩, h₁⟩⟩
+        refine ⟨x :: as, ⟨⟨bs, rfl⟩, ?_⟩⟩
+        intro a m
+        simp at m
+        obtain (rfl|m) := m
+        · exact h
+        · exact h₁ a m
+      · rintro ⟨as, ⟨bs, h₁⟩, h₂⟩
+        cases as with
+        | nil => simp_all
+        | cons a as =>
+          refine ⟨as, ⟨⟨bs, ?_⟩, fun a m => h₂ a (mem_cons_of_mem _ m)⟩⟩
+          cases h₁
+          simp
+
+@[simp]
+theorem find?_cons_eq_some : (a :: xs).find? p = some b ↔ (p a ∧ a = b) ∨ (!p a ∧ xs.find? p = some b) := by
+  rw [find?_cons]
+  split <;> simp_all
+
+@[simp] theorem find?_isSome (xs : List α) (p : α → Bool) : (xs.find? p).isSome ↔ ∃ x, x ∈ xs ∧ p x := by
+  induction xs with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [find?_cons, mem_cons, exists_eq_or_imp]
     split <;> simp_all
 
+theorem find?_some : ∀ {l}, find? p l = some a → p a
+  | b :: l, H => by
+    by_cases h : p b <;> simp [find?, h] at H
+    · exact H ▸ h
+    · exact find?_some H
+
+theorem mem_of_find?_eq_some : ∀ {l}, find? p l = some a → a ∈ l
+  | b :: l, H => by
+    by_cases h : p b <;> simp [find?, h] at H
+    · exact H ▸ .head _
+    · exact .tail _ (mem_of_find?_eq_some H)
+
+@[simp] theorem get_find?_mem (xs : List α) (p : α → Bool) (h) : (xs.find? p).get h ∈ xs := by
+  induction xs with
+  | nil => simp at h
+  | cons x xs ih =>
+    simp only [find?_cons]
+    by_cases h : p x
+    · simp [h]
+    · simp only [h]
+      right
+      apply ih
+
+@[simp] theorem find?_filter (xs : List α) (p : α → Bool) (q : α → Bool) :
+    (xs.filter p).find? q = xs.find? (fun a => p a ∧ q a) := by
+  induction xs with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [filter_cons]
+    split <;>
+    · simp only [find?_cons]
+      split <;> simp_all
+
+@[simp] theorem filter_head? (p : α → Bool) (l : List α) : (l.filter p).head? = l.find? p := by
+  rw [← filterMap_eq_filter, filterMap_head?, findSome?_guard]
+
+@[simp] theorem filter_head (p : α → Bool) (l : List α) (h) :
+    (l.filter p).head h = (l.find? p).get (by simp_all [Option.isSome_iff_ne_none]) := by
+  simp
+
+@[simp] theorem filter_getLast? (p : α → Bool) (l : List α) : (l.filter p).getLast? = l.reverse.find? p := by
+  rw [getLast?_eq_head?_reverse]
+  simp [← filter_reverse]
+
+@[simp] theorem filter_getLast (p : α → Bool) (l : List α) (h) :
+    (l.filter p).getLast h = (l.reverse.find? p).get (by simp_all [Option.isSome_iff_ne_none]) := by
+  simp
+
+@[simp] theorem find?_filterMap (xs : List α) (f : α → Option β) (p : β → Bool) :
+    (xs.filterMap f).find? p = (xs.find? (fun a => match f a with | none => false | some b => p b)).map f := by
+  induction xs with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [filterMap_cons]
+    split <;>
+    · simp only [find?_cons]
+      split <;> simp_all
+
+@[simp] theorem find?_map (f : β → α) (l : List β) : find? p (l.map f) = (l.find? (p ∘ f)).map f := by
+  induction l with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [map_cons, find?]
+    by_cases h : p (f x) <;> simp [h, ih]
+
+@[simp] theorem find?_append {l₁ l₂ : List α} : (l₁ ++ l₂).find? p = (l₁.find? p).or (l₂.find? p) := by
+  induction l₁ with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [cons_append, find?]
+    by_cases h : p x <;> simp [h, ih]
+
+@[simp] theorem find?_join (xs : List (List α)) (p : α → Bool) :
+    xs.join.find? p = xs.findSome? (·.find? p) := by
+  induction xs with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [join_cons, find?_append, findSome?_cons, ih]
+    split <;> simp [*]
+
+theorem find?_join_eq_none (xs : List (List α)) (p : α → Bool) :
+    xs.join.find? p = none ↔ ∀ ys ∈ xs, ∀ x ∈ ys, !p x := by
+  simp
+
+/--
+If `find? p` returns `some a` from `xs.join`, then `p a` holds, and
+some list in `xs` contains `a`, and no earlier element of that list satisfies `p`.
+Moreover, no earlier list in `xs` has an element satisfying `p`.
+-/
+theorem find?_join_eq_some (xs : List (List α)) (p : α → Bool) (a : α) :
+    xs.join.find? p = some a ↔
+      p a ∧ ∃ as ys zs bs, xs = as ++ (ys ++ a :: zs) :: bs ∧
+        (∀ a ∈ as, ∀ x ∈ a, !p x) ∧ (∀ x ∈ ys, !p x) := by
+  rw [find?_eq_some]
+  constructor
+  · rintro ⟨h, ⟨ys, zs, h₁, h₂⟩⟩
+    refine ⟨h, ?_⟩
+    rw [join_eq_append] at h₁
+    obtain (⟨as, bs, rfl, rfl, h₁⟩ | ⟨as, bs, c, cs, ds, rfl, rfl, h₁⟩) := h₁
+    · replace h₁ := h₁.symm
+      rw [join_eq_cons] at h₁
+      obtain ⟨bs, cs, ds, rfl, h₁, rfl⟩ := h₁
+      refine ⟨as ++ bs, [], cs, ds, by simp, ?_⟩
+      simp
+      rintro a (ma | mb) x m
+      · simpa using h₂ x (by simpa using ⟨a, ma, m⟩)
+      · specialize h₁ _ mb
+        simp_all
+    · simp [h₁]
+      refine ⟨as, bs, ?_⟩
+      refine ⟨?_, ?_, ?_⟩
+      · simp_all
+      · intro l ml a m
+        simpa using h₂ a (by simpa using .inl ⟨l, ml, m⟩)
+      · intro x m
+        simpa using h₂ x (by simpa using .inr m)
+  · rintro ⟨h, ⟨as, ys, zs, bs, rfl, h₁, h₂⟩⟩
+    refine ⟨h, as.join ++ ys, zs ++ bs.join, by simp, ?_⟩
+    intro a m
+    simp at m
+    obtain ⟨l, ml, m⟩ | m := m
+    · exact h₁ l ml a m
+    · exact h₂ a m
+
+@[simp] theorem find?_bind (xs : List α) (f : α → List β) (p : β → Bool) :
+    (xs.bind f).find? p = xs.findSome? (fun x => (f x).find? p) := by
+  simp [bind_def, findSome?_map]; rfl
+
+theorem find?_bind_eq_none (xs : List α) (f : α → List β) (p : β → Bool) :
+    (xs.bind f).find? p = none ↔ ∀ x ∈ xs, ∀ y ∈ f x, !p y := by
+  simp
+
+theorem find?_replicate : find? p (replicate n a) = if n = 0 then none else if p a then some a else none := by
+  cases n
+  · simp
+  · by_cases p a <;> simp_all [replicate_succ]
+
+@[simp] theorem find?_replicate_of_length_pos (h : 0 < n) : find? p (replicate n a) = if p a then some a else none := by
+  simp [find?_replicate, Nat.ne_of_gt h]
+
+@[simp] theorem find?_replicate_of_pos (h : p a) : find? p (replicate n a) = if n = 0 then none else some a := by
+  simp [find?_replicate, h]
+
+@[simp] theorem find?_replicate_of_neg (h : ¬ p a) : find? p (replicate n a) = none := by
+  simp [find?_replicate, h]
+
+-- This isn't a `@[simp]` lemma since there is already a lemma for `l.find? p = none` for any `l`.
+theorem find?_replicate_eq_none (n : Nat) (a : α) (p : α → Bool) :
+    (replicate n a).find? p = none ↔ n = 0 ∨ !p a := by
+  simp [Classical.or_iff_not_imp_left]
+
+@[simp] theorem find?_replicate_eq_some (n : Nat) (a b : α) (p : α → Bool) :
+    (replicate n a).find? p = some b ↔ n ≠ 0 ∧ p a ∧ a = b := by
+  cases n <;> simp
+
+@[simp] theorem get_find?_replicate (n : Nat) (a : α) (p : α → Bool) (h) : ((replicate n a).find? p).get h = a := by
+  cases n with
+  | zero => simp at h
+  | succ n => simp
+
+theorem Sublist.find?_isSome {l₁ l₂ : List α} (h : l₁ <+ l₂) : (l₁.find? p).isSome → (l₂.find? p).isSome := by
+  induction h with
+  | slnil => simp
+  | cons a h ih
+  | cons₂ a h ih =>
+    simp only [find?]
+    split
+    · simp
+    · simpa using ih
+
+theorem Sublist.find?_eq_none {l₁ l₂ : List α} (h : l₁ <+ l₂) : l₂.find? p = none → l₁.find? p = none := by
+  simp only [List.find?_eq_none, Bool.not_eq_true]
+  exact fun w x m => w x (Sublist.mem m h)
+
+theorem IsPrefix.find?_eq_some {l₁ l₂ : List α} {p : α → Bool} (h : l₁ <+: l₂) :
+    List.find? p l₁ = some b → List.find? p l₂ = some b := by
+  rw [IsPrefix] at h
+  obtain ⟨t, rfl⟩ := h
+  simp (config := {contextual := true}) [find?_append]
+
+theorem IsPrefix.find?_eq_none {l₁ l₂ : List α} {p : α → Bool} (h : l₁ <+: l₂) :
+    List.find? p l₂ = none → List.find? p l₁ = none :=
+  h.sublist.find?_eq_none
+theorem IsSuffix.find?_eq_none {l₁ l₂ : List α} {p : α → Bool} (h : l₁ <:+ l₂) :
+    List.find? p l₂ = none → List.find? p l₁ = none :=
+  h.sublist.find?_eq_none
+theorem IsInfix.find?_eq_none {l₁ l₂ : List α} {p : α → Bool} (h : l₁ <:+: l₂) :
+    List.find? p l₂ = none → List.find? p l₁ = none :=
+  h.sublist.find?_eq_none
+
+theorem find?_pmap {P : α → Prop} (f : (a : α) → P a → β) (xs : List α)
+    (H : ∀ (a : α), a ∈ xs → P a) (p : β → Bool) :
+    (xs.pmap f H).find? p = (xs.attach.find? (fun ⟨a, m⟩ => p (f a (H a m)))).map fun ⟨a, m⟩ => f a (H a m) := by
+  simp only [pmap_eq_map_attach, find?_map]
+  rfl
+
 /-! ### findIdx -/
 
 theorem findIdx_cons (p : α → Bool) (b : α) (l : List α) :
@@ -163,8 +448,7 @@ theorem findIdx_lt_length_of_exists {xs : List α} (h : ∃ x ∈ xs, p x) :
     · simp_all only [forall_exists_index, and_imp, mem_cons, exists_eq_or_imp, true_or,
         findIdx_cons, cond_true, length_cons]
       apply Nat.succ_pos
-    · simp_all [findIdx_cons]
-      refine Nat.succ_lt_succ ?_
+    · simp_all [findIdx_cons, Nat.succ_lt_succ_iff]
       obtain ⟨x', m', h'⟩ := h
       exact ih x' m' h'
 
@@ -187,6 +471,11 @@ theorem findIdx_eq_length {p : α → Bool} {xs : List α} :
     simp only [cond_eq_if]
     split <;> simp_all [Nat.succ.injEq]
 
+theorem findIdx_eq_length_of_false {p : α → Bool} {xs : List α} (h : ∀ x ∈ xs, p x = false) :
+    xs.findIdx p = xs.length := by
+  rw [findIdx_eq_length]
+  exact h
+
 theorem findIdx_le_length (p : α → Bool) {xs : List α} : xs.findIdx p ≤ xs.length := by
   by_cases e : ∃ x ∈ xs, p x
   · exact Nat.le_of_lt (findIdx_lt_length_of_exists e)
@@ -250,6 +539,38 @@ theorem findIdx_eq {p : α → Bool} {xs : List α} {i : Nat} (h : i < xs.length
   simp at h3
   exact not_of_lt_findIdx h3 h1
 
+theorem findIdx_append (p : α → Bool) (l₁ l₂ : List α) :
+    (l₁ ++ l₂).findIdx p =
+      if l₁.findIdx p < l₁.length then l₁.findIdx p else l₂.findIdx p + l₁.length := by
+  simp
+  induction l₁ with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [findIdx_cons, length_cons, cons_append]
+    by_cases h : p x
+    · simp [h]
+    · simp only [h, ih, cond_eq_if, Bool.false_eq_true, ↓reduceIte, mem_cons, exists_eq_or_imp,
+        false_or]
+      split <;> simp [Nat.add_assoc]
+
+theorem IsPrefix.findIdx_le {l₁ l₂ : List α} {p : α → Bool} (h : l₁ <+: l₂) :
+    l₁.findIdx p ≤ l₂.findIdx p := by
+  rw [IsPrefix] at h
+  obtain ⟨t, rfl⟩ := h
+  simp only [findIdx_append, findIdx_lt_length]
+  split
+  · exact Nat.le_refl ..
+  · simp_all [findIdx_eq_length_of_false]
+
+theorem IsPrefix.findIdx_eq_of_findIdx_lt_length {l₁ l₂ : List α} {p : α → Bool} (h : l₁ <+: l₂)
+    (lt : l₁.findIdx p < l₁.length) : l₂.findIdx p = l₁.findIdx p := by
+  rw [IsPrefix] at h
+  obtain ⟨t, rfl⟩ := h
+  simp only [findIdx_append, findIdx_lt_length]
+  split
+  · rfl
+  · simp_all
+
 /-! ### findIdx? -/
 
 @[simp] theorem findIdx?_nil : ([] : List α).findIdx? p i = none := rfl
@@ -262,16 +583,91 @@ theorem findIdx_eq {p : α → Bool} {xs : List α} {i : Nat} (h : i < xs.length
   induction xs generalizing i with simp
   | cons _ _ _ => split <;> simp_all
 
-theorem findIdx?_eq_some_iff (xs : List α) (p : α → Bool) :
-    xs.findIdx? p = some i ↔ (xs.take (i + 1)).map p = replicate i false ++ [true] := by
+@[simp]
+theorem findIdx?_eq_none_iff {xs : List α} {p : α → Bool} :
+    xs.findIdx? p = none ↔ ∀ x, x ∈ xs → p x = false := by
+  induction xs with
+  | nil => simp_all
+  | cons x xs ih =>
+    simp only [findIdx?_cons]
+    split <;> simp_all [cond_eq_if]
+
+theorem findIdx?_isSome {xs : List α} {p : α → Bool} :
+    (xs.findIdx? p).isSome = xs.any p := by
+  induction xs with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [findIdx?_cons]
+    split <;> simp_all
+
+theorem findIdx?_isNone {xs : List α} {p : α → Bool} :
+    (xs.findIdx? p).isNone = xs.all (¬p ·) := by
+  induction xs with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [findIdx?_cons]
+    split <;> simp_all
+
+theorem findIdx?_eq_some_iff_findIdx_eq {xs : List α} {p : α → Bool} {i : Nat} :
+    xs.findIdx? p = some i ↔ i < xs.length ∧ xs.findIdx p = i := by
+  induction xs generalizing i with
+  | nil => simp_all
+  | cons x xs ih =>
+    simp only [findIdx?_cons, findIdx_cons]
+    split
+    · simp_all [cond_eq_if]
+      rintro rfl
+      exact zero_lt_succ xs.length
+    · simp_all [cond_eq_if, and_assoc]
+      constructor
+      · rintro ⟨a, lt, rfl, rfl⟩
+        simp_all [Nat.succ_lt_succ_iff]
+      · rintro ⟨h, rfl⟩
+        exact ⟨_, by simp_all [Nat.succ_lt_succ_iff], rfl, rfl⟩
+
+theorem findIdx?_eq_some_of_exists {xs : List α} {p : α → Bool} (h : ∃ x, x ∈ xs ∧ p x) :
+    xs.findIdx? p = some (xs.findIdx p) := by
+  rw [findIdx?_eq_some_iff_findIdx_eq]
+  exact ⟨findIdx_lt_length_of_exists h, rfl⟩
+
+theorem findIdx?_eq_none_iff_findIdx_eq {xs : List α} {p : α → Bool} :
+    xs.findIdx? p = none ↔ xs.findIdx p = xs.length := by
+  simp
+
+theorem findIdx?_eq_some_iff_getElem (xs : List α) (p : α → Bool) :
+    xs.findIdx? p = some i ↔
+      ∃ h : i < xs.length, p xs[i] ∧ ∀ j (hji : j < i), ¬p (xs[j]'(Nat.lt_trans hji h)) := by
   induction xs generalizing i with
   | nil => simp
   | cons x xs ih =>
-    simp only [findIdx?_cons, Nat.zero_add, findIdx?_succ, take_succ_cons, map_cons]
-    split <;> cases i <;> simp_all [replicate_succ, succ_inj']
+    simp only [findIdx?_cons, Nat.zero_add, findIdx?_succ]
+    split
+    · simp only [Option.some.injEq, Bool.not_eq_true, length_cons]
+      cases i with
+      | zero => simp_all
+      | succ i =>
+        simp only [Bool.not_eq_true, zero_ne_add_one, getElem_cons_succ, false_iff, not_exists,
+          not_and, Classical.not_forall, Bool.not_eq_false]
+        intros
+        refine ⟨0, zero_lt_succ i, ‹_›⟩
+    · simp only [Option.map_eq_some', ih, Bool.not_eq_true, length_cons]
+      constructor
+      · rintro ⟨a, ⟨⟨h, h₁, h₂⟩, rfl⟩⟩
+        refine ⟨Nat.succ_lt_succ_iff.mpr h, by simpa, fun j hj => ?_⟩
+        cases j with
+        | zero => simp_all
+        | succ j =>
+          apply h₂
+          simp_all [Nat.succ_lt_succ_iff]
+      · rintro ⟨h, h₁, h₂⟩
+        cases i with
+        | zero => simp_all
+        | succ i =>
+          refine ⟨i, ⟨Nat.succ_lt_succ_iff.mp h, by simpa, fun j hj => ?_⟩, rfl⟩
+          simpa using h₂ (j + 1) (Nat.succ_lt_succ_iff.mpr hj)
 
 theorem findIdx?_of_eq_some {xs : List α} {p : α → Bool} (w : xs.findIdx? p = some i) :
-    match xs.get? i with | some a => p a | none => false := by
+    match xs[i]? with | some a => p a | none => false := by
   induction xs generalizing i with
   | nil => simp_all
   | cons x xs ih =>
@@ -279,7 +675,7 @@ theorem findIdx?_of_eq_some {xs : List α} {p : α → Bool} (w : xs.findIdx? p
     split at w <;> cases i <;> simp_all [succ_inj']
 
 theorem findIdx?_of_eq_none {xs : List α} {p : α → Bool} (w : xs.findIdx? p = none) :
-    ∀ i, match xs.get? i with | some a => ¬ p a | none => true := by
+    ∀ i : Nat, match xs[i]? with | some a => ¬ p a | none => true := by
   intro i
   induction xs generalizing i with
   | nil => simp_all
@@ -289,24 +685,90 @@ theorem findIdx?_of_eq_none {xs : List α} {p : α → Bool} (w : xs.findIdx? p
     | zero =>
       split at w <;> simp_all
     | succ i =>
-      simp only [get?_cons_succ]
+      simp only [getElem?_cons_succ]
       apply ih
       split at w <;> simp_all
 
+@[simp] theorem findIdx?_map (f : β → α) (l : List β) : findIdx? p (l.map f) = l.findIdx? (p ∘ f) := by
+  induction l with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [map_cons, findIdx?]
+    split <;> simp_all
+
 @[simp] theorem findIdx?_append :
     (xs ++ ys : List α).findIdx? p =
-      (xs.findIdx? p <|> (ys.findIdx? p).map fun i => i + xs.length) := by
+      (xs.findIdx? p).or ((ys.findIdx? p).map fun i => i + xs.length) := by
   induction xs with simp
-  | cons _ _ _ => split <;> simp_all [Option.map_orElse, Option.map_map]; rfl
+  | cons _ _ _ => split <;> simp_all [Option.map_or', Option.map_map]; rfl
+
+theorem findIdx?_join {l : List (List α)} {p : α → Bool} :
+    l.join.findIdx? p =
+      (l.findIdx? (·.any p)).map
+        fun i => Nat.sum ((l.take i).map List.length) +
+          (l[i]?.map fun xs => xs.findIdx p).getD 0 := by
+  induction l with
+  | nil => simp
+  | cons xs l ih =>
+    simp only [join, findIdx?_append, map_take, map_cons, findIdx?, any_eq_true, Nat.zero_add,
+      findIdx?_succ]
+    split
+    · simp only [Option.map_some', take_zero, sum_nil, length_cons, zero_lt_succ,
+        getElem?_eq_getElem, getElem_cons_zero, Option.getD_some, Nat.zero_add]
+      rw [Option.or_of_isSome (by simpa [findIdx?_isSome])]
+      rw [findIdx?_eq_some_of_exists ‹_›]
+    · simp_all only [map_take, not_exists, not_and, Bool.not_eq_true, Option.map_map]
+      rw [Option.or_of_isNone (by simpa [findIdx?_isNone])]
+      congr 1
+      ext i
+      simp [Nat.add_comm, Nat.add_assoc]
 
 @[simp] theorem findIdx?_replicate :
     (replicate n a).findIdx? p = if 0 < n ∧ p a then some 0 else none := by
-  induction n with
+  cases n with
   | zero => simp
-  | succ n ih =>
-    simp only [replicate, findIdx?_cons, Nat.zero_add, findIdx?_succ, Nat.zero_lt_succ, true_and]
+  | succ n =>
+    simp only [replicate, findIdx?_cons, Nat.zero_add, findIdx?_succ, zero_lt_succ, true_and]
     split <;> simp_all
 
+theorem findIdx?_eq_enum_findSome? {xs : List α} {p : α → Bool} :
+    xs.findIdx? p = xs.enum.findSome? fun ⟨i, a⟩ => if p a then some i else none := by
+  induction xs with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [findIdx?_cons, Nat.zero_add, findIdx?_succ, enum]
+    split
+    · simp_all
+    · simp_all only [enumFrom_cons, ite_false, Option.isNone_none, findSome?_cons_of_isNone]
+      simp [Function.comp_def, ← map_fst_add_enum_eq_enumFrom, findSome?_map]
+
+theorem Sublist.findIdx?_isSome {l₁ l₂ : List α} (h : l₁ <+ l₂) :
+    (l₁.findIdx? p).isSome → (l₂.findIdx? p).isSome := by
+  simp only [List.findIdx?_isSome, any_eq_true]
+  rintro ⟨w, m, q⟩
+  exact ⟨w, h.mem m, q⟩
+
+theorem Sublist.findIdx?_eq_none {l₁ l₂ : List α} (h : l₁ <+ l₂) :
+    l₂.findIdx? p = none → l₁.findIdx? p = none := by
+  simp only [findIdx?_eq_none_iff]
+  exact fun w x m => w x (h.mem m)
+
+theorem IsPrefix.findIdx?_eq_some {l₁ l₂ : List α} {p : α → Bool} (h : l₁ <+: l₂) :
+    List.findIdx? p l₁ = some i → List.findIdx? p l₂ = some i := by
+  rw [IsPrefix] at h
+  obtain ⟨t, rfl⟩ := h
+  intro h
+  simp [findIdx?_append, h]
+theorem IsPrefix.findIdx?_eq_none {l₁ l₂ : List α} {p : α → Bool} (h : l₁ <+: l₂) :
+    List.findIdx? p l₂ = none → List.findIdx? p l₁ = none :=
+  h.sublist.findIdx?_eq_none
+theorem IsSuffix.findIdx?_eq_none {l₁ l₂ : List α} {p : α → Bool} (h : l₁ <:+ l₂) :
+    List.findIdx? p l₂ = none → List.findIdx? p l₁ = none :=
+  h.sublist.findIdx?_eq_none
+theorem IsInfix.findIdx?_eq_none {l₁ l₂ : List α} {p : α → Bool} (h : l₁ <:+: l₂) :
+    List.findIdx? p l₂ = none → List.findIdx? p l₁ = none :=
+  h.sublist.findIdx?_eq_none
+
 /-! ### indexOf -/
 
 theorem indexOf_cons [BEq α] :

src/Init/Data/List/Lemmas.lean

@@ -79,6 +79,11 @@ open Nat
 
 /-! ## Preliminaries -/
 
+/-! ### nil -/
+
+@[simp] theorem nil_eq {α} (xs : List α) : [] = xs ↔ xs = [] := by
+  cases xs <;> simp
+
 /-! ### cons -/
 
 theorem cons_ne_nil (a : α) (l : List α) : a :: l ≠ [] := nofun
@@ -86,6 +91,10 @@ theorem cons_ne_nil (a : α) (l : List α) : a :: l ≠ [] := nofun
 @[simp]
 theorem cons_ne_self (a : α) (l : List α) : a :: l ≠ l := mt (congrArg length) (Nat.succ_ne_self _)
 
+@[simp] theorem ne_cons_self {a : α} {l : List α} : l ≠ a :: l := by
+  rw [ne_eq, eq_comm]
+  simp
+
 theorem head_eq_of_cons_eq (H : h₁ :: t₁ = h₂ :: t₂) : h₁ = h₂ := (cons.inj H).1
 
 theorem tail_eq_of_cons_eq (H : h₁ :: t₁ = h₂ :: t₂) : t₁ = t₂ := (cons.inj H).2
@@ -256,6 +265,18 @@ theorem getElem?_eq_some {l : List α} : l[n]? = some a ↔ ∃ h : n < l.length
 
 theorem getElem?_eq_none (h : length l ≤ n) : l[n]? = none := getElem?_eq_none_iff.mpr h
 
+theorem getElem?_eq (l : List α) (i : Nat) :
+    l[i]? = if h : i < l.length then some l[i] else none := by
+  split <;> simp_all
+
+@[simp] theorem some_getElem_eq_getElem? {α} (xs : List α) (i : Nat) (h : i < xs.length) :
+    (some xs[i] = xs[i]?) ↔ True := by
+  simp [h]
+
+@[simp] theorem getElem?_eq_some_getElem {α} (xs : List α) (i : Nat) (h : i < xs.length) :
+    (xs[i]? = some xs[i]) ↔ True := by
+  simp [h]
+
 theorem getElem_eq_iff {l : List α} {n : Nat} {h : n < l.length} : l[n] = x ↔ l[n]? = some x := by
   simp only [getElem?_eq_some]
   exact ⟨fun w => ⟨h, w⟩, fun h => h.2⟩
@@ -272,6 +293,9 @@ theorem getElem?_cons_zero {l : List α} : (a::l)[0]? = some a := by simp
   simp only [← get?_eq_getElem?]
   rfl
 
+theorem getElem?_cons : (a :: l)[i]? = if i = 0 then some a else l[i-1]? := by
+  cases i <;> simp
+
 theorem getElem?_len_le : ∀ {l : List α} {n}, length l ≤ n → l[n]? = none
   | [], _, _ => rfl
   | _ :: l, _+1, h => by
@@ -340,6 +364,11 @@ theorem get?_concat_length (l : List α) (a : α) : (l ++ [a]).get? l.length = s
 
 theorem mem_cons_self (a : α) (l : List α) : a ∈ a :: l := .head ..
 
+theorem mem_concat_self (xs : List α) (a : α) : a ∈ xs ++ [a] :=
+  mem_append_of_mem_right xs (mem_cons_self a _)
+
+theorem mem_append_cons_self : a ∈ xs ++ a :: ys := mem_append_of_mem_right _ (mem_cons_self _ _)
+
 theorem mem_cons_of_mem (y : α) {a : α} {l : List α} : a ∈ l → a ∈ y :: l := .tail _
 
 theorem exists_mem_of_ne_nil (l : List α) (h : l ≠ []) : ∃ x, x ∈ l :=
@@ -359,27 +388,21 @@ theorem forall_mem_cons {p : α → Prop} {a : α} {l : List α} :
   ⟨fun H => ⟨H _ (.head ..), fun _ h => H _ (.tail _ h)⟩,
    fun ⟨H₁, H₂⟩ _ => fun | .head .. => H₁ | .tail _ h => H₂ _ h⟩
 
-@[simp]
 theorem forall_mem_ne {a : α} {l : List α} : (∀ a' : α, a' ∈ l → ¬a = a') ↔ a ∉ l :=
   ⟨fun h m => h _ m rfl, fun h _ m e => h (e.symm ▸ m)⟩
 
-@[simp]
 theorem forall_mem_ne' {a : α} {l : List α} : (∀ a' : α, a' ∈ l → ¬a' = a) ↔ a ∉ l :=
   ⟨fun h m => h _ m rfl, fun h _ m e => h (e.symm ▸ m)⟩
 
-@[simp]
 theorem any_beq [BEq α] [LawfulBEq α] {l : List α} : (l.any fun x => a == x) ↔ a ∈ l := by
   induction l <;> simp_all
 
-@[simp]
 theorem any_beq' [BEq α] [LawfulBEq α] {l : List α} : (l.any fun x => x == a) ↔ a ∈ l := by
   induction l <;> simp_all [eq_comm (a := a)]
 
-@[simp]
 theorem all_bne [BEq α] [LawfulBEq α] {l : List α} : (l.all fun x => a != x) ↔ a ∉ l := by
   induction l <;> simp_all
 
-@[simp]
 theorem all_bne' [BEq α] [LawfulBEq α] {l : List α} : (l.all fun x => x != a) ↔ a ∉ l := by
   induction l <;> simp_all [eq_comm (a := a)]
 
@@ -503,7 +526,7 @@ theorem isEmpty_iff_length_eq_zero {l : List α} : l.isEmpty ↔ l.length = 0 :=
 @[simp] theorem isEmpty_eq_true {l : List α} : l.isEmpty ↔ l = [] := by
   cases l <;> simp
 
-@[simp] theorem isEmpty_eq_false {l : List α} : ¬ l.isEmpty ↔ l ≠ [] := by
+@[simp] theorem isEmpty_eq_false {l : List α} : l.isEmpty = false ↔ l ≠ [] := by
   cases l <;> simp
 
 /-! ### any / all -/
@@ -543,7 +566,7 @@ theorem get_set_eq {l : List α} {i : Nat} {a : α} (h : i < (l.set i a).length)
   simp_all [getElem?_eq_some]
 
 @[simp]
-theorem getElem?_set_eq' {l : List α} {i : Nat} {a : α} : (set l i a)[i]? = (fun _ => a) <$> l[i]? := by
+theorem getElem?_set_eq' {l : List α} {i : Nat} {a : α} : (set l i a)[i]? = Function.const _ a <$> l[i]? := by
   by_cases h : i < l.length
   · simp [getElem?_set_eq h, getElem?_eq_getElem h]
   · simp only [Nat.not_lt] at h
@@ -600,7 +623,7 @@ theorem getElem?_set {l : List α} {i j : Nat} {a : α} :
 theorem getElem?_set' {l : List α} {i j : Nat} {a : α} :
     (set l i a)[j]? = if i = j then (fun _ => a) <$> l[j]? else l[j]? := by
   by_cases i = j
-  · simp only [getElem?_set_eq', Option.map_eq_map, ↓reduceIte, *]
+  · simp only [getElem?_set_eq', Option.map_eq_map, ↓reduceIte, *]; rfl
   · simp only [ne_eq, not_false_eq_true, getElem?_set_ne, ↓reduceIte, *]
 
 theorem set_eq_of_length_le {l : List α} {n : Nat} (h : l.length ≤ n) {a : α} :
@@ -710,9 +733,14 @@ theorem foldr_eq_foldrM (f : α → β → β) (b) (l : List α) :
 
 /-! ### foldl and foldr -/
 
-@[simp] theorem foldr_self_append (l : List α) : l.foldr cons l' = l ++ l' := by
+@[simp] theorem foldr_cons_eq_append (l : List α) : l.foldr cons l' = l ++ l' := by
   induction l <;> simp [*]
 
+@[deprecated foldr_cons_eq_append (since := "2024-08-22")] abbrev foldr_self_append := @foldr_cons_eq_append
+
+@[simp] theorem foldl_flip_cons_eq_append (l : List α) : l.foldl (fun x y => y :: x) l' = l.reverse ++ l' := by
+  induction l generalizing l' <;> simp [*]
+
 theorem foldr_self (l : List α) : l.foldr cons [] = l := by simp
 
 theorem foldl_map (f : β₁ → β₂) (g : α → β₂ → α) (l : List β₁) (init : α) :
@@ -745,6 +773,58 @@ theorem foldr_hom (f : β₁ → β₂) (g₁ : α → β₁ → β₁) (g₂ :
     (H : ∀ x y, g₂ x (f y) = f (g₁ x y)) : l.foldr g₂ (f init) = f (l.foldr g₁ init) := by
   induction l <;> simp [*, H]
 
+/--
+Prove a proposition about the result of `List.foldl`,
+by proving it for the initial data,
+and the implication that the operation applied to any element of the list preserves the property.
+
+The motive can take values in `Sort _`, so this may be used to construct data,
+as well as to prove propositions.
+-/
+def foldlRecOn {motive : β → Sort _} : ∀ (l : List α) (op : β → α → β) (b : β) (_ : motive b)
+    (_ : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ l), motive (op b a)), motive (List.foldl op b l)
+  | [], _, _, hb, _ => hb
+  | hd :: tl, op, b, hb, hl =>
+    foldlRecOn tl op (op b hd) (hl b hb hd (mem_cons_self hd tl))
+      fun y hy x hx => hl y hy x (mem_cons_of_mem hd hx)
+
+@[simp] theorem foldlRecOn_nil {motive : β → Sort _} (hb : motive b)
+    (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ []), motive (op b a)) :
+    foldlRecOn [] op b hb hl = hb := rfl
+
+@[simp] theorem foldlRecOn_cons {motive : β → Sort _} (hb : motive b)
+    (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ x :: l), motive (op b a)) :
+    foldlRecOn (x :: l) op b hb hl =
+      foldlRecOn l op (op b x) (hl b hb x (mem_cons_self x l))
+        (fun b c a m => hl b c a (mem_cons_of_mem x m)) :=
+  rfl
+
+/--
+Prove a proposition about the result of `List.foldr`,
+by proving it for the initial data,
+and the implication that the operation applied to any element of the list preserves the property.
+
+The motive can take values in `Sort _`, so this may be used to construct data,
+as well as to prove propositions.
+-/
+def foldrRecOn {motive : β → Sort _} : ∀ (l : List α) (op : α → β → β) (b : β) (_ : motive b)
+    (_ : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ l), motive (op a b)), motive (List.foldr op b l)
+  | nil, _, _, hb, _ => hb
+  | x :: l, op, b, hb, hl =>
+    hl (foldr op b l)
+      (foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m)) x (mem_cons_self x l)
+
+@[simp] theorem foldrRecOn_nil {motive : β → Sort _} (hb : motive b)
+    (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ []), motive (op a b)) :
+    foldrRecOn [] op b hb hl = hb := rfl
+
+@[simp] theorem foldrRecOn_cons {motive : β → Sort _} (hb : motive b)
+    (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ x :: l), motive (op a b)) :
+    foldrRecOn (x :: l) op b hb hl =
+      hl _ (foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m))
+        x (mem_cons_self x l) :=
+  rfl
+
 /-! ### getLast -/
 
 theorem getLast_eq_getElem : ∀ (l : List α) (h : l ≠ []),
@@ -779,7 +859,7 @@ theorem getLast_eq_getLastD (a l h) : @getLast α (a::l) h = getLastD l a := by
 theorem getLast!_cons [Inhabited α] : @getLast! α _ (a::l) = getLastD l a := by
   simp [getLast!, getLast_eq_getLastD]
 
-theorem getLast_mem : ∀ {l : List α} (h : l ≠ []), getLast l h ∈ l
+@[simp] theorem getLast_mem : ∀ {l : List α} (h : l ≠ []), getLast l h ∈ l
   | [], h => absurd rfl h
   | [_], _ => .head ..
   | _::a::l, _ => .tail _ <| getLast_mem (cons_ne_nil a l)
@@ -799,11 +879,14 @@ theorem get_cons_length (x : α) (xs : List α) (n : Nat) (h : n = xs.length) :
 
 /-! ### getLast? -/
 
-theorem getLast?_cons : @getLast? α (a::l) = getLastD l a := by
-  simp only [getLast?, getLast_eq_getLastD]
-
 @[simp] theorem getLast?_singleton (a : α) : getLast? [a] = a := rfl
 
+theorem getLast?_cons {a : α} : (a::l).getLast? = l.getLast?.getD a := by
+  cases l <;> simp [getLast?, getLast]
+
+@[simp] theorem getLast?_cons_cons : (a :: b :: l).getLast? = (b :: l).getLast? := by
+  simp [getLast?_cons]
+
 theorem getLast?_eq_getLast : ∀ l h, @getLast? α l = some (getLast l h)
   | [], h => nomatch h rfl
   | _::_, _ => rfl
@@ -820,7 +903,7 @@ theorem getLast?_eq_get? (l : List α) : getLast? l = l.get? (l.length - 1) := b
 @[simp] theorem getLast?_concat (l : List α) : getLast? (l ++ [a]) = some a := by
   simp [getLast?_eq_getElem?, Nat.succ_sub_succ]
 
-@[simp] theorem getLastD_concat (a b l) : @getLastD α (l ++ [b]) a = b := by
+theorem getLastD_concat (a b l) : @getLastD α (l ++ [b]) a = b := by
   rw [getLastD_eq_getLast?, getLast?_concat]; rfl
 
 /-! ## Head and tail -/
@@ -833,6 +916,17 @@ theorem head!_of_head? [Inhabited α] : ∀ {l : List α}, head? l = some a →
 theorem head?_eq_head : ∀ {l} h, @head? α l = some (head l h)
   | _::_, _ => rfl
 
+/--
+We simplify `xs.head h = a` to `xs.head? = some a`,
+despite not simplifying `xs.head h` to `(xs.head?).get ⋯`.
+We can often make further progress on the goal after this simplification,
+because the dependency on `h` has been removed.
+-/
+@[simp] theorem head_eq_iff_head?_eq_some {xs : List α} (h) : xs.head h = a ↔ xs.head? = some a := by
+  cases xs with
+  | nil => simp at h
+  | cons x xs => simp
+
 theorem head?_eq_getElem? : ∀ l : List α, head? l = l[0]?
   | [] => rfl
   | a::l => by simp
@@ -840,6 +934,9 @@ theorem head?_eq_getElem? : ∀ l : List α, head? l = l[0]?
 @[simp] theorem head?_eq_none_iff : l.head? = none ↔ l = [] := by
   cases l <;> simp
 
+theorem head?_eq_some_iff {xs : List α} {a : α} : xs.head? = some a ↔ ∃ ys, xs = a :: ys := by
+  cases xs <;> simp_all
+
 @[simp] theorem head_mem : ∀ {l : List α} (h : l ≠ []), head l h ∈ l
   | [], h => absurd rfl h
   | _::_, _ => .head ..
@@ -868,9 +965,16 @@ theorem tail_eq_tail? (l) : @tail α l = (tail? l).getD [] := by simp [tail_eq_t
 
 /-! ### map -/
 
-@[simp] theorem map_id (l : List α) : map id l = l := by induction l <;> simp_all
+@[simp] theorem map_id_fun : map (id : α → α) = id := by
+  funext l
+  induction l <;> simp_all
 
-@[simp] theorem map_id' (l : List α) : map (fun a => a) l = l := by induction l <;> simp_all
+@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
+
+theorem map_id (l : List α) : map (id : α → α) l = l := by
+  induction l <;> simp_all
+
+theorem map_id' (l : List α) : map (fun (a : α) => a) l = l := map_id l
 
 theorem map_id'' {f : α → α} (h : ∀ x, f x = x) (l : List α) : map f l = l := by
   simp [show f = id from funext h]
@@ -1057,7 +1161,7 @@ theorem filter_length_eq_length {l} : (filter p l).length = l.length ↔ ∀ a
     · simp_all [or_and_left]
     · simp_all [or_and_right]
 
-theorem filter_eq_nil {l} : filter p l = [] ↔ ∀ a, a ∈ l → ¬p a := by
+@[simp] theorem filter_eq_nil {l} : filter p l = [] ↔ ∀ a, a ∈ l → ¬p a := by
   simp only [eq_nil_iff_forall_not_mem, mem_filter, not_and]
 
 theorem forall_mem_filter {l : List α} {p : α → Bool} {P : α → Prop} :
@@ -1145,8 +1249,13 @@ theorem head_filter_of_pos {p : α → Bool} {l : List α} (w : l ≠ []) (h : p
 theorem filterMap_eq_map (f : α → β) : filterMap (some ∘ f) = map f := by
   funext l; induction l <;> simp [*, filterMap_cons]
 
-@[simp] theorem filterMap_some (l : List α) : filterMap some l = l := by
-  erw [filterMap_eq_map, map_id]
+@[simp] theorem filterMap_some_fun : filterMap (some : α → Option α) = id := by
+  funext l
+  erw [filterMap_eq_map]
+  simp
+
+theorem filterMap_some (l : List α) : filterMap some l = l := by
+  rw [filterMap_some_fun, id]
 
 theorem map_filterMap_some_eq_filter_map_isSome (f : α → Option β) (l : List α) :
     (l.filterMap f).map some = (l.map f).filter fun b => b.isSome := by
@@ -1221,7 +1330,7 @@ theorem forall_mem_filterMap {f : α → Option β} {l : List α} {P : β → Pr
   induction l <;> simp [filterMap_cons]; split <;> simp [*]
 
 theorem map_filterMap_of_inv (f : α → Option β) (g : β → α) (H : ∀ x : α, (f x).map g = some x)
-    (l : List α) : map g (filterMap f l) = l := by simp only [map_filterMap, H, filterMap_some]
+    (l : List α) : map g (filterMap f l) = l := by simp only [map_filterMap, H, filterMap_some, id]
 
 theorem head_filterMap_of_eq_some {f : α → Option β} {l : List α} (w : l ≠ []) {b : β} (h : f (l.head w) = some b) :
     (filterMap f l).head ((ne_nil_of_mem (mem_filterMap.2 ⟨_, head_mem w, h⟩))) =
@@ -1244,7 +1353,7 @@ theorem forall_none_of_filterMap_eq_nil (h : filterMap f xs = []) : ∀ x ∈ xs
       | tail _ hmem => exact ih h hmem
     · contradiction
 
-theorem filterMap_eq_nil {l} : filterMap f l = [] ↔ ∀ a ∈ l, f a = none := by
+@[simp] theorem filterMap_eq_nil {l} : filterMap f l = [] ↔ ∀ a ∈ l, f a = none := by
   constructor
   · exact forall_none_of_filterMap_eq_nil
   · intro h
@@ -1363,6 +1472,18 @@ theorem append_right_inj {t₁ t₂ : List α} (s) : s ++ t₁ = s ++ t₂ ↔ t
 theorem append_left_inj {s₁ s₂ : List α} (t) : s₁ ++ t = s₂ ++ t ↔ s₁ = s₂ :=
   ⟨fun h => append_inj_left' h rfl, congrArg (· ++ _)⟩
 
+@[simp] theorem append_left_eq_self {x y : List α} : x ++ y = y ↔ x = [] := by
+  rw [← append_left_inj (s₁ := x), nil_append]
+
+@[simp] theorem self_eq_append_left {x y : List α} : y = x ++ y ↔ x = [] := by
+  rw [eq_comm, append_left_eq_self]
+
+@[simp] theorem append_right_eq_self {x y : List α} : x ++ y = x ↔ y = [] := by
+  rw [← append_right_inj (t₁ := y), append_nil]
+
+@[simp] theorem self_eq_append_right {x y : List α} : x = x ++ y ↔ y = [] := by
+  rw [eq_comm, append_right_eq_self]
+
 @[simp] theorem append_eq_nil : p ++ q = [] ↔ p = [] ∧ q = [] := by
   cases p <;> simp
 
@@ -1391,20 +1512,26 @@ theorem get_append_right (as bs : List α) (h : ¬ i < as.length) {h' h''} :
     (as ++ bs).get ⟨i, h'⟩ = bs.get ⟨i - as.length, h''⟩ := by
   simp [getElem_append_right, h, h', h'']
 
-theorem getElem?_append {l₁ l₂ : List α} {n : Nat} (hn : n < l₁.length) :
+theorem getElem?_append_left {l₁ l₂ : List α} {n : Nat} (hn : n < l₁.length) :
     (l₁ ++ l₂)[n]? = l₁[n]? := by
   have hn' : n < (l₁ ++ l₂).length := Nat.lt_of_lt_of_le hn <|
     length_append .. ▸ Nat.le_add_right ..
   simp_all [getElem?_eq_getElem, getElem_append]
 
-@[deprecated (since := "2024-06-12")]
+@[deprecated getElem?_append_left (since := "2024-06-12")]
 theorem get?_append {l₁ l₂ : List α} {n : Nat} (hn : n < l₁.length) :
     (l₁ ++ l₂).get? n = l₁.get? n := by
-  simp [getElem?_append hn]
+  simp [getElem?_append_left hn]
 
-@[simp] theorem head_append_of_ne_nil {l : List α} (w : l ≠ []) :
-    head (l ++ l') (by simp_all) = head l w := by
-  match l, w with
+theorem getElem?_append {l₁ l₂ : List α} {n : Nat} :
+    (l₁ ++ l₂)[n]? = if n < l₁.length then l₁[n]? else l₂[n - l₁.length]? := by
+  split <;> rename_i h
+  · exact getElem?_append_left h
+  · exact getElem?_append_right (by simpa using h)
+
+@[simp] theorem head_append_of_ne_nil {l : List α} {w₁} (w₂) :
+    head (l ++ l') w₁ = head l w₂ := by
+  match l, w₂ with
   | a :: l, _ => rfl
 
 theorem head_append {l₁ l₂ : List α} (w : l₁ ++ l₂ ≠ []) :
@@ -1438,6 +1565,14 @@ theorem append_ne_nil_of_ne_nil_left {s : List α} (h : s ≠ []) (t : List α)
 @[deprecated append_ne_nil_of_right_ne_nil (since := "2024-07-24")]
 theorem append_ne_nil_of_ne_nil_right (s : List α) : t ≠ [] → s ++ t ≠ [] := by simp_all
 
+theorem tail_append (xs ys : List α) :
+    (xs ++ ys).tail = if xs.isEmpty then ys.tail else xs.tail ++ ys := by
+  cases xs <;> simp
+
+@[simp] theorem tail_append_of_ne_nil (xs ys : List α) (h : xs ≠ []) :
+    (xs ++ ys).tail = xs.tail ++ ys := by
+  simp_all [tail_append]
+
 theorem append_eq_cons :
     a ++ b = x :: c ↔ (a = [] ∧ b = x :: c) ∨ (∃ a', a = x :: a' ∧ c = a' ++ b) := by
   cases a with simp | cons a as => ?_
@@ -1453,6 +1588,24 @@ theorem append_eq_append_iff {a b c d : List α} :
   | nil => simp_all
   | cons a as ih => cases c <;> simp [eq_comm, and_assoc, ih, and_or_left]
 
+theorem append_inj_of_length_left {a b c d : List α}
+    (h : a ++ b = c ++ d) (hl : length a = length c) : a = c ∧ b = d := by
+  rcases append_eq_append_iff.mp h with (⟨a', rfl, rfl⟩ | ⟨c', rfl, rfl⟩)
+  · simp only [length_append] at hl
+    have : a'.length = 0 := (Nat.add_left_cancel hl).symm
+    simp_all
+  · simp only [length_append] at hl
+    have : c'.length = 0 := (Nat.add_left_cancel hl.symm).symm
+    simp_all
+
+theorem append_inj_of_length_right {a b c d : List α}
+    (h : a ++ b = c ++ d) (hl : length b = length d) : a = c ∧ b = d := by
+  have : length a = length c :=  by
+    replace h := congrArg length h
+    simp only [length_append, hl] at h
+    exact Nat.add_right_cancel h
+  exact append_inj_of_length_left h this
+
 @[simp] theorem mem_append {a : α} {s t : List α} : a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t := by
   induction s <;> simp_all [or_assoc]
 
@@ -1505,9 +1658,55 @@ theorem set_append {s t : List α} :
 @[simp] theorem foldr_append (f : α → β → β) (b) (l l' : List α) :
     (l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM]
 
+theorem filterMap_eq_append (f : α → Option β) :
+    filterMap f l = L₁ ++ L₂ ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ filterMap f l₁ = L₁ ∧ filterMap f l₂ = L₂ := by
+  constructor
+  · induction l generalizing L₁ with
+    | nil =>
+      simp only [filterMap_nil, nil_eq_append, and_imp]
+      rintro rfl rfl
+      exact ⟨[], [], by simp⟩
+    | cons x l ih =>
+      simp only [filterMap_cons]
+      split
+      · intro h
+        obtain ⟨l₁, l₂, rfl, rfl, rfl⟩ := ih h
+        refine ⟨x :: l₁, l₂, ?_⟩
+        simp_all
+      · rename_i b w
+        intro h
+        rcases cons_eq_append.mp h with (⟨rfl, rfl⟩ | ⟨L₁, ⟨rfl, h⟩⟩)
+        · refine ⟨[], x :: l, ?_⟩
+          simp [filterMap_cons, w]
+        · obtain ⟨l₁, l₂, rfl, rfl, rfl⟩ := ih ‹_›
+          refine ⟨x :: l₁, l₂, ?_⟩
+          simp [filterMap_cons, w]
+  · rintro ⟨l₁, l₂, rfl, rfl, rfl⟩
+    simp
+
+theorem append_eq_filterMap (f : α → Option β) :
+    L₁ ++ L₂ = filterMap f l ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ filterMap f l₁ = L₁ ∧ filterMap f l₂ = L₂ := by
+  rw [eq_comm, filterMap_eq_append]
+
+theorem filter_eq_append (p : α → Bool) :
+    filter p l = L₁ ++ L₂ ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ filter p l₁ = L₁ ∧ filter p l₂ = L₂ := by
+  rw [← filterMap_eq_filter, filterMap_eq_append]
+
+theorem append_eq_filter (p : α → Bool) :
+    L₁ ++ L₂ = filter p l ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ filter p l₁ = L₁ ∧ filter p l₂ = L₂ := by
+  rw [eq_comm, filter_eq_append]
+
 @[simp] theorem map_append (f : α → β) : ∀ l₁ l₂, map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by
   intro l₁; induction l₁ <;> intros <;> simp_all
 
+theorem map_eq_append (f : α → β) :
+    map f l = L₁ ++ L₂ ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ map f l₁ = L₁ ∧ map f l₂ = L₂ := by
+  rw [← filterMap_eq_map, filterMap_eq_append]
+
+theorem append_eq_map (f : α → β) :
+    L₁ ++ L₂ = map f l ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ map f l₁ = L₁ ∧ map f l₂ = L₂ := by
+  rw [eq_comm, map_eq_append]
+
 /-! ### concat
 
 Note that `concat_eq_append` is a `@[simp]` lemma, so `concat` should usually not appear in goals.
@@ -1561,13 +1760,21 @@ theorem eq_nil_or_concat : ∀ l : List α, l = [] ∨ ∃ L b, l = concat L b
   | cons =>
     simp [join, length_append, *]
 
+theorem join_singleton (l : List α) : [l].join = l := by simp
+
 @[simp] theorem mem_join : ∀ {L : List (List α)}, a ∈ L.join ↔ ∃ l, l ∈ L ∧ a ∈ l
   | [] => by simp
   | b :: l => by simp [mem_join, or_and_right, exists_or]
 
-@[simp] theorem join_eq_nil_iff {L : List (List α)} : L.join = [] ↔ ∀ l ∈ L, l = [] := by
+@[simp] theorem join_eq_nil {L : List (List α)} : L.join = [] ↔ ∀ l ∈ L, l = [] := by
   induction L <;> simp_all
 
+@[deprecated join_eq_nil (since := "2024-08-22")]
+theorem join_eq_nil_iff {L : List (List α)} : L.join = [] ↔ ∀ l ∈ L, l = [] := join_eq_nil
+
+theorem join_ne_nil (xs : List (List α)) : xs.join ≠ [] ↔ ∃ x, x ∈ xs ∧ x ≠ [] := by
+  simp
+
 theorem exists_of_mem_join : a ∈ join L → ∃ l, l ∈ L ∧ a ∈ l := mem_join.1
 
 theorem mem_join_of_mem (lL : l ∈ L) (al : a ∈ l) : a ∈ join L := mem_join.2 ⟨l, lL, al⟩
@@ -1608,6 +1815,26 @@ theorem foldr_join (f : α → β → β) (b : β) (L : List (List α)) :
     filter p (join L) = join (map (filter p) L) := by
   induction L <;> simp [*, filter_append]
 
+@[simp]
+theorem join_filter_not_isEmpty  :
+    ∀ {L : List (List α)}, join (L.filter fun l => !l.isEmpty) = L.join
+  | [] => rfl
+  | [] :: L
+  | (a :: l) :: L => by
+      simp [join_filter_not_isEmpty (L := L)]
+
+@[simp]
+theorem join_filter_ne_nil [DecidablePred fun l : List α => l ≠ []] {L : List (List α)} :
+    join (L.filter fun l => l ≠ []) = L.join := by
+  simp only [ne_eq, ← isEmpty_iff, Bool.not_eq_true, Bool.decide_eq_false,
+    join_filter_not_isEmpty]
+
+@[simp] theorem join_map_filter (p : α → Bool) (l : List (List α)) : (l.map (filter p)).join = (l.join).filter p := by
+  induction l with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [ih, map_cons, join_cons, filter_append]
+
 @[simp] theorem join_append (L₁ L₂ : List (List α)) : join (L₁ ++ L₂) = join L₁ ++ join L₂ := by
   induction L₁ <;> simp_all
 
@@ -1617,6 +1844,71 @@ theorem join_concat (L : List (List α)) (l : List α) : join (L ++ [l]) = join
 theorem join_join {L : List (List (List α))} : join (join L) = join (map join L) := by
   induction L <;> simp_all
 
+theorem join_eq_cons (xs : List (List α)) (y : α) (ys : List α) :
+    xs.join = y :: ys ↔
+      ∃ as bs cs, xs = as ++ (y :: bs) :: cs ∧ (∀ l, l ∈ as → l = []) ∧ ys = bs ++ cs.join := by
+  constructor
+  · induction xs with
+    | nil => simp
+    | cons x xs ih =>
+      intro h
+      simp only [join_cons] at h
+      replace h := h.symm
+      rw [cons_eq_append] at h
+      obtain (⟨rfl, h⟩ | ⟨z⟩) := h
+      · obtain ⟨as, bs, cs, rfl, _, rfl⟩ := ih h
+        refine ⟨[] :: as, bs, cs, ?_⟩
+        simpa
+      · obtain ⟨a', rfl, rfl⟩ := z
+        refine ⟨[], a', xs, ?_⟩
+        simp
+  · rintro ⟨as, bs, cs, rfl, h₁, rfl⟩
+    simp [join_eq_nil.mpr h₁]
+
+theorem join_eq_append (xs : List (List α)) (ys zs : List α) :
+    xs.join = ys ++ zs ↔
+      (∃ as bs, xs = as ++ bs ∧ ys = as.join ∧ zs = bs.join) ∨
+        ∃ as bs c cs ds, xs = as ++ (bs ++ c :: cs) :: ds ∧ ys = as.join ++ bs ∧
+          zs = c :: cs ++ ds.join := by
+  constructor
+  · induction xs generalizing ys with
+    | nil =>
+      simp only [join_nil, nil_eq, append_eq_nil, and_false, cons_append, false_and, exists_const,
+        exists_false, or_false, and_imp]
+      rintro rfl rfl
+      exact ⟨[], [], by simp⟩
+    | cons x xs ih =>
+      intro h
+      simp only [join_cons] at h
+      rw [append_eq_append_iff] at h
+      obtain (⟨ys, rfl, h⟩ | ⟨c', rfl, h⟩) := h
+      · obtain (⟨as, bs, rfl, rfl, rfl⟩ | ⟨as, bs, c, cs, ds, rfl, rfl, rfl⟩) := ih _ h
+        · exact .inl ⟨x :: as, bs, by simp⟩
+        · exact .inr ⟨x :: as, bs, c, cs, ds, by simp⟩
+      · simp only [h]
+        cases c' with
+        | nil => exact .inl ⟨[ys], xs, by simp⟩
+        | cons x c' => exact .inr ⟨[], ys, x, c', xs, by simp⟩
+  · rintro (⟨as, bs, rfl, rfl, rfl⟩ | ⟨as, bs, c, cs, ds, rfl, rfl, rfl⟩)
+    · simp
+    · simp
+
+/-- Two lists of sublists are equal iff their joins coincide, as well as the lengths of the
+sublists. -/
+theorem eq_iff_join_eq : ∀ (L L' : List (List α)),
+    L = L' ↔ L.join = L'.join ∧ map length L = map length L'
+  | _, [] => by simp_all
+  | [], x' :: L' => by simp_all
+  | x :: L, x' :: L' => by
+    simp
+    rw [eq_iff_join_eq]
+    constructor
+    · rintro ⟨rfl, h₁, h₂⟩
+      simp_all
+    · rintro ⟨h₁, h₂, h₃⟩
+      obtain ⟨rfl, h⟩ := append_inj_of_length_left h₁ h₂
+      exact ⟨rfl, h, h₃⟩
+
 /-! ### bind -/
 
 theorem bind_def (l : List α) (f : α → List β) : l.bind f = join (map f l) := by rfl
@@ -1633,6 +1925,11 @@ theorem exists_of_mem_bind {b : β} {l : List α} {f : α → List β} :
 theorem mem_bind_of_mem {b : β} {l : List α} {f : α → List β} {a} (al : a ∈ l) (h : b ∈ f a) :
     b ∈ l.bind f := mem_bind.2 ⟨a, al, h⟩
 
+@[simp]
+theorem bind_eq_nil {l : List α} {f : α → List β} : List.bind l f = [] ↔ ∀ x ∈ l, f x = [] :=
+  join_eq_nil.trans <| by
+    simp only [mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂]
+
 theorem forall_mem_bind {p : β → Prop} {l : List α} {f : α → List β} :
     (∀ (x) (_ : x ∈ l.bind f), p x) ↔ ∀ (a) (_ : a ∈ l) (b) (_ : b ∈ f a), p b := by
   simp only [mem_bind, forall_exists_index, and_imp]
@@ -1720,6 +2017,9 @@ theorem forall_mem_replicate {p : α → Prop} {a : α} {n} :
 @[simp] theorem replicate_succ_ne_nil (n : Nat) (a : α) : replicate (n+1) a ≠ [] := by
   simp [replicate_succ]
 
+@[simp] theorem replicate_eq_nil (n : Nat) (a : α) : replicate n a = [] ↔ n = 0 := by
+  cases n <;> simp
+
 @[simp] theorem getElem_replicate (a : α) {n : Nat} {m} (h : m < (replicate n a).length) :
     (replicate n a)[m] = a :=
   eq_of_mem_replicate (get_mem _ _ _)
@@ -1744,6 +2044,9 @@ theorem head?_replicate (a : α) (n : Nat) : (replicate n a).head? = if n = 0 th
   · simp at w
   · simp_all [replicate_succ]
 
+@[simp] theorem tail_replicate (n : Nat) (a : α) : (replicate n a).tail = replicate (n - 1) a := by
+  cases n <;> simp [replicate_succ]
+
 @[simp] theorem replicate_inj : replicate n a = replicate m b ↔ n = m ∧ (n = 0 ∨ a = b) :=
   ⟨fun h => have eq : n = m := by simpa using congrArg length h
     ⟨eq, by
@@ -1788,15 +2091,23 @@ theorem map_const' (l : List α) (b : β) : map (fun _ => b) l = replicate l.len
     simp only [mem_append, mem_replicate, ne_eq]
     rintro (⟨-, rfl⟩ | ⟨_, rfl⟩) <;> rfl
 
+theorem append_eq_replicate {l₁ l₂ : List α} {a : α} :
+    l₁ ++ l₂ = replicate n a ↔
+      l₁.length + l₂.length = n ∧ l₁ = replicate l₁.length a ∧ l₂ = replicate l₂.length a := by
+  simp only [eq_replicate, length_append, mem_append, true_and, and_congr_right_iff]
+  exact fun _ =>
+    { mp := fun h => ⟨fun b m => h b (Or.inl m), fun b m => h b (Or.inr m)⟩,
+      mpr := fun h b x => Or.casesOn x (fun m => h.left b m) fun m => h.right b m }
+
 @[simp] theorem map_replicate : (replicate n a).map f = replicate n (f a) := by
   ext1 n
   simp only [getElem?_map, getElem?_replicate]
   split <;> simp
 
 theorem filter_replicate : (replicate n a).filter p = if p a then replicate n a else [] := by
-  induction n with
+  cases n with
   | zero => simp
-  | succ n ih =>
+  | succ n =>
     simp only [replicate_succ, filter_cons]
     split <;> simp_all
 
@@ -1857,36 +2168,48 @@ theorem bind_replicate {β} (f : α → List β) : (replicate n a).bind f = (rep
   | nil => rfl
   | cons a as ih => simp [ih]
 
-@[simp] theorem mem_reverseAux {x : α} : ∀ {as bs}, x ∈ reverseAux as bs ↔ x ∈ as ∨ x ∈ bs
+theorem mem_reverseAux {x : α} : ∀ {as bs}, x ∈ reverseAux as bs ↔ x ∈ as ∨ x ∈ bs
   | [], _ => ⟨.inr, fun | .inr h => h⟩
   | a :: _, _ => by rw [reverseAux, mem_cons, or_assoc, or_left_comm, mem_reverseAux, mem_cons]
 
-@[simp] theorem mem_reverse {x : α} {as : List α} : x ∈ reverse as ↔ x ∈ as := by simp [reverse]
+@[simp] theorem mem_reverse {x : α} {as : List α} : x ∈ reverse as ↔ x ∈ as := by
+  simp [reverse, mem_reverseAux]
 
 @[simp] theorem reverse_eq_nil_iff {xs : List α} : xs.reverse = [] ↔ xs = [] := by
   match xs with
   | [] => simp
   | x :: xs => simp
 
+theorem reverse_ne_nil_iff {xs : List α} : xs.reverse ≠ [] ↔ xs ≠ [] :=
+  not_congr reverse_eq_nil_iff
+
 theorem getElem?_reverse' : ∀ {l : List α} (i j), i + j + 1 = length l →
     l.reverse[i]? = l[j]?
   | [], _, _, _ => rfl
   | a::l, i, 0, h => by simp [Nat.succ.injEq] at h; simp [h, getElem?_append_right, Nat.succ.injEq]
   | a::l, i, j+1, h => by
     have := Nat.succ.inj h; simp at this ⊢
-    rw [getElem?_append, getElem?_reverse' _ _ this]
+    rw [getElem?_append_left, getElem?_reverse' _ _ this]
     rw [length_reverse, ← this]; apply Nat.lt_add_of_pos_right (Nat.succ_pos _)
 
 @[deprecated getElem?_reverse' (since := "2024-06-12")]
 theorem get?_reverse' {l : List α} (i j) (h : i + j + 1 = length l) : get? l.reverse i = get? l j := by
   simp [getElem?_reverse' _ _ h]
 
+@[simp]
 theorem getElem?_reverse {l : List α} {i} (h : i < length l) :
     l.reverse[i]? = l[l.length - 1 - i]? :=
   getElem?_reverse' _ _ <| by
     rw [Nat.add_sub_of_le (Nat.le_sub_one_of_lt h),
       Nat.sub_add_cancel (Nat.lt_of_le_of_lt (Nat.zero_le _) h)]
 
+@[simp]
+theorem getElem_reverse {l : List α} {i} (h : i < l.reverse.length) :
+    l.reverse[i] = l[l.length - 1 - i]'(Nat.sub_one_sub_lt_of_lt (by simpa using h)) := by
+  apply Option.some.inj
+  rw [← getElem?_eq_getElem, ← getElem?_eq_getElem]
+  rw [getElem?_reverse (by simpa using h)]
+
 @[deprecated getElem?_reverse (since := "2024-06-12")]
 theorem get?_reverse {l : List α} {i} (h : i < length l) :
     get? l.reverse i = get? l (l.length - 1 - i) := by
@@ -1903,11 +2226,24 @@ theorem reverseAux_reverseAux_nil (as bs : List α) : reverseAux (reverseAux as
 theorem reverse_eq_iff {as bs : List α} : as.reverse = bs ↔ as = bs.reverse := by
   constructor <;> (rintro rfl; simp)
 
+@[simp] theorem reverse_inj {xs ys : List α} : xs.reverse = ys.reverse ↔ xs = ys := by
+  simp [reverse_eq_iff]
+
+@[simp] theorem reverse_eq_cons {xs : List α} {a : α} {ys : List α} :
+    xs.reverse = a :: ys ↔ xs = ys.reverse ++ [a] := by
+  rw [reverse_eq_iff, reverse_cons]
+
 @[simp] theorem getLast?_reverse (l : List α) : l.reverse.getLast? = l.head? := by cases l <;> simp
 
 @[simp] theorem head?_reverse (l : List α) : l.reverse.head? = l.getLast? := by
   rw [← getLast?_reverse, reverse_reverse]
 
+theorem getLast?_eq_head?_reverse {xs : List α} : xs.getLast? = xs.reverse.head? := by
+  simp
+
+theorem head?_eq_getLast?_reverse {xs : List α} : xs.head? = xs.reverse.getLast? := by
+  simp
+
 @[simp] theorem map_reverse (f : α → β) (l : List α) : l.reverse.map f = (l.map f).reverse := by
   induction l <;> simp [*]
 
@@ -1932,8 +2268,16 @@ theorem reverse_map (f : α → β) (l : List α) : (l.map f).reverse = l.revers
 @[simp] theorem reverse_append (as bs : List α) : (as ++ bs).reverse = bs.reverse ++ as.reverse := by
   induction as <;> simp_all
 
-theorem reverse_concat (l : List α) (a : α) : (l.concat a).reverse = a :: l.reverse := by
-  rw [concat_eq_append, reverse_append]; rfl
+@[simp] theorem reverse_eq_append {xs ys zs : List α} :
+    xs.reverse = ys ++ zs ↔ xs = zs.reverse ++ ys.reverse := by
+  rw [reverse_eq_iff, reverse_append]
+
+theorem reverse_concat (l : List α) (a : α) : (l ++ [a]).reverse = a :: l.reverse := by
+  rw [reverse_append]; rfl
+
+@[simp] theorem reverse_eq_concat {xs ys : List α} {a : α} :
+    xs.reverse = ys ++ [a] ↔ xs = a :: ys.reverse := by
+  rw [reverse_eq_iff, reverse_concat]
 
 /-- Reversing a join is the same as reversing the order of parts and reversing all parts. -/
 theorem reverse_join (L : List (List α)) :
@@ -1951,7 +2295,7 @@ theorem reverse_bind {β} (l : List α) (f : α → List β) : (l.bind f).revers
 theorem bind_reverse {β} (l : List α) (f : α → List β) : (l.reverse.bind f) = (l.bind (reverse ∘ f)).reverse := by
   induction l <;> simp_all
 
-theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs :=
+@[simp] theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs :=
   reverseAux_eq_append ..
 
 @[simp] theorem foldrM_reverse [Monad m] (l : List α) (f : α → β → m β) (b) :
@@ -1977,16 +2321,38 @@ theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs :=
   induction l with
   | nil => contradiction
   | cons a l ih =>
-    simp
+    simp only [reverse_cons]
     by_cases h' : l = []
     · simp_all
-    · rw [getLast_cons, head_append_of_ne_nil, ih]
-      simp_all
+    · simp only [head_eq_iff_head?_eq_some, head?_reverse] at ih
+      simp [ih, h, h', getLast_cons]
 
 theorem getLast_eq_head_reverse {l : List α} (h : l ≠ []) :
     l.getLast h = l.reverse.head (by simp_all) := by
   rw [← head_reverse]
 
+/--
+We simplify `xs.getLast h = a` to `xs.getLast? = some a`,
+despite not simplifying `xs.getLast h` to `(xs.getLast?).get ⋯`.
+We can often make further progress on the goal after this simplification,
+because the dependency on `h` has been removed.
+-/
+@[simp] theorem getLast_eq_iff_getLast_eq_some {xs : List α} (h) : xs.getLast h = a ↔ xs.getLast? = some a := by
+  rw [getLast_eq_head_reverse, head_eq_iff_head?_eq_some]
+  simp
+
+@[simp] theorem getLast?_eq_none_iff {xs : List α} : xs.getLast? = none ↔ xs = [] := by
+  rw [getLast?_eq_head?_reverse, head?_eq_none_iff, reverse_eq_nil_iff]
+
+theorem getLast?_eq_some_iff {xs : List α} {a : α} : xs.getLast? = some a ↔ ∃ ys, xs = ys ++ [a] := by
+  rw [getLast?_eq_head?_reverse, head?_eq_some_iff]
+  simp only [reverse_eq_cons]
+  exact ⟨fun ⟨ys, h⟩ => ⟨ys.reverse, by simpa using h⟩, fun ⟨ys, h⟩ => ⟨ys.reverse, by simpa using h⟩⟩
+
+theorem mem_of_getLast?_eq_some {xs : List α} {a : α} (h : xs.getLast? = some a) : a ∈ xs := by
+  obtain ⟨ys, rfl⟩ := getLast?_eq_some_iff.1 h
+  exact mem_concat_self ys a
+
 @[simp] theorem getLast_reverse {l : List α} (h : l.reverse ≠ []) :
     l.reverse.getLast h = l.head (by simp_all) := by
   simp [getLast_eq_head_reverse]
@@ -1995,8 +2361,8 @@ theorem head_eq_getLast_reverse {l : List α} (h : l ≠ []) :
     l.head h = l.reverse.getLast (by simp_all) := by
   rw [← getLast_reverse]
 
-@[simp] theorem getLast_append_of_ne_nil {l : List α} (h : l' ≠ []) :
-    (l ++ l').getLast (append_ne_nil_of_right_ne_nil l h) = l'.getLast (by simp_all) := by
+@[simp] theorem getLast_append_of_ne_nil {l : List α} {h₁} (h₂ : l' ≠ []) :
+    (l ++ l').getLast h₁ = l'.getLast h₂ := by
   simp only [getLast_eq_head_reverse, reverse_append]
   rw [head_append_of_ne_nil]
 
@@ -2144,6 +2510,14 @@ theorem dropLast_cons_of_ne_nil {α : Type u} {x : α}
     {l : List α} (h : l ≠ []) : (x :: l).dropLast = x :: l.dropLast := by
   simp [dropLast, h]
 
+theorem dropLast_concat_getLast : ∀ {l : List α} (h : l ≠ []), dropLast l ++ [getLast l h] = l
+  | [], h => absurd rfl h
+  | [a], h => rfl
+  | a :: b :: l, h => by
+    rw [dropLast_cons₂, cons_append, getLast_cons (cons_ne_nil _ _)]
+    congr
+    exact dropLast_concat_getLast (cons_ne_nil b l)
+
 @[simp] theorem map_dropLast (f : α → β) (l : List α) : l.dropLast.map f = (l.map f).dropLast := by
   induction l with
   | nil => rfl
@@ -2160,8 +2534,8 @@ theorem dropLast_append {l₁ l₂ : List α} :
     (l₁ ++ l₂).dropLast = if l₂.isEmpty then l₁.dropLast else l₁ ++ l₂.dropLast := by
   split <;> simp_all
 
-@[simp] theorem dropLast_append_cons : dropLast (l₁ ++ b::l₂) = l₁ ++ dropLast (b::l₂) := by
-  simp only [ne_eq, not_false_eq_true, dropLast_append_of_ne_nil]
+theorem dropLast_append_cons : dropLast (l₁ ++ b::l₂) = l₁ ++ dropLast (b::l₂) := by
+  simp
 
 @[simp 1100] theorem dropLast_concat : dropLast (l₁ ++ [b]) = l₁ := by simp
 
@@ -2178,6 +2552,27 @@ theorem dropLast_append {l₁ l₂ : List α} :
     dropLast (a :: replicate n a) = replicate n a := by
   rw [← replicate_succ, dropLast_replicate, Nat.add_sub_cancel]
 
+/-!
+### splitAt
+
+We don't provide any API for `splitAt`, beyond the `@[simp]` lemma
+`splitAt n l = (l.take n, l.drop n)`,
+which is proved in `Init.Data.List.TakeDrop`.
+-/
+
+theorem splitAt_go (n : Nat) (l acc : List α) :
+    splitAt.go l xs n acc =
+      if n < xs.length then (acc.reverse ++ xs.take n, xs.drop n) else (l, []) := by
+  induction xs generalizing n acc with
+  | nil => simp [splitAt.go]
+  | cons x xs ih =>
+    cases n with
+    | zero => simp [splitAt.go]
+    | succ n =>
+      rw [splitAt.go, take_succ_cons, drop_succ_cons, ih n (x :: acc),
+        reverse_cons, append_assoc, singleton_append, length_cons]
+      simp only [Nat.succ_lt_succ_iff]
+
 /-! ## Manipulating elements -/
 
 /-! ### replace -/

src/Init/Data/List/Nat.lean

@@ -7,4 +7,5 @@ prelude
 import Init.Data.List.Nat.Basic
 import Init.Data.List.Nat.Pairwise
 import Init.Data.List.Nat.Range
+import Init.Data.List.Nat.Sublist
 import Init.Data.List.Nat.TakeDrop

src/Init/Data/List/Nat/Basic.lean

@@ -25,6 +25,14 @@ theorem length_filter_lt_length_iff_exists (l) :
   simpa [length_eq_countP_add_countP p l, countP_eq_length_filter] using
   countP_pos (fun x => ¬p x) (l := l)
 
+/-! ### reverse -/
+
+theorem getElem_eq_getElem_reverse {l : List α} {i} (h : i < l.length) :
+    l[i] = l.reverse[l.length - 1 - i]'(by simpa using Nat.sub_one_sub_lt_of_lt h) := by
+  rw [getElem_reverse]
+  congr
+  omega
+
 /-! ### leftpad -/
 
 /-- The length of the List returned by `List.leftpad n a l` is equal

src/Init/Data/List/Nat/Range.lean

@@ -5,7 +5,9 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M
 -/
 prelude
 import Init.Data.List.Nat.TakeDrop
+import Init.Data.List.Range
 import Init.Data.List.Pairwise
+import Init.Data.List.Find
 
 /-!
 # Lemmas about `List.range` and `List.enum`
@@ -22,8 +24,6 @@ open Nat
 theorem range'_succ (s n step) : range' s (n + 1) step = s :: range' (s + step) n step := by
   simp [range', Nat.add_succ, Nat.mul_succ]
 
-@[simp] theorem range'_one {s step : Nat} : range' s 1 step = [s] := rfl
-
 @[simp] theorem length_range' (s step) : ∀ n : Nat, length (range' s n step) = n
   | 0 => rfl
   | _ + 1 => congrArg succ (length_range' _ _ _)
@@ -31,6 +31,27 @@ theorem range'_succ (s n step) : range' s (n + 1) step = s :: range' (s + step)
 @[simp] theorem range'_eq_nil : range' s n step = [] ↔ n = 0 := by
   rw [← length_eq_zero, length_range']
 
+theorem range'_ne_nil (s n : Nat) : range' s n ≠ [] ↔ n ≠ 0 := by
+  cases n <;> simp
+
+@[simp] theorem range'_zero : range' s 0 = [] := by
+  simp
+
+@[simp] theorem range'_one {s step : Nat} : range' s 1 step = [s] := rfl
+
+@[simp] theorem range'_inj : range' s n = range' s' n' ↔ n = n' ∧ (n = 0 ∨ s = s') := by
+  constructor
+  · intro h
+    have h' := congrArg List.length h
+    simp at h'
+    subst h'
+    cases n with
+    | zero => simp
+    | succ n =>
+      simp only [range'_succ] at h
+      simp_all
+  · rintro ⟨rfl, rfl | rfl⟩ <;> simp
+
 theorem mem_range' : ∀{n}, m ∈ range' s n step ↔ ∃ i < n, m = s + step * i
   | 0 => by simp [range', Nat.not_lt_zero]
   | n + 1 => by
@@ -44,6 +65,29 @@ theorem mem_range' : ∀{n}, m ∈ range' s n step ↔ ∃ i < n, m = s + step *
     fun ⟨i, h, e⟩ => e ▸ ⟨Nat.le_add_right .., Nat.add_lt_add_left h _⟩,
     fun ⟨h₁, h₂⟩ => ⟨m - s, Nat.sub_lt_left_of_lt_add h₁ h₂, (Nat.add_sub_cancel' h₁).symm⟩⟩
 
+theorem head?_range' (n : Nat) : (range' s n).head? = if n = 0 then none else some s := by
+  induction n <;> simp_all [range'_succ, head?_append]
+
+@[simp] theorem head_range' (n : Nat) (h) : (range' s n).head h = s := by
+  repeat simp_all [head?_range']
+
+theorem getLast?_range' (n : Nat) : (range' s n).getLast? = if n = 0 then none else some (s + n - 1) := by
+  induction n generalizing s with
+  | zero => simp
+  | succ n ih =>
+    rw [range'_succ, getLast?_cons, ih]
+    by_cases h : n = 0
+    · rw [if_pos h]
+      simp [h]
+    · rw [if_neg h]
+      simp
+      omega
+
+@[simp] theorem getLast_range' (n : Nat) (h) : (range' s n).getLast h = s + n - 1 := by
+  cases n with
+  | zero => simp at h
+  | succ n => simp [getLast?_range']
+
 theorem pairwise_lt_range' s n (step := 1) (pos : 0 < step := by simp) :
     Pairwise (· < ·) (range' s n step) :=
   match s, n, step, pos with
@@ -123,6 +167,67 @@ theorem range'_concat (s n : Nat) : range' s (n + 1) step = range' s n step ++ [
 theorem range'_1_concat (s n : Nat) : range' s (n + 1) = range' s n ++ [s + n] := by
   simp [range'_concat]
 
+theorem range'_eq_cons_iff : range' s n = a :: xs ↔ s = a ∧ 0 < n ∧ xs = range' (a + 1) (n - 1) := by
+  induction n generalizing s with
+  | zero => simp
+  | succ n ih =>
+    simp only [range'_succ]
+    simp only [cons.injEq, and_congr_right_iff]
+    rintro rfl
+    simp [eq_comm]
+
+@[simp] theorem range'_eq_singleton {s n a : Nat} : range' s n = [a] ↔ s = a ∧ n = 1 := by
+  rw [range'_eq_cons_iff]
+  simp only [nil_eq, range'_eq_nil, and_congr_right_iff]
+  rintro rfl
+  omega
+
+theorem range'_eq_append_iff : range' s n = xs ++ ys ↔ ∃ k, k ≤ n ∧ xs = range' s k ∧ ys = range' (s + k) (n - k) := by
+  induction n generalizing s xs ys with
+  | zero => simp
+  | succ n ih =>
+    simp only [range'_succ]
+    rw [cons_eq_append]
+    constructor
+    · rintro (⟨rfl, rfl⟩ | ⟨a, rfl, h⟩)
+      · exact ⟨0, by simp [range'_succ]⟩
+      · simp only [ih] at h
+        obtain ⟨k, h, rfl, rfl⟩ := h
+        refine ⟨k + 1, ?_⟩
+        simp_all [range'_succ]
+        omega
+    · rintro ⟨k, h, rfl, rfl⟩
+      cases k with
+      | zero => simp [range'_succ]
+      | succ k =>
+        simp only [range'_succ, false_and, cons.injEq, true_and, ih, exists_eq_left', false_or]
+        refine ⟨k, ?_⟩
+        simp_all
+        omega
+
+@[simp] theorem find?_range'_eq_some (s n : Nat) (i : Nat) (p : Nat → Bool) :
+    (range' s n).find? p = some i ↔ p i ∧ i ∈ range' s n ∧ ∀ j, s ≤ j → j < i → !p j := by
+  rw [find?_eq_some]
+  simp only [Bool.not_eq_true', exists_and_right, mem_range'_1, and_congr_right_iff]
+  simp only [range'_eq_append_iff, eq_comm (a := i :: _), range'_eq_cons_iff]
+  intro h
+  constructor
+  · rintro ⟨as, ⟨x, k, h₁, rfl, rfl, h₂, rfl⟩, h₃⟩
+    constructor
+    · omega
+    · simpa using h₃
+  · rintro ⟨⟨h₁, h₂⟩, h₃⟩
+    refine ⟨range' s (i - s), ⟨⟨range' (i + 1) (n - (i - s) - 1), i - s, ?_⟩ , ?_⟩⟩
+    · simp; omega
+    · simp only [mem_range'_1, and_imp]
+      intro a a₁ a₂
+      exact h₃ a a₁ (by omega)
+
+@[simp] theorem find?_range'_eq_none (s n : Nat) (p : Nat → Bool) :
+    (range' s n).find? p = none ↔ ∀ i, s ≤ i → i < s + n → !p i := by
+  rw [find?_eq_none]
+  simp
+
 /-! ### range -/
 
 theorem range_loop_range' : ∀ s n : Nat, range.loop s (range' s n) = range' 0 (n + s)
@@ -152,6 +257,9 @@ theorem range'_eq_map_range (s n : Nat) : range' s n = map (s + ·) (range n) :=
 @[simp] theorem range_eq_nil {n : Nat} : range n = [] ↔ n = 0 := by
   rw [← length_eq_zero, length_range]
 
+theorem range_ne_nil (n : Nat) : range n ≠ [] ↔ n ≠ 0 := by
+  cases n <;> simp
+
 @[simp]
 theorem range_sublist {m n : Nat} : range m <+ range n ↔ m ≤ n := by
   simp only [range_eq_range', range'_sublist_right]
@@ -187,6 +295,30 @@ theorem range_add (a b : Nat) : range (a + b) = range a ++ (range b).map (a + ·
   rw [← range'_eq_map_range]
   simpa [range_eq_range', Nat.add_comm] using (range'_append_1 0 a b).symm
 
+theorem head?_range (n : Nat) : (range n).head? = if n = 0 then none else some 0 := by
+  induction n with
+  | zero => simp
+  | succ n ih =>
+    simp only [range_succ, head?_append, ih]
+    split <;> simp_all
+
+@[simp] theorem head_range (n : Nat) (h) : (range n).head h = 0 := by
+  cases n with
+  | zero => simp at h
+  | succ n => simp [head?_range]
+
+theorem getLast?_range (n : Nat) : (range n).getLast? = if n = 0 then none else some (n - 1) := by
+  induction n with
+  | zero => simp
+  | succ n ih =>
+    simp only [range_succ, getLast?_append, ih]
+    split <;> simp_all
+
+@[simp] theorem getLast_range (n : Nat) (h) : (range n).getLast h = n - 1 := by
+  cases n with
+  | zero => simp at h
+  | succ n => simp [getLast?_range]
+
 theorem take_range (m n : Nat) : take m (range n) = range (min m n) := by
   apply List.ext_getElem
   · simp
@@ -195,6 +327,14 @@ theorem take_range (m n : Nat) : take m (range n) = range (min m n) := by
 theorem nodup_range (n : Nat) : Nodup (range n) := by
   simp (config := {decide := true}) only [range_eq_range', nodup_range']
 
+@[simp] theorem find?_range_eq_some (n : Nat) (i : Nat) (p : Nat → Bool) :
+    (range n).find? p = some i ↔ p i ∧ i ∈ range n ∧ ∀ j, j < i → !p j := by
+  simp [range_eq_range']
+
+@[simp] theorem find?_range_eq_none (n : Nat) (p : Nat → Bool) :
+    (range n).find? p = none ↔ ∀ i, i < n → !p i := by
+  simp [range_eq_range']
+
 /-! ### iota -/
 
 theorem iota_eq_reverse_range' : ∀ n : Nat, iota n = reverse (range' 1 n)
@@ -203,9 +343,49 @@ theorem iota_eq_reverse_range' : ∀ n : Nat, iota n = reverse (range' 1 n)
 
 @[simp] theorem length_iota (n : Nat) : length (iota n) = n := by simp [iota_eq_reverse_range']
 
+@[simp] theorem iota_eq_nil (n : Nat) : iota n = [] ↔ n = 0 := by
+  cases n <;> simp
+
+theorem iota_ne_nil (n : Nat) : iota n ≠ [] ↔ n ≠ 0 := by
+  cases n <;> simp
+
 @[simp]
-theorem mem_iota {m n : Nat} : m ∈ iota n ↔ 1 ≤ m ∧ m ≤ n := by
+theorem mem_iota {m n : Nat} : m ∈ iota n ↔ 0 < m ∧ m ≤ n := by
   simp [iota_eq_reverse_range', Nat.add_comm, Nat.lt_succ]
+  omega
+
+@[simp] theorem iota_inj : iota n = iota n' ↔ n = n' := by
+  constructor
+  · intro h
+    have h' := congrArg List.length h
+    simp at h'
+    exact h'
+  · rintro rfl
+    simp
+
+theorem iota_eq_cons_iff : iota n = a :: xs ↔ n = a ∧ 0 < n ∧ xs = iota (n - 1) := by
+  simp [iota_eq_reverse_range']
+  simp [range'_eq_append_iff, reverse_eq_iff]
+  constructor
+  · rintro ⟨k, h, rfl, h'⟩
+    rw [eq_comm, range'_eq_singleton] at h'
+    simp only [reverse_inj, range'_inj, or_true, and_true]
+    omega
+  · rintro ⟨rfl, h, rfl⟩
+    refine ⟨n - 1, by simp, rfl, ?_⟩
+    rw [eq_comm, range'_eq_singleton]
+    omega
+
+theorem iota_eq_append_iff : iota n = xs ++ ys ↔ ∃ k, k ≤ n ∧ xs = (range' (k + 1) (n - k)).reverse ∧ ys = iota k := by
+  simp only [iota_eq_reverse_range']
+  rw [reverse_eq_append]
+  rw [range'_eq_append_iff]
+  simp only [reverse_eq_iff]
+  constructor
+  · rintro ⟨k, h, rfl, rfl⟩
+    simp; omega
+  · rintro ⟨k, h, rfl, rfl⟩
+    exact ⟨k, by simp; omega⟩
 
 theorem pairwise_gt_iota (n : Nat) : Pairwise (· > ·) (iota n) := by
   simpa only [iota_eq_reverse_range', pairwise_reverse] using pairwise_lt_range' 1 n
@@ -213,36 +393,84 @@ theorem pairwise_gt_iota (n : Nat) : Pairwise (· > ·) (iota n) := by
 theorem nodup_iota (n : Nat) : Nodup (iota n) :=
   (pairwise_gt_iota n).imp Nat.ne_of_gt
 
+@[simp] theorem head?_iota (n : Nat) : (iota n).head? = if n = 0 then none else some n := by
+  cases n <;> simp
+
+@[simp] theorem head_iota (n : Nat) (h) : (iota n).head h = n := by
+  cases n with
+  | zero => simp at h
+  | succ n => simp
+
+@[simp] theorem reverse_iota : reverse (iota n) = range' 1 n := by
+  induction n with
+  | zero => simp
+  | succ n ih =>
+    rw [iota_succ, reverse_cons, ih, range'_1_concat, Nat.add_comm]
+
+@[simp] theorem getLast?_iota (n : Nat) : (iota n).getLast? = if n = 0 then none else some 1 := by
+  rw [getLast?_eq_head?_reverse]
+  simp [head?_range']
+
+@[simp] theorem getLast_iota (n : Nat) (h) : (iota n).getLast h = 1 := by
+  rw [getLast_eq_head_reverse]
+  simp
+
+@[simp] theorem find?_iota_eq_none (n : Nat) (p : Nat → Bool) :
+    (iota n).find? p = none ↔ ∀ i, 0 < i → i ≤ n → !p i := by
+  rw [find?_eq_none]
+  simp
+
+@[simp] theorem find?_iota_eq_some (n : Nat) (i : Nat) (p : Nat → Bool) :
+    (iota n).find? p = some i ↔ p i ∧ i ∈ iota n ∧ ∀ j, i < j → j ≤ n → !p j := by
+  rw [find?_eq_some]
+  simp only [iota_eq_reverse_range', reverse_eq_append, reverse_cons, append_assoc,
+    singleton_append, Bool.not_eq_true', exists_and_right, mem_reverse, mem_range'_1,
+    and_congr_right_iff]
+  intro h
+  constructor
+  · rintro ⟨as, ⟨xs, h⟩, h'⟩
+    constructor
+    · replace h : i ∈ range' 1 n := by
+        rw [h]
+        exact mem_append_cons_self
+      simpa using h
+    · rw [range'_eq_append_iff] at h
+      simp [reverse_eq_iff] at h
+      obtain ⟨k, h₁, rfl, h₂⟩ := h
+      rw [eq_comm, range'_eq_cons_iff, reverse_eq_iff] at h₂
+      obtain ⟨rfl, -, rfl⟩ := h₂
+      intro j j₁ j₂
+      apply h'
+      simp; omega
+  · rintro ⟨⟨i₁, i₂⟩, h⟩
+    refine ⟨(range' (i+1) (n-i)).reverse, ⟨(range' 1 (i-1)).reverse, ?_⟩, ?_⟩
+    · simp [← range'_succ]
+      rw [range'_eq_append_iff]
+      refine ⟨i-1, ?_⟩
+      constructor
+      · omega
+      · simp
+        omega
+    · simp
+      intros a a₁ a₂
+      apply h
+      · omega
+      · omega
+
 /-! ### enumFrom -/
 
 @[simp]
 theorem enumFrom_singleton (x : α) (n : Nat) : enumFrom n [x] = [(n, x)] :=
   rfl
 
-@[simp]
-theorem enumFrom_eq_nil {n : Nat} {l : List α} : List.enumFrom n l = [] ↔ l = [] := by
-  cases l <;> simp
+@[simp] theorem head?_enumFrom (n : Nat) (l : List α) :
+    (enumFrom n l).head? = l.head?.map fun a => (n, a) := by
+  simp [head?_eq_getElem?]
 
-@[simp] theorem enumFrom_length : ∀ {n} {l : List α}, (enumFrom n l).length = l.length
-  | _, [] => rfl
-  | _, _ :: _ => congrArg Nat.succ enumFrom_length
-
-@[simp]
-theorem getElem?_enumFrom :
-    ∀ n (l : List α) m, (enumFrom n l)[m]? = l[m]?.map fun a => (n + m, a)
-  | n, [], m => rfl
-  | n, a :: l, 0 => by simp
-  | n, a :: l, m + 1 => by
-    simp only [enumFrom_cons, getElem?_cons_succ]
-    exact (getElem?_enumFrom (n + 1) l m).trans <| by rw [Nat.add_right_comm]; rfl
-
-@[simp]
-theorem getElem_enumFrom (l : List α) (n) (i : Nat) (h : i < (l.enumFrom n).length) :
-    (l.enumFrom n)[i] = (n + i, l[i]'(by simpa [enumFrom_length] using h)) := by
-  simp only [enumFrom_length] at h
-  rw [getElem_eq_getElem?]
-  simp only [getElem?_enumFrom, getElem?_eq_getElem h]
-  simp
+@[simp] theorem getLast?_enumFrom (n : Nat) (l : List α) :
+    (enumFrom n l).getLast? = l.getLast?.map fun a => (n + l.length - 1, a) := by
+  simp [getLast?_eq_getElem?]
+  cases l <;> simp; omega
 
 theorem mk_add_mem_enumFrom_iff_getElem? {n i : Nat} {x : α} {l : List α} :
     (n + i, x) ∈ enumFrom n l ↔ l[i]? = some x := by
@@ -284,17 +512,24 @@ theorem enumFrom_map_snd : ∀ (n) (l : List α), map Prod.snd (enumFrom n l) =
 theorem snd_mem_of_mem_enumFrom {x : Nat × α} {n : Nat} {l : List α} (h : x ∈ enumFrom n l) : x.2 ∈ l :=
   enumFrom_map_snd n l ▸ mem_map_of_mem _ h
 
-theorem mem_enumFrom {x : α} {i j : Nat} (xs : List α) (h : (i, x) ∈ xs.enumFrom j) :
-    j ≤ i ∧ i < j + xs.length ∧ x ∈ xs :=
-  ⟨le_fst_of_mem_enumFrom h, fst_lt_add_of_mem_enumFrom h, snd_mem_of_mem_enumFrom h⟩
+theorem snd_eq_of_mem_enumFrom {x : Nat × α} {n : Nat} {l : List α} (h : x ∈ enumFrom n l) :
+    x.2 = l[x.1 - n]'(by have := le_fst_of_mem_enumFrom h; have := fst_lt_add_of_mem_enumFrom h; omega) := by
+  induction l generalizing n with
+  | nil => cases h
+  | cons hd tl ih =>
+    cases h with
+    | head h => simp
+    | tail h m =>
+      specialize ih m
+      have : x.1 - n = x.1 - (n + 1) + 1 := by
+        have := le_fst_of_mem_enumFrom m
+        omega
+      simp [this, ih]
 
-theorem map_fst_add_enumFrom_eq_enumFrom (l : List α) (n k : Nat) :
-    map (Prod.map (· + n) id) (enumFrom k l) = enumFrom (n + k) l :=
-  ext_getElem? fun i ↦ by simp [(· ∘ ·), Nat.add_comm, Nat.add_left_comm]; rfl
-
-theorem map_fst_add_enum_eq_enumFrom (l : List α) (n : Nat) :
-    map (Prod.map (· + n) id) (enum l) = enumFrom n l :=
-  map_fst_add_enumFrom_eq_enumFrom l _ _
+theorem mem_enumFrom {x : α} {i j : Nat} {xs : List α} (h : (i, x) ∈ xs.enumFrom j) :
+    j ≤ i ∧ i < j + xs.length ∧
+      x = xs[i - j]'(by have := le_fst_of_mem_enumFrom h; have := fst_lt_add_of_mem_enumFrom h; omega) :=
+  ⟨le_fst_of_mem_enumFrom h, fst_lt_add_of_mem_enumFrom h, snd_eq_of_mem_enumFrom h⟩
 
 theorem enumFrom_cons' (n : Nat) (x : α) (xs : List α) :
     enumFrom n (x :: xs) = (n, x) :: (enumFrom n xs).map (Prod.map (· + 1) id) := by
@@ -349,6 +584,14 @@ theorem getElem_enum (l : List α) (i : Nat) (h : i < l.enum.length) :
     l.enum[i] = (i, l[i]'(by simpa [enum_length] using h)) := by
   simp [enum]
 
+@[simp] theorem head?_enum (l : List α) :
+    l.enum.head? = l.head?.map fun a => (0, a) := by
+  simp [head?_eq_getElem?]
+
+@[simp] theorem getLast?_enum (l : List α) :
+    l.enum.getLast? = l.getLast?.map fun a => (l.length - 1, a) := by
+  simp [getLast?_eq_getElem?]
+
 theorem mk_mem_enum_iff_getElem? {i : Nat} {x : α} {l : List α} : (i, x) ∈ enum l ↔ l[i]? = x := by
   simp [enum, mk_mem_enumFrom_iff_le_and_getElem?_sub]
 
@@ -361,6 +604,14 @@ theorem fst_lt_of_mem_enum {x : Nat × α} {l : List α} (h : x ∈ enum l) : x.
 theorem snd_mem_of_mem_enum {x : Nat × α} {l : List α} (h : x ∈ enum l) : x.2 ∈ l :=
   snd_mem_of_mem_enumFrom h
 
+theorem snd_eq_of_mem_enum {x : Nat × α} {l : List α} (h : x ∈ enum l) :
+    x.2 = l[x.1]'(fst_lt_of_mem_enum h) :=
+  snd_eq_of_mem_enumFrom h
+
+theorem mem_enum {x : α} {i : Nat} {xs : List α} (h : (i, x) ∈ xs.enum) :
+    i < xs.length ∧ x = xs[i]'(fst_lt_of_mem_enum h) :=
+  by simpa using mem_enumFrom h
+
 theorem map_enum (f : α → β) (l : List α) : map (Prod.map id f) (enum l) = enum (map f l) :=
   map_enumFrom f 0 l
 

src/Init/Data/List/Nat/Sublist.lean

@@ -0,0 +1,174 @@
+/-
+Copyright (c) 2024 Lean FRO. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.List.Sublist
+import Init.Data.List.Nat.Basic
+import Init.Data.List.Nat.TakeDrop
+import Init.Data.Nat.Lemmas
+
+/-!
+# Further lemmas about `List.IsSuffix` / `List.IsPrefix` / `List.IsInfix`.
+
+These are in a separate file from most of the lemmas about `List.IsSuffix`
+as they required importing more lemmas about natural numbers, and use `omega`.
+-/
+
+namespace List
+
+theorem IsSuffix.getElem {x y : List α} (h : x <:+ y) {n} (hn : n < x.length) :
+    x[n] = y[y.length - x.length + n]'(by have := h.length_le; omega) := by
+  rw [getElem_eq_getElem_reverse, h.reverse.getElem, getElem_reverse]
+  congr
+  have := h.length_le
+  omega
+
+theorem isSuffix_iff : l₁ <:+ l₂ ↔
+    l₁.length ≤ l₂.length ∧ ∀ i (h : i < l₁.length), l₂[i + l₂.length - l₁.length]? = some l₁[i] := by
+  suffices l₁.length ≤ l₂.length ∧ l₁ <:+ l₂ ↔
+      l₁.length ≤ l₂.length ∧ ∀ i (h : i < l₁.length), l₂[i + l₂.length - l₁.length]? = some l₁[i] by
+    constructor
+    · intro h
+      exact this.mp ⟨h.length_le, h⟩
+    · intro h
+      exact (this.mpr h).2
+  simp only [and_congr_right_iff]
+  intro le
+  rw [← reverse_prefix, isPrefix_iff]
+  simp only [length_reverse]
+  constructor
+  · intro w i h
+    specialize w (l₁.length - 1 - i) (by omega)
+    rw [getElem?_reverse (by omega)] at w
+    have p : l₂.length - 1 - (l₁.length - 1 - i) = i + l₂.length - l₁.length := by omega
+    rw [p] at w
+    rw [w, getElem_reverse]
+    congr
+    omega
+  · intro w i h
+    rw [getElem?_reverse]
+    specialize w (l₁.length - 1 - i) (by omega)
+    have p : l₁.length - 1 - i + l₂.length - l₁.length = l₂.length - 1 - i := by omega
+    rw [p] at w
+    rw [w, getElem_reverse]
+    exact Nat.lt_of_lt_of_le h le
+
+theorem isInfix_iff : l₁ <:+: l₂ ↔
+    ∃ k, l₁.length + k ≤ l₂.length ∧ ∀ i (h : i < l₁.length), l₂[i + k]? = some l₁[i] := by
+  constructor
+  · intro h
+    obtain ⟨t, p, s⟩ := infix_iff_suffix_prefix.mp h
+    refine ⟨t.length - l₁.length, by have := p.length_le; have := s.length_le; omega, ?_⟩
+    rw [isSuffix_iff] at p
+    obtain ⟨p', p⟩ := p
+    rw [isPrefix_iff] at s
+    intro i h
+    rw [s _ (by omega)]
+    specialize p i (by omega)
+    rw [Nat.add_sub_assoc (by omega)] at p
+    rw [← getElem?_eq_getElem, p]
+  · rintro ⟨k, le, w⟩
+    refine ⟨l₂.take k, l₂.drop (k + l₁.length), ?_⟩
+    ext1 i
+    rw [getElem?_append]
+    split
+    · rw [getElem?_append]
+      split
+      · rw [getElem?_take]; simp_all; omega
+      · simp_all
+        have p : i = (i - k) + k := by omega
+        rw [p, w _ (by omega), getElem?_eq_getElem]
+        · congr 2
+          omega
+        · omega
+    · rw [getElem?_drop]
+      congr
+      simp_all
+      omega
+
+theorem suffix_iff_eq_append : l₁ <:+ l₂ ↔ take (length l₂ - length l₁) l₂ ++ l₁ = l₂ :=
+  ⟨by rintro ⟨r, rfl⟩; simp only [length_append, Nat.add_sub_cancel_right, take_left], fun e =>
+    ⟨_, e⟩⟩
+
+theorem prefix_take_iff {x y : List α} {n : Nat} : x <+: y.take n ↔ x <+: y ∧ x.length ≤ n := by
+  constructor
+  · intro h
+    constructor
+    · exact List.IsPrefix.trans h <| List.take_prefix n y
+    · replace h := h.length_le
+      rw [length_take, Nat.le_min] at h
+      exact h.left
+  · intro ⟨hp, hl⟩
+    have hl' := hp.length_le
+    rw [List.prefix_iff_eq_take] at *
+    rw [hp, List.take_take]
+    simp [Nat.min_eq_left, hl, hl']
+
+theorem suffix_iff_eq_drop : l₁ <:+ l₂ ↔ l₁ = drop (length l₂ - length l₁) l₂ :=
+  ⟨fun h => append_cancel_left <| (suffix_iff_eq_append.1 h).trans (take_append_drop _ _).symm,
+    fun e => e.symm ▸ drop_suffix _ _⟩
+
+theorem prefix_take_le_iff {L : List α} (hm : m < L.length) :
+    L.take m <+: L.take n ↔ m ≤ n := by
+  simp only [prefix_iff_eq_take, length_take]
+  induction m generalizing L n with
+  | zero => simp [Nat.min_eq_left, eq_self_iff_true, Nat.zero_le, take]
+  | succ m IH =>
+    cases L with
+    | nil => simp_all
+    | cons l ls =>
+      cases n with
+      | zero =>
+        simp
+      | succ n =>
+        simp only [length_cons, Nat.succ_eq_add_one, Nat.add_lt_add_iff_right] at hm
+        simp [← @IH n ls hm, Nat.min_eq_left, Nat.le_of_lt hm]
+
+@[simp] theorem append_left_sublist_self (xs ys : List α) : xs ++ ys <+ ys ↔ xs = [] := by
+  constructor
+  · intro h
+    replace h := h.length_le
+    simp only [length_append] at h
+    have : xs.length = 0 := by omega
+    simp_all
+  · rintro rfl
+    simp
+@[simp] theorem append_right_sublist_self (xs ys : List α) : xs ++ ys <+ xs ↔ ys = [] := by
+  constructor
+  · intro h
+    replace h := h.length_le
+    simp only [length_append] at h
+    have : ys.length = 0 := by omega
+    simp_all
+  · rintro rfl
+    simp
+
+theorem append_sublist_of_sublist_left (xs ys zs : List α) (h : zs <+ xs) :
+    xs ++ ys <+ zs ↔ ys = [] ∧ xs = zs := by
+  constructor
+  · intro h'
+    have hl := h.length_le
+    have hl' := h'.length_le
+    simp only [length_append] at hl'
+    have : ys.length = 0 := by omega
+    simp_all only [Nat.add_zero, length_eq_zero, true_and, append_nil]
+    exact Sublist.eq_of_length_le h' hl
+  · rintro ⟨rfl, rfl⟩
+    simp
+
+theorem append_sublist_of_sublist_right (xs ys zs : List α) (h : zs <+ ys) :
+    xs ++ ys <+ zs ↔ xs = [] ∧ ys = zs := by
+  constructor
+  · intro h'
+    have hl := h.length_le
+    have hl' := h'.length_le
+    simp only [length_append] at hl'
+    have : xs.length = 0 := by omega
+    simp_all only [Nat.zero_add, length_eq_zero, true_and, append_nil]
+    exact Sublist.eq_of_length_le h' hl
+  · rintro ⟨rfl, rfl⟩
+    simp
+
+end List

src/Init/Data/List/Nat/TakeDrop.lean

@@ -5,6 +5,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M
 -/
 prelude
 import Init.Data.List.Zip
+import Init.Data.List.Sublist
 import Init.Data.Nat.Lemmas
 
 /-!
@@ -69,20 +70,20 @@ theorem get?_take_eq_none {l : List α} {n m : Nat} (h : n ≤ m) :
     (l.take n).get? m = none := by
   simp [getElem?_take_eq_none h]
 
-theorem getElem?_take_eq_if {l : List α} {n m : Nat} :
+theorem getElem?_take {l : List α} {n m : Nat} :
     (l.take n)[m]? = if m < n then l[m]? else none := by
   split
-  · next h => exact getElem?_take h
+  · next h => exact getElem?_take_of_lt h
   · next h => exact getElem?_take_eq_none (Nat.le_of_not_lt h)
 
-@[deprecated getElem?_take_eq_if (since := "2024-06-12")]
+@[deprecated getElem?_take (since := "2024-06-12")]
 theorem get?_take_eq_if {l : List α} {n m : Nat} :
     (l.take n).get? m = if m < n then l.get? m else none := by
-  simp [getElem?_take_eq_if]
+  simp [getElem?_take]
 
 theorem head?_take {l : List α} {n : Nat} :
     (l.take n).head? = if n = 0 then none else l.head? := by
-  simp [head?_eq_getElem?, getElem?_take_eq_if]
+  simp [head?_eq_getElem?, getElem?_take]
   split
   · rw [if_neg (by omega)]
   · rw [if_pos (by omega)]
@@ -94,7 +95,7 @@ theorem head_take {l : List α} {n : Nat} (h : l.take n ≠ []) :
   simp_all
 
 theorem getLast?_take {l : List α} : (l.take n).getLast? = if n = 0 then none else l[n - 1]?.or l.getLast? := by
-  rw [getLast?_eq_getElem?, getElem?_take_eq_if, length_take]
+  rw [getLast?_eq_getElem?, getElem?_take, length_take]
   split
   · rw [if_neg (by omega)]
     rw [Nat.min_def]
@@ -127,7 +128,7 @@ theorem take_take : ∀ (n m) (l : List α), take n (take m l) = take (min n m)
 theorem take_set_of_lt (a : α) {n m : Nat} (l : List α) (h : m < n) :
     (l.set n a).take m = l.take m :=
   List.ext_getElem? fun i => by
-    rw [getElem?_take_eq_if, getElem?_take_eq_if]
+    rw [getElem?_take, getElem?_take]
     split
     · next h' => rw [getElem?_set_ne (by omega)]
     · rfl
@@ -199,6 +200,19 @@ theorem map_eq_append_split {f : α → β} {l : List α} {s₁ s₂ : List β}
   rw [← length_map l f, h, length_append]
   apply Nat.le_add_right
 
+theorem take_prefix_take_left (l : List α) {m n : Nat} (h : m ≤ n) : take m l <+: take n l := by
+  rw [isPrefix_iff]
+  intro i w
+  rw [getElem?_take_of_lt, getElem_take', getElem?_eq_getElem]
+  simp only [length_take] at w
+  exact Nat.lt_of_lt_of_le (Nat.lt_of_lt_of_le w (Nat.min_le_left _ _)) h
+
+theorem take_sublist_take_left (l : List α) {m n : Nat} (h : m ≤ n) : take m l <+ take n l :=
+  (take_prefix_take_left l h).sublist
+
+theorem take_subset_take_left (l : List α) {m n : Nat} (h : m ≤ n) : take m l ⊆ take n l :=
+  (take_sublist_take_left l h).subset
+
 /-! ### drop -/
 
 theorem lt_length_drop (L : List α) {i j : Nat} (h : i + j < L.length) : j < (L.drop i).length := by
@@ -261,7 +275,7 @@ theorem head?_drop (l : List α) (n : Nat) :
 theorem head_drop {l : List α} {n : Nat} (h : l.drop n ≠ []) :
     (l.drop n).head h = l[n]'(by simp_all) := by
   have w : n < l.length := length_lt_of_drop_ne_nil h
-  simpa [head?_eq_head, getElem?_eq_getElem, h, w] using head?_drop l n
+  simpa [getElem?_eq_getElem, h, w] using head?_drop l n
 
 theorem getLast?_drop {l : List α} : (l.drop n).getLast? = if l.length ≤ n then none else l.getLast? := by
   rw [getLast?_eq_getElem?, getElem?_drop]
@@ -319,8 +333,8 @@ theorem set_eq_take_append_cons_drop {l : List α} {n : Nat} {a : α} :
   split <;> rename_i h
   · ext1 m
     by_cases h' : m < n
-    · rw [getElem?_append (by simp [length_take]; omega), getElem?_set_ne (by omega),
-        getElem?_take h']
+    · rw [getElem?_append_left (by simp [length_take]; omega), getElem?_set_ne (by omega),
+        getElem?_take_of_lt h']
     · by_cases h'' : m = n
       · subst h''
         rw [getElem?_set_eq ‹_›, getElem?_append_right, length_take,
@@ -359,40 +373,67 @@ theorem drop_take : ∀ (m n : Nat) (l : List α), drop n (take m l) = take (m -
     congr 1
     omega
 
-theorem take_reverse {α} {xs : List α} {n : Nat} (h : n ≤ xs.length) :
+theorem take_reverse {α} {xs : List α} {n : Nat} :
     xs.reverse.take n = (xs.drop (xs.length - n)).reverse := by
-  induction xs generalizing n <;>
-    simp only [reverse_cons, drop, reverse_nil, Nat.zero_sub, length, take_nil]
-  next xs_hd xs_tl xs_ih =>
-  cases Nat.lt_or_eq_of_le h with
-  | inl h' =>
-    have h' := Nat.le_of_succ_le_succ h'
-    rw [take_append_of_le_length, xs_ih h']
-    rw [show xs_tl.length + 1 - n = succ (xs_tl.length - n) from _, drop]
-    · rwa [succ_eq_add_one, Nat.sub_add_comm]
-    · rwa [length_reverse]
-  | inr h' =>
-    subst h'
-    rw [length, Nat.sub_self, drop]
-    suffices xs_tl.length + 1 = (xs_tl.reverse ++ [xs_hd]).length by
-      rw [this, take_length, reverse_cons]
-    rw [length_append, length_reverse]
-    rfl
+  by_cases h : n ≤ xs.length
+  · induction xs generalizing n <;>
+      simp only [reverse_cons, drop, reverse_nil, Nat.zero_sub, length, take_nil]
+    next xs_hd xs_tl xs_ih =>
+    cases Nat.lt_or_eq_of_le h with
+    | inl h' =>
+      have h' := Nat.le_of_succ_le_succ h'
+      rw [take_append_of_le_length, xs_ih h']
+      rw [show xs_tl.length + 1 - n = succ (xs_tl.length - n) from _, drop]
+      · rwa [succ_eq_add_one, Nat.sub_add_comm]
+      · rwa [length_reverse]
+    | inr h' =>
+      subst h'
+      rw [length, Nat.sub_self, drop]
+      suffices xs_tl.length + 1 = (xs_tl.reverse ++ [xs_hd]).length by
+        rw [this, take_length, reverse_cons]
+      rw [length_append, length_reverse]
+      rfl
+  · have w : xs.length - n = 0 := by omega
+    rw [take_of_length_le, w, drop_zero]
+    simp
+    omega
 
-@[deprecated (since := "2024-06-15")] abbrev reverse_take := @take_reverse
-
-theorem drop_reverse {α} {xs : List α} {n : Nat} (h : n ≤ xs.length) :
+theorem drop_reverse {α} {xs : List α} {n : Nat} :
     xs.reverse.drop n = (xs.take (xs.length - n)).reverse := by
-  conv =>
-    rhs
-    rw [← reverse_reverse xs]
-  rw [← reverse_reverse xs] at h
-  generalize xs.reverse = xs' at h ⊢
-  rw [take_reverse]
-  · simp only [length_reverse, reverse_reverse] at *
+  by_cases h : n ≤ xs.length
+  · conv =>
+      rhs
+      rw [← reverse_reverse xs]
+    rw [← reverse_reverse xs] at h
+    generalize xs.reverse = xs' at h ⊢
+    rw [take_reverse]
+    · simp only [length_reverse, reverse_reverse] at *
+      congr
+      omega
+  · have w : xs.length - n = 0 := by omega
+    rw [drop_of_length_le, w, take_zero, reverse_nil]
+    simp
+    omega
+
+theorem reverse_take {l : List α} {n : Nat} :
+    (l.take n).reverse = l.reverse.drop (l.length - n) := by
+  by_cases h : n ≤ l.length
+  · rw [drop_reverse]
     congr
     omega
-  · simp only [length_reverse, sub_le]
+  · have w : l.length - n = 0 := by omega
+    rw [w, drop_zero, take_of_length_le]
+    omega
+
+theorem reverse_drop {l : List α} {n : Nat} :
+    (l.drop n).reverse = l.reverse.take (l.length - n) := by
+  by_cases h : n ≤ l.length
+  · rw [take_reverse]
+    congr
+    omega
+  · have w : l.length - n = 0 := by omega
+    rw [w, take_zero, drop_of_length_le, reverse_nil]
+    omega
 
 /-! ### rotateLeft -/
 

src/Init/Data/List/Pairwise.lean

@@ -5,6 +5,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M
 -/
 prelude
 import Init.Data.List.Sublist
+import Init.Data.List.Attach
 
 /-!
 # Lemmas about `List.Pairwise` and `List.Nodup`.
@@ -225,6 +226,43 @@ theorem pairwise_iff_forall_sublist : l.Pairwise R ↔ (∀ {a b}, [a,b] <+ l
         intro a b hab
         apply h; exact hab.cons _
 
+theorem Pairwise.rel_of_mem_take_of_mem_drop
+    {l : List α} (h : l.Pairwise R) (hx : x ∈ l.take n) (hy : y ∈ l.drop n) : R x y := by
+  apply pairwise_iff_forall_sublist.mp h
+  rw [← take_append_drop n l, sublist_append_iff]
+  refine ⟨[x], [y], rfl, by simpa, by simpa⟩
+
+theorem Pairwise.rel_of_mem_append
+    {l₁ l₂ : List α} (h : (l₁ ++ l₂).Pairwise R) (hx : x ∈ l₁) (hy : y ∈ l₂) : R x y := by
+  apply pairwise_iff_forall_sublist.mp h
+  rw [sublist_append_iff]
+  exact ⟨[x], [y], rfl, by simpa, by simpa⟩
+
+theorem pairwise_of_forall_mem_list {l : List α} {r : α → α → Prop} (h : ∀ a ∈ l, ∀ b ∈ l, r a b) :
+    l.Pairwise r := by
+  rw [pairwise_iff_forall_sublist]
+  intro a b hab
+  apply h <;> (apply hab.subset; simp)
+
+theorem pairwise_pmap {p : β → Prop} {f : ∀ b, p b → α} {l : List β} (h : ∀ x ∈ l, p x) :
+    Pairwise R (l.pmap f h) ↔
+      Pairwise (fun b₁ b₂ => ∀ (h₁ : p b₁) (h₂ : p b₂), R (f b₁ h₁) (f b₂ h₂)) l := by
+  induction l with
+  | nil => simp
+  | cons a l ihl =>
+    obtain ⟨_, hl⟩ : p a ∧ ∀ b, b ∈ l → p b := by simpa using h
+    simp only [ihl hl, pairwise_cons, exists₂_imp, pmap, and_congr_left_iff, mem_pmap]
+    refine fun _ => ⟨fun H b hb _ hpb => H _ _ hb rfl, ?_⟩
+    rintro H _ b hb rfl
+    exact H b hb _ _
+
+theorem Pairwise.pmap {l : List α} (hl : Pairwise R l) {p : α → Prop} {f : ∀ a, p a → β}
+    (h : ∀ x ∈ l, p x) {S : β → β → Prop}
+    (hS : ∀ ⦃x⦄ (hx : p x) ⦃y⦄ (hy : p y), R x y → S (f x hx) (f y hy)) :
+    Pairwise S (l.pmap f h) := by
+  refine (pairwise_pmap h).2 (Pairwise.imp_of_mem ?_ hl)
+  intros; apply hS; assumption
+
 /-! ### Nodup -/
 
 @[simp]

src/Init/Data/List/Perm.lean

@@ -0,0 +1,463 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro
+-/
+prelude
+import Init.Data.List.Pairwise
+import Init.Data.List.Erase
+
+/-!
+# List Permutations
+
+This file introduces the `List.Perm` relation, which is true if two lists are permutations of one
+another.
+
+## Notation
+
+The notation `~` is used for permutation equivalence.
+-/
+
+open Nat
+
+namespace List
+
+open Perm (swap)
+
+@[simp, refl] protected theorem Perm.refl : ∀ l : List α, l ~ l
+  | [] => .nil
+  | x :: xs => (Perm.refl xs).cons x
+
+protected theorem Perm.rfl {l : List α} : l ~ l := .refl _
+
+theorem Perm.of_eq (h : l₁ = l₂) : l₁ ~ l₂ := h ▸ .rfl
+
+protected theorem Perm.symm {l₁ l₂ : List α} (h : l₁ ~ l₂) : l₂ ~ l₁ := by
+  induction h with
+  | nil => exact nil
+  | cons _ _ ih => exact cons _ ih
+  | swap => exact swap ..
+  | trans _ _ ih₁ ih₂ => exact trans ih₂ ih₁
+
+theorem perm_comm {l₁ l₂ : List α} : l₁ ~ l₂ ↔ l₂ ~ l₁ := ⟨Perm.symm, Perm.symm⟩
+
+theorem Perm.swap' (x y : α) {l₁ l₂ : List α} (p : l₁ ~ l₂) : y :: x :: l₁ ~ x :: y :: l₂ :=
+  (swap ..).trans <| p.cons _ |>.cons _
+
+/--
+Similar to `Perm.recOn`, but the `swap` case is generalized to `Perm.swap'`,
+where the tail of the lists are not necessarily the same.
+-/
+@[elab_as_elim] theorem Perm.recOnSwap'
+    {motive : (l₁ : List α) → (l₂ : List α) → l₁ ~ l₂ → Prop} {l₁ l₂ : List α} (p : l₁ ~ l₂)
+    (nil : motive [] [] .nil)
+    (cons : ∀ x {l₁ l₂}, (h : l₁ ~ l₂) → motive l₁ l₂ h → motive (x :: l₁) (x :: l₂) (.cons x h))
+    (swap' : ∀ x y {l₁ l₂}, (h : l₁ ~ l₂) → motive l₁ l₂ h →
+      motive (y :: x :: l₁) (x :: y :: l₂) (.swap' _ _ h))
+    (trans : ∀ {l₁ l₂ l₃}, (h₁ : l₁ ~ l₂) → (h₂ : l₂ ~ l₃) → motive l₁ l₂ h₁ → motive l₂ l₃ h₂ →
+      motive l₁ l₃ (.trans h₁ h₂)) : motive l₁ l₂ p :=
+  have motive_refl l : motive l l (.refl l) :=
+    List.recOn l nil fun x xs ih => cons x (.refl xs) ih
+  Perm.recOn p nil cons (fun x y l => swap' x y (.refl l) (motive_refl l)) trans
+
+theorem Perm.eqv (α) : Equivalence (@Perm α) := ⟨.refl, .symm, .trans⟩
+
+instance isSetoid (α) : Setoid (List α) := .mk Perm (Perm.eqv α)
+
+theorem Perm.mem_iff {a : α} {l₁ l₂ : List α} (p : l₁ ~ l₂) : a ∈ l₁ ↔ a ∈ l₂ := by
+  induction p with
+  | nil => rfl
+  | cons _ _ ih => simp only [mem_cons, ih]
+  | swap => simp only [mem_cons, or_left_comm]
+  | trans _ _ ih₁ ih₂ => simp only [ih₁, ih₂]
+
+theorem Perm.subset {l₁ l₂ : List α} (p : l₁ ~ l₂) : l₁ ⊆ l₂ := fun _ => p.mem_iff.mp
+
+theorem Perm.append_right {l₁ l₂ : List α} (t₁ : List α) (p : l₁ ~ l₂) : l₁ ++ t₁ ~ l₂ ++ t₁ := by
+  induction p with
+  | nil => rfl
+  | cons _ _ ih => exact cons _ ih
+  | swap => exact swap ..
+  | trans _ _ ih₁ ih₂ => exact trans ih₁ ih₂
+
+theorem Perm.append_left {t₁ t₂ : List α} : ∀ l : List α, t₁ ~ t₂ → l ++ t₁ ~ l ++ t₂
+  | [], p => p
+  | x :: xs, p => (p.append_left xs).cons x
+
+theorem Perm.append {l₁ l₂ t₁ t₂ : List α} (p₁ : l₁ ~ l₂) (p₂ : t₁ ~ t₂) : l₁ ++ t₁ ~ l₂ ++ t₂ :=
+  (p₁.append_right t₁).trans (p₂.append_left l₂)
+
+theorem Perm.append_cons (a : α) {h₁ h₂ t₁ t₂ : List α} (p₁ : h₁ ~ h₂) (p₂ : t₁ ~ t₂) :
+    h₁ ++ a :: t₁ ~ h₂ ++ a :: t₂ := p₁.append (p₂.cons a)
+
+@[simp] theorem perm_middle {a : α} : ∀ {l₁ l₂ : List α}, l₁ ++ a :: l₂ ~ a :: (l₁ ++ l₂)
+  | [], _ => .refl _
+  | b :: _, _ => (Perm.cons _ perm_middle).trans (swap a b _)
+
+@[simp] theorem perm_append_singleton (a : α) (l : List α) : l ++ [a] ~ a :: l :=
+  perm_middle.trans <| by rw [append_nil]
+
+theorem perm_append_comm : ∀ {l₁ l₂ : List α}, l₁ ++ l₂ ~ l₂ ++ l₁
+  | [], l₂ => by simp
+  | a :: t, l₂ => (perm_append_comm.cons _).trans perm_middle.symm
+
+theorem perm_append_comm_assoc (l₁ l₂ l₃ : List α) :
+    Perm (l₁ ++ (l₂ ++ l₃)) (l₂ ++ (l₁ ++ l₃)) := by
+  simpa only [List.append_assoc] using perm_append_comm.append_right _
+
+theorem concat_perm (l : List α) (a : α) : concat l a ~ a :: l := by simp
+
+theorem Perm.length_eq {l₁ l₂ : List α} (p : l₁ ~ l₂) : length l₁ = length l₂ := by
+  induction p with
+  | nil => rfl
+  | cons _ _ ih => simp only [length_cons, ih]
+  | swap => rfl
+  | trans _ _ ih₁ ih₂ => simp only [ih₁, ih₂]
+
+theorem Perm.eq_nil {l : List α} (p : l ~ []) : l = [] := eq_nil_of_length_eq_zero p.length_eq
+
+theorem Perm.nil_eq {l : List α} (p : [] ~ l) : [] = l := p.symm.eq_nil.symm
+
+@[simp] theorem perm_nil {l₁ : List α} : l₁ ~ [] ↔ l₁ = [] :=
+  ⟨fun p => p.eq_nil, fun e => e ▸ .rfl⟩
+
+@[simp] theorem nil_perm {l₁ : List α} : [] ~ l₁ ↔ l₁ = [] := perm_comm.trans perm_nil
+
+theorem not_perm_nil_cons (x : α) (l : List α) : ¬[] ~ x :: l := (nomatch ·.symm.eq_nil)
+
+theorem not_perm_cons_nil {l : List α} {a : α} : ¬(Perm (a::l) []) :=
+  fun h => by simpa using h.length_eq
+
+theorem Perm.isEmpty_eq {l l' : List α} (h : Perm l l') : l.isEmpty = l'.isEmpty := by
+  cases l <;> cases l' <;> simp_all
+
+@[simp] theorem reverse_perm : ∀ l : List α, reverse l ~ l
+  | [] => .nil
+  | a :: l => reverse_cons .. ▸ (perm_append_singleton _ _).trans ((reverse_perm l).cons a)
+
+theorem perm_cons_append_cons {l l₁ l₂ : List α} (a : α) (p : l ~ l₁ ++ l₂) :
+    a :: l ~ l₁ ++ a :: l₂ := (p.cons a).trans perm_middle.symm
+
+@[simp] theorem perm_replicate {n : Nat} {a : α} {l : List α} :
+    l ~ replicate n a ↔ l = replicate n a := by
+  refine ⟨fun p => eq_replicate.2 ?_, fun h => h ▸ .rfl⟩
+  exact ⟨p.length_eq.trans <| length_replicate .., fun _b m => eq_of_mem_replicate <| p.subset m⟩
+
+@[simp] theorem replicate_perm {n : Nat} {a : α} {l : List α} :
+    replicate n a ~ l ↔ replicate n a = l := (perm_comm.trans perm_replicate).trans eq_comm
+
+@[simp] theorem perm_singleton {a : α} {l : List α} : l ~ [a] ↔ l = [a] := perm_replicate (n := 1)
+
+@[simp] theorem singleton_perm {a : α} {l : List α} : [a] ~ l ↔ [a] = l := replicate_perm (n := 1)
+
+theorem Perm.eq_singleton (h : l ~ [a]) : l = [a] := perm_singleton.mp h
+theorem Perm.singleton_eq (h : [a] ~ l) : [a] = l := singleton_perm.mp h
+
+theorem singleton_perm_singleton {a b : α} : [a] ~ [b] ↔ a = b := by simp
+
+theorem perm_cons_erase [DecidableEq α] {a : α} {l : List α} (h : a ∈ l) : l ~ a :: l.erase a :=
+  let ⟨_l₁, _l₂, _, e₁, e₂⟩ := exists_erase_eq h
+  e₂ ▸ e₁ ▸ perm_middle
+
+theorem Perm.filterMap (f : α → Option β) {l₁ l₂ : List α} (p : l₁ ~ l₂) :
+    filterMap f l₁ ~ filterMap f l₂ := by
+  induction p with
+  | nil => simp
+  | cons x _p IH => cases h : f x <;> simp [h, filterMap_cons, IH, Perm.cons]
+  | swap x y l₂ => cases hx : f x <;> cases hy : f y <;> simp [hx, hy, filterMap_cons, swap]
+  | trans _p₁ _p₂ IH₁ IH₂ => exact IH₁.trans IH₂
+
+theorem Perm.map (f : α → β) {l₁ l₂ : List α} (p : l₁ ~ l₂) : map f l₁ ~ map f l₂ :=
+  filterMap_eq_map f ▸ p.filterMap _
+
+theorem Perm.pmap {p : α → Prop} (f : ∀ a, p a → β) {l₁ l₂ : List α} (p : l₁ ~ l₂) {H₁ H₂} :
+    pmap f l₁ H₁ ~ pmap f l₂ H₂ := by
+  induction p with
+  | nil => simp
+  | cons x _p IH => simp [IH, Perm.cons]
+  | swap x y => simp [swap]
+  | trans _p₁ p₂ IH₁ IH₂ => exact IH₁.trans (IH₂ (H₁ := fun a m => H₂ a (p₂.subset m)))
+
+theorem Perm.filter (p : α → Bool) {l₁ l₂ : List α} (s : l₁ ~ l₂) :
+    filter p l₁ ~ filter p l₂ := by rw [← filterMap_eq_filter]; apply s.filterMap
+
+theorem filter_append_perm (p : α → Bool) (l : List α) :
+    filter p l ++ filter (fun x => !p x) l ~ l := by
+  induction l with
+  | nil => rfl
+  | cons x l ih =>
+    by_cases h : p x <;> simp [h]
+    · exact ih.cons x
+    · exact Perm.trans (perm_append_comm.trans (perm_append_comm.cons _)) (ih.cons x)
+
+theorem exists_perm_sublist {l₁ l₂ l₂' : List α} (s : l₁ <+ l₂) (p : l₂ ~ l₂') :
+    ∃ l₁', l₁' ~ l₁ ∧ l₁' <+ l₂' := by
+  induction p generalizing l₁ with
+  | nil => exact ⟨[], sublist_nil.mp s ▸ .rfl, nil_sublist _⟩
+  | cons x _ IH =>
+    match s with
+    | .cons _ s => let ⟨l₁', p', s'⟩ := IH s; exact ⟨l₁', p', s'.cons _⟩
+    | .cons₂ _ s => let ⟨l₁', p', s'⟩ := IH s; exact ⟨x :: l₁', p'.cons x, s'.cons₂ _⟩
+  | swap x y l' =>
+    match s with
+    | .cons _ (.cons _ s) => exact ⟨_, .rfl, (s.cons _).cons _⟩
+    | .cons _ (.cons₂ _ s) => exact ⟨x :: _, .rfl, (s.cons _).cons₂ _⟩
+    | .cons₂ _ (.cons _ s) => exact ⟨y :: _, .rfl, (s.cons₂ _).cons _⟩
+    | .cons₂ _ (.cons₂ _ s) => exact ⟨x :: y :: _, .swap .., (s.cons₂ _).cons₂ _⟩
+  | trans _ _ IH₁ IH₂ =>
+    let ⟨m₁, pm, sm⟩ := IH₁ s
+    let ⟨r₁, pr, sr⟩ := IH₂ sm
+    exact ⟨r₁, pr.trans pm, sr⟩
+
+theorem Perm.sizeOf_eq_sizeOf [SizeOf α] {l₁ l₂ : List α} (h : l₁ ~ l₂) :
+    sizeOf l₁ = sizeOf l₂ := by
+  induction h with
+  | nil => rfl
+  | cons _ _ h_sz₁₂ => simp [h_sz₁₂]
+  | swap => simp [Nat.add_left_comm]
+  | trans _ _ h_sz₁₂ h_sz₂₃ => simp [h_sz₁₂, h_sz₂₃]
+
+theorem Sublist.exists_perm_append {l₁ l₂ : List α} : l₁ <+ l₂ → ∃ l, l₂ ~ l₁ ++ l
+  | Sublist.slnil => ⟨nil, .rfl⟩
+  | Sublist.cons a s =>
+    let ⟨l, p⟩ := Sublist.exists_perm_append s
+    ⟨a :: l, (p.cons a).trans perm_middle.symm⟩
+  | Sublist.cons₂ a s =>
+    let ⟨l, p⟩ := Sublist.exists_perm_append s
+    ⟨l, p.cons a⟩
+
+theorem Perm.countP_eq (p : α → Bool) {l₁ l₂ : List α} (s : l₁ ~ l₂) :
+    countP p l₁ = countP p l₂ := by
+  simp only [countP_eq_length_filter]
+  exact (s.filter _).length_eq
+
+theorem Perm.countP_congr {l₁ l₂ : List α} (s : l₁ ~ l₂) {p p' : α → Bool}
+    (hp : ∀ x ∈ l₁, p x = p' x) : l₁.countP p = l₂.countP p' := by
+  rw [← s.countP_eq p']
+  clear s
+  induction l₁ with
+  | nil => rfl
+  | cons y s hs =>
+    simp only [mem_cons, forall_eq_or_imp] at hp
+    simp only [countP_cons, hs hp.2, hp.1]
+
+theorem countP_eq_countP_filter_add (l : List α) (p q : α → Bool) :
+    l.countP p = (l.filter q).countP p + (l.filter fun a => !q a).countP p :=
+  countP_append .. ▸ Perm.countP_eq _ (filter_append_perm _ _).symm
+
+theorem Perm.count_eq [DecidableEq α] {l₁ l₂ : List α} (p : l₁ ~ l₂) (a) :
+    count a l₁ = count a l₂ := p.countP_eq _
+
+theorem Perm.foldl_eq' {f : β → α → β} {l₁ l₂ : List α} (p : l₁ ~ l₂)
+    (comm : ∀ x ∈ l₁, ∀ y ∈ l₁, ∀ (z), f (f z x) y = f (f z y) x)
+    (init) : foldl f init l₁ = foldl f init l₂ := by
+  induction p using recOnSwap' generalizing init with
+  | nil => simp
+  | cons x _p IH =>
+    simp only [foldl]
+    apply IH; intros; apply comm <;> exact .tail _ ‹_›
+  | swap' x y _p IH =>
+    simp only [foldl]
+    rw [comm x (.tail _ <| .head _) y (.head _)]
+    apply IH; intros; apply comm <;> exact .tail _ (.tail _ ‹_›)
+  | trans p₁ _p₂ IH₁ IH₂ =>
+    refine (IH₁ comm init).trans (IH₂ ?_ _)
+    intros; apply comm <;> apply p₁.symm.subset <;> assumption
+
+theorem Perm.rec_heq {β : List α → Sort _} {f : ∀ a l, β l → β (a :: l)} {b : β []} {l l' : List α}
+    (hl : l ~ l') (f_congr : ∀ {a l l' b b'}, l ~ l' → HEq b b' → HEq (f a l b) (f a l' b'))
+    (f_swap : ∀ {a a' l b}, HEq (f a (a' :: l) (f a' l b)) (f a' (a :: l) (f a l b))) :
+    HEq (@List.rec α β b f l) (@List.rec α β b f l') := by
+  induction hl with
+  | nil => rfl
+  | cons a h ih => exact f_congr h ih
+  | swap a a' l => exact f_swap
+  | trans _h₁ _h₂ ih₁ ih₂ => exact ih₁.trans ih₂
+
+/-- Lemma used to destruct perms element by element. -/
+theorem perm_inv_core {a : α} {l₁ l₂ r₁ r₂ : List α} :
+    l₁ ++ a :: r₁ ~ l₂ ++ a :: r₂ → l₁ ++ r₁ ~ l₂ ++ r₂ := by
+  -- Necessary generalization for `induction`
+  suffices ∀ s₁ s₂ (_ : s₁ ~ s₂) {l₁ l₂ r₁ r₂},
+      l₁ ++ a :: r₁ = s₁ → l₂ ++ a :: r₂ = s₂ → l₁ ++ r₁ ~ l₂ ++ r₂ from (this _ _ · rfl rfl)
+  intro s₁ s₂ p
+  induction p using Perm.recOnSwap' with intro l₁ l₂ r₁ r₂ e₁ e₂
+  | nil =>
+    simp at e₁
+  | cons x p IH =>
+    cases l₁ <;> cases l₂ <;>
+      dsimp at e₁ e₂ <;> injections <;> subst_vars
+    · exact p
+    · exact p.trans perm_middle
+    · exact perm_middle.symm.trans p
+    · exact (IH rfl rfl).cons _
+  | swap' x y p IH =>
+    obtain _ | ⟨y, _ | ⟨z, l₁⟩⟩ := l₁
+      <;> obtain _ | ⟨u, _ | ⟨v, l₂⟩⟩ := l₂
+      <;> dsimp at e₁ e₂ <;> injections <;> subst_vars
+      <;> try exact p.cons _
+    · exact (p.trans perm_middle).cons u
+    · exact ((p.trans perm_middle).cons _).trans (swap _ _ _)
+    · exact (perm_middle.symm.trans p).cons y
+    · exact (swap _ _ _).trans ((perm_middle.symm.trans p).cons u)
+    · exact (IH rfl rfl).swap' _ _
+  | trans p₁ p₂ IH₁ IH₂ =>
+    subst e₁ e₂
+    obtain ⟨l₂, r₂, rfl⟩ := append_of_mem (a := a) (p₁.subset (by simp))
+    exact (IH₁ rfl rfl).trans (IH₂ rfl rfl)
+
+theorem Perm.cons_inv {a : α} {l₁ l₂ : List α} : a :: l₁ ~ a :: l₂ → l₁ ~ l₂ :=
+  perm_inv_core (l₁ := []) (l₂ := [])
+
+@[simp] theorem perm_cons (a : α) {l₁ l₂ : List α} : a :: l₁ ~ a :: l₂ ↔ l₁ ~ l₂ :=
+  ⟨.cons_inv, .cons a⟩
+
+theorem perm_append_left_iff {l₁ l₂ : List α} : ∀ l, l ++ l₁ ~ l ++ l₂ ↔ l₁ ~ l₂
+  | [] => .rfl
+  | a :: l => (perm_cons a).trans (perm_append_left_iff l)
+
+theorem perm_append_right_iff {l₁ l₂ : List α} (l) : l₁ ++ l ~ l₂ ++ l ↔ l₁ ~ l₂ := by
+  refine ⟨fun p => ?_, .append_right _⟩
+  exact (perm_append_left_iff _).1 <| perm_append_comm.trans <| p.trans perm_append_comm
+
+section DecidableEq
+
+variable [DecidableEq α]
+
+theorem Perm.erase (a : α) {l₁ l₂ : List α} (p : l₁ ~ l₂) : l₁.erase a ~ l₂.erase a :=
+  if h₁ : a ∈ l₁ then
+    have h₂ : a ∈ l₂ := p.subset h₁
+    .cons_inv <| (perm_cons_erase h₁).symm.trans <| p.trans (perm_cons_erase h₂)
+  else by
+    have h₂ : a ∉ l₂ := mt p.mem_iff.2 h₁
+    rw [erase_of_not_mem h₁, erase_of_not_mem h₂]; exact p
+
+theorem cons_perm_iff_perm_erase {a : α} {l₁ l₂ : List α} :
+    a :: l₁ ~ l₂ ↔ a ∈ l₂ ∧ l₁ ~ l₂.erase a := by
+  refine ⟨fun h => ?_, fun ⟨m, h⟩ => (h.cons a).trans (perm_cons_erase m).symm⟩
+  have : a ∈ l₂ := h.subset (mem_cons_self a l₁)
+  exact ⟨this, (h.trans <| perm_cons_erase this).cons_inv⟩
+
+theorem perm_iff_count {l₁ l₂ : List α} : l₁ ~ l₂ ↔ ∀ a, count a l₁ = count a l₂ := by
+  refine ⟨Perm.count_eq, fun H => ?_⟩
+  induction l₁ generalizing l₂ with
+  | nil =>
+    match l₂ with
+    | nil => rfl
+    | cons b l₂ =>
+      specialize H b
+      simp at H
+  | cons a l₁ IH =>
+    have : a ∈ l₂ := count_pos_iff_mem.mp (by rw [← H]; simp)
+    refine ((IH fun b => ?_).cons a).trans (perm_cons_erase this).symm
+    specialize H b
+    rw [(perm_cons_erase this).count_eq] at H
+    by_cases h : b = a <;> simpa [h, count_cons, Nat.succ_inj'] using H
+
+theorem isPerm_iff : ∀ {l₁ l₂ : List α}, l₁.isPerm l₂ ↔ l₁ ~ l₂
+  | [], [] => by simp [isPerm, isEmpty]
+  | [], _ :: _ => by simp [isPerm, isEmpty, Perm.nil_eq]
+  | a :: l₁, l₂ => by simp [isPerm, isPerm_iff, cons_perm_iff_perm_erase]
+
+instance decidablePerm (l₁ l₂ : List α) : Decidable (l₁ ~ l₂) := decidable_of_iff _ isPerm_iff
+
+protected theorem Perm.insert (a : α) {l₁ l₂ : List α} (p : l₁ ~ l₂) :
+    l₁.insert a ~ l₂.insert a := by
+  if h : a ∈ l₁ then
+    simp [h, p.subset h, p]
+  else
+    have := p.cons a
+    simpa [h, mt p.mem_iff.2 h] using this
+
+theorem perm_insert_swap (x y : α) (l : List α) :
+    List.insert x (List.insert y l) ~ List.insert y (List.insert x l) := by
+  by_cases xl : x ∈ l <;> by_cases yl : y ∈ l <;> simp [xl, yl]
+  if xy : x = y then simp [xy] else
+  simp [List.insert, xl, yl, xy, Ne.symm xy]
+  constructor
+
+end DecidableEq
+
+theorem Perm.pairwise_iff {R : α → α → Prop} (S : ∀ {x y}, R x y → R y x) :
+    ∀ {l₁ l₂ : List α} (_p : l₁ ~ l₂), Pairwise R l₁ ↔ Pairwise R l₂ :=
+  suffices ∀ {l₁ l₂}, l₁ ~ l₂ → Pairwise R l₁ → Pairwise R l₂
+    from fun p => ⟨this p, this p.symm⟩
+  fun {l₁ l₂} p d => by
+    induction d generalizing l₂ with
+    | nil => rw [← p.nil_eq]; constructor
+    | cons h _ IH =>
+      have : _ ∈ l₂ := p.subset (mem_cons_self _ _)
+      obtain ⟨s₂, t₂, rfl⟩ := append_of_mem this
+      have p' := (p.trans perm_middle).cons_inv
+      refine (pairwise_middle S).2 (pairwise_cons.2 ⟨fun b m => ?_, IH p'⟩)
+      exact h _ (p'.symm.subset m)
+
+theorem Pairwise.perm {R : α → α → Prop} {l l' : List α} (hR : l.Pairwise R) (hl : l ~ l')
+    (hsymm : ∀ {x y}, R x y → R y x) : l'.Pairwise R := (hl.pairwise_iff hsymm).mp hR
+
+theorem Perm.pairwise {R : α → α → Prop} {l l' : List α} (hl : l ~ l') (hR : l.Pairwise R)
+    (hsymm : ∀ {x y}, R x y → R y x) : l'.Pairwise R := hR.perm hl hsymm
+
+/--
+If two lists are sorted by an antisymmetric relation, and permutations of each other,
+they must be equal.
+-/
+theorem Perm.eq_of_sorted : ∀ {l₁ l₂ : List α}
+    (_ : ∀ a b, a ∈ l₁ → b ∈ l₂ → le a b → le b a → a = b)
+    (_ : l₁.Pairwise le) (_ : l₂.Pairwise le) (_ : l₁ ~ l₂), l₁ = l₂
+  | [], [], _, _, _, _ => rfl
+  | [], b :: l₂, _, _, _, h => by simp_all
+  | a :: l₁, [], _, _, _, h => by simp_all
+  | a :: l₁, b :: l₂, w, h₁, h₂, h => by
+    have am : a ∈ b :: l₂ := h.subset (mem_cons_self _ _)
+    have bm : b ∈ a :: l₁ := h.symm.subset (mem_cons_self _ _)
+    have ab : a = b := by
+      simp only [mem_cons] at am
+      rcases am with rfl | am
+      · rfl
+      · simp only [mem_cons] at bm
+        rcases bm with rfl | bm
+        · rfl
+        · exact w _ _ (mem_cons_self _ _) (mem_cons_self _ _)
+            (rel_of_pairwise_cons h₁ bm) (rel_of_pairwise_cons h₂ am)
+    subst ab
+    simp only [perm_cons] at h
+    have := Perm.eq_of_sorted
+      (fun x y hx hy => w x y (mem_cons_of_mem a hx) (mem_cons_of_mem a hy))
+      h₁.tail h₂.tail h
+    simp_all
+
+theorem Nodup.perm {l l' : List α} (hR : l.Nodup) (hl : l ~ l') : l'.Nodup :=
+  Pairwise.perm hR hl (by intro x y h h'; simp_all)
+
+theorem Perm.nodup {l l' : List α} (hl : l ~ l') (hR : l.Nodup) : l'.Nodup := hR.perm hl
+
+theorem Perm.nodup_iff {l₁ l₂ : List α} : l₁ ~ l₂ → (Nodup l₁ ↔ Nodup l₂) :=
+  Perm.pairwise_iff <| @Ne.symm α
+
+theorem Perm.join {l₁ l₂ : List (List α)} (h : l₁ ~ l₂) : l₁.join ~ l₂.join := by
+  induction h with
+  | nil => rfl
+  | cons _ _ ih => simp only [join_cons, perm_append_left_iff, ih]
+  | swap => simp only [join_cons, ← append_assoc, perm_append_right_iff]; exact perm_append_comm ..
+  | trans _ _ ih₁ ih₂ => exact trans ih₁ ih₂
+
+theorem Perm.bind_right {l₁ l₂ : List α} (f : α → List β) (p : l₁ ~ l₂) : l₁.bind f ~ l₂.bind f :=
+  (p.map _).join
+
+theorem Perm.eraseP (f : α → Bool) {l₁ l₂ : List α}
+    (H : Pairwise (fun a b => f a → f b → False) l₁) (p : l₁ ~ l₂) : eraseP f l₁ ~ eraseP f l₂ := by
+  induction p with
+  | nil => simp
+  | cons a p IH =>
+    if h : f a then simp [h, p]
+    else simp [h]; exact IH (pairwise_cons.1 H).2
+  | swap a b l =>
+    by_cases h₁ : f a <;> by_cases h₂ : f b <;> simp [h₁, h₂]
+    · cases (pairwise_cons.1 H).1 _ (mem_cons.2 (Or.inl rfl)) h₂ h₁
+    · apply swap
+  | trans p₁ _ IH₁ IH₂ =>
+    refine (IH₁ H).trans (IH₂ ((p₁.pairwise_iff ?_).1 H))
+    exact fun h h₁ h₂ => h h₂ h₁
+
+end List

src/Init/Data/List/Range.lean

@@ -0,0 +1,57 @@
+/-
+Copyright (c) 2014 Parikshit Khanna. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
+-/
+prelude
+import Init.Data.List.Pairwise
+
+/-!
+# Lemmas about `List.range` and `List.enum`
+
+Most of the results are deferred to `Data.Init.List.Nat.Range`, where more results about
+natural arithmetic are available.
+-/
+
+namespace List
+
+open Nat
+
+/-! ## Ranges and enumeration -/
+
+/-! ### enumFrom -/
+
+@[simp]
+theorem enumFrom_eq_nil {n : Nat} {l : List α} : List.enumFrom n l = [] ↔ l = [] := by
+  cases l <;> simp
+
+@[simp] theorem enumFrom_length : ∀ {n} {l : List α}, (enumFrom n l).length = l.length
+  | _, [] => rfl
+  | _, _ :: _ => congrArg Nat.succ enumFrom_length
+
+@[simp]
+theorem getElem?_enumFrom :
+    ∀ n (l : List α) m, (enumFrom n l)[m]? = l[m]?.map fun a => (n + m, a)
+  | n, [], m => rfl
+  | n, a :: l, 0 => by simp
+  | n, a :: l, m + 1 => by
+    simp only [enumFrom_cons, getElem?_cons_succ]
+    exact (getElem?_enumFrom (n + 1) l m).trans <| by rw [Nat.add_right_comm]; rfl
+
+@[simp]
+theorem getElem_enumFrom (l : List α) (n) (i : Nat) (h : i < (l.enumFrom n).length) :
+    (l.enumFrom n)[i] = (n + i, l[i]'(by simpa [enumFrom_length] using h)) := by
+  simp only [enumFrom_length] at h
+  rw [getElem_eq_getElem?]
+  simp only [getElem?_enumFrom, getElem?_eq_getElem h]
+  simp
+
+theorem map_fst_add_enumFrom_eq_enumFrom (l : List α) (n k : Nat) :
+    map (Prod.map (· + n) id) (enumFrom k l) = enumFrom (n + k) l :=
+  ext_getElem? fun i ↦ by simp [(· ∘ ·), Nat.add_comm, Nat.add_left_comm]; rfl
+
+theorem map_fst_add_enum_eq_enumFrom (l : List α) (n : Nat) :
+    map (Prod.map (· + n) id) (enum l) = enumFrom n l :=
+  map_fst_add_enumFrom_eq_enumFrom l _ _
+
+end List

src/Init/Data/List/Sort.lean

@@ -0,0 +1,9 @@
+/-
+Copyright (c) 2024 Lean FRO. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.List.Sort.Basic
+import Init.Data.List.Sort.Impl
+import Init.Data.List.Sort.Lemmas

src/Init/Data/List/Sort/Basic.lean

@@ -0,0 +1,81 @@
+/-
+Copyright (c) 2024 Lean FRO. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.List.Impl
+
+/-!
+# Definition of `merge` and `mergeSort`.
+
+These definitions are intended for verification purposes,
+and are replaced at runtime by efficient versions in `Init.Data.List.Sort.Impl`.
+-/
+
+namespace List
+
+/--
+`O(min |l| |r|)`. Merge two lists using `le` as a switch.
+
+This version is not tail-recursive,
+but it is replaced at runtime by `mergeTR` using a `@[csimp]` lemma.
+-/
+def merge (le : α → α → Bool) : List α → List α → List α
+  | [], ys => ys
+  | xs, [] => xs
+  | x :: xs, y :: ys =>
+    if le x y then
+      x :: merge le xs (y :: ys)
+    else
+      y :: merge le (x :: xs) ys
+
+@[simp] theorem nil_merge (ys : List α) : merge le [] ys = ys := by simp [merge]
+@[simp] theorem merge_right (xs : List α) : merge le xs [] = xs := by
+  induction xs with
+  | nil => simp [merge]
+  | cons x xs ih => simp [merge, ih]
+
+/--
+Split a list in two equal parts. If the length is odd, the first part will be one element longer.
+-/
+def splitInTwo (l : { l : List α // l.length = n }) :
+    { l : List α // l.length = (n+1)/2 } × { l : List α // l.length = n/2 } :=
+  let r := splitAt ((n+1)/2) l.1
+  (⟨r.1, by simp [r, splitAt_eq, l.2]; omega⟩, ⟨r.2, by simp [r, splitAt_eq, l.2]; omega⟩)
+
+/--
+Simplified implementation of stable merge sort.
+
+This function is designed for reasoning about the algorithm, and is not efficient.
+(It particular it uses the non tail-recursive `merge` function,
+and so can not be run on large lists, but also makes unnecessary traversals of lists.)
+It is replaced at runtime in the compiler by `mergeSortTR₂` using a `@[csimp]` lemma.
+
+Because we want the sort to be stable,
+it is essential that we split the list in two contiguous sublists.
+-/
+def mergeSort (le : α → α → Bool) : List α → List α
+  | [] => []
+  | [a] => [a]
+  | a :: b :: xs =>
+    let lr := splitInTwo ⟨a :: b :: xs, rfl⟩
+    have := by simpa using lr.2.2
+    have := by simpa using lr.1.2
+    merge le (mergeSort le lr.1) (mergeSort le lr.2)
+termination_by l => l.length
+
+
+/--
+Given an ordering relation `le : α → α → Bool`,
+construct the reverse lexicographic ordering on `Nat × α`.
+which first compares the second components using `le`,
+but if these are equivalent (in the sense `le a.2 b.2 && le b.2 a.2`)
+then compares the first components using `≤`.
+
+This function is only used in stating the stability properties of `mergeSort`.
+-/
+def enumLE (le : α → α → Bool) (a b : Nat × α) : Bool :=
+  if le a.2 b.2 then if le b.2 a.2 then a.1 ≤ b.1 else true else false
+
+end List

src/Init/Data/List/Sort/Impl.lean

@@ -0,0 +1,237 @@
+/-
+Copyright (c) 2024 Lean FRO. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.List.Sort.Lemmas
+
+/-!
+# Replacing `merge` and `mergeSort` at runtime with tail-recursive and faster versions.
+
+We replace `merge` with `mergeTR` using a `@[csimp]` lemma.
+
+We replace `mergeSort` in two steps:
+* first with `mergeSortTR`, which while not tail-recursive itself (it can't be),
+  uses `mergeTR` internally.
+* second with `mergeSortTR₂`, which achieves an ~20% speed-up over `mergeSortTR`
+  by avoiding some unnecessary list reversals.
+
+There is no public API in this file; it solely exists to implement the `@[csimp]` lemmas
+affecting runtime behaviour.
+
+## Future work
+The current runtime implementation could be further improved in a number of ways, e.g.:
+* only walking the list once during splitting,
+* using insertion sort for small chunks rather than splitting all the way down to singletons,
+* identifying already sorted or reverse sorted chunks and skipping them.
+
+Because the theory developed for `mergeSort` is independent of the runtime implementation,
+as long as such improvements are carefully validated by benchmarking,
+they can be done without changing the theory, as long as a `@[csimp]` lemma is provided.
+-/
+
+open List
+
+namespace List.MergeSort.Internal
+
+/--
+`O(min |l| |r|)`. Merge two lists using `le` as a switch.
+-/
+def mergeTR (le : α → α → Bool) (l₁ l₂ : List α) : List α :=
+  go l₁ l₂ []
+where go : List α → List α → List α → List α
+  | [], l₂, acc => reverseAux acc l₂
+  | l₁, [], acc => reverseAux acc l₁
+  | x :: xs, y :: ys, acc =>
+    if le x y then
+      go xs (y :: ys) (x :: acc)
+    else
+      go (x :: xs) ys (y :: acc)
+
+theorem mergeTR_go_eq : mergeTR.go le l₁ l₂ acc = acc.reverse ++ merge le l₁ l₂ := by
+  induction l₁ generalizing l₂ acc with
+  | nil => simp [mergeTR.go, merge, reverseAux_eq]
+  | cons x l₁ ih₁ =>
+    induction l₂ generalizing acc with
+    | nil => simp [mergeTR.go, merge, reverseAux_eq]
+    | cons y l₂ ih₂ =>
+      simp [mergeTR.go, merge]
+      split <;> simp [ih₁, ih₂]
+
+@[csimp] theorem merge_eq_mergeTR : @merge = @mergeTR := by
+  funext
+  simp [mergeTR, mergeTR_go_eq]
+
+/--
+Variant of `splitAt`, that does not reverse the first list, i.e
+`splitRevAt n l = ((l.take n).reverse, l.drop n)`.
+
+This exists solely as an optimization for `mergeSortTR` and `mergeSortTR₂`,
+and should not be used elsewhere.
+-/
+def splitRevAt (n : Nat) (l : List α) : List α × List α := go l n [] where
+  /-- Auxiliary for `splitAtRev`: `splitAtRev.go xs n acc = ((take n xs).reverse ++ acc, drop n xs)`. -/
+  go : List α → Nat → List α → List α × List α
+  | x :: xs, n+1, acc => go xs n (x :: acc)
+  | xs, _, acc => (acc, xs)
+
+theorem splitRevAt_go (xs : List α) (n : Nat) (acc : List α) :
+    splitRevAt.go xs n acc = ((take n xs).reverse ++ acc, drop n xs) := by
+  induction xs generalizing n acc with
+  | nil => simp [splitRevAt.go]
+  | cons x xs ih =>
+    cases n with
+    | zero => simp [splitRevAt.go]
+    | succ n =>
+      rw [splitRevAt.go, ih n (x :: acc), take_succ_cons, reverse_cons, drop_succ_cons,
+        append_assoc, singleton_append]
+
+theorem splitRevAt_eq (n : Nat) (l : List α) : splitRevAt n l = ((l.take n).reverse, l.drop n) := by
+  rw [splitRevAt, splitRevAt_go, append_nil]
+
+/--
+An intermediate speed-up for `mergeSort`.
+This version uses the tail-recurive `mergeTR` function as a subroutine.
+
+This is not the final version we use at runtime, as `mergeSortTR₂` is faster.
+This definition is useful as an intermediate step in proving the `@[csimp]` lemma for `mergeSortTR₂`.
+-/
+def mergeSortTR (le : α → α → Bool) (l : List α) : List α :=
+  run ⟨l, rfl⟩
+where run : {n : Nat} → { l : List α // l.length = n } → List α
+  | 0, ⟨[], _⟩ => []
+  | 1, ⟨[a], _⟩ => [a]
+  | n+2, xs =>
+    let (l, r) := splitInTwo xs
+    mergeTR le (run l) (run r)
+
+/--
+Split a list in two equal parts, reversing the first part.
+If the length is odd, the first part will be one element longer.
+-/
+def splitRevInTwo (l : { l : List α // l.length = n }) :
+    { l : List α // l.length = (n+1)/2 } × { l : List α // l.length = n/2 } :=
+  let r := splitRevAt ((n+1)/2) l.1
+  (⟨r.1, by simp [r, splitRevAt_eq, l.2]; omega⟩, ⟨r.2, by simp [r, splitRevAt_eq, l.2]; omega⟩)
+
+/--
+Split a list in two equal parts, reversing the first part.
+If the length is odd, the second part will be one element longer.
+-/
+def splitRevInTwo' (l : { l : List α // l.length = n }) :
+    { l : List α // l.length = n/2 } × { l : List α // l.length = (n+1)/2 } :=
+  let r := splitRevAt (n/2) l.1
+  (⟨r.1, by simp [r, splitRevAt_eq, l.2]; omega⟩, ⟨r.2, by simp [r, splitRevAt_eq, l.2]; omega⟩)
+
+/--
+Faster version of `mergeSortTR`, which avoids unnecessary list reversals.
+-/
+-- Per the benchmark in `tests/bench/mergeSort/`
+-- (which averages over 4 use cases: already sorted lists, reverse sorted lists, almost sorted lists, and random lists),
+-- for lists of length 10^6, `mergeSortTR₂` is about 20% faster than `mergeSortTR`.
+def mergeSortTR₂ (le : α → α → Bool) (l : List α) : List α :=
+  run ⟨l, rfl⟩
+where
+  run : {n : Nat} → { l : List α // l.length = n } → List α
+  | 0, ⟨[], _⟩ => []
+  | 1, ⟨[a], _⟩ => [a]
+  | n+2, xs =>
+    let (l, r) := splitRevInTwo xs
+    mergeTR le (run' l) (run r)
+  run' : {n : Nat} → { l : List α // l.length = n } → List α
+  | 0, ⟨[], _⟩ => []
+  | 1, ⟨[a], _⟩ => [a]
+  | n+2, xs =>
+    let (l, r) := splitRevInTwo' xs
+    mergeTR le (run' r) (run l)
+
+theorem splitRevInTwo'_fst (l : { l : List α // l.length = n }) :
+    (splitRevInTwo' l).1 = ⟨(splitInTwo ⟨l.1.reverse, by simpa using l.2⟩).2.1, by have := l.2; simp; omega⟩ := by
+  simp only [splitRevInTwo', splitRevAt_eq, reverse_take, splitInTwo_snd]
+  congr
+  have := l.2
+  omega
+theorem splitRevInTwo'_snd (l : { l : List α // l.length = n }) :
+    (splitRevInTwo' l).2 = ⟨(splitInTwo ⟨l.1.reverse, by simpa using l.2⟩).1.1.reverse, by have := l.2; simp; omega⟩ := by
+  simp only [splitRevInTwo', splitRevAt_eq, reverse_take, splitInTwo_fst, reverse_reverse]
+  congr 2
+  have := l.2
+  simp
+  omega
+theorem splitRevInTwo_fst (l : { l : List α // l.length = n }) :
+    (splitRevInTwo l).1 = ⟨(splitInTwo l).1.1.reverse, by have := l.2; simp; omega⟩ := by
+  simp only [splitRevInTwo, splitRevAt_eq, reverse_take, splitInTwo_fst]
+theorem splitRevInTwo_snd (l : { l : List α // l.length = n }) :
+    (splitRevInTwo l).2 = ⟨(splitInTwo l).2.1, by have := l.2; simp; omega⟩ := by
+  simp only [splitRevInTwo, splitRevAt_eq, reverse_take, splitInTwo_snd]
+
+theorem mergeSortTR_run_eq_mergeSort : {n : Nat} → (l : { l : List α // l.length = n }) → mergeSortTR.run le l = mergeSort le l.1
+  | 0, ⟨[], _⟩
+  | 1, ⟨[a], _⟩ => by simp [mergeSortTR.run, mergeSort]
+  | n+2, ⟨a :: b :: l, h⟩ => by
+    cases h
+    simp only [mergeSortTR.run, mergeSortTR.run, mergeSort]
+    rw [merge_eq_mergeTR]
+    rw [mergeSortTR_run_eq_mergeSort, mergeSortTR_run_eq_mergeSort]
+
+-- We don't make this a `@[csimp]` lemma because `mergeSort_eq_mergeSortTR₂` is faster.
+theorem mergeSort_eq_mergeSortTR : @mergeSort = @mergeSortTR := by
+  funext
+  rw [mergeSortTR, mergeSortTR_run_eq_mergeSort]
+
+-- This mutual block is unfortunately quite slow to elaborate.
+set_option maxHeartbeats 400000 in
+mutual
+theorem mergeSortTR₂_run_eq_mergeSort : {n : Nat} → (l : { l : List α // l.length = n }) → mergeSortTR₂.run le l = mergeSort le l.1
+  | 0, ⟨[], _⟩
+  | 1, ⟨[a], _⟩ => by simp [mergeSortTR₂.run, mergeSort]
+  | n+2, ⟨a :: b :: l, h⟩ => by
+    cases h
+    simp only [mergeSortTR₂.run, mergeSort]
+    rw [splitRevInTwo_fst, splitRevInTwo_snd]
+    rw [mergeSortTR₂_run_eq_mergeSort, mergeSortTR₂_run'_eq_mergeSort]
+    rw [merge_eq_mergeTR]
+    rw [reverse_reverse]
+termination_by n => n
+
+theorem mergeSortTR₂_run'_eq_mergeSort : {n : Nat} → (l : { l : List α // l.length = n }) → (w : l' = l.1.reverse) → mergeSortTR₂.run' le l = mergeSort le l'
+  | 0, ⟨[], _⟩, w
+  | 1, ⟨[a], _⟩, w => by simp_all [mergeSortTR₂.run', mergeSort]
+  | n+2, ⟨a :: b :: l, h⟩, w => by
+    cases h
+    simp only [mergeSortTR₂.run', mergeSort]
+    rw [splitRevInTwo'_fst, splitRevInTwo'_snd]
+    rw [mergeSortTR₂_run_eq_mergeSort, mergeSortTR₂_run'_eq_mergeSort _ rfl]
+    rw [← merge_eq_mergeTR]
+    have w' := congrArg length w
+    simp at w'
+    cases l' with
+    | nil => simp at w'
+    | cons x l' =>
+      cases l' with
+      | nil => simp at w'
+      | cons y l' =>
+        rw [mergeSort]
+        congr 2
+        · dsimp at w
+          simp only [w]
+          simp only [splitInTwo_fst, splitInTwo_snd, reverse_take, take_reverse]
+          congr 1
+          rw [w, length_reverse]
+          simp
+        · dsimp at w
+          simp only [w]
+          simp only [reverse_cons, append_assoc, singleton_append, splitInTwo_snd, length_cons]
+          congr 1
+          simp at w'
+          omega
+termination_by n => n
+
+end
+
+@[csimp] theorem mergeSort_eq_mergeSortTR₂ : @mergeSort = @mergeSortTR₂ := by
+  funext
+  rw [mergeSortTR₂, mergeSortTR₂_run_eq_mergeSort]
+
+end List.MergeSort.Internal

src/Init/Data/List/Sort/Lemmas.lean

@@ -0,0 +1,406 @@
+/-
+Copyright (c) 2024 Lean FRO. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.List.Perm
+import Init.Data.List.Sort.Basic
+import Init.Data.Bool
+
+/-!
+# Basic properties of `mergeSort`.
+
+* `mergeSort_sorted`: `mergeSort` produces a sorted list.
+* `mergeSort_perm`: `mergeSort` is a permutation of the input list.
+* `mergeSort_of_sorted`: `mergeSort` does not change a sorted list.
+* `mergeSort_cons`: proves `mergeSort le (x :: xs) = l₁ ++ x :: l₂` for some `l₁, l₂`
+  so that `mergeSort le xs = l₁ ++ l₂`, and no `a ∈ l₁` satisfies `le a x`.
+* `mergeSort_stable`: if `c` is a sorted sublist of `l`, then `c` is still a sublist of `mergeSort le l`.
+
+-/
+
+namespace List
+
+-- We enable this instance locally so we can write `Sorted le` instead of `Sorted (le · ·)` everywhere.
+attribute [local instance] boolRelToRel
+
+variable {le : α → α → Bool}
+
+/-! ### splitInTwo -/
+
+@[simp] theorem splitInTwo_fst (l : { l : List α // l.length = n }) : (splitInTwo l).1 = ⟨l.1.take ((n+1)/2), by simp [splitInTwo, splitAt_eq, l.2]; omega⟩ := by
+  simp [splitInTwo, splitAt_eq]
+
+@[simp] theorem splitInTwo_snd (l : { l : List α // l.length = n }) : (splitInTwo l).2 = ⟨l.1.drop ((n+1)/2), by simp [splitInTwo, splitAt_eq, l.2]; omega⟩ := by
+  simp [splitInTwo, splitAt_eq]
+
+theorem splitInTwo_fst_append_splitInTwo_snd (l : { l : List α // l.length = n }) : (splitInTwo l).1.1 ++ (splitInTwo l).2.1 = l.1 := by
+  simp
+
+theorem splitInTwo_cons_cons_enumFrom_fst (i : Nat) (l : List α) :
+    (splitInTwo ⟨(i, a) :: (i+1, b) :: l.enumFrom (i+2), rfl⟩).1.1 =
+      (splitInTwo ⟨a :: b :: l, rfl⟩).1.1.enumFrom i := by
+  simp only [length_cons, splitInTwo_fst, enumFrom_length]
+  ext1 j
+  rw [getElem?_take, getElem?_enumFrom, getElem?_take]
+  split
+  · rw [getElem?_cons, getElem?_cons, getElem?_cons, getElem?_cons]
+    split
+    · simp; omega
+    · split
+      · simp; omega
+      · simp only [getElem?_enumFrom]
+        congr
+        ext <;> simp; omega
+  · simp
+
+theorem splitInTwo_cons_cons_enumFrom_snd (i : Nat) (l : List α) :
+    (splitInTwo ⟨(i, a) :: (i+1, b) :: l.enumFrom (i+2), rfl⟩).2.1 =
+      (splitInTwo ⟨a :: b :: l, rfl⟩).2.1.enumFrom (i+(l.length+3)/2) := by
+  simp only [length_cons, splitInTwo_snd, enumFrom_length]
+  ext1 j
+  rw [getElem?_drop, getElem?_enumFrom, getElem?_drop]
+  rw [getElem?_cons, getElem?_cons, getElem?_cons, getElem?_cons]
+  split
+  · simp; omega
+  · split
+    · simp; omega
+    · simp only [getElem?_enumFrom]
+      congr
+      ext <;> simp; omega
+
+theorem splitInTwo_fst_sorted (l : { l : List α // l.length = n }) (h : Pairwise le l.1) : Pairwise le (splitInTwo l).1.1 := by
+  rw [splitInTwo_fst]
+  exact h.take
+
+theorem splitInTwo_snd_sorted (l : { l : List α // l.length = n }) (h : Pairwise le l.1) : Pairwise le (splitInTwo l).2.1 := by
+  rw [splitInTwo_snd]
+  exact h.drop
+
+theorem splitInTwo_fst_le_splitInTwo_snd {l : { l : List α // l.length = n }} (h : Pairwise le l.1) :
+    ∀ a b, a ∈ (splitInTwo l).1.1 → b ∈ (splitInTwo l).2.1 → le a b := by
+  rw [splitInTwo_fst, splitInTwo_snd]
+  intro a b ma mb
+  exact h.rel_of_mem_take_of_mem_drop ma mb
+
+/-! ### enumLE -/
+
+theorem enumLE_trans (trans : ∀ a b c, le a b → le b c → le a c)
+    (a b c : Nat × α) : enumLE le a b → enumLE le b c → enumLE le a c := by
+  simp only [enumLE]
+  split <;> split <;> split <;> rename_i ab₂ ba₂ bc₂
+  · simp_all
+    intro ab₁
+    intro h
+    refine ⟨trans _ _ _ ab₂ bc₂, ?_⟩
+    rcases h with (cd₂ | bc₁)
+    · exact Or.inl (Decidable.byContradiction
+        (fun ca₂ => by simp_all [trans _ _ _ (by simpa using ca₂) ab₂]))
+    · exact Or.inr (Nat.le_trans ab₁ bc₁)
+  · simp_all
+  · simp_all
+    intro h
+    refine ⟨trans _ _ _ ab₂ bc₂, ?_⟩
+    left
+    rcases h with (cb₂ | _)
+    · exact (Decidable.byContradiction
+        (fun ca₂ => by simp_all [trans _ _ _ (by simpa using ca₂) ab₂]))
+    · exact (Decidable.byContradiction
+        (fun ca₂ => by simp_all [trans _ _ _ bc₂ (by simpa using ca₂)]))
+  · simp_all
+  · simp_all
+  · simp_all
+  · simp_all
+  · simp_all
+
+theorem enumLE_total (total : ∀ a b, !le a b → le b a)
+    (a b : Nat × α) : !enumLE le a b → enumLE le b a := by
+  simp only [enumLE]
+  split <;> split
+  · simpa using Nat.le_of_lt
+  · simp
+  · simp
+  · simp_all [total a.2 b.2]
+
+/-! ### merge -/
+
+theorem merge_stable : ∀ (xs ys) (_ : ∀ x y, x ∈ xs → y ∈ ys → x.1 ≤ y.1),
+    (merge (enumLE le) xs ys).map (·.2) = merge le (xs.map (·.2)) (ys.map (·.2))
+  | [], ys, _ => by simp [merge]
+  | xs, [], _ => by simp [merge]
+  | (i, x) :: xs, (j, y) :: ys, h => by
+    simp only [merge, enumLE, map_cons]
+    split <;> rename_i w
+    · rw [if_pos (by simp [h _ _ (mem_cons_self ..) (mem_cons_self ..)])]
+      simp only [map_cons, cons.injEq, true_and]
+      rw [merge_stable, map_cons]
+      exact fun x' y' mx my => h x' y' (mem_cons_of_mem (i, x) mx) my
+    · simp only [↓reduceIte, map_cons, cons.injEq, true_and]
+      rw [merge_stable, map_cons]
+      exact fun x' y' mx my => h x' y' mx (mem_cons_of_mem (j, y) my)
+
+/--
+The elements of `merge le xs ys` are exactly the elements of `xs` and `ys`.
+-/
+-- We subsequently prove that `mergeSort_perm : merge le xs ys ~ xs ++ ys`.
+theorem mem_merge {a : α} {xs ys : List α} : a ∈ merge le xs ys ↔ a ∈ xs ∨ a ∈ ys := by
+  induction xs generalizing ys with
+  | nil => simp [merge]
+  | cons x xs ih =>
+    induction ys with
+    | nil => simp [merge]
+    | cons y ys ih =>
+      simp only [merge]
+      split <;> rename_i h
+      · simp_all [or_assoc]
+      · simp only [mem_cons, or_assoc, Bool.not_eq_true, ih, ← or_assoc]
+        apply or_congr_left
+        simp only [or_comm (a := a = y), or_assoc]
+
+/--
+If the ordering relation `le` is transitive and total (i.e. `le a b ∨ le b a` for all `a, b`)
+then the `merge` of two sorted lists is sorted.
+-/
+theorem merge_sorted
+    (trans : ∀ (a b c : α), le a b → le b c → le a c)
+    (total : ∀ (a b : α), !le a b → le b a)
+    (l₁ l₂ : List α) (h₁ : l₁.Pairwise le) (h₂ : l₂.Pairwise le) : (merge le l₁ l₂).Pairwise le := by
+  induction l₁ generalizing l₂ with
+  | nil => simpa only [merge]
+  | cons x l₁ ih₁ =>
+    induction l₂ with
+    | nil => simpa only [merge]
+    | cons y l₂ ih₂ =>
+      simp only [merge]
+      split <;> rename_i h
+      · apply Pairwise.cons
+        · intro z m
+          rw [mem_merge, mem_cons] at m
+          rcases m with (m|rfl|m)
+          · exact rel_of_pairwise_cons h₁ m
+          · exact h
+          · exact trans _ _ _ h (rel_of_pairwise_cons h₂ m)
+        · exact ih₁ _ h₁.tail h₂
+      · apply Pairwise.cons
+        · intro z m
+          rw [mem_merge, mem_cons] at m
+          rcases m with (⟨rfl|m⟩|m)
+          · exact total _ _ (by simpa using h)
+          · exact trans _ _ _ (total _ _ (by simpa using h)) (rel_of_pairwise_cons h₁ m)
+          · exact rel_of_pairwise_cons h₂ m
+        · exact ih₂ h₂.tail
+
+theorem merge_of_le : ∀ {xs ys : List α} (_ : ∀ a b, a ∈ xs → b ∈ ys → le a b),
+    merge le xs ys = xs ++ ys
+  | [], ys, _
+  | xs, [], _ => by simp [merge]
+  | x :: xs, y :: ys, h => by
+    simp only [merge, cons_append]
+    rw [if_pos, merge_of_le]
+    · intro a b ma mb
+      exact h a b (mem_cons_of_mem _ ma) mb
+    · exact h x y (mem_cons_self _ _) (mem_cons_self _ _)
+
+variable (le) in
+theorem merge_perm_append : ∀ {xs ys : List α}, merge le xs ys ~ xs ++ ys
+  | [], ys => by simp [merge]
+  | xs, [] => by simp [merge]
+  | x :: xs, y :: ys => by
+    simp only [merge]
+    split
+    · exact merge_perm_append.cons x
+    · exact (merge_perm_append.cons y).trans
+        ((Perm.swap x y _).trans (perm_middle.symm.cons x))
+
+/-! ### mergeSort -/
+
+@[simp] theorem mergeSort_nil : [].mergeSort r = [] := by rw [List.mergeSort]
+
+@[simp] theorem mergeSort_singleton (a : α) : [a].mergeSort r = [a] := by rw [List.mergeSort]
+
+variable (le) in
+theorem mergeSort_perm : ∀ (l : List α), mergeSort le l ~ l
+  | [] => by simp [mergeSort]
+  | [a] => by simp [mergeSort]
+  | a :: b :: xs => by
+    simp only [mergeSort]
+    have : (splitInTwo ⟨a :: b :: xs, rfl⟩).1.1.length < xs.length + 1 + 1 := by simp [splitInTwo_fst]; omega
+    have : (splitInTwo ⟨a :: b :: xs, rfl⟩).2.1.length < xs.length + 1 + 1 := by simp [splitInTwo_snd]; omega
+    exact (merge_perm_append le).trans
+      (((mergeSort_perm _).append (mergeSort_perm _)).trans
+        (Perm.of_eq (splitInTwo_fst_append_splitInTwo_snd _)))
+termination_by l => l.length
+
+@[simp] theorem mergeSort_length (l : List α) : (mergeSort le l).length = l.length :=
+  (mergeSort_perm le l).length_eq
+
+@[simp] theorem mem_mergeSort {a : α} {l : List α} : a ∈ mergeSort le l ↔ a ∈ l :=
+  (mergeSort_perm le l).mem_iff
+
+/--
+The result of `mergeSort` is sorted,
+as long as the comparison function is transitive (`le a b → le b c → le a c`)
+and total in the sense that `le a b ∨ le b a`.
+
+The comparison function need not be irreflexive, i.e. `le a b` and `le b a` is allowed even when `a ≠ b`.
+-/
+theorem mergeSort_sorted
+    (trans : ∀ (a b c : α), le a b → le b c → le a c)
+    (total : ∀ (a b : α), !le a b → le b a) :
+    (l : List α) → (mergeSort le l).Pairwise le
+  | [] => by simp [mergeSort]
+  | [a] => by simp [mergeSort]
+  | a :: b :: xs => by
+    have : (splitInTwo ⟨a :: b :: xs, rfl⟩).1.1.length < xs.length + 1 + 1 := by simp [splitInTwo_fst]; omega
+    have : (splitInTwo ⟨a :: b :: xs, rfl⟩).2.1.length < xs.length + 1 + 1 := by simp [splitInTwo_snd]; omega
+    rw [mergeSort]
+    apply merge_sorted @trans @total
+    apply mergeSort_sorted trans total
+    apply mergeSort_sorted trans total
+termination_by l => l.length
+
+/--
+If the input list is already sorted, then `mergeSort` does not change the list.
+-/
+theorem mergeSort_of_sorted : ∀ {l : List α} (_ : Pairwise le l), mergeSort le l = l
+  | [], _ => by simp [mergeSort]
+  | [a], _ => by simp [mergeSort]
+  | a :: b :: xs, h => by
+    have : (splitInTwo ⟨a :: b :: xs, rfl⟩).1.1.length < xs.length + 1 + 1 := by simp [splitInTwo_fst]; omega
+    have : (splitInTwo ⟨a :: b :: xs, rfl⟩).2.1.length < xs.length + 1 + 1 := by simp [splitInTwo_snd]; omega
+    rw [mergeSort]
+    rw [mergeSort_of_sorted (splitInTwo_fst_sorted ⟨a :: b :: xs, rfl⟩ h)]
+    rw [mergeSort_of_sorted (splitInTwo_snd_sorted ⟨a :: b :: xs, rfl⟩ h)]
+    rw [merge_of_le (splitInTwo_fst_le_splitInTwo_snd h)]
+    rw [splitInTwo_fst_append_splitInTwo_snd]
+termination_by l => l.length
+
+/--
+This merge sort algorithm is stable,
+in the sense that breaking ties in the ordering function using the position in the list
+has no effect on the output.
+
+That is, elements which are equal with respect to the ordering function will remain
+in the same order in the output list as they were in the input list.
+
+See also:
+* `mergeSort_stable`: if `c <+ l` and `c.Pairwise le`, then `c <+ mergeSort le l`.
+* `mergeSort_stable_pair`: if `[a, b] <+ l` and `le a b`, then `[a, b] <+ mergeSort le l`)
+-/
+theorem mergeSort_enum {l : List α} :
+    (mergeSort (enumLE le) (l.enum)).map (·.2) = mergeSort le l :=
+  go 0 l
+where go : ∀ (i : Nat) (l : List α),
+    (mergeSort (enumLE le) (l.enumFrom i)).map (·.2) = mergeSort le l
+  | _, []
+  | _, [a] => by simp [mergeSort]
+  | _, a :: b :: xs => by
+    have : (splitInTwo ⟨a :: b :: xs, rfl⟩).1.1.length < xs.length + 1 + 1 := by simp [splitInTwo_fst]; omega
+    have : (splitInTwo ⟨a :: b :: xs, rfl⟩).2.1.length < xs.length + 1 + 1 := by simp [splitInTwo_snd]; omega
+    simp only [mergeSort, enumFrom]
+    rw [splitInTwo_cons_cons_enumFrom_fst]
+    rw [splitInTwo_cons_cons_enumFrom_snd]
+    rw [merge_stable]
+    · rw [go, go]
+    · simp only [mem_mergeSort, Prod.forall]
+      intros j x k y mx my
+      have := mem_enumFrom mx
+      have := mem_enumFrom my
+      simp_all
+      omega
+termination_by _ l => l.length
+
+theorem mergeSort_cons {le : α → α → Bool}
+    (trans : ∀ (a b c : α), le a b → le b c → le a c)
+    (total : ∀ (a b : α), !le a b → le b a)
+    (a : α) (l : List α) :
+    ∃ l₁ l₂, mergeSort le (a :: l) = l₁ ++ a :: l₂ ∧ mergeSort le l = l₁ ++ l₂ ∧
+      ∀ b, b ∈ l₁ → !le a b := by
+  rw [← mergeSort_enum]
+  rw [enum_cons]
+  have nd : Nodup ((a :: l).enum.map (·.1)) := by rw [enum_map_fst]; exact nodup_range _
+  have m₁ : (0, a) ∈ mergeSort (enumLE le) ((a :: l).enum) :=
+    mem_mergeSort.mpr (mem_cons_self _ _)
+  obtain ⟨l₁, l₂, h⟩ := append_of_mem m₁
+  have s := mergeSort_sorted (enumLE_trans trans) (enumLE_total total) ((a :: l).enum)
+  rw [h] at s
+  have p := mergeSort_perm (enumLE le) ((a :: l).enum)
+  rw [h] at p
+  refine ⟨l₁.map (·.2), l₂.map (·.2), ?_, ?_, ?_⟩
+  · simpa using congrArg (·.map (·.2)) h
+  · rw [← mergeSort_enum.go 1, ← map_append]
+    congr 1
+    have q : mergeSort (enumLE le) (enumFrom 1 l) ~ l₁ ++ l₂ :=
+      (mergeSort_perm (enumLE le) (enumFrom 1 l)).trans
+        (p.symm.trans perm_middle).cons_inv
+    apply Perm.eq_of_sorted (le := enumLE le)
+    · rintro ⟨i, a⟩ ⟨j, b⟩  ha hb
+      simp only [mem_mergeSort] at ha
+      simp only [← q.mem_iff, mem_mergeSort] at hb
+      simp only [enumLE]
+      simp only [Bool.if_false_right, Bool.and_eq_true, Prod.mk.injEq, and_imp]
+      intro ab h ba h'
+      simp only [Bool.decide_eq_true] at ba
+      replace h : i ≤ j := by simpa [ab, ba] using h
+      replace h' : j ≤ i := by simpa [ab, ba] using h'
+      cases Nat.le_antisymm h h'
+      constructor
+      · rfl
+      · have := mem_enumFrom ha
+        have := mem_enumFrom hb
+        simp_all
+    · exact mergeSort_sorted (enumLE_trans trans) (enumLE_total total) ..
+    · exact s.sublist ((sublist_cons_self (0, a) l₂).append_left l₁)
+    · exact q
+  · intro b m
+    simp only [mem_map, Prod.exists, exists_eq_right] at m
+    obtain ⟨j, m⟩ := m
+    replace p := p.map (·.1)
+    have nd' := nd.perm p.symm
+    rw [map_append] at nd'
+    have j0 := nd'.rel_of_mem_append
+      (mem_map_of_mem (·.1) m) (mem_map_of_mem _ (mem_cons_self _ _))
+    simp only [ne_eq] at j0
+    have r := s.rel_of_mem_append m (mem_cons_self _ _)
+    simp_all [enumLE]
+
+/--
+Another statement of stability of merge sort.
+If `c` is a sorted sublist of `l`,
+then `c` is still a sublist of `mergeSort le l`.
+-/
+theorem mergeSort_stable
+    (trans : ∀ (a b c : α), le a b → le b c → le a c)
+    (total : ∀ (a b : α), !le a b → le b a) :
+    ∀ {c : List α} (_ : c.Pairwise le) (_ : c <+ l),
+    c <+ mergeSort le l
+  | _, _, .slnil => nil_sublist _
+  | c, hc, @Sublist.cons _ _ l a h => by
+    obtain ⟨l₁, l₂, h₁, h₂, -⟩ := mergeSort_cons trans total a l
+    rw [h₁]
+    have h' := mergeSort_stable trans total hc h
+    rw [h₂] at h'
+    exact h'.middle a
+  | _, _, @Sublist.cons₂ _ l₁ l₂ a h => by
+    rename_i hc
+    obtain ⟨l₃, l₄, h₁, h₂, h₃⟩ := mergeSort_cons trans total a l₂
+    rw [h₁]
+    have h' := mergeSort_stable trans total hc.tail h
+    rw [h₂] at h'
+    simp only [Bool.not_eq_true', tail_cons] at h₃ h'
+    exact
+      sublist_append_of_sublist_right (Sublist.cons₂ a
+        ((fun w => Sublist.of_sublist_append_right w h') fun b m₁ m₃ =>
+          (Bool.eq_not_self true).mp ((rel_of_pairwise_cons hc m₁).symm.trans (h₃ b m₃))))
+
+/--
+Another statement of stability of merge sort.
+If a pair `[a, b]` is a sublist of `l` and `le a b`,
+then `[a, b]` is still a sublist of `mergeSort le l`.
+-/
+theorem mergeSort_stable_pair
+    (trans : ∀ (a b c : α), le a b → le b c → le a c)
+    (total : ∀ (a b : α), !le a b → le b a)
+    (hab : le a b) (h : [a, b] <+ l) : [a, b] <+ mergeSort le l :=
+  mergeSort_stable trans total (pairwise_pair.mpr hab) h

src/Init/Data/List/Sublist.lean

@@ -1,7 +1,8 @@
 /-
 Copyright (c) 2014 Parikshit Khanna. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
+Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro,
+  Kim Morrison
 -/
 prelude
 import Init.Data.List.TakeDrop
@@ -67,12 +68,12 @@ instance : Trans (Membership.mem : α → List α → Prop) Subset Membership.me
 instance : Trans (Subset : List α → List α → Prop) Subset Subset :=
   ⟨Subset.trans⟩
 
-@[simp] theorem subset_cons_self (a : α) (l : List α) : l ⊆ a :: l := fun _ => Mem.tail _
+theorem subset_cons_self (a : α) (l : List α) : l ⊆ a :: l := fun _ => Mem.tail _
 
 theorem subset_of_cons_subset {a : α} {l₁ l₂ : List α} : a :: l₁ ⊆ l₂ → l₁ ⊆ l₂ :=
   fun s _ i => s (mem_cons_of_mem _ i)
 
-theorem subset_cons_of_subset (a : α) {l₁ l₂ : List α} : l₁ ⊆ l₂ → l₁ ⊆ a :: l₂ :=
+@[simp] theorem subset_cons_of_subset (a : α) {l₁ l₂ : List α} : l₁ ⊆ l₂ → l₁ ⊆ a :: l₂ :=
   fun s _ i => .tail _ (s i)
 
 theorem cons_subset_cons {l₁ l₂ : List α} (a : α) (s : l₁ ⊆ l₂) : a :: l₁ ⊆ a :: l₂ :=
@@ -84,6 +85,8 @@ theorem cons_subset_cons {l₁ l₂ : List α} (a : α) (s : l₁ ⊆ l₂) : a
 @[simp] theorem subset_nil {l : List α} : l ⊆ [] ↔ l = [] :=
   ⟨fun h => match l with | [] => rfl | _::_ => (nomatch h (.head ..)), fun | rfl => Subset.refl _⟩
 
+theorem eq_nil_of_subset_nil {l : List α} : l ⊆ [] → l = [] := subset_nil.mp
+
 theorem map_subset {l₁ l₂ : List α} (f : α → β) (h : l₁ ⊆ l₂) : map f l₁ ⊆ map f l₂ :=
   fun x => by simp only [mem_map]; exact .imp fun a => .imp_left (@h _)
 
@@ -97,14 +100,14 @@ theorem filterMap_subset {l₁ l₂ : List α} (f : α → Option β) (H : l₁
   rintro ⟨a, h, w⟩
   exact ⟨a, H h, w⟩
 
-@[simp] theorem subset_append_left (l₁ l₂ : List α) : l₁ ⊆ l₁ ++ l₂ := fun _ => mem_append_left _
+theorem subset_append_left (l₁ l₂ : List α) : l₁ ⊆ l₁ ++ l₂ := fun _ => mem_append_left _
 
-@[simp] theorem subset_append_right (l₁ l₂ : List α) : l₂ ⊆ l₁ ++ l₂ := fun _ => mem_append_right _
+theorem subset_append_right (l₁ l₂ : List α) : l₂ ⊆ l₁ ++ l₂ := fun _ => mem_append_right _
 
-theorem subset_append_of_subset_left (l₂ : List α) : l ⊆ l₁ → l ⊆ l₁ ++ l₂ :=
+@[simp] theorem subset_append_of_subset_left (l₂ : List α) : l ⊆ l₁ → l ⊆ l₁ ++ l₂ :=
 fun s => Subset.trans s <| subset_append_left _ _
 
-theorem subset_append_of_subset_right (l₁ : List α) : l ⊆ l₂ → l ⊆ l₁ ++ l₂ :=
+@[simp] theorem subset_append_of_subset_right (l₁ : List α) : l ⊆ l₂ → l ⊆ l₁ ++ l₂ :=
 fun s => Subset.trans s <| subset_append_right _ _
 
 @[simp] theorem append_subset {l₁ l₂ l : List α} :
@@ -152,7 +155,9 @@ theorem Sublist.trans {l₁ l₂ l₃ : List α} (h₁ : l₁ <+ l₂) (h₂ : l
 
 instance : Trans (@Sublist α) Sublist Sublist := ⟨Sublist.trans⟩
 
-@[simp] theorem sublist_cons_self (a : α) (l : List α) : l <+ a :: l := (Sublist.refl l).cons _
+attribute [simp] Sublist.cons
+
+theorem sublist_cons_self (a : α) (l : List α) : l <+ a :: l := (Sublist.refl l).cons _
 
 theorem sublist_of_cons_sublist : a :: l₁ <+ l₂ → l₁ <+ l₂ :=
   (sublist_cons_self a l₁).trans
@@ -177,6 +182,15 @@ theorem Sublist.subset : l₁ <+ l₂ → l₁ ⊆ l₂
   | .cons₂ .., _, .head .. => .head ..
   | .cons₂ _ s, _, .tail _ h => .tail _ (s.subset h)
 
+protected theorem Sublist.mem (hx : a ∈ l₁) (hl : l₁ <+ l₂) : a ∈ l₂ :=
+  hl.subset hx
+
+theorem Sublist.head_mem (s : ys <+ xs) (h) : ys.head h ∈ xs :=
+  s.mem (List.head_mem h)
+
+theorem Sublist.getLast_mem (s : ys <+ xs) (h) : ys.getLast h ∈ xs :=
+  s.mem (List.getLast_mem h)
+
 instance : Trans (@Sublist α) Subset Subset :=
   ⟨fun h₁ h₂ => trans h₁.subset h₂⟩
 
@@ -192,6 +206,9 @@ theorem mem_of_cons_sublist {a : α} {l₁ l₂ : List α} (s : a :: l₁ <+ l
 @[simp] theorem sublist_nil {l : List α} : l <+ [] ↔ l = [] :=
   ⟨fun s => subset_nil.1 s.subset, fun H => H ▸ Sublist.refl _⟩
 
+theorem eq_nil_of_sublist_nil {l : List α} (s : l <+ []) : l = [] :=
+  eq_nil_of_subset_nil <| s.subset
+
 theorem Sublist.length_le : l₁ <+ l₂ → length l₁ ≤ length l₂
   | .slnil => Nat.le_refl 0
   | .cons _l s => le_succ_of_le (length_le s)
@@ -208,6 +225,18 @@ theorem Sublist.eq_of_length_le (s : l₁ <+ l₂) (h : length l₂ ≤ length l
 theorem Sublist.length_eq (s : l₁ <+ l₂) : length l₁ = length l₂ ↔ l₁ = l₂ :=
   ⟨s.eq_of_length, congrArg _⟩
 
+theorem tail_sublist : ∀ l : List α, tail l <+ l
+  | [] => .slnil
+  | a::l => sublist_cons_self a l
+
+protected theorem Sublist.tail : ∀ {l₁ l₂ : List α}, l₁ <+ l₂ → tail l₁ <+ tail l₂
+  | _, _, slnil => .slnil
+  | _, _, Sublist.cons _ h => (tail_sublist _).trans h
+  | _, _, Sublist.cons₂ _ h => h
+
+theorem Sublist.of_cons_cons {l₁ l₂ : List α} {a b : α} (h : a :: l₁ <+ b :: l₂) : l₁ <+ l₂ :=
+  h.tail
+
 protected theorem Sublist.map (f : α → β) {l₁ l₂} (s : l₁ <+ l₂) : map f l₁ <+ map f l₂ := by
   induction s with
   | slnil => simp
@@ -223,6 +252,12 @@ protected theorem Sublist.filterMap (f : α → Option β) (s : l₁ <+ l₂) :
 protected theorem Sublist.filter (p : α → Bool) {l₁ l₂} (s : l₁ <+ l₂) : filter p l₁ <+ filter p l₂ := by
   rw [← filterMap_eq_filter]; apply s.filterMap
 
+theorem head_filter_mem (xs : List α) (p : α → Bool) (h) : (xs.filter p).head h ∈ xs :=
+  (filter_sublist xs).head_mem h
+
+theorem getLast_filter_mem (xs : List α) (p : α → Bool) (h) : (xs.filter p).getLast h ∈ xs :=
+  (filter_sublist xs).getLast_mem h
+
 theorem sublist_filterMap_iff {l₁ : List β} {f : α → Option β} :
     l₁ <+ l₂.filterMap f ↔ ∃ l', l' <+ l₂ ∧ l₁ = l'.filterMap f := by
   induction l₂ generalizing l₁ with
@@ -265,11 +300,11 @@ theorem sublist_filter_iff {l₁ : List α} {p : α → Bool} :
     l₁ <+ l₂.filter p ↔ ∃ l', l' <+ l₂ ∧ l₁ = l'.filter p := by
   simp only [← filterMap_eq_filter, sublist_filterMap_iff]
 
-@[simp] theorem sublist_append_left : ∀ l₁ l₂ : List α, l₁ <+ l₁ ++ l₂
+theorem sublist_append_left : ∀ l₁ l₂ : List α, l₁ <+ l₁ ++ l₂
   | [], _ => nil_sublist _
   | _ :: l₁, l₂ => (sublist_append_left l₁ l₂).cons₂ _
 
-@[simp] theorem sublist_append_right : ∀ l₁ l₂ : List α, l₂ <+ l₁ ++ l₂
+theorem sublist_append_right : ∀ l₁ l₂ : List α, l₂ <+ l₁ ++ l₂
   | [], _ => Sublist.refl _
   | _ :: l₁, l₂ => (sublist_append_right l₁ l₂).cons _
 
@@ -278,10 +313,10 @@ theorem sublist_filter_iff {l₁ : List α} {p : α → Bool} :
   obtain ⟨_, _, rfl⟩ := append_of_mem h
   exact ((nil_sublist _).cons₂ _).trans (sublist_append_right ..)
 
-theorem sublist_append_of_sublist_left (s : l <+ l₁) : l <+ l₁ ++ l₂ :=
+@[simp] theorem sublist_append_of_sublist_left (s : l <+ l₁) : l <+ l₁ ++ l₂ :=
   s.trans <| sublist_append_left ..
 
-theorem sublist_append_of_sublist_right (s : l <+ l₂) : l <+ l₁ ++ l₂ :=
+@[simp] theorem sublist_append_of_sublist_right (s : l <+ l₂) : l <+ l₁ ++ l₂ :=
   s.trans <| sublist_append_right ..
 
 @[simp] theorem append_sublist_append_left : ∀ l, l ++ l₁ <+ l ++ l₂ ↔ l₁ <+ l₂
@@ -377,6 +412,27 @@ theorem append_sublist_iff {l₁ l₂ : List α} :
     · rintro ⟨r₁, r₂, rfl, h₁, h₂⟩
       exact Sublist.append h₁ h₂
 
+theorem Sublist.of_sublist_append_left (w : ∀ a, a ∈ l → a ∉ l₂) (h : l <+ l₁ ++ l₂) : l <+ l₁ := by
+  rw [sublist_append_iff] at h
+  obtain ⟨l₁', l₂', rfl, h₁, h₂⟩ := h
+  have : l₂' = [] := by
+    rw [eq_nil_iff_forall_not_mem]
+    exact fun x m => w x (mem_append_of_mem_right l₁' m) (h₂.mem m)
+  simp_all
+
+theorem Sublist.of_sublist_append_right (w : ∀ a, a ∈ l → a ∉ l₁) (h : l <+ l₁ ++ l₂) : l <+ l₂ := by
+  rw [sublist_append_iff] at h
+  obtain ⟨l₁', l₂', rfl, h₁, h₂⟩ := h
+  have : l₁' = [] := by
+    rw [eq_nil_iff_forall_not_mem]
+    exact fun x m => w x (mem_append_of_mem_left l₂' m) (h₁.mem m)
+  simp_all
+
+theorem Sublist.middle {l : List α} (h : l <+ l₁ ++ l₂) (a : α) : l <+ l₁ ++ a :: l₂ := by
+  rw [sublist_append_iff] at h
+  obtain ⟨l₁', l₂', rfl, h₁, h₂⟩ := h
+  exact Sublist.append h₁ (h₂.cons a)
+
 theorem Sublist.reverse : l₁ <+ l₂ → l₁.reverse <+ l₂.reverse
   | .slnil => Sublist.refl _
   | .cons _ h => by rw [reverse_cons]; exact sublist_append_of_sublist_left h.reverse
@@ -446,7 +502,7 @@ theorem sublist_join_iff {L : List (List α)} {l} :
       subst w
       exact ⟨[], by simp, fun i x => by cases x⟩
     · rintro ⟨L', rfl, h⟩
-      simp only [join_nil, sublist_nil, join_eq_nil_iff]
+      simp only [join_nil, sublist_nil, join_eq_nil]
       simp only [getElem?_nil, Option.getD_none, sublist_nil] at h
       exact (forall_getElem L' (· = [])).1 h
   | cons l' L ih =>
@@ -512,6 +568,10 @@ theorem join_sublist_iff {L : List (List α)} {l} :
 instance [DecidableEq α] (l₁ l₂ : List α) : Decidable (l₁ <+ l₂) :=
   decidable_of_iff (l₁.isSublist l₂) isSublist_iff_sublist
 
+protected theorem Sublist.drop : ∀ {l₁ l₂ : List α}, l₁ <+ l₂ → ∀ n, l₁.drop n <+ l₂.drop n
+  | _, _, h, 0 => h
+  | _, _, h, n + 1 => by rw [← drop_tail, ← drop_tail]; exact h.tail.drop n
+
 /-! ### IsPrefix / IsSuffix / IsInfix -/
 
 @[simp] theorem prefix_append (l₁ l₂ : List α) : l₁ <+: l₁ ++ l₂ := ⟨l₂, rfl⟩
@@ -527,17 +587,20 @@ theorem IsPrefix.isInfix : l₁ <+: l₂ → l₁ <:+: l₂ := fun ⟨t, h⟩ =>
 
 theorem IsSuffix.isInfix : l₁ <:+ l₂ → l₁ <:+: l₂ := fun ⟨t, h⟩ => ⟨t, [], by rw [h, append_nil]⟩
 
-@[simp] theorem nil_prefix (l : List α) : [] <+: l := ⟨l, rfl⟩
+@[simp] theorem nil_prefix {l : List α} : [] <+: l := ⟨l, rfl⟩
 
-@[simp] theorem nil_suffix (l : List α) : [] <:+ l := ⟨l, append_nil _⟩
+@[simp] theorem nil_suffix {l : List α} : [] <:+ l := ⟨l, append_nil _⟩
 
-@[simp] theorem nil_infix (l : List α) : [] <:+: l := (nil_prefix _).isInfix
+@[simp] theorem nil_infix {l : List α} : [] <:+: l := nil_prefix.isInfix
 
-@[simp] theorem prefix_refl (l : List α) : l <+: l := ⟨[], append_nil _⟩
+theorem prefix_refl (l : List α) : l <+: l := ⟨[], append_nil _⟩
+@[simp] theorem prefix_rfl {l : List α} : l <+: l := prefix_refl l
 
-@[simp] theorem suffix_refl (l : List α) : l <:+ l := ⟨[], rfl⟩
+theorem suffix_refl (l : List α) : l <:+ l := ⟨[], rfl⟩
+@[simp] theorem suffix_rfl {l : List α} : l <:+ l := suffix_refl l
 
-@[simp] theorem infix_refl (l : List α) : l <:+: l := (prefix_refl l).isInfix
+theorem infix_refl (l : List α) : l <:+: l := prefix_rfl.isInfix
+@[simp] theorem infix_rfl {l : List α} : l <:+: l := infix_refl l
 
 @[simp] theorem suffix_cons (a : α) : ∀ l, l <:+ a :: l := suffix_append [a]
 
@@ -573,6 +636,50 @@ protected theorem IsSuffix.sublist (h : l₁ <:+ l₂) : l₁ <+ l₂ :=
 protected theorem IsSuffix.subset (hl : l₁ <:+ l₂) : l₁ ⊆ l₂ :=
   hl.sublist.subset
 
+@[simp] theorem infix_nil : l <:+: [] ↔ l = [] := ⟨(sublist_nil.1 ·.sublist), (· ▸ infix_rfl)⟩
+
+@[simp] theorem prefix_nil : l <+: [] ↔ l = [] := ⟨(sublist_nil.1 ·.sublist), (· ▸ prefix_rfl)⟩
+
+@[simp] theorem suffix_nil : l <:+ [] ↔ l = [] := ⟨(sublist_nil.1 ·.sublist), (· ▸ suffix_rfl)⟩
+
+theorem eq_nil_of_infix_nil (h : l <:+: []) : l = [] := infix_nil.mp h
+theorem eq_nil_of_prefix_nil (h : l <+: []) : l = [] := prefix_nil.mp h
+theorem eq_nil_of_suffix_nil (h : l <:+ []) : l = [] := suffix_nil.mp h
+
+theorem IsPrefix.ne_nil {x y : List α} (h : x <+: y) (hx : x ≠ []) : y ≠ [] := by
+  rintro rfl; exact hx <| List.prefix_nil.mp h
+
+theorem IsSuffix.ne_nil {x y : List α} (h : x <:+ y) (hx : x ≠ []) : y ≠ [] := by
+  rintro rfl; exact hx <| List.suffix_nil.mp h
+
+theorem IsInfix.ne_nil {x y : List α} (h : x <:+: y) (hx : x ≠ []) : y ≠ [] := by
+  rintro rfl; exact hx <| List.infix_nil.mp h
+
+theorem IsInfix.length_le (h : l₁ <:+: l₂) : l₁.length ≤ l₂.length :=
+  h.sublist.length_le
+
+theorem IsPrefix.length_le (h : l₁ <+: l₂) : l₁.length ≤ l₂.length :=
+  h.sublist.length_le
+
+theorem IsSuffix.length_le (h : l₁ <:+ l₂) : l₁.length ≤ l₂.length :=
+  h.sublist.length_le
+
+theorem IsPrefix.getElem {x y : List α} (h : x <+: y) {n} (hn : n < x.length) :
+    x[n] = y[n]'(Nat.le_trans hn h.length_le) := by
+  obtain ⟨_, rfl⟩ := h
+  exact (List.getElem_append n hn).symm
+
+-- See `Init.Data.List.Nat.Sublist` for `IsSuffix.getElem`.
+
+theorem IsPrefix.mem (hx : a ∈ l₁) (hl : l₁ <+: l₂) : a ∈ l₂ :=
+  hl.subset hx
+
+theorem IsSuffix.mem (hx : a ∈ l₁) (hl : l₁ <:+ l₂) : a ∈ l₂ :=
+  hl.subset hx
+
+theorem IsInfix.mem (hx : a ∈ l₁) (hl : l₁ <:+: l₂) : a ∈ l₂ :=
+  hl.subset hx
+
 @[simp] theorem reverse_suffix : reverse l₁ <:+ reverse l₂ ↔ l₁ <+: l₂ :=
   ⟨fun ⟨r, e⟩ => ⟨reverse r, by rw [← reverse_reverse l₁, ← reverse_append, e, reverse_reverse]⟩,
    fun ⟨r, e⟩ => ⟨reverse r, by rw [← reverse_append, e]⟩⟩
@@ -586,25 +693,35 @@ protected theorem IsSuffix.subset (hl : l₁ <:+ l₂) : l₁ ⊆ l₂ :=
       reverse_reverse]
   · rw [append_assoc, ← reverse_append, ← reverse_append, e]
 
-theorem IsInfix.length_le (h : l₁ <:+: l₂) : l₁.length ≤ l₂.length :=
-  h.sublist.length_le
+theorem IsInfix.reverse : l₁ <:+: l₂ → reverse l₁ <:+: reverse l₂ :=
+  reverse_infix.2
 
-theorem IsPrefix.length_le (h : l₁ <+: l₂) : l₁.length ≤ l₂.length :=
-  h.sublist.length_le
+theorem IsSuffix.reverse : l₁ <:+ l₂ → reverse l₁ <+: reverse l₂ :=
+  reverse_prefix.2
 
-theorem IsSuffix.length_le (h : l₁ <:+ l₂) : l₁.length ≤ l₂.length :=
-  h.sublist.length_le
+theorem IsPrefix.reverse : l₁ <+: l₂ → reverse l₁ <:+ reverse l₂ :=
+  reverse_suffix.2
 
-@[simp] theorem infix_nil : l <:+: [] ↔ l = [] := ⟨(sublist_nil.1 ·.sublist), (· ▸ infix_refl _)⟩
+theorem IsPrefix.head {x y : List α} (h : x <+: y) (hx : x ≠ []) :
+    x.head hx = y.head (h.ne_nil hx) := by
+  cases x <;> cases y <;> simp only [head_cons, ne_eq, not_true_eq_false] at hx ⊢
+  all_goals (obtain ⟨_, h⟩ := h; injection h)
 
-@[simp] theorem prefix_nil : l <+: [] ↔ l = [] := ⟨(sublist_nil.1 ·.sublist), (· ▸ prefix_refl _)⟩
+theorem IsSuffix.getLast {x y : List α} (h : x <:+ y) (hx : x ≠ []) :
+    x.getLast hx = y.getLast (h.ne_nil hx) := by
+  rw [← head_reverse (by simpa), h.reverse.head,
+    head_reverse (by rintro h; simp only [reverse_eq_nil_iff] at h; simp_all)]
 
-@[simp] theorem suffix_nil : l <:+ [] ↔ l = [] := ⟨(sublist_nil.1 ·.sublist), (· ▸ suffix_refl _)⟩
+theorem prefix_concat (a : α) (l) : l <+: concat l a := by simp
 
-theorem infix_iff_prefix_suffix (l₁ l₂ : List α) : l₁ <:+: l₂ ↔ ∃ t, l₁ <+: t ∧ t <:+ l₂ :=
+theorem infix_iff_prefix_suffix {l₁ l₂ : List α} : l₁ <:+: l₂ ↔ ∃ t, l₁ <+: t ∧ t <:+ l₂ :=
   ⟨fun ⟨_, t, e⟩ => ⟨l₁ ++ t, ⟨_, rfl⟩, e ▸ append_assoc .. ▸ ⟨_, rfl⟩⟩,
     fun ⟨_, ⟨t, rfl⟩, s, e⟩ => ⟨s, t, append_assoc .. ▸ e⟩⟩
 
+theorem infix_iff_suffix_prefix {l₁ l₂ : List α} : l₁ <:+: l₂ ↔ ∃ t, l₁ <:+ t ∧ t <+: l₂ :=
+  ⟨fun ⟨s, t, e⟩ => ⟨s ++ l₁, ⟨_, rfl⟩, ⟨t, e⟩⟩,
+    fun ⟨_, ⟨s, rfl⟩, t, e⟩ => ⟨s, t, append_assoc .. ▸ e⟩⟩
+
 theorem IsInfix.eq_of_length (h : l₁ <:+: l₂) : l₁.length = l₂.length → l₁ = l₂ :=
   h.sublist.eq_of_length
 
@@ -616,7 +733,7 @@ theorem IsSuffix.eq_of_length (h : l₁ <:+ l₂) : l₁.length = l₂.length
 
 theorem prefix_of_prefix_length_le :
     ∀ {l₁ l₂ l₃ : List α}, l₁ <+: l₃ → l₂ <+: l₃ → length l₁ ≤ length l₂ → l₁ <+: l₂
-  | [], l₂, _, _, _, _ => nil_prefix _
+  | [], l₂, _, _, _, _ => nil_prefix
   | a :: l₁, b :: l₂, _, ⟨r₁, rfl⟩, ⟨r₂, e⟩, ll => by
     injection e with _ e'; subst b
     rcases prefix_of_prefix_length_le ⟨_, rfl⟩ ⟨_, e'⟩ (le_of_succ_le_succ ll) with ⟨r₃, rfl⟩
@@ -679,6 +796,121 @@ theorem infix_cons_iff : l₁ <:+: a :: l₂ ↔ l₁ <+: a :: l₂ ∨ l₁ <:+
     · exact h.isInfix
     · exact infix_cons hl₁
 
+theorem prefix_concat_iff {l₁ l₂ : List α} {a : α} :
+    l₁ <+: l₂ ++ [a] ↔ l₁ = l₂ ++ [a] ∨ l₁ <+: l₂ := by
+  simp only [← reverse_suffix, reverse_concat, suffix_cons_iff]
+  simp only [concat_eq_append, ← reverse_concat, reverse_eq_iff, reverse_reverse]
+
+theorem suffix_concat_iff {l₁ l₂ : List α} {a : α} :
+    l₁ <:+ l₂ ++ [a] ↔ l₁ = [] ∨ ∃ t, l₁ = t ++ [a] ∧ t <:+ l₂ := by
+  rw [← reverse_prefix, reverse_concat, prefix_cons_iff]
+  simp only [reverse_eq_nil_iff]
+  apply or_congr_right
+  constructor
+  · rintro ⟨t, w, h⟩
+    exact ⟨t.reverse, by simpa using congrArg reverse w, by simpa using h.reverse⟩
+  · rintro ⟨t, rfl, h⟩
+    exact ⟨t.reverse, by simp, by simpa using h.reverse⟩
+
+theorem infix_concat_iff {l₁ l₂ : List α} {a : α} :
+    l₁ <:+: l₂ ++ [a] ↔ l₁ <:+ l₂ ++ [a] ∨ l₁ <:+: l₂ := by
+  rw [← reverse_infix, reverse_concat, infix_cons_iff, reverse_infix,
+    ← reverse_prefix, reverse_concat]
+
+theorem isPrefix_iff : l₁ <+: l₂ ↔ ∀ i (h : i < l₁.length), l₂[i]? = some l₁[i] := by
+  induction l₁ generalizing l₂ with
+  | nil => simp
+  | cons a l₁ ih =>
+    cases l₂ with
+    | nil =>
+      simpa using ⟨0, by simp⟩
+    | cons b l₂ =>
+      simp only [cons_append, cons_prefix_cons, ih]
+      rw (config := {occs := .pos [2]}) [← Nat.and_forall_add_one]
+      simp [Nat.succ_lt_succ_iff, eq_comm]
+
+-- See `Init.Data.List.Nat.Sublist` for `isSuffix_iff` and `ifInfix_iff`.
+
+theorem isPrefix_filterMap_iff {β} (f : α → Option β) {l₁ : List α} {l₂ : List β} :
+    l₂ <+: filterMap f l₁ ↔ ∃ l, l <+: l₁ ∧ l₂ = filterMap f l := by
+  simp only [IsPrefix, append_eq_filterMap]
+  constructor
+  · rintro ⟨_, l₁, l₂, rfl, rfl, rfl⟩
+    exact ⟨l₁, ⟨l₂, rfl⟩, rfl⟩
+  · rintro ⟨l₁, ⟨l₂, rfl⟩, rfl⟩
+    exact ⟨_, l₁, l₂, rfl, rfl, rfl⟩
+
+theorem isSuffix_filterMap_iff {β} (f : α → Option β) {l₁ : List α} {l₂ : List β} :
+    l₂ <:+ filterMap f l₁ ↔ ∃ l, l <:+ l₁ ∧ l₂ = filterMap f l := by
+  simp only [IsSuffix, append_eq_filterMap]
+  constructor
+  · rintro ⟨_, l₁, l₂, rfl, rfl, rfl⟩
+    exact ⟨l₂, ⟨l₁, rfl⟩, rfl⟩
+  · rintro ⟨l₁, ⟨l₂, rfl⟩, rfl⟩
+    exact ⟨_, l₂, l₁, rfl, rfl, rfl⟩
+
+theorem isInfix_filterMap_iff {β} (f : α → Option β) {l₁ : List α} {l₂ : List β} :
+    l₂ <:+: filterMap f l₁ ↔ ∃ l, l <:+: l₁ ∧ l₂ = filterMap f l := by
+  simp only [IsInfix, append_eq_filterMap, filterMap_eq_append]
+  constructor
+  · rintro ⟨_, _, _, l₁, rfl, ⟨⟨l₂, l₃, rfl, rfl, rfl⟩, rfl⟩⟩
+    exact ⟨l₃, ⟨l₂, l₁, rfl⟩, rfl⟩
+  · rintro ⟨l₃, ⟨l₂, l₁, rfl⟩, rfl⟩
+    exact ⟨_, _, _, l₁, rfl, ⟨⟨l₂, l₃, rfl, rfl, rfl⟩, rfl⟩⟩
+
+theorem isPrefix_filter_iff {p : α → Bool} {l₁ l₂ : List α} :
+    l₂ <+: l₁.filter p ↔ ∃ l, l <+: l₁ ∧ l₂ = l.filter p := by
+  rw [← filterMap_eq_filter, isPrefix_filterMap_iff]
+
+theorem isSuffix_filter_iff {p : α → Bool} {l₁ l₂ : List α} :
+    l₂ <:+ l₁.filter p ↔ ∃ l, l <:+ l₁ ∧ l₂ = l.filter p := by
+  rw [← filterMap_eq_filter, isSuffix_filterMap_iff]
+
+theorem isInfix_filter_iff {p : α → Bool} {l₁ l₂ : List α} :
+    l₂ <:+: l₁.filter p ↔ ∃ l, l <:+: l₁ ∧ l₂ = l.filter p := by
+  rw [← filterMap_eq_filter, isInfix_filterMap_iff]
+
+theorem isPrefix_map_iff {β} (f : α → β) {l₁ : List α} {l₂ : List β} :
+    l₂ <+: l₁.map f ↔ ∃ l, l <+: l₁ ∧ l₂ = l.map f := by
+  rw [← filterMap_eq_map, isPrefix_filterMap_iff]
+
+theorem isSuffix_map_iff {β} (f : α → β) {l₁ : List α} {l₂ : List β} :
+    l₂ <:+ l₁.map f ↔ ∃ l, l <:+ l₁ ∧ l₂ = l.map f := by
+  rw [← filterMap_eq_map, isSuffix_filterMap_iff]
+
+theorem isInfix_map_iff {β} (f : α → β) {l₁ : List α} {l₂ : List β} :
+    l₂ <:+: l₁.map f ↔ ∃ l, l <:+: l₁ ∧ l₂ = l.map f := by
+  rw [← filterMap_eq_map, isInfix_filterMap_iff]
+
+theorem isPrefix_replicate_iff {n} {a : α} {l : List α} :
+    l <+: List.replicate n a ↔ l.length ≤ n ∧ l = List.replicate l.length a := by
+  rw [IsPrefix]
+  simp only [append_eq_replicate]
+  constructor
+  · rintro ⟨_, rfl, _, _⟩
+    exact ⟨le_add_right .., ‹_›⟩
+  · rintro ⟨h, w⟩
+    refine ⟨replicate (n - l.length) a, ?_, ?_⟩
+    · simpa using add_sub_of_le h
+    · simpa using w
+
+theorem isSuffix_replicate_iff {n} {a : α} {l : List α} :
+    l <:+ List.replicate n a ↔ l.length ≤ n ∧ l = List.replicate l.length a := by
+  rw [← reverse_prefix, reverse_replicate, isPrefix_replicate_iff]
+  simp [reverse_eq_iff]
+
+theorem isInfix_replicate_iff {n} {a : α} {l : List α} :
+    l <:+: List.replicate n a ↔ l.length ≤ n ∧ l = List.replicate l.length a := by
+  rw [IsInfix]
+  simp only [append_eq_replicate, length_append]
+  constructor
+  · rintro ⟨_, _, rfl, ⟨-, _, _⟩, _⟩
+    exact ⟨le_add_right_of_le (le_add_left ..), ‹_›⟩
+  · rintro ⟨h, w⟩
+    refine ⟨replicate (n - l.length) a, [], ?_, ?_⟩
+    · simpa using Nat.sub_add_cancel h
+    · simpa using w
+
 theorem infix_of_mem_join : ∀ {L : List (List α)}, l ∈ L → l <:+: join L
   | l' :: _, h =>
     match h with
@@ -717,6 +949,60 @@ theorem mem_of_mem_take {l : List α} (h : a ∈ l.take n) : a ∈ l :=
 theorem mem_of_mem_drop {n} {l : List α} (h : a ∈ l.drop n) : a ∈ l :=
   drop_subset _ _ h
 
+theorem drop_suffix_drop_left (l : List α) {m n : Nat} (h : m ≤ n) : drop n l <:+ drop m l := by
+  rw [← Nat.sub_add_cancel h, ← drop_drop]
+  apply drop_suffix
+
+-- See `Init.Data.List.Nat.TakeDrop` for `take_prefix_take_left`.
+
+theorem drop_sublist_drop_left (l : List α) {m n : Nat} (h : m ≤ n) : drop n l <+ drop m l :=
+  (drop_suffix_drop_left l h).sublist
+
+theorem drop_subset_drop_left (l : List α) {m n : Nat} (h : m ≤ n) : drop n l ⊆ drop m l :=
+  (drop_sublist_drop_left l h).subset
+
+theorem takeWhile_prefix (p : α → Bool) : l.takeWhile p <+: l :=
+  ⟨l.dropWhile p, takeWhile_append_dropWhile p l⟩
+
+theorem dropWhile_suffix (p : α → Bool) : l.dropWhile p <:+ l :=
+  ⟨l.takeWhile p, takeWhile_append_dropWhile p l⟩
+
+theorem takeWhile_sublist (p : α → Bool) : l.takeWhile p <+ l :=
+  (takeWhile_prefix p).sublist
+
+theorem dropWhile_sublist (p : α → Bool) : l.dropWhile p <+ l :=
+  (dropWhile_suffix p).sublist
+
+theorem takeWhile_subset {l : List α} (p : α → Bool) : l.takeWhile p ⊆ l :=
+  (takeWhile_sublist p).subset
+
+theorem dropWhile_subset {l : List α} (p : α → Bool) : l.dropWhile p ⊆ l :=
+  (dropWhile_sublist p).subset
+
+theorem dropLast_prefix : ∀ l : List α, l.dropLast <+: l
+  | [] => ⟨nil, by rw [dropLast, List.append_nil]⟩
+  | a :: l => ⟨_, dropLast_concat_getLast (cons_ne_nil a l)⟩
+
+theorem dropLast_sublist (l : List α) : l.dropLast <+ l :=
+  (dropLast_prefix l).sublist
+
+theorem dropLast_subset (l : List α) : l.dropLast ⊆ l :=
+  (dropLast_sublist l).subset
+
+theorem tail_suffix (l : List α) : tail l <:+ l := by rw [← drop_one]; apply drop_suffix
+
+theorem IsPrefix.map {β} (f : α → β) ⦃l₁ l₂ : List α⦄ (h : l₁ <+: l₂) : l₁.map f <+: l₂.map f := by
+  obtain ⟨r, rfl⟩ := h
+  rw [map_append]; apply prefix_append
+
+theorem IsSuffix.map {β} (f : α → β) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+ l₂) : l₁.map f <:+ l₂.map f := by
+  obtain ⟨r, rfl⟩ := h
+  rw [map_append]; apply suffix_append
+
+theorem IsInfix.map {β} (f : α → β) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+: l₂) : l₁.map f <:+: l₂.map f := by
+  obtain ⟨r₁, r₂, rfl⟩ := h
+  rw [map_append, map_append]; apply infix_append
+
 theorem IsPrefix.filter (p : α → Bool) ⦃l₁ l₂ : List α⦄ (h : l₁ <+: l₂) :
     l₁.filter p <+: l₂.filter p := by
   obtain ⟨xs, rfl⟩ := h
@@ -732,6 +1018,21 @@ theorem IsInfix.filter (p : α → Bool) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+
   obtain ⟨xs, ys, rfl⟩ := h
   rw [filter_append, filter_append]; apply infix_append _
 
+theorem IsPrefix.filterMap {β} (f : α → Option β) ⦃l₁ l₂ : List α⦄ (h : l₁ <+: l₂) :
+    filterMap f l₁ <+: filterMap f l₂ := by
+  obtain ⟨xs, rfl⟩ := h
+  rw [filterMap_append]; apply prefix_append
+
+theorem IsSuffix.filterMap {β} (f : α → Option β) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+ l₂) :
+    filterMap f l₁ <:+ filterMap f l₂ := by
+  obtain ⟨xs, rfl⟩ := h
+  rw [filterMap_append]; apply suffix_append
+
+theorem IsInfix.filterMap {β} (f : α → Option β) ⦃l₁ l₂ : List α⦄ (h : l₁ <:+: l₂) :
+    filterMap f l₁ <:+: filterMap f l₂ := by
+  obtain ⟨xs, ys, rfl⟩ := h
+  rw [filterMap_append, filterMap_append]; apply infix_append
+
 @[simp] theorem isPrefixOf_iff_prefix [BEq α] [LawfulBEq α] {l₁ l₂ : List α} :
     l₁.isPrefixOf l₂ ↔ l₁ <+: l₂ := by
   induction l₁ generalizing l₂ with
@@ -751,4 +1052,13 @@ instance [DecidableEq α] (l₁ l₂ : List α) : Decidable (l₁ <+: l₂) :=
 instance [DecidableEq α] (l₁ l₂ : List α) : Decidable (l₁ <:+ l₂) :=
   decidable_of_iff (l₁.isSuffixOf l₂) isSuffixOf_iff_suffix
 
+theorem prefix_iff_eq_append : l₁ <+: l₂ ↔ l₁ ++ drop (length l₁) l₂ = l₂ :=
+  ⟨by rintro ⟨r, rfl⟩; rw [drop_left], fun e => ⟨_, e⟩⟩
+
+theorem prefix_iff_eq_take : l₁ <+: l₂ ↔ l₁ = take (length l₁) l₂ :=
+  ⟨fun h => append_cancel_right <| (prefix_iff_eq_append.1 h).trans (take_append_drop _ _).symm,
+    fun e => e.symm ▸ take_prefix _ _⟩
+
+-- See `Init.Data.List.Nat.Sublist` for `suffix_iff_eq_append`, `prefix_take_iff`, and `suffix_iff_eq_drop`.
+
 end List

src/Init/Data/List/TakeDrop.lean

@@ -20,6 +20,11 @@ Further results on `List.take` and `List.drop`, which rely on stronger automatio
 are given in `Init.Data.List.TakeDrop`.
 -/
 
+theorem take_cons {l : List α} (h : 0 < n) : take n (a :: l) = a :: take (n - 1) l := by
+  cases n with
+  | zero => exact absurd h (Nat.lt_irrefl _)
+  | succ n => rfl
+
 @[simp]
 theorem drop_one : ∀ l : List α, drop 1 l = tail l
   | [] | _ :: _ => rfl
@@ -74,7 +79,7 @@ theorem drop_eq_get_cons {n} {l : List α} (h) : drop n l = get l ⟨n, h⟩ ::
   simp [drop_eq_getElem_cons]
 
 @[simp]
-theorem getElem?_take {l : List α} {n m : Nat} (h : m < n) : (l.take n)[m]? = l[m]? := by
+theorem getElem?_take_of_lt {l : List α} {n m : Nat} (h : m < n) : (l.take n)[m]? = l[m]? := by
   induction n generalizing l m with
   | zero =>
     exact absurd h (Nat.not_lt_of_le m.zero_le)
@@ -86,14 +91,31 @@ theorem getElem?_take {l : List α} {n m : Nat} (h : m < n) : (l.take n)[m]? = l
       · simp
       · simpa using hn (Nat.lt_of_succ_lt_succ h)
 
-@[deprecated getElem?_take (since := "2024-06-12")]
+@[deprecated getElem?_take_of_lt (since := "2024-06-12")]
 theorem get?_take {l : List α} {n m : Nat} (h : m < n) : (l.take n).get? m = l.get? m := by
-  simp [getElem?_take, h]
+  simp [getElem?_take_of_lt, h]
+
+theorem getElem?_take_of_succ {l : List α} {n : Nat} : (l.take (n + 1))[n]? = l[n]? := by simp
+
+@[simp] theorem drop_drop (n : Nat) : ∀ (m) (l : List α), drop n (drop m l) = drop (n + m) l
+  | m, [] => by simp
+  | 0, l => by simp
+  | m + 1, a :: l =>
+    calc
+      drop n (drop (m + 1) (a :: l)) = drop n (drop m l) := rfl
+      _ = drop (n + m) l := drop_drop n m l
+      _ = drop (n + (m + 1)) (a :: l) := rfl
+
+theorem take_drop : ∀ (m n : Nat) (l : List α), take n (drop m l) = drop m (take (m + n) l)
+  | 0, _, _ => by simp
+  | _, _, [] => by simp
+  | _+1, _, _ :: _ => by simpa [Nat.succ_add, take_succ_cons, drop_succ_cons] using take_drop ..
+
+@[deprecated drop_drop (since := "2024-06-15")]
+theorem drop_add (m n) (l : List α) : drop (m + n) l = drop m (drop n l) := by
+  simp [drop_drop]
 
 @[simp]
-theorem getElem?_take_of_succ {l : List α} {n : Nat} : (l.take (n + 1))[n]? = l[n]? :=
-  getElem?_take (Nat.lt_succ_self n)
-
 theorem tail_drop (l : List α) (n : Nat) : (l.drop n).tail = l.drop (n + 1) := by
   induction l generalizing n with
   | nil => simp
@@ -102,9 +124,13 @@ theorem tail_drop (l : List α) (n : Nat) : (l.drop n).tail = l.drop (n + 1) :=
     · simp
     · simp [hl]
 
+@[simp]
+theorem drop_tail (l : List α) (n : Nat) : l.tail.drop n = l.drop (n + 1) := by
+  rw [← drop_drop, drop_one]
+
 @[simp]
 theorem drop_eq_nil_iff_le {l : List α} {k : Nat} : l.drop k = [] ↔ l.length ≤ k := by
-  refine' ⟨fun h => _, drop_eq_nil_of_le⟩
+  refine ⟨fun h => ?_, drop_eq_nil_of_le⟩
   induction k generalizing l with
   | zero =>
     simp only [drop] at h
@@ -226,24 +252,6 @@ theorem dropLast_eq_take (l : List α) : l.dropLast = l.take (l.length - 1) := b
     dsimp
     rw [map_drop f t]
 
-@[simp] theorem drop_drop (n : Nat) : ∀ (m) (l : List α), drop n (drop m l) = drop (n + m) l
-  | m, [] => by simp
-  | 0, l => by simp
-  | m + 1, a :: l =>
-    calc
-      drop n (drop (m + 1) (a :: l)) = drop n (drop m l) := rfl
-      _ = drop (n + m) l := drop_drop n m l
-      _ = drop (n + (m + 1)) (a :: l) := rfl
-
-theorem take_drop : ∀ (m n : Nat) (l : List α), take n (drop m l) = drop m (take (m + n) l)
-  | 0, _, _ => by simp
-  | _, _, [] => by simp
-  | _+1, _, _ :: _ => by simpa [Nat.succ_add, take_succ_cons, drop_succ_cons] using take_drop ..
-
-@[deprecated drop_drop (since := "2024-06-15")]
-theorem drop_add (m n) (l : List α) : drop (m + n) l = drop m (drop n l) := by
-  simp [drop_drop]
-
 /-! ### takeWhile and dropWhile -/
 
 theorem takeWhile_cons (p : α → Bool) (a : α) (l : List α) :
@@ -428,6 +436,12 @@ theorem take_takeWhile {l : List α} (p : α → Bool) n :
   | nil => rfl
   | cons h t ih => by_cases p h <;> simp_all
 
+/-! ### splitAt -/
+
+@[simp] theorem splitAt_eq (n : Nat) (l : List α) : splitAt n l = (l.take n, l.drop n) := by
+  rw [splitAt, splitAt_go, reverse_nil, nil_append]
+  split <;> simp_all [take_of_length_le, drop_of_length_le]
+
 /-! ### rotateLeft -/
 
 @[simp] theorem rotateLeft_zero (l : List α) : rotateLeft l 0 = l := by

src/Init/Data/List/Zip.lean

@@ -78,13 +78,13 @@ theorem map_prod_left_eq_zip {l : List α} (f : α → β) :
     (l.map fun x => (x, f x)) = l.zip (l.map f) := by
   rw [← zip_map']
   congr
-  exact map_id _
+  simp
 
 theorem map_prod_right_eq_zip {l : List α} (f : α → β) :
     (l.map fun x => (f x, x)) = (l.map f).zip l := by
   rw [← zip_map']
   congr
-  exact map_id _
+  simp
 
 /-- See also `List.zip_replicate` in `Init.Data.List.TakeDrop` for a generalization with different lengths. -/
 @[simp] theorem zip_replicate' {a : α} {b : β} {n : Nat} :

src/Init/Data/Nat/Basic.lean

@@ -158,7 +158,7 @@ theorem add_one (n : Nat) : n + 1 = succ n :=
   rfl
 
 @[simp] theorem add_one_ne_zero (n : Nat) : n + 1 ≠ 0 := nofun
-@[simp] theorem zero_ne_add_one (n : Nat) : 0 ≠ n + 1 := nofun
+theorem zero_ne_add_one (n : Nat) : 0 ≠ n + 1 := by simp
 
 protected theorem add_comm : ∀ (n m : Nat), n + m = m + n
   | n, 0   => Eq.symm (Nat.zero_add n)
@@ -1087,6 +1087,10 @@ protected theorem sub_eq_iff_eq_add {c : Nat} (h : b ≤ a) : a - b = c ↔ a =
 protected theorem sub_eq_iff_eq_add' {c : Nat} (h : b ≤ a) : a - b = c ↔ a = b + c := by
   rw [Nat.add_comm, Nat.sub_eq_iff_eq_add h]
 
+protected theorem sub_one_sub_lt_of_lt (h : a < b) : b - 1 - a < b := by
+  rw [← Nat.sub_add_eq]
+  exact sub_lt (zero_lt_of_lt h) (Nat.lt_add_right a Nat.one_pos)
+
 /-! ## Mul sub distrib -/
 
 theorem pred_mul (n m : Nat) : pred n * m = n * m - m := by

src/Init/Data/Nat/Bitwise/Lemmas.lean

@@ -86,6 +86,12 @@ noncomputable def div2Induction {motive : Nat → Sort u}
 @[simp] theorem testBit_zero (x : Nat) : testBit x 0 = decide (x % 2 = 1) := by
   cases mod_two_eq_zero_or_one x with | _ p => simp [testBit, p]
 
+theorem mod_two_eq_one_iff_testBit_zero : (x % 2 = 1) ↔ x.testBit 0 = true := by
+  cases mod_two_eq_zero_or_one x <;> simp_all
+
+theorem mod_two_eq_zero_iff_testBit_zero : (x % 2 = 0) ↔ x.testBit 0 = false := by
+  cases mod_two_eq_zero_or_one x <;> simp_all
+
 theorem testBit_succ (x i : Nat) : testBit x (succ i) = testBit (x/2) i := by
   unfold testBit
   simp [shiftRight_succ_inside]
@@ -94,6 +100,9 @@ theorem testBit_succ (x i : Nat) : testBit x (succ i) = testBit (x/2) i := by
   unfold testBit
   simp [shiftRight_succ_inside]
 
+theorem testBit_div_two (x i : Nat) : testBit (x / 2) i = testBit x (i + 1) := by
+  simp
+
 theorem testBit_to_div_mod {x : Nat} : testBit x i = decide (x / 2^i % 2 = 1) := by
   induction i generalizing x with
   | zero =>
@@ -315,6 +324,17 @@ theorem testBit_one_eq_true_iff_self_eq_zero {i : Nat} :
     Nat.testBit 1 i = true ↔ i = 0 := by
   cases i <;> simp
 
+@[simp] theorem two_pow_sub_one_mod_two : (2 ^ n - 1) % 2 = 1 % 2 ^ n := by
+  cases n with
+  | zero => simp
+  | succ n =>
+    rw [mod_eq_of_lt (a := 1) (Nat.one_lt_two_pow (by omega)), mod_two_eq_one_iff_testBit_zero, testBit_two_pow_sub_one ]
+    simp only [zero_lt_succ, decide_True]
+
+@[simp] theorem mod_two_pos_mod_two_eq_one : x % 2 ^ j % 2 = 1 ↔ (0 < j) ∧ x % 2 = 1 := by
+  rw [mod_two_eq_one_iff_testBit_zero, testBit_mod_two_pow]
+  simp
+
 /-! ### bitwise -/
 
 theorem testBit_bitwise
@@ -417,6 +437,11 @@ theorem and_pow_two_identity {x : Nat} (lt : x < 2^n) : x &&& 2^n-1 = x := by
   rw [and_pow_two_is_mod]
   apply Nat.mod_eq_of_lt lt
 
+@[simp] theorem and_mod_two_eq_one : (a &&& b) % 2 = 1 ↔ a % 2 = 1 ∧ b % 2 = 1 := by
+  simp only [mod_two_eq_one_iff_testBit_zero]
+  rw [testBit_and]
+  simp
+
 /-! ### lor -/
 
 @[simp] theorem zero_or (x : Nat) : 0 ||| x = x := by
@@ -435,6 +460,11 @@ theorem and_pow_two_identity {x : Nat} (lt : x < 2^n) : x &&& 2^n-1 = x := by
 theorem or_lt_two_pow {x y n : Nat} (left : x < 2^n) (right : y < 2^n) : x ||| y < 2^n :=
   bitwise_lt_two_pow left right
 
+@[simp] theorem or_mod_two_eq_one : (a ||| b) % 2 = 1 ↔ a % 2 = 1 ∨ b % 2 = 1 := by
+  simp only [mod_two_eq_one_iff_testBit_zero]
+  rw [testBit_or]
+  simp
+
 /-! ### xor -/
 
 @[simp] theorem testBit_xor (x y i : Nat) :
@@ -444,6 +474,19 @@ theorem or_lt_two_pow {x y n : Nat} (left : x < 2^n) (right : y < 2^n) : x ||| y
 theorem xor_lt_two_pow {x y n : Nat} (left : x < 2^n) (right : y < 2^n) : x ^^^ y < 2^n :=
   bitwise_lt_two_pow left right
 
+theorem and_xor_distrib_right {a b c : Nat} : (a ^^^ b) &&& c = (a &&& c) ^^^ (b &&& c) := by
+  apply Nat.eq_of_testBit_eq
+  simp [Bool.and_xor_distrib_right]
+
+theorem and_xor_distrib_left {a b c : Nat} : a &&& (b ^^^ c) = (a &&& b) ^^^ (a &&& c) := by
+  apply Nat.eq_of_testBit_eq
+  simp [Bool.and_xor_distrib_left]
+
+@[simp] theorem xor_mod_two_eq_one : ((a ^^^ b) % 2 = 1) ↔ ¬ ((a % 2 = 1) ↔ (b % 2 = 1)) := by
+  simp only [mod_two_eq_one_iff_testBit_zero]
+  rw [testBit_xor]
+  simp
+
 /-! ### Arithmetic -/
 
 theorem testBit_mul_pow_two_add (a : Nat) {b i : Nat} (b_lt : b < 2^i) (j : Nat) :
@@ -505,6 +548,15 @@ theorem mul_add_lt_is_or {b : Nat} (b_lt : b < 2^i) (a : Nat) : 2^i * a + b = 2^
 @[simp] theorem testBit_shiftRight (x : Nat) : testBit (x >>> i) j = testBit x (i+j) := by
   simp [testBit, ←shiftRight_add]
 
+@[simp] theorem shiftLeft_mod_two_eq_one : x <<< i % 2 = 1 ↔ i = 0 ∧ x % 2 = 1 := by
+  rw [mod_two_eq_one_iff_testBit_zero, testBit_shiftLeft]
+  simp
+
+@[simp] theorem decide_shiftRight_mod_two_eq_one :
+    decide (x >>> i % 2 = 1) = x.testBit i := by
+  simp only [testBit, one_and_eq_mod_two, mod_two_bne_zero]
+  exact (Bool.beq_eq_decide_eq _ _).symm
+
 /-! ### le -/
 
 theorem le_of_testBit {n m : Nat} (h : ∀ i, n.testBit i = true → m.testBit i = true) : n ≤ m := by

src/Init/Data/Nat/Lemmas.lean

@@ -50,6 +50,11 @@ protected theorem add_eq_zero_iff : n + m = 0 ↔ n = 0 ∧ m = 0 :=
 @[simp] protected theorem add_right_cancel_iff {n : Nat} : m + n = k + n ↔ m = k :=
   ⟨Nat.add_right_cancel, fun | rfl => rfl⟩
 
+@[simp] protected theorem add_left_eq_self  {a b : Nat} : a + b = b ↔ a = 0 := by omega
+@[simp] protected theorem add_right_eq_self {a b : Nat} : a + b = a ↔ b = 0 := by omega
+@[simp] protected theorem self_eq_add_right {a b : Nat} : a = a + b ↔ b = 0 := by omega
+@[simp] protected theorem self_eq_add_left  {a b : Nat} : a = b + a ↔ b = 0 := by omega
+
 @[simp] protected theorem add_le_add_iff_left {n : Nat} : n + m ≤ n + k ↔ m ≤ k :=
   ⟨Nat.le_of_add_le_add_left, fun h => Nat.add_le_add_left h _⟩
 
@@ -539,6 +544,11 @@ theorem mod_two_eq_zero_or_one (n : Nat) : n % 2 = 0 ∨ n % 2 = 1 :=
   | 0, _ => .inl rfl
   | 1, _ => .inr rfl
 
+@[simp] theorem mod_two_bne_zero : ((a % 2) != 0) = (a % 2 == 1) := by
+  cases mod_two_eq_zero_or_one a <;> simp_all
+@[simp] theorem mod_two_bne_one : ((a % 2) != 1) = (a % 2 == 0) := by
+  cases mod_two_eq_zero_or_one a <;> simp_all
+
 theorem le_of_mod_lt {a b : Nat} (h : a % b < a) : b ≤ a :=
   Nat.not_lt.1 fun hf => (ne_of_lt h).elim (Nat.mod_eq_of_lt hf)
 
@@ -649,6 +659,13 @@ protected theorem one_le_two_pow : 1 ≤ 2 ^ n :=
   else
     Nat.le_of_lt (Nat.one_lt_two_pow h)
 
+@[simp] theorem one_mod_two_pow_eq_one : 1 % 2 ^ n = 1 ↔ 0 < n := by
+  cases n with
+  | zero => simp
+  | succ n =>
+    rw [mod_eq_of_lt (a := 1) (Nat.one_lt_two_pow (by omega))]
+    simp
+
 protected theorem pow_pos (h : 0 < a) : 0 < a^n :=
   match n with
   | 0 => Nat.zero_lt_one

src/Init/Data/Option/Lemmas.lean

@@ -87,6 +87,9 @@ theorem eq_some_iff_get_eq : o = some a ↔ ∃ h : o.isSome, o.get h = a := by
 theorem eq_some_of_isSome : ∀ {o : Option α} (h : o.isSome), o = some (o.get h)
   | some _, _ => rfl
 
+theorem isSome_iff_ne_none : o.isSome ↔ o ≠ none := by
+  cases o <;> simp
+
 theorem not_isSome_iff_eq_none : ¬o.isSome ↔ o = none := by
   cases o <;> simp
 
@@ -167,6 +170,9 @@ theorem isSome_map {x : Option α} : (f <$> x).isSome = x.isSome := by
 @[simp] theorem isSome_map' {x : Option α} : (x.map f).isSome = x.isSome := by
   cases x <;> simp
 
+@[simp] theorem isNone_map' {x : Option α} : (x.map f).isNone = x.isNone := by
+  cases x <;> simp
+
 theorem map_eq_none : f <$> x = none ↔ x = none := map_eq_none'
 
 theorem map_eq_bind {x : Option α} : x.map f = x.bind (some ∘ f) := by
@@ -175,8 +181,19 @@ theorem map_eq_bind {x : Option α} : x.map f = x.bind (some ∘ f) := by
 theorem map_congr {x : Option α} (h : ∀ a, a ∈ x → f a = g a) : x.map f = x.map g := by
   cases x <;> simp only [map_none', map_some', h, mem_def]
 
-@[simp] theorem map_id' : Option.map (@id α) = id := map_id
-@[simp] theorem map_id'' {x : Option α} : (x.map fun a => a) = x := congrFun map_id x
+@[simp] theorem map_id_fun {α : Type u} : Option.map (id : α → α) = id := by
+  funext; simp [map_id]
+
+theorem map_id' {x : Option α} : (x.map fun a => a) = x := congrFun map_id x
+
+@[simp] theorem map_id_fun' {α : Type u} : Option.map (fun (a : α) => a) = id := by
+  funext; simp [map_id']
+
+theorem get_map {f : α → β} {o : Option α} {h : (o.map f).isSome} :
+    (o.map f).get h = f (o.get (by simpa using h)) := by
+  cases o with
+  | none => simp at h
+  | some a => simp
 
 @[simp] theorem map_map (h : β → γ) (g : α → β) (x : Option α) :
     (x.map g).map h = x.map (h ∘ g) := by
@@ -190,6 +207,14 @@ theorem comp_map (h : β → γ) (g : α → β) (x : Option α) : x.map (h ∘
 
 theorem mem_map_of_mem (g : α → β) (h : a ∈ x) : g a ∈ Option.map g x := h.symm ▸ map_some' ..
 
+@[simp] theorem map_if {f : α → β} [Decidable c] :
+     (if c then some a else none).map f = if c then some (f a) else none := by
+  split <;> rfl
+
+@[simp] theorem map_dif {f : α → β} [Decidable c] {a : c → α} :
+     (if h : c then some (a h) else none).map f = if h : c then some (f (a h)) else none := by
+  split <;> rfl
+
 @[simp] theorem filter_none (p : α → Bool) : none.filter p = none := rfl
 theorem filter_some : Option.filter p (some a) = if p a then some a else none := rfl
 
@@ -227,6 +252,15 @@ theorem map_orElse {x y : Option α} : (x <|> y).map f = (x.map f <|> y.map f) :
 @[simp] theorem guard_eq_some [DecidablePred p] : guard p a = some b ↔ a = b ∧ p a :=
   if h : p a then by simp [Option.guard, h] else by simp [Option.guard, h]
 
+@[simp] theorem guard_isSome [DecidablePred p] : (Option.guard p a).isSome ↔ p a :=
+  if h : p a then by simp [Option.guard, h] else by simp [Option.guard, h]
+
+@[simp] theorem guard_eq_none [DecidablePred p] : Option.guard p a = none ↔ ¬ p a :=
+  if h : p a then by simp [Option.guard, h] else by simp [Option.guard, h]
+
+@[simp] theorem guard_pos [DecidablePred p] (h : p a) : Option.guard p a = some a := by
+  simp [Option.guard, h]
+
 theorem liftOrGet_eq_or_eq {f : α → α → α} (h : ∀ a b, f a b = a ∨ f a b = b) :
     ∀ o₁ o₂, liftOrGet f o₁ o₂ = o₁ ∨ liftOrGet f o₁ o₂ = o₂
   | none, none => .inl rfl
@@ -250,7 +284,7 @@ theorem liftOrGet_eq_or_eq {f : α → α → α} (h : ∀ a b, f a b = a ∨ f
 @[simp] theorem getD_map (f : α → β) (x : α) (o : Option α) :
   (o.map f).getD (f x) = f (getD o x) := by cases o <;> rfl
 
-section
+section choice
 
 attribute [local instance] Classical.propDecidable
 
@@ -266,7 +300,7 @@ theorem choice_eq {α : Type _} [Subsingleton α] (a : α) : choice α = some a
 theorem choice_isSome_iff_nonempty {α : Type _} : (choice α).isSome ↔ Nonempty α :=
   ⟨fun h => ⟨(choice α).get h⟩, fun h => by simp only [choice, dif_pos h, isSome_some]⟩
 
-end
+end choice
 
 @[simp] theorem toList_some (a : α) : (a : Option α).toList = [a] := rfl
 
@@ -287,7 +321,7 @@ theorem or_eq_bif : or o o' = bif o.isSome then o else o' := by
 @[simp] theorem or_eq_none : or o o' = none ↔ o = none ∧ o' = none := by
   cases o <;> simp
 
-theorem or_eq_some : or o o' = some a ↔ o = some a ∨ (o = none ∧ o' = some a) := by
+@[simp] theorem or_eq_some : or o o' = some a ↔ o = some a ∨ (o = none ∧ o' = some a) := by
   cases o <;> simp
 
 theorem or_assoc : or (or o₁ o₂) o₃ = or o₁ (or o₂ o₃) := by
@@ -314,3 +348,51 @@ theorem map_or : f <$> or o o' = (f <$> o).or (f <$> o') := by
 
 theorem map_or' : (or o o').map f = (o.map f).or (o'.map f) := by
   cases o <;> rfl
+
+theorem or_of_isSome {o o' : Option α} (h : o.isSome) : o.or o' = o := by
+  match o, h with
+  | some _, _ => simp
+
+theorem or_of_isNone {o o' : Option α} (h : o.isNone) : o.or o' = o' := by
+  match o, h with
+  | none, _ => simp
+
+section ite
+
+@[simp] theorem isSome_dite {p : Prop} [Decidable p] {b : p → β} :
+    (if h : p then some (b h) else none).isSome = true ↔ p := by
+  split <;> simpa
+@[simp] theorem isSome_ite {p : Prop} [Decidable p] :
+    (if p then some b else none).isSome = true ↔ p := by
+  split <;> simpa
+@[simp] theorem isSome_dite' {p : Prop} [Decidable p] {b : ¬ p → β} :
+    (if h : p then none else some (b h)).isSome = true ↔ ¬ p := by
+  split <;> simpa
+@[simp] theorem isSome_ite' {p : Prop} [Decidable p] :
+    (if p then none else some b).isSome = true ↔ ¬ p := by
+  split <;> simpa
+
+@[simp] theorem get_dite {p : Prop} [Decidable p] (b : p → β) (w) :
+    (if h : p then some (b h) else none).get w = b (by simpa using w) := by
+  split
+  · simp
+  · exfalso
+    simp at w
+    contradiction
+@[simp] theorem get_ite {p : Prop} [Decidable p] (h) :
+    (if p then some b else none).get h = b := by
+  simpa using get_dite (p := p) (fun _ => b) (by simpa using h)
+@[simp] theorem get_dite' {p : Prop} [Decidable p] (b : ¬ p → β) (w) :
+    (if h : p then none else some (b h)).get w = b (by simpa using w) := by
+  split
+  · exfalso
+    simp at w
+    contradiction
+  · simp
+@[simp] theorem get_ite' {p : Prop} [Decidable p] (h) :
+    (if p then none else some b).get h = b := by
+  simpa using get_dite' (p := p) (fun _ => b) (by simpa using h)
+
+end ite
+
+end Option

src/Init/Data/PLift.lean

@@ -0,0 +1,12 @@
+/-
+Copyright (c) 2024 Lean FRO. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Core
+
+deriving instance DecidableEq for PLift
+
+instance [Subsingleton α] : Subsingleton (PLift α) where
+  allEq := fun ⟨a⟩ ⟨b⟩ => congrArg PLift.up (Subsingleton.elim a b)

src/Init/Data/Queue.lean

@@ -7,7 +7,7 @@ Simple queue implemented using two lists.
 Note: this is only a temporary placeholder.
 -/
 prelude
-import Init.Data.List
+import Init.Data.Array.Basic
 
 namespace Std
 

src/Init/Data/String/Basic.lean

@@ -558,7 +558,7 @@ structure Iterator where
   `Iterator.next` when `Iterator.atEnd` is true. If the position is not valid, then the
   current character is `(default : Char)`, similar to `String.get` on an invalid position. -/
   i : Pos
-  deriving DecidableEq
+  deriving DecidableEq, Inhabited
 
 /-- Creates an iterator at the beginning of a string. -/
 def mkIterator (s : String) : Iterator :=

src/Init/Data/ULift.lean

@@ -0,0 +1,12 @@
+/-
+Copyright (c) 2024 Lean FRO. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Core
+
+deriving instance DecidableEq for ULift
+
+instance [Subsingleton α] : Subsingleton (ULift α) where
+  allEq := fun ⟨a⟩ ⟨b⟩ => congrArg ULift.up (Subsingleton.elim a b)

src/Init/GetElem.lean

@@ -184,7 +184,7 @@ instance [GetElem? cont Nat elem dom] [h : LawfulGetElem cont Nat elem dom] :
 @[simp] theorem getElem!_fin [GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n) [Inhabited Elem] : a[i]! = a[i.1]! := rfl
 
 macro_rules
-  | `(tactic| get_elem_tactic_trivial) => `(tactic| apply Fin.val_lt_of_le; get_elem_tactic_trivial; done)
+  | `(tactic| get_elem_tactic_trivial) => `(tactic| (with_reducible apply Fin.val_lt_of_le); get_elem_tactic_trivial; done)
 
 end Fin
 

src/Init/MetaTypes.lean

@@ -104,6 +104,11 @@ structure Config where
   That is, given a local context containing entry `x : t := e`, the free variable `x` reduces to `e`.
   -/
   zetaDelta         : Bool := false
+  /--
+  When `index` (default : `true`) is `false`, `simp` will only use the root symbol
+  to find candidate `simp` theorems. It approximates Lean 3 `simp` behavior.
+  -/
+  index             : Bool := true
   deriving Inhabited, BEq
 
 end DSimp

src/Init/Notation.lean

@@ -704,6 +704,17 @@ syntax (name := checkSimp) "#check_simp " term "~>" term : command
 -/
 syntax (name := checkSimpFailure) "#check_simp " term "!~>" : command
 
+/--
+Time the elaboration of a command, and print the result (in milliseconds).
+
+Example usage:
+```
+set_option maxRecDepth 100000 in
+#time example : (List.range 500).length = 500 := rfl
+```
+-/
+syntax (name := timeCmd) "#time " command : command
+
 /--
 `#discr_tree_key  t` prints the discrimination tree keys for a term `t` (or, if it is a single identifier, the type of that constant).
 It uses the default configuration for generating keys.

src/Init/Omega/Constraint.lean

@@ -300,6 +300,8 @@ theorem normalize_sat {s x v} (w : s.sat' x v) :
   · split
     · simp
     · dsimp [Constraint.sat'] at w
+      simp only [IntList.gcd_eq_zero] at h
+      simp only [IntList.dot_eq_zero_of_left_eq_zero h] at w
       simp_all
   · split
     · exact w

src/Init/Omega/Int.lean

@@ -116,7 +116,7 @@ theorem ofNat_max (a b : Nat) : ((max a b : Nat) : Int) = max (a : Int) (b : Int
   split <;> rfl
 
 theorem ofNat_natAbs (a : Int) : (a.natAbs : Int) = if 0 ≤ a then a else -a := by
-  rw [Int.natAbs]
+  rw [Int.natAbs.eq_def]
   split <;> rename_i n
   · simp only [Int.ofNat_eq_coe]
     rw [if_pos (Int.ofNat_nonneg n)]

src/Init/Omega/IntList.lean

@@ -352,7 +352,6 @@ attribute [simp] Int.zero_dvd
 theorem gcd_dvd_dot_left (xs ys : IntList) : (xs.gcd : Int) ∣ dot xs ys :=
   Int.dvd_of_emod_eq_zero (dot_mod_gcd_left xs ys)
 
-@[simp]
 theorem dot_eq_zero_of_left_eq_zero {xs ys : IntList} (h : ∀ x, x ∈ xs → x = 0) : dot xs ys = 0 := by
   induction xs generalizing ys with
   | nil => rfl
@@ -363,6 +362,8 @@ theorem dot_eq_zero_of_left_eq_zero {xs ys : IntList} (h : ∀ x, x ∈ xs → x
       rw [dot_cons₂, h x (List.mem_cons_self _ _), ih (fun x m => h x (List.mem_cons_of_mem _ m)),
         Int.zero_mul, Int.add_zero]
 
+@[simp] theorem nil_dot (xs : IntList) : dot [] xs = 0 := rfl
+
 theorem dot_sdiv_left (xs ys : IntList) {d : Int} (h : d ∣ xs.gcd) :
     dot (xs.sdiv d) ys = (dot xs ys) / d := by
   induction xs generalizing ys with

src/Init/Prelude.lean

@@ -1845,14 +1845,11 @@ theorem Fin.eq_of_val_eq {n} : ∀ {i j : Fin n}, Eq i.val j.val → Eq i j
 theorem Fin.val_eq_of_eq {n} {i j : Fin n} (h : Eq i j) : Eq i.val j.val :=
   h ▸ rfl
 
-theorem Fin.ne_of_val_ne {n} {i j : Fin n} (h : Not (Eq i.val j.val)) : Not (Eq i j) :=
-  fun h' => absurd (val_eq_of_eq h') h
-
 instance (n : Nat) : DecidableEq (Fin n) :=
   fun i j =>
     match decEq i.val j.val with
     | isTrue h  => isTrue (Fin.eq_of_val_eq h)
-    | isFalse h => isFalse (Fin.ne_of_val_ne h)
+    | isFalse h => isFalse (fun h' => absurd (Fin.val_eq_of_eq h') h)
 
 instance {n} : LT (Fin n) where
   lt a b := LT.lt a.val b.val

src/Init/PropLemmas.lean

@@ -198,6 +198,7 @@ theorem Exists.imp' {β} {q : β → Prop} (f : α → β) (hpq : ∀ a, p a →
   | ⟨_, hp⟩ => ⟨_, hpq _ hp⟩
 
 theorem exists_imp : ((∃ x, p x) → b) ↔ ∀ x, p x → b := forall_exists_index
+theorem exists₂_imp {P : (x : α) → p x → Prop} : (∃ x h, P x h) → b ↔ ∀ x h, P x h → b := by simp
 
 @[simp] theorem exists_const (α) [i : Nonempty α] : (∃ _ : α, b) ↔ b :=
   ⟨fun ⟨_, h⟩ => h, i.elim Exists.intro⟩
@@ -402,7 +403,7 @@ theorem Decidable.not_imp_symm [Decidable a] (h : ¬a → b) (hb : ¬b) : a :=
 theorem Decidable.not_imp_comm [Decidable a] [Decidable b] : (¬a → b) ↔ (¬b → a) :=
   ⟨not_imp_symm, not_imp_symm⟩
 
-@[simp] theorem Decidable.not_imp_self [Decidable a] : (¬a → a) ↔ a := by
+theorem Decidable.not_imp_self [Decidable a] : (¬a → a) ↔ a := by
   have := @imp_not_self (¬a); rwa [not_not] at this
 
 theorem Decidable.or_iff_not_imp_left [Decidable a] : a ∨ b ↔ (¬a → b) :=

src/Init/SimpLemmas.lean

@@ -244,7 +244,7 @@ instance : Std.Associative (· || ·) := ⟨Bool.or_assoc⟩
 
 @[simp] theorem decide_not [g : Decidable p] [h : Decidable (Not p)] : decide (Not p) = !(decide p) := by
   cases g <;> (rename_i gp; simp [gp]; rfl)
-@[simp] theorem not_decide_eq_true [h : Decidable p] : ((!decide p) = true) = ¬ p := by simp
+theorem not_decide_eq_true [h : Decidable p] : ((!decide p) = true) = ¬ p := by simp
 
 @[simp] theorem heq_eq_eq (a b : α) : HEq a b = (a = b) := propext <| Iff.intro eq_of_heq heq_of_eq
 

src/Init/System/IO.lean

@@ -447,6 +447,7 @@ see there for more information.
 @[extern "lean_io_remove_dir"] opaque removeDir : @& FilePath → IO Unit
 @[extern "lean_io_create_dir"] opaque createDir : @& FilePath → IO Unit
 
+
 /--
 Moves a file or directory `old` to the new location `new`.
 
@@ -455,6 +456,16 @@ see there for more information.
 -/
 @[extern "lean_io_rename"] opaque rename (old new : @& FilePath) : IO Unit
 
+/--
+Creates a temporary file in the most secure manner possible. There are no race conditions in the
+file’s creation. The file is readable and writable only by the creating user ID. Additionally
+on UNIX style platforms the file is executable by nobody. The function returns both a `Handle`
+to the already opened file as well as its `FilePath`.
+
+Note that it is the caller's job to remove the file after use.
+-/
+@[extern "lean_io_create_tempfile"] opaque createTempFile : IO (Handle × FilePath)
+
 end FS
 
 @[extern "lean_io_getenv"] opaque getEnv (var : @& String) : BaseIO (Option String)
@@ -467,6 +478,17 @@ namespace FS
 def withFile (fn : FilePath) (mode : Mode) (f : Handle → IO α) : IO α :=
   Handle.mk fn mode >>= f
 
+/--
+Like `createTempFile` but also takes care of removing the file after usage.
+-/
+def withTempFile [Monad m] [MonadFinally m] [MonadLiftT IO m] (f : Handle → FilePath → m α) :
+    m α := do
+  let (handle, path) ← createTempFile
+  try
+    f handle path
+  finally
+    removeFile path
+
 def Handle.putStrLn (h : Handle) (s : String) : IO Unit :=
   h.putStr (s.push '\n')
 

src/Init/Tactics.lean

@@ -552,9 +552,9 @@ The `simp` tactic uses lemmas and hypotheses to simplify the main goal target or
 non-dependent hypotheses. It has many variants:
 - `simp` simplifies the main goal target using lemmas tagged with the attribute `[simp]`.
 - `simp [h₁, h₂, ..., hₙ]` simplifies the main goal target using the lemmas tagged
-  with the attribute `[simp]` and the given `hᵢ`'s, where the `hᵢ`'s are expressions.
-  If an `hᵢ` is a defined constant `f`, then the equational lemmas associated with
-  `f` are used. This provides a convenient way to unfold `f`.
+  with the attribute `[simp]` and the given `hᵢ`'s, where the `hᵢ`'s are expressions.-
+- If an `hᵢ` is a defined constant `f`, then `f` is unfolded. If `f` has equational lemmas associated
+  with it (and is not a projection or a `reducible` definition), these are used to rewrite with `f`.
 - `simp [*]` simplifies the main goal target using the lemmas tagged with the
   attribute `[simp]` and all hypotheses.
 - `simp only [h₁, h₂, ..., hₙ]` is like `simp [h₁, h₂, ..., hₙ]` but does not use `[simp]` lemmas.
@@ -679,9 +679,9 @@ syntax (name := delta) "delta" (ppSpace colGt ident)+ (location)? : tactic
 * `unfold id` unfolds definition `id`.
 * `unfold id1 id2 ...` is equivalent to `unfold id1; unfold id2; ...`.
 
-For non-recursive definitions, this tactic is identical to `delta`.
-For definitions by pattern matching, it uses "equation lemmas" which are
-autogenerated for each match arm.
+For non-recursive definitions, this tactic is identical to `delta`. For recursive definitions,
+it uses the "unfolding lemma" `id.eq_def`, which is generated for each recursive definition,
+to unfold according to the recursive definition given by the user.
 -/
 syntax (name := unfold) "unfold" (ppSpace colGt ident)+ (location)? : tactic
 

src/Init/WF.lean

@@ -173,7 +173,7 @@ namespace Nat
 
 -- less-than is well-founded
 def lt_wfRel : WellFoundedRelation Nat where
-  rel := Nat.lt
+  rel := (· < ·)
   wf  := by
     apply WellFounded.intro
     intro n

src/Init/WFTactics.lean

@@ -8,11 +8,26 @@ import Init.SizeOf
 import Init.MetaTypes
 import Init.WF
 
-/-- Unfold definitions commonly used in well founded relation definitions.
-This is primarily intended for internal use in `decreasing_tactic`. -/
+/--
+Unfold definitions commonly used in well founded relation definitions.
+
+Since Lean 4.12, Lean unfolds these definitions automatically before presenting the goal to the
+user, and this tactic should no longer be necessary. Calls to `simp_wf` can be removed or replaced
+by plain calls to `simp`.
+-/
 macro "simp_wf" : tactic =>
   `(tactic| try simp (config := { unfoldPartialApp := true, zetaDelta := true }) [invImage, InvImage, Prod.lex, sizeOfWFRel, measure, Nat.lt_wfRel, WellFoundedRelation.rel])
 
+/--
+This tactic is used internally by lean before presenting the proof obligations from a well-founded
+definition to the user via `decreasing_by`. It is not necessary to use this tactic manuall.
+-/
+macro "clean_wf" : tactic =>
+  `(tactic| simp
+     (config := { unfoldPartialApp := true, zetaDelta := true, failIfUnchanged := false })
+     only [invImage, InvImage, Prod.lex, sizeOfWFRel, measure, Nat.lt_wfRel,
+           WellFoundedRelation.rel, sizeOf_nat])
+
 /-- Extensible helper tactic for `decreasing_tactic`. This handles the "base case"
 reasoning after applying lexicographic order lemmas.
 It can be extended by adding more macro definitions, e.g.
@@ -36,12 +51,13 @@ macro_rules | `(tactic| decreasing_trivial_pre_omega) => `(tactic| apply Nat.pre
 macro_rules | `(tactic| decreasing_trivial_pre_omega) => `(tactic| apply Nat.pred_lt; assumption)  -- i-1 < i if i ≠ 0
 
 
-/-- Constructs a proof of decreasing along a well founded relation, by applying
-lexicographic order lemmas and using `ts` to solve the base case. If it fails,
+/-- Constructs a proof of decreasing along a well founded relation, by simplifying, then applying
+lexicographic order lemmas and finally using `ts` to solve the base case. If it fails,
 it prints a message to help the user diagnose an ill-founded recursive definition. -/
 macro "decreasing_with " ts:tacticSeq : tactic =>
  `(tactic|
-   (simp_wf
+   (clean_wf -- remove after next stage0 update
+    try simp
     repeat (first | apply Prod.Lex.right | apply Prod.Lex.left)
     repeat (first | apply PSigma.Lex.right | apply PSigma.Lex.left)
     first

src/Lean/Data.lean

@@ -18,7 +18,6 @@ import Lean.Data.Name
 import Lean.Data.NameMap
 import Lean.Data.OpenDecl
 import Lean.Data.Options
-import Lean.Data.Parsec
 import Lean.Data.PersistentArray
 import Lean.Data.PersistentHashMap
 import Lean.Data.PersistentHashSet

src/Lean/Data/Json/Parser.lean

@@ -6,13 +6,13 @@ Authors: Gabriel Ebner, Marc Huisinga
 -/
 prelude
 import Lean.Data.Json.Basic
-import Lean.Data.Parsec
 import Lean.Data.RBMap
+import Std.Internal.Parsec
 
 namespace Lean.Json.Parser
 
-open Lean.Parsec
-open Lean.Parsec.String
+open Std.Internal.Parsec
+open Std.Internal.Parsec.String
 
 @[inline]
 def hexChar : Parser Nat := do
@@ -216,8 +216,8 @@ namespace Json
 
 def parse (s : String) : Except String Lean.Json :=
   match Json.Parser.any s.mkIterator with
-  | Parsec.ParseResult.success _ res => Except.ok res
-  | Parsec.ParseResult.error it err  => Except.error s!"offset {repr it.i.byteIdx}: {err}"
+  | .success _ res => Except.ok res
+  | .error it err  => Except.error s!"offset {repr it.i.byteIdx}: {err}"
 
 end Json
 

src/Lean/Data/Lsp/Diagnostics.lean

@@ -113,8 +113,7 @@ structure DiagnosticWith (α : Type) where
 def DiagnosticWith.fullRange (d : DiagnosticWith α) : Range :=
   d.fullRange?.getD d.range
 
-local instance [Ord α] : Ord (Array α) := Ord.arrayOrd
-
+attribute [local instance] Ord.arrayOrd in
 /-- Restriction of `DiagnosticWith` to properties that are displayed to users in the InfoView. -/
 private structure DiagnosticWith.UserVisible (α : Type) where
   range               : Range

src/Lean/Data/Xml/Parser.lean

@@ -4,8 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Author: Dany Fabian
 -/
 prelude
-import Lean.Data.Parsec
+import Std.Internal.Parsec
 import Lean.Data.Xml.Basic
+
 open System
 open Lean
 
@@ -14,8 +15,8 @@ namespace Xml
 
 namespace Parser
 
-open Lean.Parsec
-open Lean.Parsec.String
+open Std.Internal.Parsec
+open Std.Internal.Parsec.String
 
 abbrev LeanChar := Char
 

src/Lean/Elab.lean

@@ -51,3 +51,4 @@ import Lean.Elab.GuardMsgs
 import Lean.Elab.CheckTactic
 import Lean.Elab.MatchExpr
 import Lean.Elab.Tactic.Doc
+import Lean.Elab.Time

src/Lean/Elab/AutoBound.lean

@@ -17,7 +17,7 @@ register_builtin_option autoImplicit : Bool := {
 
 register_builtin_option relaxedAutoImplicit : Bool := {
     defValue := true
-    descr    := "When \"relaxed\" mode is enabled, any atomic nonempty identifier is eligible for auto bound implicit locals (see optin `autoBoundImplicitLocal`."
+    descr    := "When \"relaxed\" mode is enabled, any atomic nonempty identifier is eligible for auto bound implicit locals (see option `autoImplicit`)."
   }
 
 

src/Lean/Elab/BuiltinCommand.lean

@@ -176,7 +176,8 @@ private def replaceBinderAnnotation (binder : TSyntax ``Parser.Term.bracketedBin
   let mut binderIds := binderIds
   let mut binderIdsIniSize := binderIds.size
   let mut modifiedVarDecls := false
-  for varDecl in varDecls do
+  -- Go through declarations in reverse to respect shadowing
+  for varDecl in varDecls.reverse do
     let (ids, ty?, explicit') ← match varDecl with
       | `(bracketedBinderF|($ids* $[: $ty?]? $(annot?)?)) =>
         if annot?.isSome then
@@ -208,7 +209,7 @@ private def replaceBinderAnnotation (binder : TSyntax ``Parser.Term.bracketedBin
           `(bracketedBinderF| ($id $[: $ty?]?))
         else
           `(bracketedBinderF| {$id $[: $ty?]?})
-      for id in ids do
+      for id in ids.reverse do
         if let some idx := binderIds.findIdx? fun binderId => binderId.raw.isIdent && binderId.raw.getId == id.raw.getId then
           binderIds := binderIds.eraseIdx idx
           modifiedVarDecls := true
@@ -216,7 +217,7 @@ private def replaceBinderAnnotation (binder : TSyntax ``Parser.Term.bracketedBin
         else
           varDeclsNew := varDeclsNew.push (← mkBinder id explicit')
   if modifiedVarDecls then
-    modifyScope fun scope => { scope with varDecls := varDeclsNew }
+    modifyScope fun scope => { scope with varDecls := varDeclsNew.reverse }
   if binderIds.size != binderIdsIniSize then
     binderIds.mapM fun binderId =>
       if explicit then
@@ -228,15 +229,14 @@ private def replaceBinderAnnotation (binder : TSyntax ``Parser.Term.bracketedBin
 
 @[builtin_command_elab «variable»] def elabVariable : CommandElab
   | `(variable $binders*) => do
+    let binders ← binders.concatMapM replaceBinderAnnotation
     -- Try to elaborate `binders` for sanity checking
     runTermElabM fun _ => Term.withSynthesize <| Term.withAutoBoundImplicit <|
       Term.elabBinders binders fun _ => pure ()
+    -- Remark: if we want to produce error messages when variables shadow existing ones, here is the place to do it.
     for binder in binders do
-      let binders ← replaceBinderAnnotation binder
-      -- Remark: if we want to produce error messages when variables shadow existing ones, here is the place to do it.
-      for binder in binders do
-        let varUIds ← getBracketedBinderIds binder |>.mapM (withFreshMacroScope ∘ MonadQuotation.addMacroScope)
-        modifyScope fun scope => { scope with varDecls := scope.varDecls.push binder, varUIds := scope.varUIds ++ varUIds }
+      let varUIds ← (← getBracketedBinderIds binder) |>.mapM (withFreshMacroScope ∘ MonadQuotation.addMacroScope)
+      modifyScope fun scope => { scope with varDecls := scope.varDecls.push binder, varUIds := scope.varUIds ++ varUIds }
   | _ => throwUnsupportedSyntax
 
 open Meta
@@ -504,12 +504,60 @@ def elabRunMeta : CommandElab := fun stx =>
 
 @[builtin_command_elab Lean.Parser.Command.include] def elabInclude : CommandElab
   | `(Lean.Parser.Command.include| include $ids*) => do
-    let vars := (← getScope).varDecls.concatMap getBracketedBinderIds
+    let sc ← getScope
+    let vars ← sc.varDecls.concatMapM getBracketedBinderIds
+    let mut uids := #[]
     for id in ids do
-      unless vars.contains id.getId do
+      if let some idx := vars.findIdx? (· == id.getId) then
+        uids := uids.push sc.varUIds[idx]!
+      else
         throwError "invalid 'include', variable '{id}' has not been declared in the current scope"
-    modifyScope fun sc =>
-      { sc with includedVars := sc.includedVars ++ ids.toList.map (·.getId) }
+    modifyScope fun sc => { sc with
+      includedVars := sc.includedVars ++ uids.toList
+      omittedVars := sc.omittedVars.filter (!uids.contains ·) }
+  | _ => throwUnsupportedSyntax
+
+@[builtin_command_elab Lean.Parser.Command.omit] def elabOmit : CommandElab
+  | `(Lean.Parser.Command.omit| omit $omits*) => do
+    -- TODO: this really shouldn't have to re-elaborate section vars... they should come
+    -- pre-elaborated
+    let omittedVars ← runTermElabM fun vars => do
+      Term.synthesizeSyntheticMVarsNoPostponing
+      -- We don't want to store messages produced when elaborating `(getVarDecls s)` because they have already been saved when we elaborated the `variable`(s) command.
+      -- So, we use `Core.resetMessageLog`.
+      Core.resetMessageLog
+      -- resolve each omit to variable user name or type pattern
+      let elaboratedOmits : Array (Sum Name Expr) ← omits.mapM fun
+        | `(ident| $id:ident) => pure <| Sum.inl id.getId
+        | `(Lean.Parser.Term.instBinder| [$id : $_]) => pure <| Sum.inl id.getId
+        | `(Lean.Parser.Term.instBinder| [$ty]) =>
+          Sum.inr <$> Term.withoutErrToSorry (Term.elabTermAndSynthesize ty none)
+        | _ => throwUnsupportedSyntax
+      -- check that each omit is actually used in the end
+      let mut omitsUsed := omits.map fun _ => false
+      let mut omittedVars := #[]
+      let mut revSectionFVars : Std.HashMap FVarId Name := {}
+      for (uid, var) in (← read).sectionFVars do
+        revSectionFVars := revSectionFVars.insert var.fvarId! uid
+      for var in vars do
+        let ldecl ← var.fvarId!.getDecl
+        if let some idx := (← elaboratedOmits.findIdxM? fun
+            | .inl id => return ldecl.userName == id
+            | .inr ty => do
+              let mctx ← getMCtx
+              isDefEq ty ldecl.type <* setMCtx mctx) then
+          if let some uid := revSectionFVars[var.fvarId!]? then
+            omittedVars := omittedVars.push uid
+            omitsUsed := omitsUsed.set! idx true
+          else
+            throwError "invalid 'omit', '{ldecl.userName}' has not been declared in the current scope"
+      for o in omits, used in omitsUsed do
+        unless used do
+          throwError "'{o}' did not match any variables in the current scope"
+      return omittedVars
+    modifyScope fun sc => { sc with
+      omittedVars := sc.omittedVars ++ omittedVars.toList
+      includedVars := sc.includedVars.filter (!omittedVars.contains ·) }
   | _ => throwUnsupportedSyntax
 
 @[builtin_command_elab Parser.Command.exit] def elabExit : CommandElab := fun _ =>

src/Lean/Elab/Command.lean

@@ -51,8 +51,6 @@ structure Scope where
   even if they do not work with binders per se.
   -/
   varDecls      : Array (TSyntax ``Parser.Term.bracketedBinder) := #[]
-  /-- `include`d section variable names -/
-  includedVars  : List Name := []
   /--
   Globally unique internal identifiers for the `varDecls`.
   There is one identifier per variable introduced by the binders
@@ -62,6 +60,10 @@ structure Scope where
   that capture these variables.
   -/
   varUIds       : Array Name := #[]
+  /-- `include`d section variable names (from `varUIds`) -/
+  includedVars  : List Name := []
+  /-- `omit`ted section variable names (from `varUIds`) -/
+  omittedVars  : List Name := []
   /--
   If true (default: false), all declarations that fail to compile
   automatically receive the `noncomputable` modifier.
@@ -555,19 +557,21 @@ private def mkMetaContext : Meta.Context := {
 
 open Lean.Parser.Term in
 /-- Return identifier names in the given bracketed binder. -/
-def getBracketedBinderIds : Syntax → Array Name
-  | `(bracketedBinderF|($ids* $[: $ty?]? $(_annot?)?)) => ids.map Syntax.getId
-  | `(bracketedBinderF|{$ids* $[: $ty?]?})             => ids.map Syntax.getId
-  | `(bracketedBinderF|[$id : $_])                     => #[id.getId]
-  | `(bracketedBinderF|[$_])                           => #[Name.anonymous]
-  | _                                                 => #[]
+def getBracketedBinderIds : Syntax → CommandElabM (Array Name)
+  | `(bracketedBinderF|($ids* $[: $ty?]? $(_annot?)?)) => return ids.map Syntax.getId
+  | `(bracketedBinderF|{$ids* $[: $ty?]?})             => return ids.map Syntax.getId
+  | `(bracketedBinderF|⦃$ids* : $_⦄)                   => return ids.map Syntax.getId
+  | `(bracketedBinderF|[$id : $_])                     => return #[id.getId]
+  | `(bracketedBinderF|[$_])                           => return #[Name.anonymous]
+  | _                                                  => throwUnsupportedSyntax
 
-private def mkTermContext (ctx : Context) (s : State) : Term.Context := Id.run do
+private def mkTermContext (ctx : Context) (s : State) : CommandElabM Term.Context := do
   let scope      := s.scopes.head!
   let mut sectionVars := {}
-  for id in scope.varDecls.concatMap getBracketedBinderIds, uid in scope.varUIds do
+  for id in (← scope.varDecls.concatMapM getBracketedBinderIds), uid in scope.varUIds do
     sectionVars := sectionVars.insert id uid
-  { macroStack             := ctx.macroStack
+  return {
+    macroStack             := ctx.macroStack
     sectionVars            := sectionVars
     isNoncomputableSection := scope.isNoncomputable
     tacticCache?           := ctx.tacticCache? }
@@ -607,7 +611,7 @@ def liftTermElabM (x : TermElabM α) : CommandElabM α := do
   -- make sure `observing` below also catches runtime exceptions (like we do by default in
   -- `CommandElabM`)
   let _ := MonadAlwaysExcept.except (m := TermElabM)
-  let x : MetaM _ := (observing (try x finally Meta.reportDiag)).run (mkTermContext ctx s) { levelNames := scope.levelNames }
+  let x : MetaM _ := (observing (try x finally Meta.reportDiag)).run (← mkTermContext ctx s) { levelNames := scope.levelNames }
   let x : CoreM _ := x.run mkMetaContext {}
   let ((ea, _), _) ← runCore x
   MonadExcept.ofExcept ea
@@ -704,7 +708,7 @@ def expandDeclId (declId : Syntax) (modifiers : Modifiers) : CommandElabM Expand
   let currNamespace ← getCurrNamespace
   let currLevelNames ← getLevelNames
   let r ← Elab.expandDeclId currNamespace currLevelNames declId modifiers
-  for id in (← getScope).varDecls.concatMap getBracketedBinderIds do
+  for id in (← (← getScope).varDecls.concatMapM getBracketedBinderIds) do
     if id == r.shortName then
       throwError "invalid declaration name '{r.shortName}', there is a section variable with the same name"
   return r

src/Lean/Elab/Do.lean

@@ -1264,7 +1264,7 @@ def withNewMutableVars {α} (newVars : Array Var) (mutable : Bool) (x : M α) :
 
 def checkReassignable (xs : Array Var) : M Unit := do
   let throwInvalidReassignment (x : Name) : M Unit :=
-    throwError "`{x.simpMacroScopes}` cannot be mutated, only variables declared using `let mut` can be mutated. If you did not intent to mutate but define `{x.simpMacroScopes}`, consider using `let {x.simpMacroScopes}` instead"
+    throwError "`{x.simpMacroScopes}` cannot be mutated, only variables declared using `let mut` can be mutated. If you did not intend to mutate but define `{x.simpMacroScopes}`, consider using `let {x.simpMacroScopes}` instead"
   let ctx ← read
   for x in xs do
     unless ctx.mutableVars.contains x.getId do

src/Lean/Elab/Frontend.lean

@@ -143,7 +143,7 @@ def runFrontend
     : IO (Environment × Bool) := do
   let startTime := (← IO.monoNanosNow).toFloat / 1000000000
   let inputCtx := Parser.mkInputContext input fileName
-  let opts := Language.Lean.internal.minimalSnapshots.set opts true
+  let opts := Language.Lean.internal.cmdlineSnapshots.set opts true
   let ctx := { inputCtx with }
   let processor := Language.Lean.process
   let snap ← processor (fun _ => pure <| .ok { mainModuleName, opts, trustLevel }) none ctx

src/Lean/Elab/Inductive.lean

@@ -771,6 +771,7 @@ private def mkInductiveDecl (vars : Array Expr) (views : Array InductiveView) :
   let isUnsafe          := view0.modifiers.isUnsafe
   withRef view0.ref <| Term.withLevelNames allUserLevelNames do
     let rs ← elabHeader views
+    Term.synthesizeSyntheticMVarsNoPostponing
     withInductiveLocalDecls rs fun params indFVars => do
       trace[Elab.inductive] "indFVars: {indFVars}"
       let mut indTypesArray := #[]
@@ -778,11 +779,19 @@ private def mkInductiveDecl (vars : Array Expr) (views : Array InductiveView) :
         let indFVar := indFVars[i]!
         Term.addLocalVarInfo views[i]!.declId indFVar
         let r     := rs[i]!
-        let type  := r.type |>.abstract r.params |>.instantiateRev params
+        /- At this point, because of `withInductiveLocalDecls`, the only fvars that are in context are the ones related to the first inductive type.
+           Because of this, we need to replace the fvars present in each inductive type's header of the mutual block with those of the first inductive.
+           However, some mvars may still be uninstantiated there, and might hide some of the old fvars.
+           As such we first need to synthesize all possible mvars at this stage, instantiate them in the header types and only
+           then replace the parameters' fvars in the header type.
+
+           See issue #3242 (`https://github.com/leanprover/lean4/issues/3242`)
+        -/
+        let type  ←  instantiateMVars r.type
+        let type  := type.replaceFVars r.params params
         let type  ← mkForallFVars params type
         let ctors ← withExplicitToImplicit params (elabCtors indFVars indFVar params r)
         indTypesArray := indTypesArray.push { name := r.view.declName, type, ctors }
-      Term.synthesizeSyntheticMVarsNoPostponing
       let numExplicitParams ← fixedIndicesToParams params.size indTypesArray indFVars
       trace[Elab.inductive] "numExplicitParams: {numExplicitParams}"
       let indTypes := indTypesArray.toList

src/Lean/Elab/MutualDef.lean

@@ -336,30 +336,42 @@ def instantiateMVarsProfiling (e : Expr) : MetaM Expr := do
 /--
 Runs `k` with a restricted local context where only section variables from `vars` are included that
 * are directly referenced in any `headers`,
-* are included in `includedVars` (via the `include` command),
+* are included in `sc.includedVars` (via the `include` command),
 * are directly referenced in any variable included by these rules, OR
-* are instance-implicit variables that only reference section variables included by these rules.
+* are instance-implicit variables that only reference section variables included by these rules AND
+  are not listed in `sc.omittedVars` (via `omit`; note that `omit` also subtracts from
+  `sc.includedVars`).
 -/
-private def withHeaderSecVars {α} (vars : Array Expr) (includedVars : List Name) (headers : Array DefViewElabHeader)
+private def withHeaderSecVars {α} (vars : Array Expr) (sc : Command.Scope) (headers : Array DefViewElabHeader)
     (k : Array Expr → TermElabM α) : TermElabM α := do
-  let (_, used) ← collectUsed.run {}
+  let mut revSectionFVars : Std.HashMap FVarId Name := {}
+  for (uid, var) in (← read).sectionFVars do
+    revSectionFVars := revSectionFVars.insert var.fvarId! uid
+  let (_, used) ← collectUsed revSectionFVars |>.run {}
   let (lctx, localInsts, vars) ← removeUnused vars used
   withLCtx lctx localInsts <| k vars
 where
-  collectUsed : StateRefT CollectFVars.State MetaM Unit := do
+  collectUsed revSectionFVars : StateRefT CollectFVars.State MetaM Unit := do
     -- directly referenced in headers
     headers.forM (·.type.collectFVars)
     -- included by `include`
-    vars.forM fun var => do
-      let ldecl ← getFVarLocalDecl var
-      if includedVars.contains ldecl.userName then
-        modify (·.add ldecl.fvarId)
+    for var in vars do
+      if let some uid := revSectionFVars[var.fvarId!]? then
+        if sc.includedVars.contains uid then
+          modify (·.add var.fvarId!)
     -- transitively referenced
     get >>= (·.addDependencies) >>= set
+    for var in (← get).fvarIds do
+      if let some uid := revSectionFVars[var]? then
+        if sc.omittedVars.contains uid then
+          throwError "cannot omit referenced section variable '{Expr.fvar var}'"
     -- instances (`addDependencies` unnecessary as by definition they may only reference variables
     -- already included)
-    vars.forM fun var => do
+    for var in vars do
       let ldecl ← getFVarLocalDecl var
+      if let some uid := revSectionFVars[var.fvarId!]? then
+        if sc.omittedVars.contains uid then
+          continue
       let st ← get
       if ldecl.binderInfo.isInstImplicit && (← getFVars ldecl.type).all st.fvarSet.contains then
         modify (·.add ldecl.fvarId)
@@ -371,7 +383,12 @@ register_builtin_option deprecated.oldSectionVars : Bool := {
   descr    := "re-enable deprecated behavior of including exactly the section variables used in a declaration"
 }
 
-private def elabFunValues (headers : Array DefViewElabHeader) (vars : Array Expr) (includedVars : List Name) : TermElabM (Array Expr) :=
+register_builtin_option linter.unusedSectionVars : Bool := {
+  defValue := true
+  descr := "enable the 'unused section variables in theorem body' linter"
+}
+
+private def elabFunValues (headers : Array DefViewElabHeader) (vars : Array Expr) (sc : Command.Scope) : TermElabM (Array Expr) :=
   headers.mapM fun header => do
     let mut reusableResult? := none
     if let some snap := header.bodySnap? then
@@ -386,7 +403,7 @@ private def elabFunValues (headers : Array DefViewElabHeader) (vars : Array Expr
       withReuseContext header.value do
       withDeclName header.declName <| withLevelNames header.levelNames do
       let valStx ← liftMacroM <| declValToTerm header.value
-      (if header.kind.isTheorem && !deprecated.oldSectionVars.get (← getOptions) then withHeaderSecVars vars includedVars #[header] else fun x => x #[]) fun vars => do
+      (if header.kind.isTheorem && !deprecated.oldSectionVars.get (← getOptions) then withHeaderSecVars vars sc #[header] else fun x => x #[]) fun vars => do
       forallBoundedTelescope header.type header.numParams fun xs type => do
         -- Add new info nodes for new fvars. The server will detect all fvars of a binder by the binder's source location.
         for i in [0:header.binderIds.size] do
@@ -399,18 +416,25 @@ private def elabFunValues (headers : Array DefViewElabHeader) (vars : Array Expr
         -- leads to more section variables being included than necessary
         let val ← instantiateMVarsProfiling val
         let val ← mkLambdaFVars xs val
-        unless header.type.hasSorry || val.hasSorry do
-          for var in vars do
-            unless header.type.containsFVar var.fvarId! ||
-                val.containsFVar var.fvarId! ||
-                (← vars.anyM (fun v => return (← v.fvarId!.getType).containsFVar var.fvarId!)) do
-              let varDecl ← var.fvarId!.getDecl
-              let var := if varDecl.userName.hasMacroScopes && varDecl.binderInfo.isInstImplicit then
-                m!"[{varDecl.type}]".group
+        if linter.unusedSectionVars.get (← getOptions) && !header.type.hasSorry && !val.hasSorry then
+          let unusedVars ← vars.filterMapM fun var => do
+            let varDecl ← var.fvarId!.getDecl
+            return if sc.includedVars.contains varDecl.userName ||
+                header.type.containsFVar var.fvarId! || val.containsFVar var.fvarId! ||
+                (← vars.anyM (fun v => return (← v.fvarId!.getType).containsFVar var.fvarId!)) then
+              none
+            else
+              if varDecl.userName.hasMacroScopes && varDecl.binderInfo.isInstImplicit then
+                some m!"[{varDecl.type}]"
               else
-                var
-              logWarningAt header.ref m!"included section variable '{var}' is not used in \
-                '{header.declName}', consider excluding it"
+                some m!"{var}"
+          if unusedVars.size > 0 then
+            Linter.logLint linter.unusedSectionVars header.ref
+              m!"automatically included section variable(s) unused in theorem '{header.declName}':\
+              \n  {MessageData.joinSep unusedVars.toList "\n  "}\
+              \nconsider restructuring your `variable` declarations so that the variables are not \
+                in scope or explicitly omit them:\
+              \n  omit {MessageData.joinSep unusedVars.toList " "} in theorem ..."
         return val
     if let some snap := header.bodySnap? then
       snap.new.resolve <| some {
@@ -962,7 +986,7 @@ partial def checkForHiddenUnivLevels (allUserLevelNames : List Name) (preDefs :
     for preDef in preDefs do
       checkPreDef preDef
 
-def elabMutualDef (vars : Array Expr) (includedVars : List Name) (views : Array DefView) : TermElabM Unit :=
+def elabMutualDef (vars : Array Expr) (sc : Command.Scope) (views : Array DefView) : TermElabM Unit :=
   if isExample views then
     withoutModifyingEnv do
       -- save correct environment in info tree
@@ -983,7 +1007,7 @@ where
           addLocalVarInfo view.declId funFVar
         let values ←
           try
-            let values ← elabFunValues headers vars includedVars
+            let values ← elabFunValues headers vars sc
             Term.synthesizeSyntheticMVarsNoPostponing
             values.mapM (instantiateMVarsProfiling ·)
           catch ex =>
@@ -993,7 +1017,7 @@ where
         let letRecsToLift ← getLetRecsToLift
         let letRecsToLift ← letRecsToLift.mapM instantiateMVarsAtLetRecToLift
         checkLetRecsToLiftTypes funFVars letRecsToLift
-        (if headers.all (·.kind.isTheorem) && !deprecated.oldSectionVars.get (← getOptions) then withHeaderSecVars vars includedVars headers else withUsed vars headers values letRecsToLift) fun vars => do
+        (if headers.all (·.kind.isTheorem) && !deprecated.oldSectionVars.get (← getOptions) then withHeaderSecVars vars sc headers else withUsed vars headers values letRecsToLift) fun vars => do
           let preDefs ← MutualClosure.main vars headers funFVars values letRecsToLift
           for preDef in preDefs do
             trace[Elab.definition] "{preDef.declName} : {preDef.type} :=\n{preDef.value}"
@@ -1064,8 +1088,8 @@ def elabMutualDef (ds : Array Syntax) : CommandElabM Unit := do
     if let some snap := snap? then
       -- no non-fatal diagnostics at this point
       snap.new.resolve <| .ofTyped { defs, diagnostics := .empty : DefsParsedSnapshot }
-    let includedVars := (← getScope).includedVars
-    runTermElabM fun vars => Term.elabMutualDef vars includedVars views
+    let sc ← getScope
+    runTermElabM fun vars => Term.elabMutualDef vars sc views
 
 builtin_initialize
   registerTraceClass `Elab.definition.mkClosure

src/Lean/Elab/PreDefinition.lean

@@ -10,3 +10,4 @@ import Lean.Elab.PreDefinition.Main
 import Lean.Elab.PreDefinition.MkInhabitant
 import Lean.Elab.PreDefinition.WF
 import Lean.Elab.PreDefinition.Eqns
+import Lean.Elab.PreDefinition.Nonrec.Eqns

src/Lean/Elab/PreDefinition/Basic.lean

@@ -12,6 +12,7 @@ import Lean.Util.NumApps
 import Lean.PrettyPrinter
 import Lean.Meta.AbstractNestedProofs
 import Lean.Meta.ForEachExpr
+import Lean.Meta.Eqns
 import Lean.Elab.RecAppSyntax
 import Lean.Elab.DefView
 import Lean.Elab.PreDefinition.TerminationHint
@@ -153,6 +154,7 @@ private def addNonRecAux (preDef : PreDefinition) (compile : Bool) (all : List N
     if compile && shouldGenCodeFor preDef then
       discard <| compileDecl decl
     if applyAttrAfterCompilation then
+      generateEagerEqns preDef.declName
       applyAttributesOf #[preDef] AttributeApplicationTime.afterCompilation
 
 def addAndCompileNonRec (preDef : PreDefinition) (all : List Name := [preDef.declName]) : TermElabM Unit := do

src/Lean/Elab/PreDefinition/Eqns.lean

@@ -60,7 +60,8 @@ def simpIf? (mvarId : MVarId) : MetaM (Option MVarId) := do
   let mvarId' ← simpIfTarget mvarId (useDecide := true)
   if mvarId != mvarId' then return some mvarId' else return none
 
-private def findMatchToSplit? (env : Environment) (e : Expr) (declNames : Array Name) (exceptionSet : ExprSet) : Option Expr :=
+private def findMatchToSplit? (deepRecursiveSplit : Bool) (env : Environment) (e : Expr)
+    (declNames : Array Name) (exceptionSet : ExprSet) : Option Expr :=
   e.findExt? fun e => Id.run do
     if e.hasLooseBVars || exceptionSet.contains e then
       return Expr.FindStep.visit
@@ -75,7 +76,14 @@ private def findMatchToSplit? (env : Environment) (e : Expr) (declNames : Array
           break
       unless hasFVarDiscr do
         return Expr.FindStep.visit
-      -- At least one alternative must contain a `declNames` application with loose bound variables.
+      -- For non-recursive functions (`declNames` empty), we split here
+      if declNames.isEmpty then
+          return Expr.FindStep.found
+      -- For recursive functions, the “new” behavior is to likewise split
+      if deepRecursiveSplit then
+          return Expr.FindStep.found
+      -- Else, the “old” behavior is split only when at least one alternative contains a `declNames`
+      -- application with loose bound variables.
       for i in [info.getFirstAltPos : info.getFirstAltPos + info.numAlts] do
         let alt := args[i]!
         if Option.isSome <| alt.find? fun e => declNames.any e.isAppOf && e.hasLooseBVars then
@@ -92,7 +100,8 @@ private def findMatchToSplit? (env : Environment) (e : Expr) (declNames : Array
 partial def splitMatch? (mvarId : MVarId) (declNames : Array Name) : MetaM (Option (List MVarId)) := commitWhenSome? do
   let target ← mvarId.getType'
   let rec go (badCases : ExprSet) : MetaM (Option (List MVarId)) := do
-    if let some e := findMatchToSplit? (← getEnv) target declNames badCases then
+    if let some e := findMatchToSplit? (eqns.deepRecursiveSplit.get (← getOptions)) (← getEnv)
+                                       target declNames badCases then
       try
         Meta.Split.splitMatch mvarId e
       catch _ =>
@@ -102,9 +111,6 @@ partial def splitMatch? (mvarId : MVarId) (declNames : Array Name) : MetaM (Opti
       return none
   go {}
 
-structure Context where
-  declNames : Array Name
-
 private def lhsDependsOn (type : Expr) (fvarId : FVarId) : MetaM Bool :=
   forallTelescope type fun _ type => do
     if let some (_, lhs, _) ← matchEq? type then
@@ -228,16 +234,12 @@ private def shouldUseSimpMatch (e : Expr) : MetaM Bool := do
             throwThe Unit ()
   return (← (find e).run) matches .error _
 
-partial def mkEqnTypes (tryRefl : Bool) (declNames : Array Name) (mvarId : MVarId) : MetaM (Array Expr) := do
-  let (_, eqnTypes) ← go mvarId |>.run { declNames } |>.run #[]
+partial def mkEqnTypes (declNames : Array Name) (mvarId : MVarId) : MetaM (Array Expr) := do
+  let (_, eqnTypes) ← go mvarId |>.run #[]
   return eqnTypes
 where
-  go (mvarId : MVarId) : ReaderT Context (StateRefT (Array Expr) MetaM) Unit := do
+  go (mvarId : MVarId) : StateRefT (Array Expr) MetaM Unit := do
     trace[Elab.definition.eqns] "mkEqnTypes step\n{MessageData.ofGoal mvarId}"
-    if tryRefl then
-      if (← tryURefl mvarId) then
-        saveEqn mvarId
-        return ()
 
     if let some mvarId ← expandRHS? mvarId then
       return (← go mvarId)

src/Lean/Elab/PreDefinition/Nonrec/Eqns.lean

@@ -0,0 +1,108 @@
+/-
+Copyright (c) 2022 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura, Joachim Breitner
+-/
+prelude
+import Lean.Meta.Tactic.Rewrite
+import Lean.Meta.Tactic.Split
+import Lean.Elab.PreDefinition.Basic
+import Lean.Elab.PreDefinition.Eqns
+import Lean.Meta.ArgsPacker.Basic
+import Init.Data.Array.Basic
+
+namespace Lean.Elab.Nonrec
+open Meta
+open Eqns
+
+/--
+Simple, coarse-grained equation theorem for nonrecursive definitions.
+-/
+private def mkSimpleEqThm (declName : Name) (suffix := Name.mkSimple unfoldThmSuffix) : MetaM (Option Name) := do
+  if let some (.defnInfo info) := (← getEnv).find? declName then
+    lambdaTelescope (cleanupAnnotations := true) info.value fun xs body => do
+      let lhs := mkAppN (mkConst info.name <| info.levelParams.map mkLevelParam) xs
+      let type  ← mkForallFVars xs (← mkEq lhs body)
+      let value ← mkLambdaFVars xs (← mkEqRefl lhs)
+      let name := declName ++ suffix
+      addDecl <| Declaration.thmDecl {
+        name, type, value
+        levelParams := info.levelParams
+      }
+      return some name
+  else
+    return none
+
+private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
+  trace[Elab.definition.eqns] "proving: {type}"
+  withNewMCtxDepth do
+    let main ← mkFreshExprSyntheticOpaqueMVar type
+    let (_, mvarId) ← main.mvarId!.intros
+    let rec go (mvarId : MVarId) : MetaM Unit := do
+      trace[Elab.definition.eqns] "step\n{MessageData.ofGoal mvarId}"
+      if ← withAtLeastTransparency .all (tryURefl mvarId) then
+        return ()
+      else if (← tryContradiction mvarId) then
+        return ()
+      else if let some mvarId ← simpMatch? mvarId then
+        go mvarId
+      else if let some mvarId ← simpIf? mvarId then
+        go mvarId
+      else if let some mvarId ← whnfReducibleLHS? mvarId then
+        go mvarId
+      else match (← simpTargetStar mvarId { config.dsimp := false } (simprocs := {})).1 with
+        | TacticResultCNM.closed => return ()
+        | TacticResultCNM.modified mvarId => go mvarId
+        | TacticResultCNM.noChange =>
+          if let some mvarIds ← casesOnStuckLHS? mvarId then
+            mvarIds.forM go
+          else if let some mvarIds ← splitTarget? mvarId then
+            mvarIds.forM go
+          else
+            throwError "failed to generate equational theorem for '{declName}'\n{MessageData.ofGoal mvarId}"
+
+    -- Try rfl before deltaLHS to avoid `id` checkpoints in the proof, which would make
+    -- the lemma ineligible for dsimp
+    unless ← withAtLeastTransparency .all (tryURefl mvarId) do
+      go (← deltaLHS mvarId)
+    instantiateMVars main
+
+def mkEqns (declName : Name) (info : DefinitionVal) : MetaM (Array Name) :=
+  withOptions (tactic.hygienic.set · false) do
+  let baseName := declName
+  let eqnTypes ← withNewMCtxDepth <| lambdaTelescope (cleanupAnnotations := true) info.value fun xs body => do
+    let us := info.levelParams.map mkLevelParam
+    let target ← mkEq (mkAppN (Lean.mkConst declName us) xs) body
+    let goal ← mkFreshExprSyntheticOpaqueMVar target
+    withReducible do
+      mkEqnTypes #[] goal.mvarId!
+  let mut thmNames := #[]
+  for i in [: eqnTypes.size] do
+    let type := eqnTypes[i]!
+    trace[Elab.definition.eqns] "eqnType[{i}]: {eqnTypes[i]!}"
+    let name := (Name.str baseName eqnThmSuffixBase).appendIndexAfter (i+1)
+    thmNames := thmNames.push name
+    let value ← mkProof declName type
+    let (type, value) ← removeUnusedEqnHypotheses type value
+    addDecl <| Declaration.thmDecl {
+      name, type, value
+      levelParams := info.levelParams
+    }
+  return thmNames
+
+def getEqnsFor? (declName : Name) : MetaM (Option (Array Name)) := do
+  if (← isRecursiveDefinition declName) then
+    return none
+  if let some (.defnInfo info) := (← getEnv).find? declName then
+    if eqns.nonrecursive.get (← getOptions) then
+      mkEqns declName info
+    else
+      let o ← mkSimpleEqThm declName
+      return o.map (#[·])
+  else
+    return none
+
+builtin_initialize
+  registerGetEqnsFn getEqnsFor?
+
+end Lean.Elab.Nonrec

src/Lean/Elab/PreDefinition/Structural/Eqns.lean

@@ -64,7 +64,7 @@ def mkEqns (info : EqnInfo) : MetaM (Array Name) :=
     let us := info.levelParams.map mkLevelParam
     let target ← mkEq (mkAppN (Lean.mkConst info.declName us) xs) body
     let goal ← mkFreshExprSyntheticOpaqueMVar target
-    mkEqnTypes (tryRefl := true) info.declNames goal.mvarId!
+    mkEqnTypes info.declNames goal.mvarId!
   let baseName := info.declName
   let mut thmNames := #[]
   for i in [: eqnTypes.size] do

src/Lean/Elab/PreDefinition/Structural/Main.lean

@@ -65,7 +65,7 @@ where
   go (fvars : Array Expr) (vals : Array Expr) : M α := do
     if !(vals.all fun val => val.isLambda) then
       k fvars vals
-    else if !(← vals.allM fun val => return val.bindingName! == vals[0]!.bindingName! && val.binderInfo == vals[0]!.binderInfo && (← isDefEq val.bindingDomain! vals[0]!.bindingDomain!)) then
+    else if !(← vals.allM fun val=> isDefEq val.bindingDomain! vals[0]!.bindingDomain!) then
       k fvars vals
     else
       withLocalDecl vals[0]!.bindingName! vals[0]!.binderInfo vals[0]!.bindingDomain! fun x =>
@@ -193,6 +193,7 @@ def structuralRecursion (preDefs : Array PreDefinition) (termArg?s : Array (Opti
         registerEqnsInfo preDef (preDefs.map (·.declName)) recArgPos numFixed
     addSmartUnfoldingDef preDef recArgPos
     markAsRecursive preDef.declName
+    generateEagerEqns preDef.declName
   applyAttributesOf preDefsNonRec AttributeApplicationTime.afterCompilation
 
 

src/Lean/Elab/PreDefinition/WF/Basic.lean

@@ -0,0 +1,25 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joachim Breitner
+-/
+
+prelude
+import Lean.Elab.Tactic.Basic
+
+namespace Lean.Elab.WF
+
+register_builtin_option debug.rawDecreasingByGoal : Bool := {
+  defValue := false
+  descr    := "Shows the raw `decreasing_by` goal including internal implementation detail \
+               intead of cleaning it up with the `clean_wf` tactic. Can be enabled for debugging \
+               purposes. Please report an issue if you have to use this option for other reasons."
+}
+
+open Lean Elab Tactic
+
+def applyCleanWfTactic : TacticM Unit := do
+  unless debug.rawDecreasingByGoal.get (← getOptions) do
+    Tactic.evalTactic (← `(tactic| all_goals clean_wf))
+
+end Lean.Elab.WF

src/Lean/Elab/PreDefinition/WF/Eqns.lean

@@ -81,7 +81,7 @@ def mkEqns (declName : Name) (info : EqnInfo) : MetaM (Array Name) :=
     let target ← mkEq (mkAppN (Lean.mkConst declName us) xs) body
     let goal ← mkFreshExprSyntheticOpaqueMVar target
     withReducible do
-      mkEqnTypes (tryRefl := false) info.declNames goal.mvarId!
+      mkEqnTypes info.declNames goal.mvarId!
   let mut thmNames := #[]
   for i in [: eqnTypes.size] do
     let type := eqnTypes[i]!

src/Lean/Elab/PreDefinition/WF/Fix.lean

@@ -14,6 +14,7 @@ import Lean.Elab.RecAppSyntax
 import Lean.Elab.PreDefinition.Basic
 import Lean.Elab.PreDefinition.Structural.Basic
 import Lean.Elab.PreDefinition.Structural.BRecOn
+import Lean.Elab.PreDefinition.WF.Basic
 import Lean.Data.Array
 
 namespace Lean.Elab.WF
@@ -142,6 +143,7 @@ private partial def processPSigmaCasesOn (x F val : Expr) (k : (F : Expr) → (v
 
 private def applyDefaultDecrTactic (mvarId : MVarId) : TermElabM Unit := do
   let remainingGoals ← Tactic.run mvarId do
+    applyCleanWfTactic
     Tactic.evalTactic (← `(tactic| decreasing_tactic))
   unless remainingGoals.isEmpty do
     Term.reportUnsolvedGoals remainingGoals
@@ -202,6 +204,7 @@ def solveDecreasingGoals (argsPacker : ArgsPacker) (decrTactics : Array (Option
         goals.forM fun goal => pushInfoTree (.hole goal)
         let remainingGoals ← Tactic.run goals[0]! do
           Tactic.setGoals goals.toList
+          applyCleanWfTactic
           Tactic.withTacticInfoContext decrTactic.ref do
             Tactic.evalTactic decrTactic.tactic
         unless remainingGoals.isEmpty do

src/Lean/Elab/PreDefinition/WF/GuessLex.lean

@@ -15,6 +15,7 @@ import Lean.Elab.RecAppSyntax
 import Lean.Elab.PreDefinition.Basic
 import Lean.Elab.PreDefinition.Structural.Basic
 import Lean.Elab.PreDefinition.TerminationArgument
+import Lean.Elab.PreDefinition.WF.Basic
 import Lean.Data.Array
 
 
@@ -445,6 +446,7 @@ def evalRecCall (decrTactic? : Option DecreasingBy) (callerMeasures calleeMeasur
         else do
           Lean.Elab.Term.TermElabM.run' do Term.withoutErrToSorry do
             let remainingGoals ← Tactic.run mvarId do Tactic.withoutRecover do
+              applyCleanWfTactic
               let tacticStx : Syntax ←
                 match decrTactic? with
                 | none => pure (← `(tactic| decreasing_tactic)).raw

src/Lean/Elab/PreDefinition/WF/Main.lean

@@ -36,7 +36,7 @@ where
   go (fvars : Array Expr) (vals : Array Expr) : TermElabM α := do
     if !(vals.all fun val => val.isLambda) then
       k fvars vals
-    else if !(← vals.allM fun val => return val.bindingName! == vals[0]!.bindingName! && val.binderInfo == vals[0]!.binderInfo && (← isDefEq val.bindingDomain! vals[0]!.bindingDomain!)) then
+    else if !(← vals.allM fun val => isDefEq val.bindingDomain! vals[0]!.bindingDomain!) then
       k fvars vals
     else
       withLocalDecl vals[0]!.bindingName! vals[0]!.binderInfo vals[0]!.bindingDomain! fun x =>
@@ -145,6 +145,7 @@ def wfRecursion (preDefs : Array PreDefinition) (termArg?s : Array (Option Termi
   registerEqnsInfo preDefs preDefNonRec.declName fixedPrefixSize argsPacker
   for preDef in preDefs do
     markAsRecursive preDef.declName
+    generateEagerEqns preDef.declName
     applyAttributesOf #[preDef] AttributeApplicationTime.afterCompilation
     -- Unless the user asks for something else, mark the definition as irreducible
     unless preDef.modifiers.attrs.any fun a =>

src/Lean/Elab/Print.lean

@@ -134,7 +134,7 @@ private def printAxiomsOf (constName : Name) : CommandElabM Unit := do
   | _ => throwUnsupportedSyntax
 
 private def printEqnsOf (constName : Name) : CommandElabM Unit := do
-  let some eqns ← liftTermElabM <| Meta.getEqnsFor? constName (nonRec := true) |
+  let some eqns ← liftTermElabM <| Meta.getEqnsFor? constName |
     logInfo m!"'{constName}' does not have equations"
   let mut m := m!"equations:"
   for eq in eqns do

src/Lean/Elab/StructInst.lean

@@ -9,6 +9,7 @@ import Lean.Parser.Term
 import Lean.Meta.Structure
 import Lean.Elab.App
 import Lean.Elab.Binders
+import Lean.PrettyPrinter
 
 namespace Lean.Elab.Term.StructInst
 
@@ -433,7 +434,7 @@ private def expandParentFields (s : Struct) : TermElabM Struct := do
     | { lhs := .fieldName ref fieldName :: _,    .. } =>
       addCompletionInfo <| CompletionInfo.fieldId ref fieldName (← getLCtx) s.structName
       match findField? env s.structName fieldName with
-      | none => throwErrorAt ref "'{fieldName}' is not a field of structure '{s.structName}'"
+      | none => throwErrorAt ref "'{fieldName}' is not a field of structure '{MessageData.ofConstName s.structName}'"
       | some baseStructName =>
         if baseStructName == s.structName then pure field
         else match getPathToBaseStructure? env baseStructName s.structName with

src/Lean/Elab/Tactic.lean

@@ -41,3 +41,4 @@ import Lean.Elab.Tactic.ShowTerm
 import Lean.Elab.Tactic.Rfl
 import Lean.Elab.Tactic.Rewrites
 import Lean.Elab.Tactic.DiscrTreeKey
+import Lean.Elab.Tactic.BVDecide

src/Lean/Elab/Tactic/BVDecide.lean

@@ -0,0 +1,14 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Henrik Böving
+-/
+prelude
+import Lean.Elab.Tactic.BVDecide.LRAT
+import Lean.Elab.Tactic.BVDecide.External
+
+/-!
+This directory implements the `bv_decide` tactic as a verified bitblaster with subterm sharing.
+It makes use of proof by reflection and `ofReduceBool`, thus adding the Lean compiler to the trusted
+code base.
+-/

src/Lean/Elab/Tactic/BVDecide/External.lean

@@ -0,0 +1,163 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Henrik Böving
+-/
+prelude
+import Lean.Elab.Tactic.BVDecide.LRAT.Parser
+import Lean.CoreM
+import Std.Internal.Parsec
+
+/-!
+This module implements the logic to call CaDiCal (or CLI interface compatible SAT solvers) and
+extract an LRAT UNSAT proof or a model from its output.
+-/
+
+namespace Lean.Elab.Tactic.BVDecide
+
+namespace External
+
+/--
+The result of calling a SAT solver.
+-/
+inductive SolverResult where
+  /--
+  The solver returned SAT with some literal assignment.
+  -/
+  | sat (assignment : Array (Bool × Nat))
+  /--
+  The solver returned UNSAT.
+  -/
+  | unsat
+
+namespace ModelParser
+
+open Std.Internal.Parsec
+open Std.Internal.Parsec.ByteArray
+
+def parsePartialAssignment : Parser (Bool × (Array (Bool × Nat))) := do
+  skipByteChar 'v'
+  let idents ← many (attempt wsLit)
+  let idents := idents.map (fun i => if i > 0 then (true, i.natAbs) else (false, i.natAbs))
+  tryCatch
+    (skipString " 0")
+    (csuccess := fun _ => pure (true, idents))
+    (cerror := fun _ => do
+      skipByteChar '\n'
+      return (false, idents)
+    )
+where
+  @[inline]
+  wsLit : Parser Int := do
+    skipByteChar ' '
+    LRAT.Parser.Text.parseLit
+
+partial def parseLines : Parser (Array (Bool × Nat)) :=
+  go #[]
+where
+  go (acc : Array (Bool × Nat)) : Parser (Array (Bool × Nat)) := do
+    let (terminal?, additionalAssignment) ← parsePartialAssignment
+    let acc := acc ++ additionalAssignment
+    if terminal? then
+      return acc
+    else
+      go acc
+
+@[inline]
+def parseHeader : Parser Unit := do
+  skipString "s SATISFIABLE\n"
+
+/--
+Parse the witness format of a SAT solver. The rough grammar for this is:
+line = "v" (" " lit)*\n
+terminal_line = "v" (" " lit)* (" " 0)\n
+witness = "s SATISFIABLE\n" line+ terminal_line
+-/
+def parse : Parser (Array (Bool × Nat)) := do
+  parseHeader
+  parseLines
+
+end ModelParser
+
+open Lean (CoreM)
+
+/--
+Run a process with `args` until it terminates or the cancellation token in `CoreM` tells us to abort.
+-/
+partial def runInterruptible (args : IO.Process.SpawnArgs) : CoreM IO.Process.Output := do
+  let child ← IO.Process.spawn { args with stdout := .piped, stderr := .piped, stdin := .null }
+  let stdout ← IO.asTask child.stdout.readToEnd Task.Priority.dedicated
+  let stderr ← IO.asTask child.stderr.readToEnd Task.Priority.dedicated
+  if let some tk := (← read).cancelTk? then
+    go child stdout stderr tk
+  else
+    let stdout ← IO.ofExcept stdout.get
+    let stderr ← IO.ofExcept stderr.get
+    let exitCode ← child.wait
+    return { exitCode := exitCode, stdout := stdout, stderr := stderr }
+where
+  go {cfg} (child : IO.Process.Child cfg) (stdout stderr : Task (Except IO.Error String))
+      (tk : IO.CancelToken) : CoreM IO.Process.Output := do
+    withInterruptCheck tk child.kill do
+      match ← child.tryWait with
+      | some exitCode =>
+        let stdout ← IO.ofExcept stdout.get
+        let stderr ← IO.ofExcept stderr.get
+        return { exitCode := exitCode, stdout := stdout, stderr := stderr }
+      | none =>
+        IO.sleep 50
+        go child stdout stderr tk
+
+  withInterruptCheck {α : Type} (tk : IO.CancelToken) (interrupted : CoreM Unit) (x : CoreM α) :
+      CoreM α := do
+    if ← tk.isSet then
+      interrupted
+      throw <| .internal Core.interruptExceptionId
+    else
+      x
+
+/--
+Call the SAT solver in `solverPath` with `problemPath` as CNF input and ask it to output an LRAT
+UNSAT proof (binary or non-binary depending on `binaryProofs`) into `proofOutput`. To avoid runaway
+solvers the solver is run with `timeout` in seconds as a maximum time limit to solve the problem.
+
+Note: This function currently assume that the solver has the same CLI as CaDiCal.
+-/
+def satQuery (solverPath : String) (problemPath : System.FilePath) (proofOutput : System.FilePath)
+    (timeout : Nat := 10) (binaryProofs : Bool := true) :
+    CoreM SolverResult := do
+  let cmd := solverPath
+  let args := #[
+    problemPath.toString,
+    proofOutput.toString,
+    "-t",
+    s!"{timeout}",
+    "--lrat",
+    s!"--binary={binaryProofs}",
+    "--quiet",
+    "--unsat" -- This sets the magic parameters of cadical to optimize for UNSAT search.
+  ]
+
+  let out ← runInterruptible { cmd, args, stdin := .piped, stdout := .piped, stderr := .null }
+  if out.exitCode == 255 then
+    throwError s!"Failed to execute external prover:\n{out.stderr}"
+  else
+    let stdout := out.stdout
+    if stdout.startsWith "s UNSATISFIABLE" then
+      return .unsat
+    else if stdout.startsWith "s SATISFIABLE" then
+      match ModelParser.parse.run stdout.toUTF8 with
+      | .ok assignment =>
+        return .sat assignment
+      | .error err =>
+        throwError s!"Error {err} while parsing:\n{stdout}"
+    else if stdout.startsWith "c UNKNOWN" then
+      let mut err := "The SAT solver timed out while solving the problem."
+      err := err ++ "\nConsider increasing the timeout with `set_option sat.timeout <sec>`"
+      throwError err
+    else
+      throwError s!"The external prover produced unexpected output:\n{stdout}"
+
+end External
+
+end Lean.Elab.Tactic.BVDecide