chore: begin dev cycle for v4.24.0

This PR marks `List.drop_length` and `List.take_length` with `[grind
=]`.

.github/workflows/build-template.yml

@@ -205,7 +205,7 @@ jobs:
         id: test
         run: |
           ulimit -c unlimited  # coredumps
-          time ctest --preset ${{ matrix.CMAKE_PRESET || 'release' }} --test-dir build/$TARGET_STAGE -j$NPROC --output-junit test-results.xml ${{ matrix.CTARGET_OPTIONS }}
+          time ctest --preset ${{ matrix.CMAKE_PRESET || 'release' }} --test-dir build/$TARGET_STAGE -j$NPROC --output-junit test-results.xml
         if: (matrix.wasm || !matrix.cross) && (inputs.check-level >= 1 || matrix.test)
       - name: Test Summary
         uses: test-summary/action@v2
@@ -235,9 +235,13 @@ jobs:
         if: matrix.test-speedcenter
       - name: Check rebootstrap
         run: |
+          set -e
           # clean rebuild in case of Makefile changes/Lake does not detect uncommited stage 0
           # changes yet
-          make -C build update-stage0 && make -C build/stage1 clean-stdlib && make -C build -j$NPROC
+          make -C build update-stage0
+          make -C build/stage1 clean-stdlib
+          time make -C build -j$NPROC
+          time ctest --preset ${{ matrix.CMAKE_PRESET || 'release' }} --test-dir build/stage1 -j$NPROC
         if: matrix.check-rebootstrap
       - name: CCache stats
         if: always()

flake.nix

@@ -18,14 +18,14 @@
       # An old nixpkgs for creating releases with an old glibc
       pkgsDist-old-aarch = import inputs.nixpkgs-old { localSystem.config = "aarch64-unknown-linux-gnu"; };
 
-      lean-packages = pkgs.callPackage (./nix/packages.nix) { src = ./.; };
+      llvmPackages = pkgs.llvmPackages_15;
 
       devShellWithDist = pkgsDist: pkgs.mkShell.override {
-          stdenv = pkgs.overrideCC pkgs.stdenv lean-packages.llvmPackages.clang;
+          stdenv = pkgs.overrideCC pkgs.stdenv llvmPackages.clang;
         } ({
           buildInputs = with pkgs; [
             cmake gmp libuv ccache pkg-config
-            lean-packages.llvmPackages.llvm  # llvm-symbolizer for asan/lsan
+            llvmPackages.llvm  # llvm-symbolizer for asan/lsan
             gdb
             tree  # for CI
           ];
@@ -60,12 +60,6 @@
           GDB = pkgsDist.gdb;
         });
     in {
-      packages.${system} = {
-        # to be removed when Nix CI is not needed anymore
-        inherit (lean-packages) cacheRoots test update-stage0-commit ciShell;
-        deprecated = lean-packages;
-      };
-
       devShells.${system} = {
         # The default development shell for working on lean itself
         default = devShellWithDist pkgs;

nix/bareStdenv/setup

@@ -1,7 +0,0 @@
-set -eo pipefail
-
-for pkg in $buildInputs; do
-  export PATH=$PATH:$pkg/bin
-done
-
-: ${outputs:=out}

nix/bootstrap.nix

@@ -1,208 +0,0 @@
-{ src, debug ? false, stage0debug ? false, extraCMakeFlags ? [],
-  stdenv, lib, cmake, pkg-config, 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 {
-  inherit stdenv;
-  sourceByRegex = p: rs: lib.sourceByRegex p (map (r: "(/src/)?${r}") rs);
-  buildCMake = args: stdenv.mkDerivation ({
-    nativeBuildInputs = [ cmake pkg-config ];
-    buildInputs = [ gmp libuv llvmPackages.llvm ];
-    # https://github.com/NixOS/nixpkgs/issues/60919
-    hardeningDisable = [ "all" ];
-    dontStrip = (args.debug or debug);
-
-    postConfigure = ''
-      patchShebangs .
-    '';
-  } // args // {
-    src = args.realSrc or (sourceByRegex args.src [ "[a-z].*" "CMakeLists\.txt" ]);
-    cmakeFlags = ["-DSMALL_ALLOCATOR=ON" "-DUSE_MIMALLOC=OFF"] ++ (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
-    '';
-  });
-  lean-bin-tools-unwrapped = buildCMake {
-    name = "lean-bin-tools";
-    outputs = [ "out" "leanc_src" ];
-    realSrc = sourceByRegex (src + "/src") [ "CMakeLists\.txt" "[a-z].*" ".*\.in" "Leanc\.lean" ];
-    dontBuild = true;
-    installPhase = ''
-      mkdir $out $leanc_src
-      mv bin/ include/ share/ $out/
-      mv leanc.sh $out/bin/leanc
-      mv leanc/Leanc.lean $leanc_src/
-      substituteInPlace $out/bin/leanc --replace '$root' "$out" --replace " sed " " ${gnused}/bin/sed "
-      substituteInPlace $out/bin/leanmake --replace "make" "${gnumake}/bin/make"
-      substituteInPlace $out/share/lean/lean.mk --replace "/usr/bin/env bash" "${bash}/bin/bash"
-    '';
-  };
-  leancpp = buildCMake {
-    name = "leancpp";
-    src = src + "/src";
-    buildFlags = [ "leancpp" "leanrt" "leanrt_initial-exec" "leanshell" "leanmain" ];
-    installPhase = ''
-      mkdir -p $out
-      mv lib/ $out/
-      mv runtime/libleanrt_initial-exec.a $out/lib
-    '';
-  };
-  stage0 = args.stage0 or (buildCMake {
-    name = "lean-stage0";
-    realSrc = src + "/stage0/src";
-    debug = stage0debug;
-    cmakeFlags = [ "-DSTAGE=0" ];
-    extraCMakeFlags = [];
-    preConfigure = ''
-      ln -s ${src + "/stage0/stdlib"} ../stdlib
-    '';
-    installPhase = ''
-      mkdir -p $out/bin $out/lib/lean
-      mv bin/lean $out/bin/
-      mv lib/lean/*.{so,dylib} $out/lib/lean
-    '';
-    meta.mainProgram = "lean";
-  });
-  stage = { stage, prevStage, self }:
-    let
-      desc = "stage${toString stage}";
-      build = args: buildLeanPackage.override {
-        lean = prevStage;
-        leanc = lean-bin-tools-unwrapped;
-        # use same stage for retrieving dependencies
-        lean-leanDeps = stage0;
-        lean-final = self;
-      } ({
-        src = src + "/src";
-        roots = [ { mod = args.name; glob = "andSubmodules"; } ];
-        fullSrc = src;
-        srcPath = "$PWD/src:$PWD/src/lake";
-        inherit debug;
-        leanFlags = [ "-DwarningAsError=true" ];
-      } // args);
-      Init' = build { name = "Init"; deps = []; };
-      Std' = build { name = "Std"; deps = [ Init' ]; };
-      Lean' = build { name = "Lean"; deps = [ Std' ]; };
-      attachSharedLib = sharedLib: pkg: pkg // {
-        inherit sharedLib;
-        mods = mapAttrs (_: m: m // { inherit sharedLib; propagatedLoadDynlibs = []; }) pkg.mods;
-      };
-    in (all: all // all.lean) rec {
-      inherit (Lean) emacs-dev emacs-package vscode-dev vscode-package;
-      Init = attachSharedLib leanshared Init';
-      Std = attachSharedLib leanshared Std' // { allExternalDeps = [ Init ]; };
-      Lean = attachSharedLib leanshared Lean' // { allExternalDeps = [ Std ]; };
-      Lake = build {
-        name = "Lake";
-        sharedLibName = "Lake_shared";
-        src = src + "/src/lake";
-        deps = [ Init Lean ];
-      };
-      Lake-Main = build {
-        name = "LakeMain";
-        roots = [{ glob = "one"; mod = "LakeMain"; }];
-        executableName = "lake";
-        deps = [ Lake ];
-        linkFlags = lib.optional stdenv.isLinux "-rdynamic";
-        src = src + "/src/lake";
-      };
-      stdlib = [ Init Std Lean Lake ];
-      modDepsFiles = symlinkJoin { name = "modDepsFiles"; paths = map (l: l.modDepsFile) (stdlib ++ [ Leanc ]); };
-      depRoots = symlinkJoin { name = "depRoots"; paths = map (l: l.depRoots) stdlib; };
-      iTree = symlinkJoin { name = "ileans"; paths = map (l: l.iTree) stdlib; };
-      Leanc = build { name = "Leanc"; src = lean-bin-tools-unwrapped.leanc_src; deps = stdlib; roots = [ "Leanc" ]; };
-      stdlibLinkFlags = "${lib.concatMapStringsSep " " (l: "-L${l.staticLib}") stdlib} -L${leancpp}/lib/lean";
-      libInit_shared = runCommand "libInit_shared" { buildInputs = [ stdenv.cc ]; libName = "libInit_shared${stdenv.hostPlatform.extensions.sharedLibrary}"; } ''
-        mkdir $out
-        touch empty.c
-        ${stdenv.cc}/bin/cc -shared -o $out/$libName empty.c
-      '';
-      leanshared_1 = runCommand "leanshared_1" { buildInputs = [ stdenv.cc ]; libName = "leanshared_1${stdenv.hostPlatform.extensions.sharedLibrary}"; } ''
-        mkdir $out
-        touch empty.c
-        ${stdenv.cc}/bin/cc -shared -o $out/$libName empty.c
-      '';
-      leanshared = runCommand "leanshared" { buildInputs = [ stdenv.cc ]; libName = "libleanshared${stdenv.hostPlatform.extensions.sharedLibrary}"; } ''
-        mkdir $out
-        LEAN_CC=${stdenv.cc}/bin/cc ${lean-bin-tools-unwrapped}/bin/leanc -shared ${lib.optionalString stdenv.isLinux "-Wl,-Bsymbolic"} \
-          -Wl,--whole-archive ${leancpp}/lib/temp/libleanshell.a -lInit -lStd -lLean -lleancpp ${leancpp}/lib/libleanrt_initial-exec.a -Wl,--no-whole-archive -lstdc++ \
-          -lm ${stdlibLinkFlags} \
-          $(${llvmPackages.libllvm.dev}/bin/llvm-config --ldflags --libs) \
-          -o $out/$libName
-      '';
-      mods = foldl' (mods: pkg: mods // pkg.mods) {} stdlib;
-      print-paths = Lean.makePrintPathsFor [] mods;
-      leanc = writeShellScriptBin "leanc" ''
-        LEAN_CC=${stdenv.cc}/bin/cc ${Leanc.executable}/bin/leanc -I${lean-bin-tools-unwrapped}/include ${stdlibLinkFlags} -L${libInit_shared} -L${leanshared_1} -L${leanshared} -L${Lake.sharedLib} "$@"
-      '';
-      lean = runCommand "lean" { buildInputs = lib.optional stdenv.isDarwin darwin.cctools; } ''
-        mkdir -p $out/bin
-        ${leanc}/bin/leanc ${leancpp}/lib/temp/libleanmain.a ${libInit_shared}/* ${leanshared_1}/* ${leanshared}/* -o $out/bin/lean
-      '';
-      # derivation following the directory layout of the "basic" setup, mostly useful for running tests
-      lean-all = stdenv.mkDerivation {
-        name = "lean-${desc}";
-        buildCommand = ''
-          mkdir -p $out/bin $out/lib/lean
-          ln -sf ${leancpp}/lib/lean/* ${lib.concatMapStringsSep " " (l: "${l.modRoot}/* ${l.staticLib}/*") (lib.reverseList stdlib)} ${libInit_shared}/* ${leanshared_1}/* ${leanshared}/* ${Lake.sharedLib}/* $out/lib/lean/
-          # put everything in a single final derivation so `IO.appDir` references work
-          cp ${lean}/bin/lean ${leanc}/bin/leanc ${Lake-Main.executable}/bin/lake $out/bin
-          # NOTE: `lndir` will not override existing `bin/leanc`
-          ${lndir}/bin/lndir -silent ${lean-bin-tools-unwrapped} $out
-        '';
-        meta.mainProgram = "lean";
-      };
-      cacheRoots = linkFarmFromDrvs "cacheRoots" ([
-        stage0 lean leanc lean-all iTree modDepsFiles depRoots Leanc.src
-      ] ++ map (lib: lib.oTree) stdlib);
-      test = buildCMake {
-        name = "lean-test-${desc}";
-        realSrc = lib.sourceByRegex src [ "src.*" "tests.*" ];
-        buildInputs = [ gmp libuv perl git cadical ];
-        preConfigure = ''
-          cd src
-        '';
-        extraCMakeFlags = [ "-DLLVM=OFF" ];
-        postConfigure = ''
-          patchShebangs ../../tests ../lake
-          rm -r bin lib include share
-          ln -sf ${lean-all}/* .
-        '';
-        buildPhase = ''
-         ctest --output-junit test-results.xml --output-on-failure -E 'leancomptest_(doc_example|foreign)|leanlaketest_reverse-ffi|leanruntest_timeIO' -j$NIX_BUILD_CORES
-        '';
-        installPhase = ''
-          mkdir $out
-          mv test-results.xml $out
-        '';
-      };
-      update-stage0 =
-        let cTree = symlinkJoin { name = "cs"; paths = map (lib: lib.cTree) (stdlib ++ [Lake-Main]); }; in
-        writeShellScriptBin "update-stage0" ''
-          CSRCS=${cTree} CP_C_PARAMS="--dereference --no-preserve=all" ${src + "/script/lib/update-stage0"}
-        '';
-      update-stage0-commit = writeShellScriptBin "update-stage0-commit" ''
-        set -euo pipefail
-        ${update-stage0}/bin/update-stage0
-        git commit -m "chore: update stage0"
-      '';
-      link-ilean = writeShellScriptBin "link-ilean" ''
-        dest=''${1:-src}
-        rm -rf $dest/build/lib || true
-        mkdir -p $dest/build/lib
-        ln -s ${iTree}/* $dest/build/lib
-      '';
-      benchmarks =
-        let
-          entries = attrNames (readDir (src + "/tests/bench"));
-          leanFiles = map (n: elemAt n 0) (filter (n: n != null) (map (match "(.*)\.lean") entries));
-        in lib.genAttrs leanFiles (n: (buildLeanPackage {
-          name = n;
-          src = filterSource (e: _: baseNameOf e == "${n}.lean") (src + "/tests/bench");
-        }).executable);
-    };
-  stage1 = stage { stage = 1; prevStage = stage0; self = stage1; };
-  stage2 = stage { stage = 2; prevStage = stage1; self = stage2; };
-  stage3 = stage { stage = 3; prevStage = stage2; self = stage3; };
-}

nix/buildLeanPackage.nix

@@ -1,247 +0,0 @@
-{ lean, lean-leanDeps ? lean, lean-final ? lean, leanc,
-  stdenv, lib, coreutils, gnused, writeShellScriptBin, bash, substituteAll, symlinkJoin, linkFarmFromDrvs,
-  runCommand, darwin, mkShell, ... }:
-let lean-final' = lean-final; in
-lib.makeOverridable (
-{ name, src, fullSrc ? src, srcPrefix ? "", srcPath ? "$PWD/${srcPrefix}",
-  # Lean dependencies. Each entry should be an output of buildLeanPackage.
-  deps ? [ lean.Init lean.Std lean.Lean ],
-  # Static library dependencies. Each derivation `static` should contain a static library in the directory `${static}`.
-  staticLibDeps ? [],
-  # Whether to wrap static library inputs in a -Wl,--start-group [...] -Wl,--end-group to ensure dependencies are resolved.
-  groupStaticLibs ? false,
-  # Shared library dependencies included at interpretation with --load-dynlib and linked to. Each derivation `shared` should contain a
-  # shared library at the path `${shared}/${shared.libName or shared.name}` and a name to link to like `-l${shared.linkName or shared.name}`.
-  # These libs are also linked to in packages that depend on this one.
-  nativeSharedLibs ? [],
-  # Lean modules to include.
-  # A set of Lean modules names as strings (`"Foo.Bar"`) or attrsets (`{ name = "Foo.Bar"; glob = "one" | "submodules" | "andSubmodules"; }`);
-  # see Lake README for glob meanings. Dependencies of selected modules are always included.
-  roots ? [ name ],
-  # Output from `lean --deps-json` on package source files. Persist the corresponding output attribute to a file and pass it back in here to avoid IFD.
-  # Must be refreshed on any change in `import`s or set of source file names.
-  modDepsFile ? null,
-  # Whether to compile each module into a native shared library that is loaded whenever the module is imported in order to accelerate evaluation
-  precompileModules ? false,
-  # Whether to compile the package into a native shared library that is loaded whenever *any* of the package's modules is imported into another package.
-  # If `precompileModules` is also `true`, the latter only affects imports within the current package.
-  precompilePackage ? precompileModules,
-  # Lean plugin dependencies. Each derivation `plugin` should contain a plugin library at path `${plugin}/${plugin.name}`.
-  pluginDeps ? [],
-  # `overrideAttrs` for `buildMod`
-  overrideBuildModAttrs ? null,
-  debug ? false, leanFlags ? [], leancFlags ? [], linkFlags ? [], executableName ? lib.toLower name, libName ? name, sharedLibName ? libName,
-  srcTarget ? "..#stage0", srcArgs ? "(\${args[*]})", lean-final ? lean-final' }@args:
-with builtins; let
-  # "Init.Core" ~> "Init/Core"
-  modToPath = mod: replaceStrings ["."] ["/"] mod;
-  modToAbsPath = mod: "${src}/${modToPath mod}";
-  # sanitize file name before copying to store, except when already in store
-  copyToStoreSafe = base: suffix: if lib.isDerivation base then base + suffix else
-    builtins.path { name = lib.strings.sanitizeDerivationName (baseNameOf suffix); path = base + suffix; };
-  modToLean = mod: copyToStoreSafe src "/${modToPath mod}.lean";
-  bareStdenv = ./bareStdenv;
-  mkBareDerivation = args: derivation (args // {
-    name = lib.strings.sanitizeDerivationName args.name;
-    stdenv = bareStdenv;
-    inherit (stdenv) system;
-    buildInputs = (args.buildInputs or []) ++ [ coreutils ];
-    builder = stdenv.shell;
-    args = [ "-c" ''
-      source $stdenv/setup
-      set -u
-      ${args.buildCommand}
-    '' ];
-  }) // { overrideAttrs = f: mkBareDerivation (lib.fix (lib.extends f (_: args))); };
-  runBareCommand = name: args: buildCommand: mkBareDerivation (args // { inherit name buildCommand; });
-  runBareCommandLocal = name: args: buildCommand: runBareCommand name (args // {
-    preferLocalBuild = true;
-    allowSubstitutes = false;
-  }) buildCommand;
-  mkSharedLib = name: args: runBareCommand "${name}-dynlib" {
-    buildInputs = [ stdenv.cc ] ++ lib.optional stdenv.isDarwin darwin.cctools;
-    libName = "${name}${stdenv.hostPlatform.extensions.sharedLibrary}";
-  } ''
-    mkdir -p $out
-    ${leanc}/bin/leanc -shared ${args} -o $out/$libName
-  '';
-  depRoot = name: deps: mkBareDerivation {
-    name = "${name}-depRoot";
-    inherit deps;
-    depRoots = map (drv: drv.LEAN_PATH) deps;
-
-    passAsFile = [ "deps" "depRoots" ];
-    buildCommand = ''
-      mkdir -p $out
-      for i in $(cat $depRootsPath); do
-        cp -dru --no-preserve=mode $i/. $out
-      done
-      for i in $(cat $depsPath); do
-        cp -drsu --no-preserve=mode $i/. $out
-      done
-    '';
-  };
-  srcRoot = src;
-
-  # A flattened list of Lean-module dependencies (`deps`)
-  allExternalDeps = lib.unique (lib.foldr (dep: allExternalDeps: allExternalDeps ++ [ dep ] ++ dep.allExternalDeps) [] deps);
-  allNativeSharedLibs =
-    lib.unique (lib.flatten (nativeSharedLibs ++ (map (dep: dep.allNativeSharedLibs or []) allExternalDeps)));
-
-  # A flattened list of all static library dependencies: this and every dep module's explicitly provided `staticLibDeps`,
-  # plus every dep module itself: `dep.staticLib`
-  allStaticLibDeps =
-    lib.unique (lib.flatten (staticLibDeps ++ (map (dep: [dep.staticLib] ++ dep.staticLibDeps or []) allExternalDeps)));
-
-  pathOfSharedLib = dep: dep.libPath or "${dep}/${dep.libName or dep.name}";
-
-  leanPluginFlags = lib.concatStringsSep " " (map (dep: "--plugin=${pathOfSharedLib dep}") pluginDeps);
-  loadDynlibsOfDeps = deps: lib.unique (concatMap (d: d.propagatedLoadDynlibs) deps);
-
-  # submodules "Init" = ["Init.List.Basic", "Init.Core", ...]
-  submodules = mod: let
-    dir = readDir (modToAbsPath mod);
-    f = p: t:
-      if t == "directory" then
-        submodules "${mod}.${p}"
-      else
-        let m = builtins.match "(.*)\.lean" p;
-        in lib.optional (m != null) "${mod}.${head m}";
-  in concatLists (lib.mapAttrsToList f dir);
-
-  # conservatively approximate list of source files matched by glob
-  expandGlobAllApprox = g:
-    if typeOf g == "string" then
-      # we can't know the required files without parsing dependencies (which is what we want this
-      # function for), so we approximate to the entire package.
-      let root = (head (split "\\." g));
-      in lib.optional (pathExists (src + "/${modToPath root}.lean")) root ++ lib.optionals (pathExists (modToAbsPath root)) (submodules root)
-    else if g.glob == "one" then expandGlobAllApprox g.mod
-    else if g.glob == "submodules" then submodules g.mod
-    else if g.glob == "andSubmodules" then [g.mod] ++ submodules g.mod
-    else throw "unknown glob kind '${g}'";
-  # list of modules that could potentially be involved in the build
-  candidateMods = lib.unique (concatMap expandGlobAllApprox roots);
-  candidateFiles = map modToLean candidateMods;
-  modDepsFile = args.modDepsFile or mkBareDerivation {
-    name = "${name}-deps.json";
-    candidateFiles = lib.concatStringsSep " " candidateFiles;
-    passAsFile = [ "candidateFiles" ];
-    buildCommand = ''
-      mkdir $out
-      ${lean-leanDeps}/bin/lean --deps-json --stdin < $candidateFilesPath > $out/$name
-    '';
-  };
-  modDeps = fromJSON (
-    # the only possible references to store paths in the JSON should be inside errors, so no chance of missed dependencies from this
-    unsafeDiscardStringContext (readFile "${modDepsFile}/${modDepsFile.name}"));
-  # map from module name to list of imports
-  modDepsMap = listToAttrs (lib.zipListsWith lib.nameValuePair candidateMods modDeps.imports);
-  maybeOverrideAttrs = f: x: if f != null then x.overrideAttrs f else x;
-  # build module (.olean and .c) given derivations of all (immediate) dependencies
-  # TODO: make `rec` parts override-compatible?
-  buildMod = mod: deps: maybeOverrideAttrs overrideBuildModAttrs (mkBareDerivation rec {
-    name = "${mod}";
-    LEAN_PATH = depRoot mod deps;
-    LEAN_ABORT_ON_PANIC = "1";
-    relpath = modToPath mod;
-    buildInputs = [ lean ];
-    leanPath = relpath + ".lean";
-    # should be either single .lean file or directory directly containing .lean file plus dependencies
-    src = copyToStoreSafe srcRoot ("/" + leanPath);
-    outputs = [ "out" "ilean" "c" ];
-    oleanPath = relpath + ".olean";
-    ileanPath = relpath + ".ilean";
-    cPath = relpath + ".c";
-    inherit leanFlags leanPluginFlags;
-    leanLoadDynlibFlags = map (p: "--load-dynlib=${pathOfSharedLib p}") (loadDynlibsOfDeps deps);
-    buildCommand = ''
-      dir=$(dirname $relpath)
-      mkdir -p $dir $out/$dir $ilean/$dir $c/$dir
-      if [ -d $src ]; then cp -r $src/. .; else cp $src $leanPath; fi
-      lean -o $out/$oleanPath -i $out/$ileanPath -c $c/$cPath $leanPath $leanFlags $leanPluginFlags $leanLoadDynlibFlags
-    '';
-  }) // {
-    inherit deps;
-    propagatedLoadDynlibs = loadDynlibsOfDeps deps;
-  };
-  compileMod = mod: drv: mkBareDerivation {
-    name = "${mod}-cc";
-    buildInputs = [ leanc stdenv.cc ];
-    hardeningDisable = [ "all" ];
-    oPath = drv.relpath + ".o";
-    inherit leancFlags;
-    buildCommand = ''
-      mkdir -p $out/$(dirname ${drv.relpath})
-      # make local "copy" so `drv`'s Nix store path doesn't end up in ccache's hash
-      ln -s ${drv.c}/${drv.cPath} src.c
-      # on the other hand, a debug build is pretty fast anyway, so preserve the path for gdb
-      leanc -c -o $out/$oPath $leancFlags -fPIC ${if debug then "${drv.c}/${drv.cPath} -g" else "src.c -O3 -DNDEBUG -DLEAN_EXPORTING"}
-    '';
-  };
-  mkMod = mod: deps:
-    let drv = buildMod mod deps;
-        obj = compileMod mod drv;
-        # this attribute will only be used if any dependent module is precompiled
-        sharedLib = mkSharedLib mod "${obj}/${obj.oPath} ${lib.concatStringsSep " " (map (d: pathOfSharedLib d.sharedLib) deps)}";
-    in drv // {
-      inherit obj sharedLib;
-    } // lib.optionalAttrs precompileModules {
-      propagatedLoadDynlibs = [sharedLib];
-    };
-  externalModMap = lib.foldr (dep: depMap: depMap // dep.mods) {} allExternalDeps;
-  # map from module name to derivation
-  modCandidates = mapAttrs (mod: header:
-    let
-      deps = if header.errors == []
-             then map (m: m.module) header.result.imports
-             else abort "errors while parsing imports of ${mod}:\n${lib.concatStringsSep "\n" header.errors}";
-    in mkMod mod (map (dep: if modDepsMap ? ${dep} then modCandidates.${dep} else externalModMap.${dep}) deps)) modDepsMap;
-  expandGlob = g:
-    if typeOf g == "string" then [g]
-    else if g.glob == "one" then [g.mod]
-    else if g.glob == "submodules" then submodules g.mod
-    else if g.glob == "andSubmodules" then [g.mod] ++ submodules g.mod
-    else throw "unknown glob kind '${g}'";
-  # subset of `modCandidates` that is transitively reachable from `roots`
-  mods' = listToAttrs (map (e: { name = e.key; value = modCandidates.${e.key}; }) (genericClosure {
-    startSet = map (m: { key = m; }) (concatMap expandGlob roots);
-    operator = e: if modDepsMap ? ${e.key} then map (m: { key = m.module; }) (filter (m: modCandidates ? ${m.module}) modDepsMap.${e.key}.result.imports) else [];
-  }));
-  allLinkFlags = lib.foldr (shared: acc: acc ++ [ "-L${shared}" "-l${shared.linkName or shared.name}" ]) linkFlags allNativeSharedLibs;
-
-  objects   = mapAttrs (_: m: m.obj) mods';
-  bintools = if stdenv.isDarwin then darwin.cctools else stdenv.cc.bintools.bintools;
-  staticLib = runCommand "${name}-lib" { buildInputs = [ bintools ]; } ''
-    mkdir -p $out
-    ar Trcs $out/lib${libName}.a ${lib.concatStringsSep " " (map (drv: "${drv}/${drv.oPath}") (attrValues objects))};
-  '';
-
-  staticLibLinkWrapper = libs: if groupStaticLibs && !stdenv.isDarwin
-    then "-Wl,--start-group ${libs} -Wl,--end-group"
-    else "${libs}";
-in rec {
-  inherit name lean deps staticLibDeps allNativeSharedLibs allLinkFlags allExternalDeps src objects staticLib modDepsFile;
-  mods = mapAttrs (_: m:
-      m //
-      # if neither precompilation option was set but a dependent module wants to be precompiled, default to precompiling this package whole
-      lib.optionalAttrs (precompilePackage || !precompileModules) { inherit sharedLib; } //
-      lib.optionalAttrs precompilePackage { propagatedLoadDynlibs = [sharedLib]; })
-    mods';
-  modRoot   = depRoot name (attrValues mods);
-  depRoots  = linkFarmFromDrvs "depRoots" (map (m: m.LEAN_PATH) (attrValues mods));
-  cTree     = symlinkJoin { name = "${name}-cTree"; paths = map (mod: mod.c) (attrValues mods); };
-  oTree     = symlinkJoin { name = "${name}-oTree"; paths = (attrValues objects); };
-  iTree     = symlinkJoin { name = "${name}-iTree"; paths = map (mod: mod.ilean) (attrValues mods); };
-  sharedLib = mkSharedLib "lib${sharedLibName}" ''
-    ${if stdenv.isDarwin then "-Wl,-force_load,${staticLib}/lib${libName}.a" else "-Wl,--whole-archive ${staticLib}/lib${libName}.a -Wl,--no-whole-archive"} \
-    ${lib.concatStringsSep " " (map (d: "${d.sharedLib}/*") deps)}'';
-  executable = lib.makeOverridable ({ withSharedStdlib ? true }: let
-      objPaths = map (drv: "${drv}/${drv.oPath}") (attrValues objects) ++ lib.optional withSharedStdlib "${lean-final.leanshared}/*";
-    in runCommand executableName { buildInputs = [ stdenv.cc leanc ]; } ''
-      mkdir -p $out/bin
-      leanc ${staticLibLinkWrapper (lib.concatStringsSep " " (objPaths ++ map (d: "${d}/*.a") allStaticLibDeps))} \
-        -o $out/bin/${executableName} \
-        ${lib.concatStringsSep " " allLinkFlags}
-    '') {};
-})

nix/lake-dev.in

@@ -1,42 +0,0 @@
-#!@bash@/bin/bash
-
-set -euo pipefail
-
-function pebkac() {
-    echo 'This is just a simple Nix adapter for `lake print-paths|serve`.'
-    exit 1
-}
-
-[[ $# -gt 0 ]] || pebkac
-case $1 in
-    --version)
-        # minimum version for `lake serve` with fallback
-        echo 3.1.0
-        ;;
-    print-paths)
-        shift
-        deps="$@"
-        root=.
-        # fall back to initial package if not in package
-        [[ ! -f "$root/flake.nix" ]] && root="@srcRoot@"
-        target="$root#print-paths"
-        args=()
-        # HACK: use stage 0 instead of 1 inside Lean's own `src/`
-        [[ -d Lean && -f ../flake.nix ]] && target="@srcTarget@print-paths" && args=@srcArgs@
-        for dep in $deps; do
-            target="$target.\"$dep\""
-        done
-        echo "Building dependencies..." >&2
-        # -v only has "built ...", but "-vv" is a bit too verbose
-        exec @nix@/bin/nix run "$target" ${args[*]} -v
-        ;;
-    serve)
-        shift
-        [[ ${1:-} == "--" ]] && shift
-        # `link-ilean` puts them there
-        LEAN_PATH=${LEAN_PATH:+$LEAN_PATH:}$PWD/build/lib exec $(dirname $0)/lean --server "$@"
-        ;;
-    *)
-        pebkac
-        ;;
-esac

nix/lean-dev.in

@@ -1,28 +0,0 @@
-#!@bash@/bin/bash
-
-set -euo pipefail
-
-root="."
-# find package root
-while [[ "$root" != / ]]; do
-    [ -f "$root/flake.nix" ] && break
-    root="$(realpath "$root/..")"
-done
-# fall back to initial package if not in package
-[[ ! -f "$root/flake.nix" ]] && root="@srcRoot@"
-
-# use Lean w/ package unless in server mode (which has its own LEAN_PATH logic)
-target="$root#lean-package"
-for arg in "$@"; do
-    case $arg in
-        --server | --worker | -v | --version)
-            target="$root#lean"
-            ;;
-    esac
-done
-
-args=(-- "$@")
-# HACK: use stage 0 instead of 1 inside Lean's own `src/`
-[[ -d Lean && -f ../flake.nix ]] && target="@srcTarget@" && args=@srcArgs@
-
-LEAN_SYSROOT="$(dirname "$0")/.." exec @nix@/bin/nix ${LEAN_NIX_ARGS:-} run "$target" ${args[*]}

nix/packages.nix

@@ -1,52 +0,0 @@
-{ src, pkgs, ... } @ args:
-with pkgs;
-let
-  # https://github.com/NixOS/nixpkgs/issues/130963
-  llvmPackages = if stdenv.isDarwin then llvmPackages_11 else llvmPackages_15;
-  cc = (ccacheWrapper.override rec {
-    cc = llvmPackages.clang;
-    extraConfig = ''
-      export CCACHE_DIR=/nix/var/cache/ccache
-      export CCACHE_UMASK=007
-      export CCACHE_BASE_DIR=$NIX_BUILD_TOP
-      # https://github.com/NixOS/nixpkgs/issues/109033
-      args=("$@")
-      for ((i=0; i<"''${#args[@]}"; i++)); do
-        case ''${args[i]} in
-          -frandom-seed=*) unset args[i]; break;;
-        esac
-      done
-      set -- "''${args[@]}"
-      [ -d $CCACHE_DIR ] || exec ${cc}/bin/$(basename "$0") "$@"
-    '';
-  }).overrideAttrs (old: {
-    # https://github.com/NixOS/nixpkgs/issues/119779
-    installPhase = builtins.replaceStrings ["use_response_file_by_default=1"] ["use_response_file_by_default=0"] old.installPhase;
-  });
-  stdenv' = if stdenv.isLinux then useGoldLinker stdenv else stdenv;
-  lean = callPackage (import ./bootstrap.nix) (args // {
-    stdenv = overrideCC stdenv' cc;
-    inherit src buildLeanPackage llvmPackages;
-  });
-  makeOverridableLeanPackage = f:
-    let newF = origArgs: f origArgs // {
-      overrideArgs = newArgs: makeOverridableLeanPackage f (origArgs // newArgs);
-    };
-    in lib.setFunctionArgs newF (lib.getFunctionArgs f) // {
-      override = args: makeOverridableLeanPackage (f.override args);
-    };
-  buildLeanPackage = makeOverridableLeanPackage (callPackage (import ./buildLeanPackage.nix) (args // {
-    inherit (lean) stdenv;
-    lean = lean.stage1;
-    inherit (lean.stage1) leanc;
-  }));
-in {
-  inherit cc buildLeanPackage llvmPackages;
-  nixpkgs = pkgs;
-  ciShell = writeShellScriptBin "ciShell" ''
-    set -o pipefail
-    export PATH=${moreutils}/bin:$PATH
-    # prefix lines with cumulative and individual execution time
-    "$@" |& ts -i "(%.S)]" | ts -s "[%M:%S"
-  '';
-} // lean.stage1

nix/templates/pkg/MyPackage.lean

@@ -1 +0,0 @@
-#eval "Hello, world!"

nix/templates/pkg/flake.nix

@@ -1,21 +0,0 @@
-{
-  description = "My Lean package";
-
-  inputs.lean.url = "github:leanprover/lean4";
-  inputs.flake-utils.url = "github:numtide/flake-utils";
-
-  outputs = { self, lean, flake-utils }: flake-utils.lib.eachDefaultSystem (system:
-    let
-      leanPkgs = lean.packages.${system};
-      pkg = leanPkgs.buildLeanPackage {
-        name = "MyPackage";  # must match the name of the top-level .lean file
-        src = ./.;
-      };
-    in {
-      packages = pkg // {
-        inherit (leanPkgs) lean;
-      };
-
-      defaultPackage = pkg.modRoot;
-    });
-}

script/AnalyzeGrindAnnotations.lean

@@ -0,0 +1,87 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+import Lean
+
+namespace Lean.Meta.Grind.Analyzer
+/-!
+A simple E-matching annotation analyzer.
+For each theorem annotated as an E-matching candidate, it creates an artificial goal, executes `grind` and shows the
+number of instances created.
+For a theorem of the form `params -> type`, the artificial goal is of the form `params -> type -> False`.
+-/
+
+/--
+`grind` configuration for the analyzer. We disable case-splits and lookahead,
+increase the number of generations, and limit the number of instances generated.
+-/
+def config : Grind.Config := {
+  splits       := 0
+  lookahead    := false
+  mbtc         := false
+  ematch       := 20
+  instances    := 100
+  gen          := 10
+}
+
+structure Config where
+  /-- Minimum number of instantiations to trigger summary report -/
+  min : Nat := 10
+  /-- Minimum number of instantiations to trigger detailed report -/
+  detailed : Nat := 50
+
+def mkParams : MetaM Params := do
+  let params ← Grind.mkParams config
+  let ematch ← getEMatchTheorems
+  let casesTypes ← Grind.getCasesTypes
+  return { params with ematch, casesTypes }
+
+/-- Returns the total number of generated instances.  -/
+private def sum (cs : PHashMap Origin Nat) : Nat := Id.run do
+  let mut r := 0
+  for (_, c) in cs do
+    r := r + c
+  return r
+
+private def thmsToMessageData (thms : PHashMap Origin Nat) : MetaM MessageData := do
+  let data := thms.toArray.filterMap fun (origin, c) =>
+    match origin with
+    | .decl declName => some (declName, c)
+    | _ => none
+  let data := data.qsort fun (d₁, c₁) (d₂, c₂) => if c₁ == c₂ then Name.lt d₁ d₂ else c₁ > c₂
+  let data ← data.mapM fun (declName, counter) =>
+    return .trace { cls := `thm } m!"{.ofConst (← mkConstWithLevelParams declName)} ↦ {counter}" #[]
+  return .trace { cls := `thm } "instances" data
+
+/--
+Analyzes theorem `declName`. That is, creates the artificial goal based on `declName` type,
+and invokes `grind` on it.
+-/
+def analyzeEMatchTheorem (declName : Name) (c : Config) : MetaM Unit := do
+  let info ← getConstInfo declName
+  let mvarId ← forallTelescope info.type fun _ type => do
+    withLocalDeclD `h type fun _ => do
+      return (← mkFreshExprMVar (mkConst ``False)).mvarId!
+  let result ← Grind.main mvarId (← mkParams) (pure ())
+  let thms := result.counters.thm
+  let s := sum thms
+  if s > c.min then
+    IO.println s!"{declName} : {s}"
+  if s > c.detailed then
+    logInfo m!"{declName}\n{← thmsToMessageData thms}"
+
+/-- Analyzes all theorems in the standard library marked as E-matching theorems. -/
+def analyzeEMatchTheorems (c : Config := {}) : MetaM Unit := do
+  let origins := (← getEMatchTheorems).getOrigins
+  for o in origins do
+    let .decl declName := o | pure ()
+    analyzeEMatchTheorem declName c
+
+set_option maxHeartbeats 5000000
+run_meta analyzeEMatchTheorems
+
+-- We can analyze specific theorems using commands such as
+set_option trace.grind.ematch.instance true in
+run_meta analyzeEMatchTheorem ``List.filterMap_some {}

src/CMakeLists.txt

@@ -10,7 +10,7 @@ endif()
 include(ExternalProject)
 project(LEAN CXX C)
 set(LEAN_VERSION_MAJOR 4)
-set(LEAN_VERSION_MINOR 23)
+set(LEAN_VERSION_MINOR 24)
 set(LEAN_VERSION_PATCH 0)
 set(LEAN_VERSION_IS_RELEASE 0)  # This number is 1 in the release revision, and 0 otherwise.
 set(LEAN_SPECIAL_VERSION_DESC "" CACHE STRING "Additional version description like 'nightly-2018-03-11'")

src/Init/Core.lean

@@ -29,6 +29,29 @@ theorem id_def {α : Sort u} (a : α) : id a = a := rfl
 
 attribute [grind] id
 
+/--
+A helper gadget for instructing the kernel to eagerly reduce terms.
+
+When the gadget wraps the argument of an application, then when checking that
+the expected and inferred type of the argument match, the kernel will evaluate terms more eagerly.
+It is often used to wrap `Eq.refl true` proof terms as `eagerReduce (Eq.refl true)`
+when using proof by reflection.
+As an example, consider the theorem:
+```
+theorem eq_norm (ctx : Context) (p₁ p₂ : Poly) (h : (p₁.norm == p₂) = true) :
+  p₁.denote ctx = 0 → p₂.denote ctx = 0
+```
+The argument `h : (p₁.norm == p₂) = true` is a candidate for `eagerReduce`.
+When applying this theorem, we would write:
+
+```
+eq_norm ctx p q (eagerReduce (Eq.refl true)) h
+```
+to instruct the kernel to use eager reduction when establishing that `(p.norm == q) = true` is
+definitionally equal to `true = true`.
+-/
+@[expose] def eagerReduce {α : Sort u} (a : α) : α := a
+
 /--
 `flip f a b` is `f b a`. It is useful for "point-free" programming,
 since it can sometimes be used to avoid introducing variables.

src/Init/Data.lean

@@ -49,5 +49,6 @@ public import Init.Data.Vector
 public import Init.Data.Iterators
 public import Init.Data.Range.Polymorphic
 public import Init.Data.Slice
+public import Init.Data.Order
 
 public section

src/Init/Data/Array/Lex/Lemmas.lean

@@ -12,9 +12,12 @@ public import Init.Data.Array.Lemmas
 public import Init.Data.List.Lex
 import Init.Data.Range.Polymorphic.Lemmas
 import Init.Data.Range.Polymorphic.NatLemmas
+import Init.Data.Order.Lemmas
 
 public section
 
+open Std
+
 set_option linter.listVariables true -- Enforce naming conventions for `List`/`Array`/`Vector` variables.
 set_option linter.indexVariables true -- Enforce naming conventions for index variables.
 
@@ -28,8 +31,8 @@ namespace Array
 @[simp] theorem lt_toList [LT α] {xs ys : Array α} : xs.toList < ys.toList ↔ xs < ys := Iff.rfl
 @[simp] theorem le_toList [LT α] {xs ys : Array α} : xs.toList ≤ ys.toList ↔ xs ≤ ys := Iff.rfl
 
-grind_pattern _root_.List.lt_toArray =>  l₁.toArray < l₂.toArray
-grind_pattern _root_.List.le_toArray =>  l₁.toArray ≤ l₂.toArray
+grind_pattern _root_.List.lt_toArray => l₁.toArray < l₂.toArray
+grind_pattern _root_.List.le_toArray => l₁.toArray ≤ l₂.toArray
 grind_pattern lt_toList => xs.toList < ys.toList
 grind_pattern le_toList => xs.toList ≤ ys.toList
 
@@ -100,6 +103,14 @@ theorem singleton_lex_singleton [BEq α] {lt : α → α → Bool} : #[a].lex #[
     xs.toList.lex ys.toList lt = xs.lex ys lt := by
   cases xs <;> cases ys <;> simp
 
+instance [LT α] [LE α] [LawfulOrderLT α] [IsLinearOrder α] : IsLinearOrder (Array α) := by
+  apply IsLinearOrder.of_le
+  · constructor
+    intro _ _ hab hba
+    simpa using Std.le_antisymm (α := List α) hab hba
+  · constructor; exact Std.le_trans (α := List α)
+  · constructor; exact fun _ _ => Std.le_total (α := List α)
+
 protected theorem lt_irrefl [LT α] [Std.Irrefl (· < · : α → α → Prop)] (xs : Array α) : ¬ xs < xs :=
   List.lt_irrefl xs.toList
 
@@ -131,27 +142,35 @@ instance [LT α] [Trans (· < · : α → α → Prop) (· < ·) (· < ·)] :
     Trans (· < · : Array α → Array α → Prop) (· < ·) (· < ·) where
   trans h₁ h₂ := Array.lt_trans h₁ h₂
 
-protected theorem lt_of_le_of_lt [LT α]
-    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
+protected theorem lt_of_le_of_lt [LE α] [LT α] [LawfulOrderLT α] [IsLinearOrder α]
+    {xs ys zs : Array α} (h₁ : xs ≤ ys) (h₂ : ys < zs) : xs < zs :=
+  Std.lt_of_le_of_lt (α := List α) h₁ h₂
+
+@[deprecated Array.lt_of_le_of_lt (since := "2025-08-01")]
+protected theorem lt_of_le_of_lt' [LT α]
     [i₁ : Std.Asymm (· < · : α → α → Prop)]
     [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
     [i₃ : Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
     {xs ys zs : Array α} (h₁ : xs ≤ ys) (h₂ : ys < zs) : xs < zs :=
-  List.lt_of_le_of_lt h₁ h₂
+  letI := LE.ofLT α
+  haveI : IsLinearOrder α := IsLinearOrder.of_lt
+  Array.lt_of_le_of_lt h₁ h₂
 
-protected theorem le_trans [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
-    [Std.Asymm (· < · : α → α → Prop)]
-    [Std.Antisymm (¬ · < · : α → α → Prop)]
-    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
+protected theorem le_trans [LE α] [LT α] [LawfulOrderLT α] [IsLinearOrder α]
     {xs ys zs : Array α} (h₁ : xs ≤ ys) (h₂ : ys ≤ zs) : xs ≤ zs :=
   fun h₃ => h₁ (Array.lt_of_le_of_lt h₂ h₃)
 
-instance [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
-    [Std.Asymm (· < · : α → α → Prop)]
-    [Std.Antisymm (¬ · < · : α → α → Prop)]
-    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)] :
+@[deprecated Array.le_trans (since := "2025-08-01")]
+protected theorem le_trans' [LT α]
+    [i₁ : Std.Asymm (· < · : α → α → Prop)]
+    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
+    [i₃ : Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
+    {xs ys zs : Array α} (h₁ : xs ≤ ys) (h₂ : ys ≤ zs) : xs ≤ zs :=
+  letI := LE.ofLT α
+  haveI : IsLinearOrder α := IsLinearOrder.of_lt
+  Array.le_trans h₁ h₂
+
+instance [LE α] [LT α] [LawfulOrderLT α] [IsLinearOrder α] :
     Trans (· ≤ · : Array α → Array α → Prop) (· ≤ ·) (· ≤ ·) where
   trans h₁ h₂ := Array.le_trans h₁ h₂
 
@@ -165,7 +184,7 @@ instance [LT α]
   asymm _ _ := Array.lt_asymm
 
 protected theorem le_total [LT α]
-    [i : Std.Total (¬ · < · : α → α → Prop)] (xs ys : Array α) : xs ≤ ys ∨ ys ≤ xs :=
+    [i : Std.Asymm (· < · : α → α → Prop)] (xs ys : Array α) : xs ≤ ys ∨ ys ≤ xs :=
   List.le_total xs.toList ys.toList
 
 @[simp] protected theorem not_lt [LT α]
@@ -175,19 +194,22 @@ protected theorem le_total [LT α]
     {xs ys : Array α} : ¬ ys ≤ xs ↔ xs < ys := Classical.not_not
 
 protected theorem le_of_lt [LT α]
-    [i : Std.Total (¬ · < · : α → α → Prop)]
+    [i : Std.Asymm (· < · : α → α → Prop)]
     {xs ys : Array α} (h : xs < ys) : xs ≤ ys :=
   List.le_of_lt h
 
 protected theorem le_iff_lt_or_eq [LT α]
     [Std.Irrefl (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)]
-    [Std.Total (¬ · < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
     {xs ys : Array α} : xs ≤ ys ↔ xs < ys ∨ xs = ys := by
   simpa using List.le_iff_lt_or_eq (l₁ := xs.toList) (l₂ := ys.toList)
 
-instance [LT α]
-    [Std.Total (¬ · < · : α → α → Prop)] :
+protected theorem le_antisymm [LT α] [LE α] [IsLinearOrder α] [LawfulOrderLT α]
+    {xs ys : Array α} : xs ≤ ys → ys ≤ xs → xs = ys := by
+  simpa using List.le_antisymm (as := xs.toList) (bs := ys.toList)
+
+instance [LT α] [Std.Asymm (· < · : α → α → Prop)] :
     Std.Total (· ≤ · : Array α → Array α → Prop) where
   total := Array.le_total
 
@@ -266,7 +288,6 @@ protected theorem lt_iff_exists [LT α] {xs ys : Array α} :
   simp [List.lt_iff_exists]
 
 protected theorem le_iff_exists [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
     [Std.Asymm (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)] {xs ys : Array α} :
     xs ≤ ys ↔
@@ -286,7 +307,6 @@ theorem append_left_lt [LT α] {xs ys zs : Array α} (h : ys < zs) :
   simpa using List.append_left_lt h
 
 theorem append_left_le [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
     [Std.Asymm (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)]
     {xs ys zs : Array α} (h : ys ≤ zs) :
@@ -310,10 +330,8 @@ protected theorem map_lt [LT α] [LT β]
   simpa using List.map_lt w h
 
 protected theorem map_le [LT α] [LT β]
-    [Std.Irrefl (· < · : α → α → Prop)]
     [Std.Asymm (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)]
-    [Std.Irrefl (· < · : β → β → Prop)]
     [Std.Asymm (· < · : β → β → Prop)]
     [Std.Antisymm (¬ · < · : β → β → Prop)]
     {xs ys : Array α} {f : α → β} (w : ∀ x y, x < y → f x < f y) (h : xs ≤ ys) :

src/Init/Data/BitVec/Lemmas.lean

@@ -19,9 +19,12 @@ public import Init.Data.Int.LemmasAux
 public import Init.Data.Int.Pow
 public import Init.Data.Int.LemmasAux
 public import Init.Data.BitVec.Bootstrap
+public import Init.Data.Order.Factories
 
 public section
 
+open Std
+
 set_option linter.missingDocs true
 
 namespace BitVec
@@ -4015,6 +4018,16 @@ protected theorem ne_of_lt {x y : BitVec n} : x < y → x ≠ y := by
   simp only [lt_def, ne_eq, toNat_eq]
   apply Nat.ne_of_lt
 
+instance instIsLinearOrder : IsLinearOrder (BitVec n) := by
+  apply IsLinearOrder.of_le
+  case le_antisymm => constructor; apply BitVec.le_antisymm
+  case le_trans => constructor; apply BitVec.le_trans
+  case le_total => constructor; apply BitVec.le_total
+
+instance instLawfulOrderLT : LawfulOrderLT (BitVec n) := by
+  apply LawfulOrderLT.of_le
+  simpa using fun _ _ => BitVec.lt_asymm
+
 protected theorem umod_lt (x : BitVec n) {y : BitVec n} : 0 < y → x % y < y := by
   simp only [ofNat_eq_ofNat, lt_def, toNat_ofNat, Nat.zero_mod]
   apply Nat.mod_lt

src/Init/Data/Char.lean

@@ -8,5 +8,6 @@ module
 prelude
 public import Init.Data.Char.Basic
 public import Init.Data.Char.Lemmas
+public import Init.Data.Char.Order
 
 public section

src/Init/Data/Char/Lemmas.lean

@@ -61,6 +61,7 @@ instance leTotal : Std.Total (· ≤ · : Char → Char → Prop) where
   total := Char.le_total
 
 -- This instance is useful while setting up instances for `String`.
+@[deprecated ltAsymm (since := "2025-08-01")]
 def notLTTotal : Std.Total (¬ · < · : Char → Char → Prop) where
   total := fun x y => by simpa using Char.le_total y x
 

src/Init/Data/Char/Order.lean

@@ -0,0 +1,27 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+public import Init.Data.Char.Basic
+import Init.Data.Char.Lemmas
+public import Init.Data.Order.Factories
+
+open Std
+
+namespace Char
+
+public instance instIsLinearOrder : IsLinearOrder Char := by
+  apply IsLinearOrder.of_le
+  case le_antisymm => constructor; apply Char.le_antisymm
+  case le_trans => constructor; apply Char.le_trans
+  case le_total => constructor; apply Char.le_total
+
+public instance : LawfulOrderLT Char where
+  lt_iff a b := by
+    simp [← Char.not_le, Decidable.imp_iff_not_or, Std.Total.total]
+
+end Char

src/Init/Data/Fin/Lemmas.lean

@@ -12,9 +12,13 @@ public import Init.Ext
 public import Init.ByCases
 public import Init.Conv
 public import Init.Omega
+public import Init.Data.Order.Factories
+import Init.Data.Order.Lemmas
 
 public section
 
+open Std
+
 namespace Fin
 
 @[simp] theorem ofNat_zero (n : Nat) [NeZero n] : Fin.ofNat n 0 = 0 := rfl
@@ -251,6 +255,16 @@ protected theorem le_antisymm_iff {x y : Fin n} : x = y ↔ x ≤ y ∧ y ≤ x
 protected theorem le_antisymm {x y : Fin n} (h1 : x ≤ y) (h2 : y ≤ x) : x = y :=
   Fin.le_antisymm_iff.2 ⟨h1, h2⟩
 
+instance instIsLinearOrder : IsLinearOrder (Fin n) := by
+  apply IsLinearOrder.of_le
+  case le_antisymm => constructor; apply Fin.le_antisymm
+  case le_total => constructor; apply Fin.le_total
+  case le_trans => constructor; apply Fin.le_trans
+
+instance : LawfulOrderLT (Fin n) where
+  lt_iff := by
+    simp [← Fin.not_le, Decidable.imp_iff_not_or, Std.Total.total]
+
 @[simp, grind =] theorem val_rev (i : Fin n) : rev i = n - (i + 1) := rfl
 
 @[simp] theorem rev_rev (i : Fin n) : rev (rev i) = i := Fin.ext <| by

src/Init/Data/Int/DivMod/Lemmas.lean

@@ -956,6 +956,12 @@ theorem neg_mul_ediv_cancel_left (a b : Int) (h : a ≠ 0) : -(a * b) / a = -b :
 @[simp] theorem emod_one (a : Int) : a % 1 = 0 := by
   simp [emod_def, Int.one_mul, Int.sub_self]
 
+theorem ediv_minus_one (a : Int) : a / (-1) = -a := by
+  simp
+
+theorem emod_minus_one (a : Int) : a % (-1) = 0 := by
+  simp
+
 @[deprecated sub_emod_right (since := "2025-04-11")]
 theorem emod_sub_cancel (x y : Int) : (x - y) % y = x % y :=
   sub_emod_right ..

src/Init/Data/Int/Order.lean

@@ -8,9 +8,13 @@ module
 prelude
 public import Init.Data.Int.Lemmas
 public import Init.ByCases
+public import Init.Data.Order.Factories
+import Init.Data.Order.Lemmas
 
 public section
 
+open Std
+
 /-!
 # Results about the order properties of the integers, and the integers as an ordered ring.
 -/
@@ -1415,4 +1419,14 @@ theorem natAbs_eq_iff_mul_eq_zero : natAbs a = n ↔ (a - n) * (a + n) = 0 := by
 @[deprecated natAbs_eq_iff_mul_eq_zero (since := "2025-03-11")]
 abbrev eq_natAbs_iff_mul_eq_zero := @natAbs_eq_iff_mul_eq_zero
 
+instance instIsLinearOrder : IsLinearOrder Int := by
+  apply IsLinearOrder.of_le
+  case le_antisymm => constructor; apply Int.le_antisymm
+  case le_total => constructor; apply Int.le_total
+  case le_trans => constructor; apply Int.le_trans
+
+instance : LawfulOrderLT Int where
+  lt_iff := by
+    simp [← Int.not_le, Decidable.imp_iff_not_or, Std.Total.total]
+
 end Int

src/Init/Data/Iterators/PostconditionMonad.lean

@@ -7,7 +7,7 @@ module
 
 prelude
 public import Init.Control.Lawful.Basic
-public import Init.Data.Subtype
+public import Init.Data.Subtype.Basic
 public import Init.PropLemmas
 
 public section

src/Init/Data/List/Attach.lean

@@ -8,7 +8,7 @@ module
 prelude
 public import all Init.Data.List.Lemmas  -- for dsimping with `getElem?_cons_succ`
 public import Init.Data.List.Count
-public import Init.Data.Subtype
+public import Init.Data.Subtype.Basic
 public import Init.BinderNameHint
 
 public section

src/Init/Data/List/Basic.lean

@@ -2108,6 +2108,11 @@ def range' : (start len : Nat) → (step : Nat := 1) → List Nat
   | _, 0, _ => []
   | s, n+1, step => s :: range' (s+step) n step
 
+@[simp, grind =] theorem range'_zero : range' s 0 step = [] := rfl
+@[simp, grind =] theorem range'_one {s step : Nat} : range' s 1 step = [s] := rfl
+-- The following theorem is intentionally not a simp lemma.
+theorem range'_succ : range' s (n + 1) step = s :: range' (s + step) n step := rfl
+
 /-! ### zipIdx -/
 
 /--

src/Init/Data/List/Lemmas.lean

@@ -70,7 +70,7 @@ See also
 
 Further results, which first require developing further automation around `Nat`, appear in
 * `Init.Data.List.Nat.Basic`: miscellaneous lemmas
-* `Init.Data.List.Nat.Range`: `List.range` and `List.enum`
+* `Init.Data.List.Nat.Range`: `List.range`, `List.range'` and `List.enum`
 * `Init.Data.List.Nat.TakeDrop`: `List.take` and `List.drop`
 
 Also
@@ -1084,6 +1084,12 @@ theorem getLast?_tail {l : List α} : (tail l).getLast? = if l.length = 1 then n
     rw [if_neg]
     rintro ⟨⟩
 
+@[simp, grind =]
+theorem cons_head_tail (h : l ≠ []) : l.head h :: l.tail = l := by
+  induction l with
+  | nil => contradiction
+  | cons ih => simp_all
+
 /-! ## Basic operations -/
 
 /-! ### map -/
@@ -1851,6 +1857,10 @@ theorem append_eq_map_iff {f : α → β} :
 theorem sum_append_nat {l₁ l₂ : List Nat} : (l₁ ++ l₂).sum = l₁.sum + l₂.sum := by
   induction l₁ generalizing l₂ <;> simp_all [Nat.add_assoc]
 
+@[simp, grind =]
+theorem sum_reverse_nat (xs : List Nat) : xs.reverse.sum = xs.sum := by
+  induction xs <;> simp_all [Nat.add_comm]
+
 /-! ### concat
 
 Note that `concat_eq_append` is a `@[simp]` lemma, so `concat` should usually not appear in goals.

src/Init/Data/List/Lex.lean

@@ -8,9 +8,13 @@ module
 prelude
 public import Init.Data.List.Lemmas
 public import Init.Data.List.Nat.TakeDrop
+public import Init.Data.Order.Factories
+import Init.Data.Order.Lemmas
 
 public section
 
+open Std
+
 set_option linter.listVariables true -- Enforce naming conventions for `List`/`Array`/`Vector` variables.
 set_option linter.indexVariables true -- Enforce naming conventions for index variables.
 
@@ -18,6 +22,11 @@ namespace List
 
 /-! ### Lexicographic ordering -/
 
+instance [LT α] [Std.Asymm (α := List α) (· < ·)] : LawfulOrderLT (List α) where
+  lt_iff := by
+    simp only [LE.le, List.le, Classical.not_not, iff_and_self]
+    apply Std.Asymm.asymm
+
 @[simp] theorem lex_lt [LT α] {l₁ l₂ : List α} : Lex (· < ·) l₁ l₂ ↔ l₁ < l₂ := Iff.rfl
 @[simp] theorem not_lex_lt [LT α] {l₁ l₂ : List α} : ¬ Lex (· < ·) l₁ l₂ ↔ l₂ ≤ l₁ := Iff.rfl
 
@@ -79,7 +88,6 @@ theorem not_cons_lex_cons_iff [DecidableEq α] [DecidableRel r] {a b} {l₁ l₂
   rw [cons_lex_cons_iff, not_or, Decidable.not_and_iff_or_not, and_or_left]
 
 theorem cons_le_cons_iff [LT α]
-    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
     [i₁ : Std.Asymm (· < · : α → α → Prop)]
     [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
     {a b} {l₁ l₂ : List α} :
@@ -101,19 +109,22 @@ theorem cons_le_cons_iff [LT α]
         exact ⟨i₂.antisymm _ _ h₃ h₁, h₂⟩
   · rintro (h | ⟨h₁, h₂⟩)
     · left
-      exact ⟨i₁.asymm _ _ h, fun w => i₀.irrefl _ (w ▸ h)⟩
+      exact ⟨i₁.asymm _ _ h, fun w => Irrefl.irrefl _ (w ▸ h)⟩
     · right
-      exact ⟨fun w => i₀.irrefl _ (h₁ ▸ w), h₂⟩
+      exact ⟨fun w => Irrefl.irrefl _ (h₁ ▸ w), h₂⟩
 
 theorem not_lt_of_cons_le_cons [LT α]
-    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
     [i₁ : Std.Asymm (· < · : α → α → Prop)]
     [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
     {a b : α} {l₁ l₂ : List α} (h : a :: l₁ ≤ b :: l₂) : ¬ b < a := by
   rw [cons_le_cons_iff] at h
   rcases h with h | ⟨rfl, h⟩
   · exact i₁.asymm _ _ h
-  · exact i₀.irrefl _
+  · exact Irrefl.irrefl _
+
+theorem left_le_left_of_cons_le_cons [LT α] [LE α] [IsLinearOrder α]
+    [LawfulOrderLT α] {a b : α} {l₁ l₂ : List α} (h : a :: l₁ ≤ b :: l₂) : a ≤ b := by
+  simpa [not_lt] using not_lt_of_cons_le_cons h
 
 theorem le_of_cons_le_cons [LT α]
     [i₀ : Std.Irrefl (· < · : α → α → Prop)]
@@ -165,11 +176,7 @@ instance [LT α] [Trans (· < · : α → α → Prop) (· < ·) (· < ·)] :
 
 
 
-protected theorem lt_of_le_of_lt [LT α]
-    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
-    [i₁ : Std.Asymm (· < · : α → α → Prop)]
-    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
-    [i₃ : Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
+protected theorem lt_of_le_of_lt [LT α] [LE α] [IsLinearOrder α] [LawfulOrderLT α]
     {l₁ l₂ l₃ : List α} (h₁ : l₁ ≤ l₂) (h₂ : l₂ < l₃) : l₁ < l₃ := by
   induction h₂ generalizing l₁ with
   | nil => simp_all
@@ -179,11 +186,8 @@ protected theorem lt_of_le_of_lt [LT α]
     | nil => simp_all
     | cons c l₁ =>
       apply Lex.rel
-      replace h₁ := not_lt_of_cons_le_cons h₁
-      apply Classical.byContradiction
-      intro h₂
-      have := i₃.trans h₁ h₂
-      contradiction
+      replace h₁ := left_le_left_of_cons_le_cons h₁
+      exact lt_of_le_of_lt h₁ hab
   | cons w₃ ih =>
     rename_i a as bs
     cases l₁ with
@@ -193,21 +197,34 @@ protected theorem lt_of_le_of_lt [LT α]
       by_cases w₅ : a = c
       · subst w₅
         exact Lex.cons (ih (le_of_cons_le_cons h₁))
-      · exact Lex.rel (Classical.byContradiction fun w₆ => w₅ (i₂.antisymm _ _ w₄ w₆))
+      · simp only [not_lt] at w₄
+        exact Lex.rel (lt_of_le_of_ne w₄ (w₅.imp Eq.symm))
 
-protected theorem le_trans [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
+@[deprecated List.lt_of_le_of_lt (since := "2025-08-01")]
+protected theorem lt_of_le_of_lt' [LT α]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
+    {l₁ l₂ l₃ : List α} (h₁ : l₁ ≤ l₂) (h₂ : l₂ < l₃) : l₁ < l₃ :=
+  letI : LE α := .ofLT α
+  haveI : IsLinearOrder α := IsLinearOrder.of_lt
+  List.lt_of_le_of_lt h₁ h₂
+
+protected theorem le_trans [LT α] [LE α] [IsLinearOrder α] [LawfulOrderLT α]
+    {l₁ l₂ l₃ : List α} (h₁ : l₁ ≤ l₂) (h₂ : l₂ ≤ l₃) : l₁ ≤ l₃ :=
+  fun h₃ => h₁ (List.lt_of_le_of_lt h₂ h₃)
+
+@[deprecated List.le_trans (since := "2025-08-01")]
+protected theorem le_trans' [LT α]
     [Std.Asymm (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)]
     [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
     {l₁ l₂ l₃ : List α} (h₁ : l₁ ≤ l₂) (h₂ : l₂ ≤ l₃) : l₁ ≤ l₃ :=
-  fun h₃ => h₁ (List.lt_of_le_of_lt h₂ h₃)
+  letI := LE.ofLT α
+  haveI : IsLinearOrder α := IsLinearOrder.of_lt
+  List.le_trans h₁ h₂
 
-instance [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
-    [Std.Asymm (· < · : α → α → Prop)]
-    [Std.Antisymm (¬ · < · : α → α → Prop)]
-    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)] :
+instance [LT α] [LE α] [IsLinearOrder α] [LawfulOrderLT α] :
     Trans (· ≤ · : List α → List α → Prop) (· ≤ ·) (· ≤ ·) where
   trans h₁ h₂ := List.le_trans h₁ h₂
 
@@ -247,14 +264,21 @@ theorem not_lex_total {r : α → α → Prop}
     obtain (_ | _) := not_lex_total h l₁ l₂ <;> contradiction
 
 protected theorem le_total [LT α]
-    [i : Std.Total (¬ · < · : α → α → Prop)] (l₁ l₂ : List α) : l₁ ≤ l₂ ∨ l₂ ≤ l₁ :=
-  not_lex_total i.total l₂ l₁
+    [i : Std.Asymm (· < · : α → α → Prop)] (l₁ l₂ : List α) : l₁ ≤ l₂ ∨ l₂ ≤ l₁ :=
+  not_lex_total i.total_not.total l₂ l₁
 
-instance [LT α]
-    [Std.Total (¬ · < · : α → α → Prop)] :
+protected theorem le_total_of_asymm [LT α]
+    [i : Std.Asymm (· < · : α → α → Prop)] (l₁ l₂ : List α) : l₁ ≤ l₂ ∨ l₂ ≤ l₁ :=
+  List.le_total l₁ l₂
+
+instance [LT α] [Std.Asymm (· < · : α → α → Prop)] :
     Std.Total (· ≤ · : List α → List α → Prop) where
   total := List.le_total
 
+@[no_expose]
+instance instIsLinearOrder [LT α] [LE α] [IsLinearOrder α] [LawfulOrderLT α] :
+    IsLinearOrder (List α) := IsLinearOrder.of_le
+
 @[simp] protected theorem not_lt [LT α]
     {l₁ l₂ : List α} : ¬ l₁ < l₂ ↔ l₂ ≤ l₁ := Iff.rfl
 
@@ -262,7 +286,7 @@ instance [LT α]
     {l₁ l₂ : List α} : ¬ l₂ ≤ l₁ ↔ l₁ < l₂ := Classical.not_not
 
 protected theorem le_of_lt [LT α]
-    [i : Std.Total (¬ · < · : α → α → Prop)]
+    [i : Std.Asymm (· < · : α → α → Prop)]
     {l₁ l₂ : List α} (h : l₁ < l₂) : l₁ ≤ l₂ := by
   obtain (h' | h') := List.le_total l₁ l₂
   · exact h'
@@ -272,7 +296,7 @@ protected theorem le_of_lt [LT α]
 protected theorem le_iff_lt_or_eq [LT α]
     [Std.Irrefl (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)]
-    [Std.Total (¬ · < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
     {l₁ l₂ : List α} : l₁ ≤ l₂ ↔ l₁ < l₂ ∨ l₁ = l₂ := by
   constructor
   · intro h
@@ -456,7 +480,6 @@ protected theorem lt_iff_exists [LT α] {l₁ l₂ : List α} :
   simp
 
 protected theorem le_iff_exists [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
     [Std.Asymm (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)] {l₁ l₂ : List α} :
     l₁ ≤ l₂ ↔
@@ -480,7 +503,6 @@ theorem append_left_lt [LT α] {l₁ l₂ l₃ : List α} (h : l₂ < l₃) :
   | cons a l₁ ih => simp [cons_lt_cons_iff, ih]
 
 theorem append_left_le [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
     [Std.Asymm (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)]
     {l₁ l₂ l₃ : List α} (h : l₂ ≤ l₃) :
@@ -514,10 +536,8 @@ protected theorem map_lt [LT α] [LT β]
     simp [cons_lt_cons_iff, w, h]
 
 protected theorem map_le [LT α] [LT β]
-    [Std.Irrefl (· < · : α → α → Prop)]
     [Std.Asymm (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)]
-    [Std.Irrefl (· < · : β → β → Prop)]
     [Std.Asymm (· < · : β → β → Prop)]
     [Std.Antisymm (¬ · < · : β → β → Prop)]
     {l₁ l₂ : List α} {f : α → β} (w : ∀ x y, x < y → f x < f y) (h : l₁ ≤ l₂) :

src/Init/Data/List/MapIdx.lean

@@ -61,7 +61,7 @@ proof that the index is valid.
 `List.mapIdxM` is a variant that does not provide the function with evidence that the index is
 valid.
 -/
-@[inline] def mapFinIdxM [Monad m] (as : List α) (f : (i : Nat) → α → (h : i < as.length) → m β) : m (List β) :=
+@[inline, expose] def mapFinIdxM [Monad m] (as : List α) (f : (i : Nat) → α → (h : i < as.length) → m β) : m (List β) :=
   go as #[] (by simp)
 where
   /-- Auxiliary for `mapFinIdxM`:
@@ -78,7 +78,7 @@ found, returning the list of results.
 `List.mapFinIdxM` is a variant that additionally provides the function with a proof that the index
 is valid.
 -/
-@[inline] def mapIdxM [Monad m] (f : Nat → α → m β) (as : List α) : m (List β) := go as #[] where
+@[inline, expose] def mapIdxM [Monad m] (f : Nat → α → m β) (as : List α) : m (List β) := go as #[] where
   /-- Auxiliary for `mapIdxM`:
   `mapIdxM.go [a₀, a₁, ...] acc = acc.toList ++ [f acc.size a₀, f (acc.size + 1) a₁, ...]` -/
   @[specialize] go : List α → Array β → m (List β)

src/Init/Data/List/MinMax.lean

@@ -8,9 +8,14 @@ module
 prelude
 public import Init.Data.List.Lemmas
 public import Init.Data.List.Pairwise
+public import Init.Data.Order.Factories
+public import Init.Data.Subtype.Order
+import Init.Data.Order.Lemmas
 
 public section
 
+open Std
+
 /-!
 # Lemmas about `List.min?` and `List.max?.
 -/
@@ -55,7 +60,7 @@ theorem min?_eq_head? {α : Type u} [Min α] {l : List α}
       have hx : min x y = x := rel_of_pairwise_cons h mem_cons_self
       rw [foldl_cons, ih _ (hx.symm ▸ h.sublist (by simp)), hx]
 
-theorem min?_mem [Min α] (min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b) :
+theorem min?_mem [Min α] [MinEqOr α] :
     {xs : List α} → xs.min? = some a → a ∈ xs := by
   intro xs
   match xs with
@@ -72,13 +77,10 @@ theorem min?_mem [Min α] (min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b
       have p := ind _ eq
       cases p with
       | inl p =>
-        cases min_eq_or x y with | _ q => simp [p, q]
+        cases MinEqOr.min_eq_or x y with | _ q => simp [p, q]
       | inr p => simp [p, mem_cons]
 
--- See also `Init.Data.List.Nat.Basic` for specialisations of the next two results to `Nat`.
-
-theorem le_min?_iff [Min α] [LE α]
-    (le_min_iff : ∀ a b c : α, a ≤ min b c ↔ a ≤ b ∧ a ≤ c) :
+theorem le_min?_iff [Min α] [LE α] [LawfulOrderInf α] :
     {xs : List α} → xs.min? = some a → ∀ {x}, x ≤ a ↔ ∀ b, b ∈ xs → x ≤ b
   | nil => by simp
   | cons x xs => by
@@ -93,34 +95,60 @@ theorem le_min?_iff [Min α] [LE α]
       simp at eq
       simp [ih _ eq, le_min_iff, and_assoc]
 
--- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `min_eq_or`,
--- and `le_min_iff`.
-theorem min?_eq_some_iff [Min α] [LE α]
-    (le_refl : ∀ a : α, a ≤ a)
-    (min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b)
-    (le_min_iff : ∀ a b c : α, a ≤ min b c ↔ a ≤ b ∧ a ≤ c) {xs : List α}
-    (anti : ∀ a b, a ∈ xs → b ∈ xs → a ≤ b → b ≤ a → a = b := by
-      exact fun a b _ _ => Std.Antisymm.antisymm a b) :
+theorem min?_eq_some_iff [Min α] [LE α] {xs : List α} [IsLinearOrder α] [LawfulOrderMin α] :
     xs.min? = some a ↔ a ∈ xs ∧ ∀ b, b ∈ xs → a ≤ b := by
-  refine ⟨fun h => ⟨min?_mem min_eq_or h, (le_min?_iff le_min_iff h).1 (le_refl _)⟩, ?_⟩
+  refine ⟨fun h => ⟨min?_mem h, (le_min?_iff h).1 (le_refl _)⟩, ?_⟩
   intro ⟨h₁, h₂⟩
   cases xs with
   | nil => simp at h₁
   | cons x xs =>
-    exact congrArg some <| anti _ _ (min?_mem min_eq_or rfl) h₁
-      ((le_min?_iff le_min_iff (xs := x::xs) rfl).1 (le_refl _) _ h₁)
-      (h₂ _ (min?_mem min_eq_or (xs := x::xs) rfl))
+    rw [List.min?]
+    exact congrArg some <| le_antisymm
+      ((le_min?_iff (xs := x :: xs) rfl).1 (le_refl _) _ h₁)
+      (h₂ _ (min?_mem (xs := x :: xs) rfl))
 
-theorem min?_replicate [Min α] {n : Nat} {a : α} (w : min a a = a) :
+private theorem min?_attach [Min α] [MinEqOr α] {xs : List α} :
+    xs.attach.min? = (xs.min?.pmap (fun m hm => ⟨m, min?_mem hm⟩) (fun _ => id)) := by
+  cases xs with
+  | nil => simp
+  | cons x xs =>
+    simp only [min?, attach_cons, Option.some.injEq, Option.pmap_some]
+    rw [foldl_map]
+    simp only [Subtype.ext_iff]
+    rw [← foldl_attach (l := xs)]
+    apply Eq.trans (foldl_hom (f := Subtype.val) ?_).symm
+    · rfl
+    · intros; rfl
+
+theorem min?_eq_min?_attach [Min α] [MinEqOr α] {xs : List α} :
+    xs.min? = (xs.attach.min?.map Subtype.val) := by
+  simp [min?_attach, Option.map_pmap]
+
+theorem min?_eq_some_iff_subtype [Min α] [LE α] {xs : List α}
+    [MinEqOr α] [IsLinearOrder (Subtype (· ∈ xs))] [LawfulOrderMin (Subtype (· ∈ xs))] :
+    xs.min? = some a ↔ a ∈ xs ∧ ∀ b, b ∈ xs → a ≤ b := by
+  have := fun a => min?_eq_some_iff (xs := xs.attach) (a := a)
+  rw [min?_eq_min?_attach]
+  simp [min?_eq_some_iff]
+  constructor
+  · rintro ⟨ha, h⟩
+    exact ⟨ha, h⟩
+  · rintro ⟨ha, h⟩
+    exact ⟨ha, h⟩
+
+theorem min?_replicate [Min α] [Std.IdempotentOp (min : α → α → α)] {n : Nat} {a : α} :
     (replicate n a).min? = if n = 0 then none else some a := by
   induction n with
   | zero => rfl
-  | succ n ih => cases n <;> simp_all [replicate_succ, min?_cons']
+  | succ n ih => cases n <;> simp_all [replicate_succ, min?_cons', Std.IdempotentOp.idempotent]
 
-@[simp] theorem min?_replicate_of_pos [Min α] {n : Nat} {a : α} (w : min a a = a) (h : 0 < n) :
+@[simp] theorem min?_replicate_of_pos [Min α] [MinEqOr α] {n : Nat} {a : α} (h : 0 < n) :
     (replicate n a).min? = some a := by
-  simp [min?_replicate, Nat.ne_of_gt h, w]
+  simp [min?_replicate, Nat.ne_of_gt h]
 
+/--
+Requirements are satisfied for `[OrderData α] [Min α] [IsLinearOrder α] [LawfulOrderMin α]`
+-/
 theorem foldl_min [Min α] [Std.IdempotentOp (min : α → α → α)] [Std.Associative (min : α → α → α)]
     {l : List α} {a : α} : l.foldl (init := a) min = min a (l.min?.getD a) := by
   cases l <;> simp [min?, foldl_assoc, Std.IdempotentOp.idempotent]
@@ -144,54 +172,120 @@ theorem isSome_max?_of_mem {l : List α} [Max α] {a : α} (h : a ∈ l) :
     l.max?.isSome := by
   cases l <;> simp_all [max?_cons']
 
-theorem max?_mem [Max α] (min_eq_or : ∀ a b : α, max a b = a ∨ max a b = b) :
-    {xs : List α} → xs.max? = some a → a ∈ xs
-  | nil => by simp
-  | cons x xs => by
-    rw [max?]; rintro ⟨⟩
-    induction xs generalizing x with simp at *
-    | cons y xs ih =>
-      rcases ih (max x y) with h | h <;> simp [h]
-      simp [← or_assoc, min_eq_or x y]
-
--- See also `Init.Data.List.Nat.Basic` for specialisations of the next two results to `Nat`.
-
-theorem max?_le_iff [Max α] [LE α]
-    (max_le_iff : ∀ a b c : α, max b c ≤ a ↔ b ≤ a ∧ c ≤ a) :
-    {xs : List α} → xs.max? = some a → ∀ {x}, a ≤ x ↔ ∀ b ∈ xs, b ≤ x
-  | nil => by simp
-  | cons x xs => by
-    rw [max?]; rintro ⟨⟩ y
-    induction xs generalizing x with
+theorem max?_eq_head? {α : Type u} [Max α] {l : List α}
+    (h : l.Pairwise (fun a b => max a b = a)) : l.max? = l.head? := by
+  cases l with
+  | nil => rfl
+  | cons x l =>
+    rw [head?_cons, max?_cons', Option.some.injEq]
+    induction l generalizing x with
     | nil => simp
-    | cons y xs ih => simp [ih, max_le_iff, and_assoc]
+    | cons y l ih =>
+      have hx : max x y = x := rel_of_pairwise_cons h mem_cons_self
+      rw [foldl_cons, ih _ (hx.symm ▸ h.sublist (by simp)), hx]
 
--- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `max_eq_or`,
--- and `le_min_iff`.
-theorem max?_eq_some_iff [Max α] [LE α] [anti : Std.Antisymm (· ≤ · : α → α → Prop)]
-    (le_refl : ∀ a : α, a ≤ a)
-    (max_eq_or : ∀ a b : α, max a b = a ∨ max a b = b)
-    (max_le_iff : ∀ a b c : α, max b c ≤ a ↔ b ≤ a ∧ c ≤ a) {xs : List α} :
-    xs.max? = some a ↔ a ∈ xs ∧ ∀ b ∈ xs, b ≤ a := by
-  refine ⟨fun h => ⟨max?_mem max_eq_or h, (max?_le_iff max_le_iff h).1 (le_refl _)⟩, ?_⟩
+theorem max?_mem [Max α] [MaxEqOr α] :
+    {xs : List α} → xs.max? = some a → a ∈ xs := by
+  intro xs
+  match xs with
+  | nil => simp
+  | x :: xs =>
+    simp only [max?_cons', Option.some.injEq, mem_cons]
+    intro eq
+    induction xs generalizing x with
+    | nil =>
+      simp at eq
+      simp [eq]
+    | cons y xs ind =>
+      simp at eq
+      have p := ind _ eq
+      cases p with
+      | inl p =>
+        cases MaxEqOr.max_eq_or x y with | _ q => simp [p, q]
+      | inr p => simp [p, mem_cons]
+
+theorem max?_le_iff [Max α] [LE α] [LawfulOrderSup α] :
+    {xs : List α} → xs.max? = some a → ∀ {x}, a ≤ x ↔ ∀ b, b ∈ xs → b ≤ x
+  | nil => by simp
+  | cons x xs => by
+    rw [max?]
+    intro eq y
+    simp only [Option.some.injEq] at eq
+    induction xs generalizing x with
+    | nil =>
+      simp at eq
+      simp [eq]
+    | cons z xs ih =>
+      simp at eq
+      simp [ih _ eq, max_le_iff, and_assoc]
+
+theorem max?_eq_some_iff [Max α] [LE α] {xs : List α} [IsLinearOrder (α)]
+    [LawfulOrderMax α] : xs.max? = some a ↔ a ∈ xs ∧ ∀ b, b ∈ xs → b ≤ a := by
+  refine ⟨fun h => ⟨max?_mem h, (max?_le_iff h).1 (le_refl _)⟩, ?_⟩
   intro ⟨h₁, h₂⟩
   cases xs with
   | nil => simp at h₁
   | cons x xs =>
-    exact congrArg some <| anti.1 _ _
-      (h₂ _ (max?_mem max_eq_or (xs := x::xs) rfl))
-      ((max?_le_iff max_le_iff (xs := x::xs) rfl).1 (le_refl _) _ h₁)
+    rw [List.max?]
+    exact congrArg some <| le_antisymm
+      (h₂ _ (max?_mem (xs := x :: xs) rfl))
+      ((max?_le_iff (xs := x :: xs) rfl).1 (le_refl _) _ h₁)
 
-theorem max?_replicate [Max α] {n : Nat} {a : α} (w : max a a = a) :
+private theorem max?_attach [Max α] [MaxEqOr α] {xs : List α} :
+    xs.attach.max? = (xs.max?.pmap (fun m hm => ⟨m, max?_mem hm⟩) (fun _ => id)) := by
+  cases xs with
+  | nil => simp
+  | cons x xs =>
+    simp only [max?, attach_cons, Option.some.injEq, Option.pmap_some]
+    rw [foldl_map]
+    simp only [Subtype.ext_iff]
+    rw [← foldl_attach (l := xs)]
+    apply Eq.trans (foldl_hom (f := Subtype.val) ?_).symm
+    · rfl
+    · intros; rfl
+
+theorem max?_eq_max?_attach [Max α] [MaxEqOr α] {xs : List α} :
+    xs.max? = (xs.attach.max?.map Subtype.val) := by
+  simp [max?_attach, Option.map_pmap]
+
+theorem max?_eq_some_iff_subtype [Max α] [LE α] {xs : List α}
+    [MaxEqOr α] [IsLinearOrder (Subtype (· ∈ xs))]
+    [LawfulOrderMax (Subtype (· ∈ xs))] :
+    xs.max? = some a ↔ a ∈ xs ∧ ∀ b, b ∈ xs → b ≤ a := by
+  have := fun a => max?_eq_some_iff (xs := xs.attach) (a := a)
+  rw [max?_eq_max?_attach]
+  simp [max?_eq_some_iff]
+  constructor
+  · rintro ⟨ha, h⟩
+    exact ⟨ha, h⟩
+  · rintro ⟨ha, h⟩
+    exact ⟨ha, h⟩
+
+@[deprecated max?_eq_some_iff (since := "2025-08-01")]
+theorem max?_eq_some_iff_legacy [Max α] [LE α] [anti : Std.Antisymm (· ≤ · : α → α → Prop)]
+    (le_refl : ∀ a : α, a ≤ a)
+    (max_eq_or : ∀ a b : α, max a b = a ∨ max a b = b)
+    (max_le_iff : ∀ a b c : α, max b c ≤ a ↔ b ≤ a ∧ c ≤ a) {xs : List α} :
+    xs.max? = some a ↔ a ∈ xs ∧ ∀ b ∈ xs, b ≤ a := by
+  haveI : MaxEqOr α := ⟨max_eq_or⟩
+  haveI : LawfulOrderMax α := .of_le (fun _ _ _ => max_le_iff _ _ _) max_eq_or
+  haveI : Refl (α := α) (· ≤ ·) := ⟨le_refl⟩
+  haveI : IsLinearOrder α := .of_refl_of_antisymm_of_lawfulOrderMax
+  apply max?_eq_some_iff
+
+theorem max?_replicate [Max α] [Std.IdempotentOp (max : α → α → α)] {n : Nat} {a : α} :
     (replicate n a).max? = if n = 0 then none else some a := by
   induction n with
   | zero => rfl
-  | succ n ih => cases n <;> simp_all [replicate_succ, max?_cons']
+  | succ n ih => cases n <;> simp_all [replicate_succ, max?_cons', Std.IdempotentOp.idempotent]
 
-@[simp] theorem max?_replicate_of_pos [Max α] {n : Nat} {a : α} (w : max a a = a) (h : 0 < n) :
+@[simp] theorem max?_replicate_of_pos [Max α] [MaxEqOr α] {n : Nat} {a : α} (h : 0 < n) :
     (replicate n a).max? = some a := by
-  simp [max?_replicate, Nat.ne_of_gt h, w]
+  simp [max?_replicate, Nat.ne_of_gt h]
 
+/--
+Requirements are satisfied for `[OrderData α] [Max α] [LinearOrder α] [LawfulOrderMax α]`
+-/
 theorem foldl_max [Max α] [Std.IdempotentOp (max : α → α → α)] [Std.Associative (max : α → α → α)]
     {l : List α} {a : α} : l.foldl (init := a) max = max a (l.max?.getD a) := by
   cases l <;> simp [max?, foldl_assoc, Std.IdempotentOp.idempotent]

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

@@ -10,6 +10,7 @@ public import Init.Data.List.Count
 public import Init.Data.List.Find
 public import Init.Data.List.MinMax
 public import Init.Data.Nat.Lemmas
+import Init.Data.Nat.Order
 
 public section
 
@@ -210,12 +211,10 @@ theorem mem_eraseIdx_iff_getElem? {x : α} {l} {k} : x ∈ eraseIdx l k ↔ ∃
 /-! ### min? -/
 
 -- A specialization of `min?_eq_some_iff` to Nat.
+@[deprecated min?_eq_some_iff (since := "2025-08-08")]
 theorem min?_eq_some_iff' {xs : List Nat} :
-    xs.min? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, a ≤ b) :=
-  min?_eq_some_iff
-    (le_refl := Nat.le_refl)
-    (min_eq_or := fun _ _ => Nat.min_def .. ▸ by split <;> simp)
-    (le_min_iff := fun _ _ _ => Nat.le_min)
+    xs.min? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, a ≤ b) := by
+  exact min?_eq_some_iff
 
 theorem min?_get_le_of_mem {l : List Nat} {a : Nat} (h : a ∈ l) :
     l.min?.get (isSome_min?_of_mem h) ≤ a := by
@@ -237,12 +236,10 @@ theorem min?_getD_le_of_mem {l : List Nat} {a k : Nat} (h : a ∈ l) : l.min?.ge
 /-! ### max? -/
 
 -- A specialization of `max?_eq_some_iff` to Nat.
+@[deprecated max?_eq_some_iff (since := "2025-08-08")]
 theorem max?_eq_some_iff' {xs : List Nat} :
     xs.max? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, b ≤ a) :=
   max?_eq_some_iff
-    (le_refl := Nat.le_refl)
-    (max_eq_or := fun _ _ => Nat.max_def .. ▸ by split <;> simp)
-    (max_le_iff := fun _ _ _ => Nat.max_le)
 
 theorem le_max?_get_of_mem {l : List Nat} {a : Nat} (h : a ∈ l) :
     a ≤ l.max?.get (isSome_max?_of_mem h) := by

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

@@ -90,28 +90,27 @@ theorem map_sub_range' {a s : Nat} (h : a ≤ s) (n : Nat) :
   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
+theorem range'_eq_append_iff : range' s n step = xs ++ ys ↔ ∃ k, k ≤ n ∧ xs = range' s k step ∧ ys = range' (s + k * step) (n - k) step := by
   induction n generalizing s xs ys with
   | zero => simp
   | succ n ih =>
     simp only [range'_succ]
     rw [cons_eq_append_iff]
+    have add_mul' (k n m : Nat) : (n + m) * k = m * k + n * k := by rw [Nat.add_mul]; omega
     constructor
     · rintro (⟨rfl, rfl⟩ | ⟨_, 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
+        simp_all [range'_succ, Nat.add_assoc]
     · rintro ⟨k, h, rfl, rfl⟩
       cases k with
       | zero => simp [range'_succ]
       | succ k =>
-        simp only [range'_succ, reduceCtorEq, false_and, cons.injEq, true_and, ih, range'_inj, exists_eq_left', or_true, and_true, false_or]
+        simp only [range'_succ, reduceCtorEq, false_and, cons.injEq, true_and, ih, exists_eq_left', false_or]
         refine ⟨k, ?_⟩
-        simp_all
-        omega
+        simp_all [Nat.add_assoc]
 
 @[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
@@ -178,6 +177,46 @@ theorem count_range_1' {a s n} :
     specialize h (a - s)
     omega
 
+@[simp, grind =]
+theorem sum_range' : (range' start n step).sum = n * start + n * (n - 1) * step / 2 := by
+  induction n generalizing start with
+  | zero => simp
+  | succ n ih =>
+    simp_all only [List.range'_succ, List.sum_cons, Nat.mul_add, ← Nat.add_assoc,
+      Nat.add_mul, Nat.one_mul, Nat.add_one_sub_one]
+    have : n * step + n * (n - 1) * step / 2 = (n * n * step + n * step) / 2 := by
+      apply Nat.eq_div_of_mul_eq_left (by omega)
+      rw [Nat.add_mul, Nat.div_mul_cancel]
+      · calc  n * step * 2 + n * (n - 1) * step
+          _ = n * step * 2 + n * step * (n - 1) := by simp [Nat.mul_comm, Nat.mul_assoc]
+          _ = n * step + n * step * n := by cases n <;> simp [Nat.mul_succ, Nat.add_assoc, Nat.add_comm]
+          _ = n * n * step + n * step := by simp [Nat.mul_comm, Nat.add_comm, Nat.mul_left_comm]
+      · have : 2 ∣ n ∨ 2 ∣ (n - 1) := by omega
+        apply Nat.dvd_mul_right_of_dvd
+        apply Nat.dvd_mul.mpr
+        cases this with
+        | inl h => exists 2, 1; omega
+        | inr h => exists 1, 2; omega
+    omega
+
+@[simp, grind =]
+theorem drop_range' : (List.range' start n step).drop k = List.range' (start + k * step) (n - k) step := by
+  induction k generalizing start n with
+  | zero => simp
+  | succ => cases n <;> simp [*, List.range'_succ, Nat.add_mul, ← Nat.add_assoc, Nat.add_right_comm]
+
+@[simp, grind =]
+theorem take_range'_of_length_le (h : n ≤ k) : (List.range' start n step).take k = List.range' start n step := by
+  induction n generalizing start k with
+  | zero => simp
+  | succ n ih => cases k <;> simp_all [List.range'_succ]
+
+@[simp, grind =]
+theorem take_range'_of_length_ge (h : n ≥ k) : (List.range' start n step).take k = List.range' start k step := by
+  induction k generalizing start n with
+  | zero => simp
+  | succ k ih => cases n <;> simp_all [List.range'_succ]
+
 /-! ### range -/
 
 theorem reverse_range' : ∀ {s n : Nat}, reverse (range' s n) = map (s + n - 1 - ·) (range n)
@@ -355,9 +394,7 @@ theorem zipIdx_eq_append_iff {l : List α} {k : Nat} :
     simp only [length_range'] at h
     obtain rfl := h
     refine ⟨ws, xs, rfl, ?_⟩
-    simp only [zipIdx_eq_zip_range', length_append, true_and]
-    congr
-    omega
+    simp [zipIdx_eq_zip_range', length_append]
   · rintro ⟨l₁', l₂', rfl, rfl, rfl⟩
     simp only [zipIdx_eq_zip_range']
     refine ⟨l₁', l₂', range' k l₁'.length, range' (k + l₁'.length) l₂'.length, ?_⟩

src/Init/Data/List/Range.lean

@@ -29,30 +29,31 @@ open Nat
 
 /-! ### range' -/
 
-theorem range'_succ {s n step} : range' s (n + 1) step = s :: range' (s + step) n step := by
-  simp [range']
-
-@[simp] theorem length_range' {s step} : ∀ {n : Nat}, length (range' s n step) = n
+@[simp, grind =] theorem length_range' {s step} : ∀ {n : Nat}, length (range' s n step) = n
   | 0 => rfl
   | _ + 1 => congrArg succ length_range'
 
-@[simp] theorem range'_eq_nil_iff : range' s n step = [] ↔ n = 0 := by
+@[simp, grind =] theorem range'_eq_nil_iff : range' s n step = [] ↔ n = 0 := by
   rw [← length_eq_zero_iff, length_range']
 
 theorem range'_ne_nil_iff (s : Nat) {n step : Nat} : range' s n step ≠ [] ↔ n ≠ 0 := by
   cases n <;> simp
 
-@[simp] theorem range'_zero : range' s 0 step = [] := by
-  simp
+theorem range'_eq_cons_iff : range' s n step = a :: xs ↔ s = a ∧ 0 < n ∧ xs = range' (a + step) (n - 1) step := 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'_one {s step : Nat} : range' s 1 step = [s] := rfl
-
-@[simp] theorem tail_range' : (range' s n step).tail = range' (s + step) (n - 1) step := by
+@[simp, grind =] theorem tail_range' : (range' s n step).tail = range' (s + step) (n - 1) step := by
   cases n with
   | zero => simp
   | succ n => simp [range'_succ]
 
-@[simp] theorem range'_inj : range' s n = range' s' n' ↔ n = n' ∧ (n = 0 ∨ s = s') := by
+@[simp, grind =] 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
@@ -81,14 +82,14 @@ theorem getElem?_range' {s step} :
     exact (getElem?_range' (s := s + step) (by exact succ_lt_succ_iff.mp h)).trans <| by
       simp [Nat.mul_succ, Nat.add_assoc, Nat.add_comm]
 
-@[simp] theorem getElem_range' {n m step} {i} (H : i < (range' n m step).length) :
+@[simp, grind =] theorem getElem_range' {n m step} {i} (H : i < (range' n m step).length) :
     (range' n m step)[i] = n + step * i :=
   (getElem?_eq_some_iff.1 <| getElem?_range' (by simpa using H)).2
 
 theorem head?_range' : (range' s n).head? = if n = 0 then none else some s := by
   induction n <;> simp_all [range'_succ]
 
-@[simp] theorem head_range' (h) : (range' s n).head h = s := by
+@[simp, grind =] theorem head_range' (h) : (range' s n).head h = s := by
   repeat simp_all [head?_range', head_eq_iff_head?_eq_some]
 
 theorem map_add_range' {a} : ∀ s n step, map (a + ·) (range' s n step) = range' (a + s) n step
@@ -107,7 +108,7 @@ theorem range'_append : ∀ {s m n step : Nat},
     simpa [range', Nat.mul_succ, Nat.add_assoc, Nat.add_comm]
       using range'_append (s := s + step)
 
-@[simp] theorem range'_append_1 {s m n : Nat} :
+@[simp, grind =] theorem range'_append_1 {s m n : Nat} :
     range' s m ++ range' (s + m) n = range' s (m + n) := by simpa using range'_append (step := 1)
 
 theorem range'_sublist_right {s m n : Nat} : range' s m step <+ range' s n step ↔ m ≤ n :=
@@ -129,15 +130,6 @@ 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]
-
 /-! ### range -/
 
 @[simp, grind =] theorem range_one : range 1 = [0] := rfl
@@ -152,7 +144,7 @@ theorem range_eq_range' {n : Nat} : range n = range' 0 n :=
 theorem getElem?_range {i n : Nat} (h : i < n) : (range n)[i]? = some i := by
   simp [range_eq_range', getElem?_range' h]
 
-@[simp] theorem getElem_range (h : j < (range n).length) : (range n)[j] = j := by
+@[simp, grind =] theorem getElem_range (h : j < (range n).length) : (range n)[j] = j := by
   simp [range_eq_range']
 
 theorem range_succ_eq_map {n : Nat} : range (n + 1) = 0 :: map succ (range n) := by
@@ -162,23 +154,23 @@ theorem range_succ_eq_map {n : Nat} : range (n + 1) = 0 :: map succ (range n) :=
 theorem range'_eq_map_range {s n : Nat} : range' s n = map (s + ·) (range n) := by
   rw [range_eq_range', map_add_range']; rfl
 
-@[simp] theorem length_range {n : Nat} : (range n).length = n := by
+@[simp, grind =] theorem length_range {n : Nat} : (range n).length = n := by
   simp only [range_eq_range', length_range']
 
-@[simp] theorem range_eq_nil {n : Nat} : range n = [] ↔ n = 0 := by
+@[simp, grind =] theorem range_eq_nil {n : Nat} : range n = [] ↔ n = 0 := by
   rw [← length_eq_zero_iff, length_range]
 
 theorem range_ne_nil {n : Nat} : range n ≠ [] ↔ n ≠ 0 := by
   cases n <;> simp
 
-@[simp] theorem tail_range : (range n).tail = range' 1 (n - 1) := by
+@[simp, grind =] theorem tail_range : (range n).tail = range' 1 (n - 1) := by
   rw [range_eq_range', tail_range']
 
-@[simp]
+@[simp, grind =]
 theorem range_sublist {m n : Nat} : range m <+ range n ↔ m ≤ n := by
   simp only [range_eq_range', range'_sublist_right]
 
-@[simp]
+@[simp, grind =]
 theorem range_subset {m n : Nat} : range m ⊆ range n ↔ m ≤ n := by
   simp only [range_eq_range', range'_subset_right, lt_succ_self]
 
@@ -196,7 +188,7 @@ theorem head?_range {n : Nat} : (range n).head? = if n = 0 then none else some 0
     simp only [range_succ, head?_append, ih]
     split <;> simp_all
 
-@[simp] theorem head_range {n : Nat} (h) : (range n).head h = 0 := by
+@[simp, grind =] theorem head_range {n : Nat} (h) : (range n).head h = 0 := by
   cases n with
   | zero => simp at h
   | succ n => simp [head?_range, head_eq_iff_head?_eq_some]
@@ -208,7 +200,7 @@ theorem getLast?_range {n : Nat} : (range n).getLast? = if n = 0 then none else
     simp only [range_succ, getLast?_append, ih]
     split <;> simp_all
 
-@[simp] theorem getLast_range {n : Nat} (h) : (range n).getLast h = n - 1 := by
+@[simp, grind =] 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, getLast_eq_iff_getLast?_eq_some]

src/Init/Data/List/TakeDrop.lean

@@ -68,9 +68,9 @@ theorem take_of_length_le {l : List α} (h : l.length ≤ i) : take i l = l := b
 theorem lt_length_of_take_ne_self {l : List α} {i} (h : l.take i ≠ l) : i < l.length :=
   gt_of_not_le (mt take_of_length_le h)
 
-@[simp] theorem drop_length {l : List α} : l.drop l.length = [] := drop_of_length_le (Nat.le_refl _)
+@[simp, grind =] theorem drop_length {l : List α} : l.drop l.length = [] := drop_of_length_le (Nat.le_refl _)
 
-@[simp] theorem take_length {l : List α} : l.take l.length = l := take_of_length_le (Nat.le_refl _)
+@[simp, grind =] theorem take_length {l : List α} : l.take l.length = l := take_of_length_le (Nat.le_refl _)
 
 @[simp]
 theorem getElem_cons_drop : ∀ {l : List α} {i : Nat} (h : i < l.length),

src/Init/Data/Nat.lean

@@ -11,6 +11,7 @@ public import Init.Data.Nat.Div
 public import Init.Data.Nat.Dvd
 public import Init.Data.Nat.Gcd
 public import Init.Data.Nat.MinMax
+public import Init.Data.Nat.Order
 public import Init.Data.Nat.Bitwise
 public import Init.Data.Nat.Control
 public import Init.Data.Nat.Log2
@@ -23,5 +24,6 @@ public import Init.Data.Nat.Lcm
 public import Init.Data.Nat.Compare
 public import Init.Data.Nat.Simproc
 public import Init.Data.Nat.Fold
+public import Init.Data.Nat.Order
 
 public section

src/Init/Data/Nat/Order.lean

@@ -0,0 +1,41 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+public import Init.Data.Nat.Basic
+import Init.Data.Nat.MinMax
+public import Init.Data.Order.Factories
+
+open Std
+
+namespace Nat
+
+public instance instIsLinearOrder : IsLinearOrder Nat := by
+  apply IsLinearOrder.of_le
+  · constructor; apply Nat.le_antisymm
+  · constructor; apply Nat.le_trans
+  · constructor; apply Nat.le_total
+
+public instance : LawfulOrderLT Nat := by
+  apply LawfulOrderLT.of_le
+  simp [Nat.lt_iff_le_and_ne]
+
+public instance : LawfulOrderMin Nat := by
+  apply LawfulOrderMin.of_le
+  · apply Nat.le_min
+  · intro a b
+    simp only [Nat.min_def]
+    split <;> simp
+
+public instance : LawfulOrderMax Nat := by
+  apply LawfulOrderMax.of_le
+  · apply Nat.max_le
+  · intro a b
+    simp only [Nat.max_def]
+    split <;> simp
+
+end Nat

src/Init/Data/Option/Lemmas.lean

@@ -58,9 +58,9 @@ theorem getD_of_ne_none {x : Option α} (hx : x ≠ none) (y : α) : some (x.get
 theorem getD_eq_iff {o : Option α} {a b} : o.getD a = b ↔ (o = some b ∨ o = none ∧ a = b) := by
   cases o <;> simp
 
-@[simp, grind] theorem get!_none [Inhabited α] : (none : Option α).get! = default := rfl
+@[simp, grind =] theorem get!_none [Inhabited α] : (none : Option α).get! = default := rfl
 
-@[simp, grind] theorem get!_some [Inhabited α] {a : α} : (some a).get! = a := rfl
+@[simp, grind =] theorem get!_some [Inhabited α] {a : α} : (some a).get! = a := rfl
 
 theorem get_eq_get! [Inhabited α] : (o : Option α) → {h : o.isSome} → o.get h = o.get!
   | some _, _ => rfl
@@ -120,7 +120,7 @@ theorem isSome_of_eq_some {x : Option α} {y : α} (h : x = some y) : x.isSome :
 @[simp] theorem isNone_eq_false_iff : isNone a = false ↔ a.isSome = true := by
   cases a <;> simp
 
-@[simp, grind]
+@[simp, grind =]
 theorem not_isSome (a : Option α) : (!a.isSome) = a.isNone := by
   cases a <;> simp
 
@@ -129,7 +129,7 @@ theorem not_comp_isSome : (! ·) ∘ @Option.isSome α = Option.isNone := by
   funext
   simp
 
-@[simp, grind]
+@[simp, grind =]
 theorem not_isNone (a : Option α) : (!a.isNone) = a.isSome := by
   cases a <;> simp
 
@@ -191,11 +191,15 @@ theorem forall_ne_none {p : Option α → Prop} : (∀ x (_ : x ≠ none), p x)
 @[deprecated forall_ne_none (since := "2025-04-04")]
 abbrev ball_ne_none := @forall_ne_none
 
-@[simp, grind] theorem pure_def : pure = @some α := rfl
+@[simp] theorem pure_def : pure = @some α := rfl
 
-@[simp, grind] theorem bind_eq_bind : bind = @Option.bind α β := rfl
+@[grind =] theorem pure_apply : pure x = some x := rfl
 
-@[simp, grind] theorem bind_fun_some (x : Option α) : x.bind some = x := by cases x <;> rfl
+@[simp] theorem bind_eq_bind : bind = @Option.bind α β := rfl
+
+@[grind =] theorem bind_apply : bind x f = Option.bind x f := rfl
+
+@[simp, grind =] theorem bind_fun_some (x : Option α) : x.bind some = x := by cases x <;> rfl
 
 @[simp] theorem bind_fun_none (x : Option α) : x.bind (fun _ => none (α := β)) = none := by
   cases x <;> rfl
@@ -216,7 +220,7 @@ theorem bind_eq_none' {o : Option α} {f : α → Option β} :
     o.bind f = none ↔ ∀ b a, o = some a → f a ≠ some b := by
   cases o <;> simp [eq_none_iff_forall_ne_some]
 
-@[grind] theorem mem_bind_iff {o : Option α} {f : α → Option β} :
+@[grind =] theorem mem_bind_iff {o : Option α} {f : α → Option β} :
     b ∈ o.bind f ↔ ∃ a, a ∈ o ∧ b ∈ f a := by
   cases o <;> simp
 
@@ -224,7 +228,7 @@ theorem bind_comm {f : α → β → Option γ} (a : Option α) (b : Option β)
     (a.bind fun x => b.bind (f x)) = b.bind fun y => a.bind fun x => f x y := by
   cases a <;> cases b <;> rfl
 
-@[grind]
+@[grind =]
 theorem bind_assoc (x : Option α) (f : α → Option β) (g : β → Option γ) :
     (x.bind f).bind g = x.bind fun y => (f y).bind g := by cases x <;> rfl
 
@@ -232,12 +236,12 @@ theorem bind_congr {α β} {o : Option α} {f g : α → Option β} :
     (h : ∀ a, o = some a → f a = g a) → o.bind f = o.bind g := by
   cases o <;> simp
 
-@[grind]
+@[grind =]
 theorem isSome_bind {α β : Type _} (x : Option α) (f : α → Option β) :
     (x.bind f).isSome = x.any (fun x => (f x).isSome) := by
   cases x <;> rfl
 
-@[grind]
+@[grind =]
 theorem isNone_bind {α β : Type _} (x : Option α) (f : α → Option β) :
     (x.bind f).isNone = x.all (fun x => (f x).isNone) := by
   cases x <;> rfl
@@ -250,7 +254,7 @@ theorem isSome_apply_of_isSome_bind {α β : Type _} {x : Option α} {f : α →
     (h : (x.bind f).isSome) : (f (x.get (isSome_of_isSome_bind h))).isSome := by
   cases x <;> trivial
 
-@[simp, grind] theorem get_bind {α β : Type _} {x : Option α} {f : α → Option β} (h : (x.bind f).isSome) :
+@[simp, grind =] theorem get_bind {α β : Type _} {x : Option α} {f : α → Option β} (h : (x.bind f).isSome) :
     (x.bind f).get h = (f (x.get (isSome_of_isSome_bind h))).get
       (isSome_apply_of_isSome_bind h) := by
   cases x <;> trivial
@@ -263,7 +267,7 @@ theorem isSome_apply_of_isSome_bind {α β : Type _} {x : Option α} {f : α →
     (o.bind f).all p = o.all (Option.all p ∘ f) := by
   cases o <;> simp
 
-@[grind] theorem bind_id_eq_join {x : Option (Option α)} : x.bind id = x.join := rfl
+@[grind =] theorem bind_id_eq_join {x : Option (Option α)} : x.bind id = x.join := rfl
 
 theorem join_eq_some_iff : x.join = some a ↔ x = some (some a) := by
   simp [← bind_id_eq_join, bind_eq_some_iff]
@@ -287,7 +291,9 @@ theorem bind_join {f : α → Option β} {o : Option (Option α)} :
     o.join.bind f = o.bind (·.bind f) := by
   cases o <;> simp
 
-@[simp, grind] theorem map_eq_map : Functor.map f = Option.map f := rfl
+@[simp] theorem map_eq_map : Functor.map f = Option.map f := rfl
+
+@[grind =] theorem map_apply : Functor.map f x = Option.map f x := rfl
 
 @[deprecated map_none (since := "2025-04-10")]
 abbrev map_none' := @map_none
@@ -313,13 +319,13 @@ abbrev map_eq_none := @map_eq_none_iff
 @[deprecated map_eq_none_iff (since := "2025-04-10")]
 abbrev map_eq_none' := @map_eq_none_iff
 
-@[simp, grind] theorem isSome_map {x : Option α} : (x.map f).isSome = x.isSome := by
+@[simp, grind =] theorem isSome_map {x : Option α} : (x.map f).isSome = x.isSome := by
   cases x <;> simp
 
 @[deprecated isSome_map (since := "2025-04-10")]
 abbrev isSome_map' := @isSome_map
 
-@[simp, grind] theorem isNone_map {x : Option α} : (x.map f).isNone = x.isNone := by
+@[simp, grind =] theorem isNone_map {x : Option α} : (x.map f).isNone = x.isNone := by
   cases x <;> simp
 
 theorem map_eq_bind {x : Option α} : x.map f = x.bind (some ∘ f) := by
@@ -329,28 +335,32 @@ theorem map_congr {x : Option α} (h : ∀ a, x = some a → f a = g a) :
     x.map f = x.map g := by
   cases x <;> simp only [map_none, map_some, h]
 
-@[simp, grind] theorem map_id_fun {α : Type u} : Option.map (id : α → α) = id := by
+@[simp] theorem map_id_fun {α : Type u} : Option.map (id : α → α) = id := by
   funext; simp [map_id]
 
+@[grind =] theorem map_id_apply {α : Type u} {x : Option α} : Option.map (id : α → α) x = x := by simp
+
 theorem map_id' {x : Option α} : (x.map fun a => a) = x := congrFun map_id x
 
-@[simp, grind] theorem map_id_fun' {α : Type u} : Option.map (fun (a : α) => a) = id := by
+@[simp] theorem map_id_fun' {α : Type u} : Option.map (fun (a : α) => a) = id := by
   funext; simp [map_id']
 
-@[simp, grind] theorem get_map {f : α → β} {o : Option α} {h : (o.map f).isSome} :
+@[grind =] theorem map_id_apply' {α : Type u} {x : Option α} : Option.map (fun (a : α) => a) x = x := by simp
+
+@[simp, grind =] 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, grind _=_] theorem map_map (h : β → γ) (g : α → β) (x : Option α) :
+@[simp] theorem map_map (h : β → γ) (g : α → β) (x : Option α) :
     (x.map g).map h = x.map (h ∘ g) := by
   cases x <;> simp only [map_none, map_some, ·∘·]
 
 theorem comp_map (h : β → γ) (g : α → β) (x : Option α) : x.map (h ∘ g) = (x.map g).map h :=
   (map_map ..).symm
 
-@[simp, grind _=_] theorem map_comp_map (f : α → β) (g : β → γ) :
+@[simp] theorem map_comp_map (f : α → β) (g : β → γ) :
     Option.map g ∘ Option.map f = Option.map (g ∘ f) := by funext x; simp
 
 theorem mem_map_of_mem (g : α → β) (h : a ∈ x) : g a ∈ Option.map g x := h.symm ▸ map_some ..
@@ -372,9 +382,9 @@ theorem map_inj_right {f : α → β} {o o' : Option α} (w : ∀ x y, f x = f y
      (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, grind] theorem filter_none (p : α → Bool) : none.filter p = none := rfl
+@[simp, grind =] theorem filter_none (p : α → Bool) : none.filter p = none := rfl
 
-@[grind] theorem filter_some : Option.filter p (some a) = if p a then some a else none := rfl
+@[grind =] theorem filter_some : Option.filter p (some a) = if p a then some a else none := rfl
 
 theorem filter_some_pos (h : p a) : Option.filter p (some a) = some a := by
   rw [filter_some, if_pos h]
@@ -417,12 +427,12 @@ theorem filter_some_eq_some : Option.filter p (some a) = some a ↔ p a := by si
 
 theorem filter_some_eq_none : Option.filter p (some a) = none ↔ ¬p a := by simp
 
-@[grind]
+@[grind =]
 theorem mem_filter_iff {p : α → Bool} {a : α} {o : Option α} :
     a ∈ o.filter p ↔ a ∈ o ∧ p a := by
   simp
 
-@[grind]
+@[grind =]
 theorem bind_guard (x : Option α) (p : α → Bool) :
     x.bind (Option.guard p) = x.filter p := by
   cases x <;> rfl
@@ -457,7 +467,7 @@ theorem filter_eq_bind (x : Option α) (p : α → Bool) :
     | false => by simp [filter_some_neg h, h]
     | true => by simp [filter_some_pos h, h]
 
-@[simp, grind] theorem isSome_filter : Option.isSome (Option.filter p o) = Option.any p o :=
+@[simp, grind =] theorem isSome_filter : Option.isSome (Option.filter p o) = Option.any p o :=
   match o with
   | none => rfl
   | some a =>
@@ -536,12 +546,12 @@ theorem get_of_any_eq_true (p : α → Bool) (x : Option α) (h : x.any p = true
     p (x.get (isSome_of_any h)) :=
   any_eq_true_iff_get p x |>.1 h |>.2
 
-@[grind]
+@[grind =]
 theorem any_map {α β : Type _} {x : Option α} {f : α → β} {p : β → Bool} :
     (x.map f).any p = x.any (fun a => p (f a)) := by
   cases x <;> rfl
 
-@[grind]
+@[grind =]
 theorem all_map {α β : Type _} {x : Option α} {f : α → β} {p : β → Bool} :
     (x.map f).all p = x.all (fun a => p (f a)) := by
   cases x <;> rfl
@@ -549,13 +559,13 @@ theorem all_map {α β : Type _} {x : Option α} {f : α → β} {p : β → Boo
 theorem bind_map_comm {α β} {x : Option (Option α)} {f : α → β} :
     x.bind (Option.map f) = (x.map (Option.map f)).bind id := by cases x <;> simp
 
-@[grind] theorem bind_map {f : α → β} {g : β → Option γ} {x : Option α} :
+@[grind =] theorem bind_map {f : α → β} {g : β → Option γ} {x : Option α} :
     (x.map f).bind g = x.bind (g ∘ f) := by cases x <;> simp
 
-@[simp, grind] theorem map_bind {f : α → Option β} {g : β → γ} {x : Option α} :
+@[simp, grind =] theorem map_bind {f : α → Option β} {g : β → γ} {x : Option α} :
     (x.bind f).map g = x.bind (Option.map g ∘ f) := by cases x <;> simp
 
-@[grind] theorem join_map_eq_map_join {f : α → β} {x : Option (Option α)} :
+@[grind =] theorem join_map_eq_map_join {f : α → β} {x : Option (Option α)} :
     (x.map (Option.map f)).join = x.join.map f := by cases x <;> simp
 
 @[grind _=_] theorem join_join {x : Option (Option (Option α))} : x.join.join = (x.map join).join := by
@@ -652,10 +662,11 @@ theorem get_none_eq_iff_true {h} : (none : Option α).get h = a ↔ True := by
   simp only [guard]
   split <;> simp
 
-@[grind]
 theorem guard_def (p : α → Bool) :
     Option.guard p = fun x => if p x then some x else none := rfl
 
+@[grind =] theorem guard_apply : Option.guard p x = if p x then some x else none := rfl
+
 @[deprecated guard_def (since := "2025-05-15")]
 theorem guard_eq_map (p : α → Bool) :
     Option.guard p = fun x => Option.map (fun _ => x) (if p x then some x else none) := by
@@ -704,13 +715,13 @@ theorem merge_eq_or_eq {f : α → α → α} (h : ∀ a b, f a b = a ∨ f a b
   | none, some _ => .inr rfl
   | some a, some b => by have := h a b; simp [merge] at this ⊢; exact this
 
-@[simp, grind] theorem merge_none_left {f} {b : Option α} : merge f none b = b := by
+@[simp, grind =] theorem merge_none_left {f} {b : Option α} : merge f none b = b := by
   cases b <;> rfl
 
-@[simp, grind] theorem merge_none_right {f} {a : Option α} : merge f a none = a := by
+@[simp, grind =] theorem merge_none_right {f} {a : Option α} : merge f a none = a := by
   cases a <;> rfl
 
-@[simp, grind] theorem merge_some_some {f} {a b : α} :
+@[simp, grind =] theorem merge_some_some {f} {a b : α} :
   merge f (some a) (some b) = some (f a b) := rfl
 
 @[deprecated merge_eq_or_eq (since := "2025-04-04")]
@@ -784,9 +795,9 @@ theorem get_merge {o o' : Option α} {f : α → α → α} {i : α} [Std.Lawful
     (o.merge f o').get h = f (o.getD i) (o'.getD i) := by
   cases o <;> cases o' <;> simp [Std.LawfulLeftIdentity.left_id, Std.LawfulRightIdentity.right_id]
 
-@[simp, grind] theorem elim_none (x : β) (f : α → β) : none.elim x f = x := rfl
+@[simp, grind =] theorem elim_none (x : β) (f : α → β) : none.elim x f = x := rfl
 
-@[simp, grind] theorem elim_some (x : β) (f : α → β) (a : α) : (some a).elim x f = f a := rfl
+@[simp, grind =] theorem elim_some (x : β) (f : α → β) (a : α) : (some a).elim x f = f a := rfl
 
 @[grind =] theorem elim_filter {o : Option α} {b : β} :
     Option.elim (Option.filter p o) b f = Option.elim o b (fun a => if p a then f a else b) :=
@@ -804,7 +815,8 @@ theorem get_merge {o o' : Option α} {f : α → α → α} {i : α} [Std.Lawful
 theorem elim_guard : (guard p a).elim b f = if p a then f a else b := by
   cases h : p a <;> simp [*, guard]
 
-@[simp, grind] theorem getD_map (f : α → β) (x : α) (o : Option α) :
+-- I don't see how to construct a good grind pattern to instantiate this.
+@[simp] theorem getD_map (f : α → β) (x : α) (o : Option α) :
   (o.map f).getD (f x) = f (getD o x) := by cases o <;> rfl
 
 section choice
@@ -867,37 +879,37 @@ theorem get!_choice [Inhabited α] : (choice α).get! = (choice α).get isSome_c
 
 end choice
 
-@[simp, grind] theorem toList_some (a : α) : (some a).toList = [a] := rfl
-@[simp, grind] theorem toList_none (α : Type _) : (none : Option α).toList = [] := rfl
+@[simp, grind =] theorem toList_some (a : α) : (some a).toList = [a] := rfl
+@[simp, grind =] theorem toList_none (α : Type _) : (none : Option α).toList = [] := rfl
 
-@[simp, grind] theorem toArray_some (a : α) : (some a).toArray = #[a] := rfl
-@[simp, grind] theorem toArray_none (α : Type _) : (none : Option α).toArray = #[] := rfl
+@[simp, grind =] theorem toArray_some (a : α) : (some a).toArray = #[a] := rfl
+@[simp, grind =] theorem toArray_none (α : Type _) : (none : Option α).toArray = #[] := rfl
 
 -- See `Init.Data.Option.List` for lemmas about `toList`.
 
-@[simp, grind] theorem some_or : (some a).or o = some a := rfl
-@[simp, grind] theorem none_or : none.or o = o := rfl
+@[simp, grind =] theorem some_or : (some a).or o = some a := rfl
+@[simp, grind =] theorem none_or : none.or o = o := rfl
 
 theorem or_eq_right_of_none {o o' : Option α} (h : o = none) : o.or o' = o' := by
   cases h; simp
 
-@[simp, grind] theorem or_some {o : Option α} : o.or (some a) = some (o.getD a) := by
+@[simp, grind =] theorem or_some {o : Option α} : o.or (some a) = some (o.getD a) := by
   cases o <;> rfl
 
 @[deprecated or_some (since := "2025-05-03")]
 abbrev or_some' := @or_some
 
-@[simp, grind]
+@[simp, grind =]
 theorem or_none : or o none = o := by
   cases o <;> rfl
 
 theorem or_eq_bif : or o o' = bif o.isSome then o else o' := by
   cases o <;> rfl
 
-@[simp, grind] theorem isSome_or : (or o o').isSome = (o.isSome || o'.isSome) := by
+@[simp, grind =] theorem isSome_or : (or o o').isSome = (o.isSome || o'.isSome) := by
   cases o <;> rfl
 
-@[simp, grind] theorem isNone_or : (or o o').isNone = (o.isNone && o'.isNone) := by
+@[simp, grind =] theorem isNone_or : (or o o').isNone = (o.isNone && o'.isNone) := by
   cases o <;> rfl
 
 @[simp] theorem or_eq_none_iff : or o o' = none ↔ o = none ∧ o' = none := by
@@ -912,7 +924,7 @@ abbrev or_eq_none := @or_eq_none_iff
 @[deprecated or_eq_some_iff (since := "2025-04-10")]
 abbrev or_eq_some := @or_eq_some_iff
 
-@[grind] theorem or_assoc : or (or o₁ o₂) o₃ = or o₁ (or o₂ o₃) := by
+@[grind _=_] theorem or_assoc : or (or o₁ o₂) o₃ = or o₁ (or o₂ o₃) := by
   cases o₁ <;> cases o₂ <;> rfl
 instance : Std.Associative (or (α := α)) := ⟨@or_assoc _⟩
 
@@ -923,7 +935,7 @@ instance : Std.LawfulIdentity (or (α := α)) none where
   left_id := @none_or _
   right_id := @or_none _
 
-@[simp, grind]
+@[simp, grind =]
 theorem or_self : or o o = o := by
   cases o <;> rfl
 instance : Std.IdempotentOp (or (α := α)) := ⟨@or_self _⟩
@@ -962,13 +974,15 @@ theorem guard_or_guard : (guard p a).or (guard q a) = guard (fun x => p x || q x
 /-! ### `orElse` -/
 
 /-- The `simp` normal form of `o <|> o'` is `o.or o'` via `orElse_eq_orElse` and `orElse_eq_or`. -/
-@[simp, grind] theorem orElse_eq_orElse : HOrElse.hOrElse = @Option.orElse α := rfl
+@[simp] theorem orElse_eq_orElse : HOrElse.hOrElse = @Option.orElse α := rfl
+
+@[grind =] theorem orElse_apply : HOrElse.hOrElse o o' = Option.orElse o o' := rfl
 
 theorem or_eq_orElse : or o o' = o.orElse (fun _ => o') := by
   cases o <;> rfl
 
 /-- The `simp` normal form of `o.orElse f` is o.or (f ())`. -/
-@[simp, grind] theorem orElse_eq_or {o : Option α} {f} : o.orElse f = o.or (f ()) := by
+@[simp, grind =] theorem orElse_eq_or {o : Option α} {f} : o.orElse f = o.or (f ()) := by
   simp [or_eq_orElse]
 
 @[deprecated or_some (since := "2025-05-03")]
@@ -1001,13 +1015,13 @@ section beq
 
 variable [BEq α]
 
-@[simp, grind] theorem none_beq_none : ((none : Option α) == none) = true := rfl
-@[simp, grind] theorem none_beq_some (a : α) : ((none : Option α) == some a) = false := rfl
-@[simp, grind] theorem some_beq_none (a : α) : ((some a : Option α) == none) = false := rfl
-@[simp, grind] theorem some_beq_some {a b : α} : (some a == some b) = (a == b) := rfl
+@[simp, grind =] theorem none_beq_none : ((none : Option α) == none) = true := rfl
+@[simp, grind =] theorem none_beq_some (a : α) : ((none : Option α) == some a) = false := rfl
+@[simp, grind =] theorem some_beq_none (a : α) : ((some a : Option α) == none) = false := rfl
+@[simp, grind =] theorem some_beq_some {a b : α} : (some a == some b) = (a == b) := rfl
 
 /-- We simplify away `isEqSome` in terms of `==`. -/
-@[simp, grind] theorem isEqSome_eq_beq_some {o : Option α} : isEqSome o y = (o == some y) := by
+@[simp, grind =] theorem isEqSome_eq_beq_some {o : Option α} : isEqSome o y = (o == some y) := by
   cases o <;> simp [isEqSome]
 
 @[simp] theorem reflBEq_iff : ReflBEq (Option α) ↔ ReflBEq α := by
@@ -1128,12 +1142,15 @@ theorem mem_ite_none_right {x : α} {_ : Decidable p} {l : Option α} :
 @[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
@@ -1145,9 +1162,11 @@ theorem mem_ite_none_right {x : α} {_ : Decidable p} {l : Option α} :
   · 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
@@ -1155,13 +1174,14 @@ theorem mem_ite_none_right {x : α} {_ : Decidable p} {l : Option α} :
     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
 
-@[simp, grind] theorem get_filter {α : Type _} {x : Option α} {f : α → Bool} (h : (x.filter f).isSome) :
+@[simp, grind =] theorem get_filter {α : Type _} {x : Option α} {f : α → Bool} (h : (x.filter f).isSome) :
     (x.filter f).get h = x.get (isSome_of_isSome_filter f x h) := by
   cases x
   · contradiction
@@ -1176,16 +1196,16 @@ end ite
 @[grind = gen] theorem pbind_none' (h : x = none) : pbind x f = none := by subst h; rfl
 @[grind = gen] theorem pbind_some' (h : x = some a) : pbind x f = f a h := by subst h; rfl
 
-@[simp, grind] theorem map_pbind {o : Option α} {f : (a : α) → o = some a → Option β}
+@[simp, grind =] theorem map_pbind {o : Option α} {f : (a : α) → o = some a → Option β}
     {g : β → γ} : (o.pbind f).map g = o.pbind (fun a h => (f a h).map g) := by
   cases o <;> rfl
 
-@[simp, grind] theorem pbind_map {α β γ : Type _} (o : Option α)
+@[simp, grind =] theorem pbind_map {α β γ : Type _} (o : Option α)
     (f : α → β) (g : (x : β) → o.map f = some x → Option γ) :
     (o.map f).pbind g = o.pbind (fun x h => g (f x) (h ▸ rfl)) := by
   cases o <;> rfl
 
-@[simp, grind] theorem pbind_eq_bind {α β : Type _} (o : Option α)
+@[simp] theorem pbind_eq_bind {α β : Type _} (o : Option α)
     (f : α → Option β) : o.pbind (fun x _ => f x) = o.bind f := by
   cases o <;> rfl
 
@@ -1253,11 +1273,11 @@ theorem get_pbind {o : Option α} {f : (a : α) → o = some a → Option β} {h
     pmap f o h = none ↔ o = none := by
   cases o <;> simp
 
-@[simp, grind] theorem isSome_pmap {p : α → Prop} {f : ∀ (a : α), p a → β} {o : Option α} {h} :
+@[simp, grind =] theorem isSome_pmap {p : α → Prop} {f : ∀ (a : α), p a → β} {o : Option α} {h} :
     (pmap f o h).isSome = o.isSome := by
   cases o <;> simp
 
-@[simp, grind] theorem isNone_pmap {p : α → Prop} {f : ∀ (a : α), p a → β} {o : Option α} {h} :
+@[simp, grind =] theorem isNone_pmap {p : α → Prop} {f : ∀ (a : α), p a → β} {o : Option α} {h} :
     (pmap f o h).isNone = o.isNone := by
   cases o <;> simp
 
@@ -1279,11 +1299,11 @@ theorem pmap_eq_map (p : α → Prop) (f : α → β) (o : Option α) (H) :
     @pmap _ _ p (fun a _ => f a) o H = Option.map f o := by
   cases o <;> simp
 
-@[grind] theorem map_pmap {p : α → Prop} (g : β → γ) (f : ∀ a, p a → β) (o H) :
+@[grind =] theorem map_pmap {p : α → Prop} (g : β → γ) (f : ∀ a, p a → β) (o H) :
     Option.map g (pmap f o H) = pmap (fun a h => g (f a h)) o H := by
   cases o <;> simp
 
-@[grind] theorem pmap_map (o : Option α) (f : α → β) {p : β → Prop} (g : ∀ b, p b → γ) (H) :
+@[grind =] theorem pmap_map (o : Option α) (f : α → β) {p : β → Prop} (g : ∀ b, p b → γ) (H) :
     pmap g (o.map f) H =
       pmap (fun a h => g (f a) h) o (fun a m => H (f a) (map_eq_some_iff.2 ⟨_, m, rfl⟩)) := by
   cases o <;> simp
@@ -1340,7 +1360,7 @@ theorem get_pmap {p : α → Bool} {f : (x : α) → p x → β} {o : Option α}
 @[simp] theorem pelim_eq_elim : pelim o b (fun a _ => f a) = o.elim b f := by
   cases o <;> simp
 
-@[simp, grind] theorem elim_pmap {p : α → Prop} (f : (a : α) → p a → β) (o : Option α)
+@[simp, grind =] theorem elim_pmap {p : α → Prop} (f : (a : α) → p a → β) (o : Option α)
     (H : ∀ (a : α), o = some a → p a) (g : γ) (g' : β → γ) :
     (o.pmap f H).elim g g' =
        o.pelim g (fun a h => g' (f a (H a h))) := by
@@ -1387,11 +1407,11 @@ theorem pfilter_congr {α : Type u} {o o' : Option α} (ho : o = o')
   congr; funext a ha
   exact hf a ha
 
-@[simp, grind] theorem pfilter_none {α : Type _} {p : (a : α) → none = some a → Bool} :
+@[simp, grind =] theorem pfilter_none {α : Type _} {p : (a : α) → none = some a → Bool} :
     none.pfilter p = none := by
   rfl
 
-@[simp, grind] theorem pfilter_some {α : Type _} {x : α} {p : (a : α) → some x = some a → Bool} :
+@[simp, grind =] theorem pfilter_some {α : Type _} {x : α} {p : (a : α) → some x = some a → Bool} :
     (some x).pfilter p = if p x rfl then some x else none := by
   simp only [pfilter, cond_eq_if]
 
@@ -1416,7 +1436,7 @@ theorem isNone_pfilter_iff {o : Option α} {p : (a : α) → o = some a → Bool
       Bool.not_eq_true, some.injEq]
     exact ⟨fun h _ h' => h' ▸ h, fun h => h _ rfl⟩
 
-@[simp, grind] theorem get_pfilter {α : Type _} {o : Option α} {p : (a : α) → o = some a → Bool}
+@[simp, grind =] theorem get_pfilter {α : Type _} {o : Option α} {p : (a : α) → o = some a → Bool}
     (h : (o.pfilter p).isSome) :
     (o.pfilter p).get h = o.get (isSome_of_isSome_pfilter h) := by
   cases o <;> simp

src/Init/Data/Order.lean

@@ -0,0 +1,12 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+public import Init.Data.Order.Classes
+public import Init.Data.Order.Lemmas
+public import Init.Data.Order.Factories
+public import Init.Data.Subtype.Order

src/Init/Data/Order/Classes.lean

@@ -0,0 +1,173 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+public import Init.Core
+
+namespace Std
+
+/-!
+# Order-related typeclasses
+
+This module provides the typeclasses used to state that basic operations on some type `α`
+reflect a certain well-behaved order structure on `α`.
+
+The basic operations are provided by the typeclasses `LE α`, `LT α`, `BEq α`, `Ord α`, `Min α` and
+`Max α`.
+All of them describe at least some way to compare elements in `α`. Usually, any subset of them
+is available and one can/must show that these comparisons are well-behaved in some sense.
+
+For example, one could merely require that the available operations reflect a preorder
+(where the less-or-equal relation only needs to be reflexive and transitive). Alternatively,
+one could require a full linear order (additionally requiring antisymmetry and totality of the
+less-or-equal relation).
+
+There are many ways to characterize, say, linear orders:
+
+* `(· ≤ ·)` is reflexive, transitive, antisymmetric and total.
+* `(· ≤ ·)` is antisymmetric, `a < b ↔ ¬ b ≤ a` and `(· < ·)` is irreflexive, transitive and asymmetric.
+* `min a b` is either `a` or `b`, is symmetric and satisfies the
+  following property: `min c (min a b) = c` if and only if `min c a = c` and `min c b = c`.
+
+It is desirable that lemmas about linear orders state this hypothesis in a canonical way.
+Therefore, the classes defining preorders, partial orders, linear preorders and linear orders
+are all formulated purely in terms of `LE`. For other operations, there are
+classes for compatibility of `LE` with other operations. Hence, a lemma may look like:
+
+```lean
+theorem lt_trans {α : Type u} [LE α] [LT α]
+    [IsPreorder α] -- The order on `α` induced by `LE α` is, among other things, transitive.
+    [LawfulOrderLT α] -- `<` is the less-than relation induced by `LE α`.
+    {a b : α} : a < b → b < c → a < c := by
+  sorry
+```
+-/
+
+/--
+This typeclass states that the order structure on `α`, represented by an `LE α` instance,
+is a preorder. In other words, the less-or-equal relation is reflexive and transitive.
+-/
+public class IsPreorder (α : Type u) [LE α] where
+  le_refl : ∀ a : α, a ≤ a
+  le_trans : ∀ a b c : α, a ≤ b → b ≤ c → a ≤ c
+
+/--
+This typeclass states that the order structure on `α`, represented by an `LE α` instance,
+is a partial order.
+In other words, the less-or-equal relation is reflexive, transitive and antisymmetric.
+-/
+public class IsPartialOrder (α : Type u) [LE α] extends IsPreorder α where
+  le_antisymm : ∀ a b : α, a ≤ b → b ≤ a → a = b
+
+/--
+This typeclass states that the order structure on `α`, represented by an `LE α` instance,
+is a linear preorder.
+In other words, the less-or-equal relation is reflexive, transitive and total.
+-/
+public class IsLinearPreorder (α : Type u) [LE α] extends IsPreorder α where
+  le_total : ∀ a b : α, a ≤ b ∨ b ≤ a
+
+/--
+This typeclass states that the order structure on `α`, represented by an `LE α` instance,
+is a linear order.
+In other words, the less-or-equal relation is reflexive, transitive, antisymmetric and total.
+-/
+public class IsLinearOrder (α : Type u) [LE α] extends IsPartialOrder α, IsLinearPreorder α
+
+section LT
+
+/--
+This typeclass states that the synthesized `LT α` instance is compatible with the `LE α`
+instance. This means that `LT.lt a b` holds if and only if `a` is less or equal to `b` according
+to the `LE α` instance, but `b` is not less or equal to `a`.
+
+`LawfulOrderLT α` automatically entails that `LT α` is asymmetric: `a < b` and `b < a` can never
+be true simultaneously.
+
+`LT α` does not uniquely determine the `LE α`: There can be only one compatible order data
+instance that is total, but there can be others that are not total.
+-/
+public class LawfulOrderLT (α : Type u) [LT α] [LE α] where
+  lt_iff : ∀ a b : α, a < b ↔ a ≤ b ∧ ¬ b ≤ a
+
+end LT
+
+section Min
+
+/--
+This typeclass states that `Min.min a b` returns one of its arguments, either `a` or `b`.
+-/
+public class MinEqOr (α : Type u) [Min α] where
+  min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b
+
+/--
+If both `a` and `b` satisfy some property `P`, then so does `min a b`, because it is equal to
+either `a` or `b`.
+-/
+public def MinEqOr.elim {α : Type u} [Min α] [MinEqOr α] {P : α → Prop} {a b : α} (ha : P a) (hb : P b) :
+    P (min a b) := by
+  cases MinEqOr.min_eq_or a b <;> rename_i h
+  case inl => exact h.symm ▸ ha
+  case inr => exact h.symm ▸ hb
+
+/--
+This typeclass states that being less or equal to `min a b` is equivalent to being less or
+equal to both `a` and `b`..
+-/
+public class LawfulOrderInf (α : Type u) [Min α] [LE α] where
+  le_min_iff : ∀ a b c : α, a ≤ (min b c) ↔ a ≤ b ∧ a ≤ c
+
+/--
+This typeclass bundles `MinEqOr α` and `LawfulOrderInf α`. It characterizes when a `Min α`
+instance reasonably computes minima in some type `α` that has an `LE α` instance.
+
+As long as `α` is a preorder (see `IsPreorder α`), this typeclass implies that the order on
+`α` is total and that `Min.min a b` returns either `a` or `b`, whichever is less or equal to
+the other.
+-/
+public class LawfulOrderMin (α : Type u) [Min α] [LE α] extends MinEqOr α, LawfulOrderInf α
+
+end Min
+
+section Max
+
+/--
+This typeclass states that `Max.max a b` returns one of its arguments, either `a` or `b`.
+-/
+public class MaxEqOr (α : Type u) [Max α] where
+  max_eq_or : ∀ a b : α, max a b = a ∨ max a b = b
+
+/--
+If both `a` and `b` satisfy some property `P`, then so does `max a b`, because it is equal to
+either `a` or `b`.
+-/
+public def MaxEqOr.elim {α : Type u} [Max α] [MaxEqOr α] {P : α → Prop} {a b : α} (ha : P a) (hb : P b) :
+    P (max a b) := by
+  cases MaxEqOr.max_eq_or a b <;> rename_i h
+  case inl => exact h.symm ▸ ha
+  case inr => exact h.symm ▸ hb
+
+/--
+This typeclass states that being less or equal to `Max.max a b` is equivalent to being less or
+equal to both `a` and `b`.
+-/
+public class LawfulOrderSup (α : Type u) [Max α] [LE α] where
+  max_le_iff : ∀ a b c : α, (max a b) ≤ c ↔ a ≤ c ∧ b ≤ c
+
+/--
+This typeclass bundles `MaxEqOr α` and `LawfulOrderSup α`. It characterizes when a `Max α`
+instance reasonably computes maxima in some type `α` that has an `LE α` instance.
+
+As long as `α` is a preorder (see `IsPreorder α`), this typeclass implies that the order on
+`α` is total and that `Min.min a b` returns either `a` or `b`, whichever is greater or equal to
+the other.
+-/
+public class LawfulOrderMax (α : Type u) [Max α] [LE α] extends MaxEqOr α, LawfulOrderSup α
+
+end Max
+
+end Std

src/Init/Data/Order/Factories.lean

@@ -0,0 +1,236 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+public import Init.Data.Order.Classes
+import Init.Classical
+
+namespace Std
+
+/-!
+This module provides utilities for the creation of order-related typeclass instances.
+-/
+
+section OfLE
+
+/--
+This instance is only publicly defined in `Init.Data.Order.Lemmas`.
+-/
+instance {r : α → α → Prop} [Total r] : Refl r where
+  refl a := by simpa using Total.total a a
+
+/--
+If an `LE α` instance is reflexive and transitive, then it represents a preorder.
+-/
+public theorem IsPreorder.of_le {α : Type u} [LE α]
+    (le_refl : Std.Refl (α := α) (· ≤ ·) := by exact inferInstance)
+    (le_trans : Trans (α := α) (· ≤ ·) (· ≤ ·) (· ≤ ·) := by exact inferInstance) :
+    IsPreorder α where
+  le_refl := le_refl.refl
+  le_trans _ _ _ := le_trans.trans
+
+/--
+If an `LE α` instance is transitive and total, then it represents a linear preorder.
+-/
+public theorem IsLinearPreorder.of_le {α : Type u} [LE α]
+    (le_trans : Trans (α := α) (· ≤ ·) (· ≤ ·) (· ≤ ·) := by exact inferInstance)
+    (le_total : Total (α := α) (· ≤ ·) := by exact inferInstance) :
+    IsLinearPreorder α where
+  toIsPreorder := .of_le
+  le_total := le_total.total
+
+/--
+If an `LE α` is reflexive, antisymmetric and transitive, then it represents a partial order.
+-/
+public theorem IsPartialOrder.of_le {α : Type u} [LE α]
+    (le_refl : Std.Refl (α := α) (· ≤ ·) := by exact inferInstance)
+    (le_antisymm : Std.Antisymm (α := α) (· ≤ ·) := by exact inferInstance)
+    (le_trans : Trans (α := α) (· ≤ ·) (· ≤ ·) (· ≤ ·) := by exact inferInstance) :
+    IsPartialOrder α where
+  toIsPreorder := .of_le
+  le_antisymm := le_antisymm.antisymm
+
+/--
+If an `LE α` instance is antisymmetric, transitive and total, then it represents a linear order.
+-/
+public theorem IsLinearOrder.of_le {α : Type u} [LE α]
+    (le_antisymm : Std.Antisymm (α := α) (· ≤ ·) := by exact inferInstance)
+    (le_trans : Trans (α := α) (· ≤ ·) (· ≤ ·) (· ≤ ·) := by exact inferInstance)
+    (le_total : Total (α := α) (· ≤ ·) := by exact inferInstance) :
+    IsLinearOrder α where
+  toIsLinearPreorder := .of_le
+  le_antisymm := le_antisymm.antisymm
+
+/--
+Returns a `LawfulOrderLT α` instance given certain properties.
+
+If an `OrderData α` instance is compatible with an `LE α` instance, then this lemma derives
+a `LawfulOrderLT α` instance from a property relating the `LE α` and `LT α` instances.
+-/
+public theorem LawfulOrderLT.of_le {α : Type u} [LT α] [LE α]
+    (lt_iff : ∀ a b : α, a < b ↔ a ≤ b ∧ ¬ b ≤ a) : LawfulOrderLT α where
+  lt_iff := lt_iff
+
+/--
+This lemma characterizes in terms of `LE α` when a `Min α` instance "behaves like an infimum
+operator".
+-/
+public theorem LawfulOrderInf.of_le {α : Type u} [Min α] [LE α]
+    (le_min_iff : ∀ a b c : α, a ≤ min b c ↔ a ≤ b ∧ a ≤ c) : LawfulOrderInf α where
+  le_min_iff := le_min_iff
+
+/--
+Returns a `LawfulOrderMin α` instance given certain properties.
+
+This lemma derives a `LawfulOrderMin α` instance from two properties involving `LE α` and `Min α`
+instances.
+
+The produced instance entails `LawfulOrderInf α` and `MinEqOr α`.
+-/
+public theorem LawfulOrderMin.of_le {α : Type u} [Min α] [LE α]
+    (le_min_iff : ∀ a b c : α, a ≤ min b c ↔ a ≤ b ∧ a ≤ c)
+    (min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b) : LawfulOrderMin α where
+  toLawfulOrderInf := .of_le le_min_iff
+  toMinEqOr := ⟨min_eq_or⟩
+
+/--
+This lemma characterizes in terms of `LE α` when a `Max α` instance "behaves like a supremum
+operator".
+-/
+public def LawfulOrderSup.of_le {α : Type u} [Max α] [LE α]
+    (max_le_iff : ∀ a b c : α, max a b ≤ c ↔ a ≤ c ∧ b ≤ c) : LawfulOrderSup α where
+  max_le_iff := max_le_iff
+
+/--
+Returns a `LawfulOrderMax α` instance given certain properties.
+
+This lemma derives a `LawfulOrderMax α` instance from two properties involving `LE α` and `Max α`
+instances.
+
+The produced instance entails `LawfulOrderSup α` and `MaxEqOr α`.
+-/
+public def LawfulOrderMax.of_le {α : Type u} [Max α] [LE α]
+    (max_le_iff : ∀ a b c : α, max a b ≤ c ↔ a ≤ c ∧ b ≤ c)
+    (max_eq_or : ∀ a b : α, max a b = a ∨ max a b = b) : LawfulOrderMax α where
+  toLawfulOrderSup := .of_le max_le_iff
+  toMaxEqOr := ⟨max_eq_or⟩
+
+end OfLE
+
+section OfLT
+
+/--
+Creates a *total* `LE α` instance from an `LT α` instance.
+
+This only makes sense for asymmetric `LT α` instances (see `Std.Asymm`).
+-/
+public def LE.ofLT (α : Type u) [LT α] : LE α where
+  le a b := ¬ b < a
+
+/--
+The `LE α` instance obtained from an asymmetric `LT α` instance is compatible with said
+`LT α` instance.
+-/
+public instance LawfulOrderLT.of_lt {α : Type u} [LT α] [i : Asymm (α := α) (· < ·)] :
+    haveI := LE.ofLT α
+    LawfulOrderLT α :=
+  letI := LE.ofLT α
+  { lt_iff a b := by simpa [LE.ofLT, Classical.not_not] using i.asymm a b }
+
+/--
+If an `LT α` instance is asymmetric and its negation is transitive, then `LE.ofLT α` represents a
+linear preorder.
+-/
+public theorem IsLinearPreorder.of_lt {α : Type u} [LT α]
+    (lt_asymm : Asymm (α := α) (· < ·) := by exact inferInstance)
+    (not_lt_trans : Trans (α := α) (¬ · < ·) (¬ · < ·) (¬ · < ·) := by exact inferInstance) :
+    haveI := LE.ofLT α
+    IsLinearPreorder α :=
+  letI := LE.ofLT α
+  { le_trans := by simpa [LE.ofLT] using fun a b c hab hbc => not_lt_trans.trans hbc hab
+    le_total a b := by
+      apply Or.symm
+      open Classical in simpa [LE.ofLT, Decidable.imp_iff_not_or] using lt_asymm.asymm a b
+    le_refl a := by
+      open Classical in simpa [LE.ofLT] using lt_asymm.asymm a a }
+
+/--
+If an `LT α` instance is asymmetric and its negation is transitive and antisymmetric, then
+`LE.ofLT α` represents a linear order.
+-/
+public theorem IsLinearOrder.of_lt {α : Type u} [LT α]
+    (lt_asymm : Asymm (α := α) (· < ·) := by exact inferInstance)
+    (not_lt_trans : Trans (α := α) (¬ · < ·) (¬ · < ·) (¬ · < ·) := by exact inferInstance)
+    (not_lt_antisymm : Antisymm (α := α) (¬ · < ·) := by exact inferInstance) :
+    haveI := LE.ofLT α
+    IsLinearOrder α :=
+  letI := LE.ofLT α
+  haveI : IsLinearPreorder α := .of_lt
+  { le_antisymm := by
+      simpa [LE.ofLT] using fun a b hab hba => not_lt_antisymm.antisymm a b hba hab }
+
+/--
+This lemma characterizes in terms of `LT α` when a `Min α` instance
+"behaves like an infimum operator" with respect to `LE.ofLT α`.
+-/
+public theorem LawfulOrderInf.of_lt {α : Type u} [Min α] [LT α]
+    (min_lt_iff : ∀ a b c : α, min b c < a ↔ b < a ∨ c < a) :
+    haveI := LE.ofLT α
+    LawfulOrderInf α :=
+  letI := LE.ofLT α
+  { le_min_iff a b c := by
+      open Classical in
+      simp only [LE.ofLT, ← Decidable.not_iff_not (a := ¬ min b c < a)]
+      simpa [Decidable.imp_iff_not_or] using min_lt_iff a b c }
+
+/--
+Derives a `LawfulOrderMin α` instance for `OrderData.ofLT` from two properties involving
+`LT α` and `Min α` instances.
+
+The produced instance entails `LawfulOrderInf α` and `MinEqOr α`.
+-/
+public theorem LawfulOrderMin.of_lt {α : Type u} [Min α] [LT α]
+    (min_lt_iff : ∀ a b c : α, min b c < a ↔ b < a ∨ c < a)
+    (min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b) :
+    haveI := LE.ofLT α
+    LawfulOrderMin α :=
+  letI := LE.ofLT α
+  { toLawfulOrderInf := .of_lt min_lt_iff
+    toMinEqOr := ⟨min_eq_or⟩ }
+
+/--
+This lemma characterizes in terms of `LT α` when a `Max α` instance
+"behaves like an supremum operator" with respect to `OrderData.ofLT α`.
+-/
+public def LawfulOrderSup.of_lt {α : Type u} [Max α] [LT α]
+    (lt_max_iff : ∀ a b c : α, c < max a b ↔ c < a ∨ c < b) :
+    haveI := LE.ofLT α
+    LawfulOrderSup α :=
+  letI := LE.ofLT α
+  { max_le_iff a b c := by
+      open Classical in
+      simp only [LE.ofLT, ← Decidable.not_iff_not ( a := ¬ c < max a b)]
+      simpa [Decidable.imp_iff_not_or] using lt_max_iff a b c }
+
+/--
+Derives a `LawfulOrderMax α` instance for `OrderData.ofLT` from two properties involving `LT α` and
+`Max α` instances.
+
+The produced instance entails `LawfulOrderSup α` and `MaxEqOr α`.
+-/
+public def LawfulOrderMax.of_lt {α : Type u} [Max α] [LT α]
+    (lt_max_iff : ∀ a b c : α, c < max a b ↔ c < a ∨ c < b)
+    (max_eq_or : ∀ a b : α, max a b = a ∨ max a b = b) :
+    haveI := LE.ofLT α
+    LawfulOrderMax α :=
+  letI := LE.ofLT α
+  { toLawfulOrderSup := .of_lt lt_max_iff
+    toMaxEqOr := ⟨max_eq_or⟩ }
+
+end OfLT
+
+end Std

src/Init/Data/Order/Lemmas.lean

@@ -0,0 +1,342 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+public import Init.Data.Order.Classes
+public import Init.Data.Order.Factories
+import Init.SimpLemmas
+import Init.Classical
+
+namespace Std
+
+/-!
+This module provides typeclass instances and lemmas about order-related typeclasses.
+-/
+
+section AxiomaticInstances
+
+public instance (r : α → α → Prop) [Asymm r] : Irrefl r where
+  irrefl a h := Asymm.asymm a a h h
+
+public instance {r : α → α → Prop} [Total r] : Refl r where
+  refl a := by simpa using Total.total a a
+
+public instance Total.asymm_of_total_not {r : α → α → Prop} [i : Total (¬ r · ·)] : Asymm r where
+  asymm a b h := by cases i.total a b <;> trivial
+
+public theorem Asymm.total_not {r : α → α → Prop} [i : Asymm r] : Total (¬ r · ·) where
+  total a b := by
+    apply Classical.byCases (p := r a b) <;> intro hab
+    · exact Or.inr <| i.asymm a b hab
+    · exact Or.inl hab
+
+public instance {α : Type u} [LE α] [IsPartialOrder α] :
+    Std.Antisymm (α := α) (· ≤ ·) where
+  antisymm := IsPartialOrder.le_antisymm
+
+public instance {α : Type u} [LE α] [IsPreorder α] :
+    Trans (α := α) (· ≤ ·) (· ≤ ·) (· ≤ ·) where
+      trans := IsPreorder.le_trans _ _ _
+
+public instance {α : Type u} [LE α] [IsPreorder α] :
+    Std.Refl (α := α) (· ≤ ·) where
+  refl a := IsPreorder.le_refl a
+
+public instance {α : Type u} [LE α] [IsLinearPreorder α] :
+    Std.Total (α := α) (· ≤ ·) where
+  total a b := IsLinearPreorder.le_total a b
+
+end AxiomaticInstances
+
+section LE
+
+public theorem le_refl {α : Type u} [LE α] [Refl (α := α) (· ≤ ·)] (a : α) : a ≤ a := by
+  simp [Refl.refl]
+
+public theorem le_antisymm {α : Type u} [LE α] [Std.Antisymm (α := α) (· ≤ ·)] {a b : α}
+    (hab : a ≤ b) (hba : b ≤ a) : a = b :=
+  Std.Antisymm.antisymm _ _ hab hba
+
+public theorem le_trans {α : Type u} [LE α] [Trans (α := α) (· ≤ ·) (· ≤ ·) (· ≤ ·)] {a b c : α}
+    (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c :=
+  Trans.trans hab hbc
+
+public theorem le_total {α : Type u} [LE α] [Std.Total (α := α) (· ≤ ·)] {a b : α} :
+    a ≤ b ∨ b ≤ a :=
+  Std.Total.total a b
+
+public instance {α : Type u} [LE α] [IsPreorder α] :
+    Refl (α := α) (· ≤ ·) where
+  refl := IsPreorder.le_refl
+
+public instance {α : Type u} [LE α] [IsPreorder α] :
+    Trans (α := α) (· ≤ ·) (· ≤ ·) (· ≤ ·) where
+  trans := IsPreorder.le_trans _ _ _
+
+public instance {α : Type u} [LE α] [IsLinearPreorder α] :
+    Total (α := α) (· ≤ ·) where
+  total := IsLinearPreorder.le_total
+
+public instance {α : Type u} [LE α] [IsPartialOrder α] :
+    Antisymm (α := α) (· ≤ ·) where
+  antisymm := IsPartialOrder.le_antisymm
+
+end LE
+
+section LT
+
+public theorem lt_iff_le_and_not_ge {α : Type u} [LT α] [LE α] [LawfulOrderLT α] {a b : α} :
+    a < b ↔ a ≤ b ∧ ¬ b ≤ a :=
+  LawfulOrderLT.lt_iff a b
+
+public theorem not_lt {α : Type u} [LT α] [LE α] [Std.Total (α := α) (· ≤ ·)] [LawfulOrderLT α]
+    {a b : α} : ¬ a < b ↔ b ≤ a := by
+  simp [lt_iff_le_and_not_ge, Classical.not_not, Std.Total.total]
+
+public theorem not_gt_of_lt {α : Type u} [LT α] [i : Std.Asymm (α := α) (· < ·)] {a b : α}
+    (h : a < b) : ¬ b < a :=
+  i.asymm a b h
+
+public instance {α : Type u} [LT α] [LE α] [LawfulOrderLT α] :
+    Std.Asymm (α := α) (· < ·) where
+  asymm a b := by
+    simp only [LawfulOrderLT.lt_iff]
+    intro h h'
+    exact h.2.elim h'.1
+
+public instance {α : Type u} [LT α] [LE α] [IsPreorder α] [LawfulOrderLT α] :
+    Std.Irrefl (α := α) (· < ·) := inferInstance
+
+public instance {α : Type u} [LT α] [LE α]
+    [Trans (α := α) (· ≤ ·) (· ≤ ·) (· ≤ ·) ] [LawfulOrderLT α] :
+    Trans (α := α) (· < ·) (· < ·) (· < ·) where
+  trans {a b c} hab hbc := by
+    simp only [lt_iff_le_and_not_ge] at hab hbc ⊢
+    apply And.intro
+    · exact le_trans hab.1 hbc.1
+    · intro hca
+      exact hab.2.elim (le_trans hbc.1 hca)
+
+public instance {α : Type u} {_ : LT α} [LE α] [LawfulOrderLT α]
+    [Total (α := α) (· ≤ ·)] [Antisymm (α := α) (· ≤ ·)] :
+    Antisymm (α := α) (¬ · < ·) where
+  antisymm a b hab hba := by
+    simp only [not_lt] at hab hba
+    exact Antisymm.antisymm (r := (· ≤ ·)) a b hba hab
+
+public instance {α : Type u} {_ : LT α} [LE α] [LawfulOrderLT α]
+    [Total (α := α) (· ≤ ·)] [Trans (α := α) (· ≤ ·) (· ≤ ·) (· ≤ ·)] :
+    Trans (α := α) (¬ · < ·) (¬ · < ·) (¬ · < ·) where
+  trans {a b c} hab hbc := by
+    simp only [not_lt] at hab hbc ⊢
+    exact le_trans hbc hab
+
+public instance {α : Type u} {_ : LT α} [LE α] [LawfulOrderLT α] [Total (α := α) (· ≤ ·)] :
+    Total (α := α) (¬ · < ·) where
+  total a b := by simp [not_lt, Std.Total.total]
+
+public theorem lt_of_le_of_lt {α : Type u} [LE α] [LT α]
+    [Trans (α := α) (· ≤ ·) (· ≤ ·) (· ≤ ·)] [LawfulOrderLT α] {a b c : α} (hab : a ≤ b)
+    (hbc : b < c) : a < c := by
+  simp only [lt_iff_le_and_not_ge] at hbc ⊢
+  apply And.intro
+  · exact le_trans hab hbc.1
+  · intro hca
+    exact hbc.2.elim (le_trans hca hab)
+
+public theorem lt_of_le_of_ne {α : Type u} [LE α] [LT α]
+    [Std.Antisymm (α := α) (· ≤ ·)] [LawfulOrderLT α] {a b : α}
+    (hle : a ≤ b) (hne : a ≠ b) : a < b := by
+  apply Classical.byContradiction
+  simp only [lt_iff_le_and_not_ge, hle, true_and, Classical.not_not, imp_false]
+  intro hge
+  exact hne.elim <| Std.Antisymm.antisymm a b hle hge
+
+end LT
+end Std
+
+namespace Classical.Order
+open Std
+
+public scoped instance instLT {α : Type u} [LE α] :
+    LT α where
+  lt a b := a ≤ b ∧ ¬ b ≤ a
+
+public instance instLawfulOrderLT {α : Type u} [LE α] :
+    LawfulOrderLT α where
+  lt_iff _ _ := Iff.rfl
+
+end Classical.Order
+
+namespace Std
+section Min
+
+public theorem min_self {α : Type u} [Min α] [Std.IdempotentOp (min : α → α → α)] {a : α} :
+    min a a = a :=
+  Std.IdempotentOp.idempotent a
+
+public theorem le_min_iff {α : Type u} [Min α] [LE α]
+    [LawfulOrderInf α] {a b c : α} :
+    a ≤ min b c ↔ a ≤ b ∧ a ≤ c :=
+  LawfulOrderInf.le_min_iff a b c
+
+public theorem min_le_left {α : Type u} [Min α] [LE α] [Refl (α := α) (· ≤ ·)] [LawfulOrderInf α]
+    {a b : α} : min a b ≤ a :=
+  le_min_iff.mp (le_refl _) |>.1
+
+public theorem min_le_right {α : Type u} [Min α] [LE α] [Refl (α := α) (· ≤ ·)] [LawfulOrderInf α]
+    {a b : α} : min a b ≤ b :=
+  le_min_iff.mp (le_refl _) |>.2
+
+public theorem min_le {α : Type u} [Min α] [LE α] [IsPreorder α] [LawfulOrderMin α] {a b c : α} :
+    min a b ≤ c ↔ a ≤ c ∨ b ≤ c := by
+  cases MinEqOr.min_eq_or a b <;> rename_i h
+  · simpa [h] using le_trans (h ▸ min_le_right (a := a) (b := b))
+  · simpa [h] using le_trans (h ▸ min_le_left (a := a) (b := b))
+
+public theorem min_eq_or {α : Type u} [Min α] [MinEqOr α] {a b : α} :
+    min a b = a ∨ min a b = b :=
+  MinEqOr.min_eq_or a b
+
+public instance {α : Type u} [LE α] [Min α] [IsLinearOrder α] [LawfulOrderInf α] :
+    MinEqOr α where
+  min_eq_or a b := by
+    open Classical.Order in
+    cases le_total (a := a) (b := b)
+    · apply Or.inl
+      apply le_antisymm
+      · apply min_le_left
+      · rw [le_min_iff]
+        exact ⟨le_refl a, ‹_›⟩
+    · apply Or.inr
+      apply le_antisymm
+      · apply min_le_right
+      · rw [le_min_iff]
+        exact ⟨‹_›, le_refl b⟩
+
+/--
+If a `Min α` instance satisfies typical properties in terms of a reflexive and antisymmetric `LE α`
+instance, then the `LE α` instance represents a linear order.
+-/
+public theorem IsLinearOrder.of_refl_of_antisymm_of_lawfulOrderMin {α : Type u} [LE α]
+    [LE α] [Min α] [Refl (α := α) (· ≤ ·)] [Antisymm (α := α) (· ≤ ·)] [LawfulOrderMin α] :
+    IsLinearOrder α := by
+  apply IsLinearOrder.of_le
+  · infer_instance
+  · constructor
+    intro a b c hab hbc
+    have : b = min b c := by
+      apply le_antisymm
+      · rw [le_min_iff]
+        exact ⟨le_refl b, hbc⟩
+      · apply min_le_left
+    rw [this, le_min_iff] at hab
+    exact hab.2
+  · constructor
+    intro a b
+    cases min_eq_or (a := a) (b := b) <;> rename_i h
+    · exact Or.inl (h ▸ min_le_right)
+    · exact Or.inr (h ▸ min_le_left)
+
+public instance {α : Type u} [Min α] [MinEqOr α] :
+    Std.IdempotentOp (min : α → α → α) where
+  idempotent a := by cases MinEqOr.min_eq_or a a <;> assumption
+
+open Classical.Order in
+public instance {α : Type u} [LE α] [Min α] [IsLinearOrder α] [LawfulOrderMin α] :
+    Std.Associative (min : α → α → α) where
+  assoc a b c := by apply le_antisymm <;> simp [min_le, le_min_iff, le_refl]
+
+end Min
+
+section Max
+
+public theorem max_self {α : Type u} [Max α] [Std.IdempotentOp (max : α → α → α)] {a : α} :
+    max a a = a :=
+  Std.IdempotentOp.idempotent a
+
+public theorem max_le_iff {α : Type u} [Max α] [LE α] [LawfulOrderSup α] {a b c : α} :
+    max a b ≤ c ↔ a ≤ c ∧ b ≤ c :=
+  LawfulOrderSup.max_le_iff a b c
+
+public theorem left_le_max {α : Type u} [Max α] [LE α] [Refl (α := α) (· ≤ ·)] [LawfulOrderSup α]
+    {a b : α} : a ≤ max a b :=
+  max_le_iff.mp (le_refl _) |>.1
+
+public theorem right_le_max {α : Type u} [Max α] [LE α] [Refl (α := α) (· ≤ ·)]
+    [LawfulOrderSup α] {a b : α} : b ≤ max a b :=
+  max_le_iff.mp (le_refl _) |>.2
+
+public theorem le_max {α : Type u} [Max α] [LE α] [IsPreorder α] [LawfulOrderMax α] {a b c : α} :
+    a ≤ max b c ↔ a ≤ b ∨ a ≤ c := by
+  cases MaxEqOr.max_eq_or b c <;> rename_i h
+  · simpa [h] using (le_trans · (h ▸ right_le_max))
+  · simpa [h] using (le_trans · (h ▸ left_le_max))
+
+public theorem max_eq_or {α : Type u} [Max α] [MaxEqOr α] {a b : α} :
+    max a b = a ∨ max a b = b :=
+  MaxEqOr.max_eq_or a b
+
+public instance {α : Type u} [LE α] [Max α] [IsLinearOrder α] [LawfulOrderSup α] :
+    MaxEqOr α where
+  max_eq_or a b := by
+    open Classical.Order in
+    cases le_total (a := a) (b := b)
+    · apply Or.inr
+      apply le_antisymm
+      · rw [max_le_iff]
+        exact ⟨‹_›, le_refl b⟩
+      · apply right_le_max
+    · apply Or.inl
+      apply le_antisymm
+      · rw [max_le_iff]
+        exact ⟨le_refl a, ‹_›⟩
+      · apply left_le_max
+
+/--
+If a `Max α` instance satisfies typical properties in terms of a reflexive and antisymmetric `LE α`
+instance, then the `LE α` instance represents a linear order.
+-/
+public theorem IsLinearOrder.of_refl_of_antisymm_of_lawfulOrderMax {α : Type u} [LE α] [Max α]
+    [Refl (α := α) (· ≤ ·)] [Antisymm (α := α) (· ≤ ·)] [LawfulOrderMax α] :
+    IsLinearOrder α := by
+  apply IsLinearOrder.of_le
+  · infer_instance
+  · constructor
+    intro a b c hab hbc
+    have : b = max a b := by
+      apply le_antisymm
+      · exact right_le_max
+      · rw [max_le_iff]
+        exact ⟨hab, le_refl b⟩
+    rw [this, max_le_iff] at hbc
+    exact hbc.1
+  · constructor
+    intro a b
+    cases max_eq_or (a := a) (b := b) <;> rename_i h
+    · exact Or.inr (h ▸ right_le_max)
+    · exact Or.inl (h ▸ left_le_max)
+
+public instance {α : Type u} [Max α] [MaxEqOr α] {P : α → Prop} : Max (Subtype P) where
+  max a b := ⟨Max.max a.val b.val, MaxEqOr.elim a.property b.property⟩
+
+public instance {α : Type u} [Max α] [MaxEqOr α] :
+    Std.IdempotentOp (max : α → α → α) where
+  idempotent a := by cases MaxEqOr.max_eq_or a a <;> assumption
+
+open Classical.Order in
+public instance {α : Type u} [LE α] [Max α] [IsLinearOrder α] [LawfulOrderMax α] :
+    Std.Associative (max : α → α → α) where
+  assoc a b c := by
+    apply le_antisymm
+    all_goals
+      simp only [max_le_iff]
+      simp [le_max, le_refl]
+
+end Max
+
+end Std

src/Init/Data/Random.lean

@@ -36,7 +36,14 @@ structure StdGen where
   s1 : Nat
   s2 : Nat
 
-instance : Inhabited StdGen := ⟨{ s1 := 0, s2 := 0 }⟩
+/-- Returns a standard number generator. -/
+def mkStdGen (s : Nat := 0) : StdGen :=
+  let q  := s / 2147483562
+  let s1 := s % 2147483562
+  let s2 := q % 2147483398
+  ⟨s1 + 1, s2 + 1⟩
+
+instance : Inhabited StdGen := ⟨mkStdGen⟩
 
 /-- The range of values returned by `StdGen` -/
 def stdRange := (1, 2147483562)
@@ -77,13 +84,6 @@ instance : RandomGen StdGen := {
   split  := stdSplit
 }
 
-/-- Returns a standard number generator. -/
-def mkStdGen (s : Nat := 0) : StdGen :=
-  let q  := s / 2147483562
-  let s1 := s % 2147483562
-  let s2 := q % 2147483398
-  ⟨s1 + 1, s2 + 1⟩
-
 /--
 Auxiliary function for randomNatVal.
 Generate random values until we exceed the target magnitude.

src/Init/Data/Range/Polymorphic/RangeIterator.lean

@@ -441,7 +441,7 @@ instance RangeIterator.instIteratorLoop {su} [UpwardEnumerable α] [SupportsUppe
         (f : (out : α) → UpwardEnumerable.LE least out → SupportsUpperBound.IsSatisfied upperBound out → (c : γ) → n (Subtype (fun s : ForInStep γ => Pl out c s)))
         (next : α) (hl : UpwardEnumerable.LE least next) (hu : SupportsUpperBound.IsSatisfied upperBound next) : n γ := do
       match ← f next hl hu acc with
-      | ⟨.yield acc', h⟩ =>
+      | ⟨.yield acc', _⟩ =>
         match hs : UpwardEnumerable.succ? next with
         | some next' =>
           if hu : SupportsUpperBound.IsSatisfied upperBound next' then

src/Init/Data/SInt/Lemmas.lean

@@ -15,9 +15,12 @@ public import Init.Data.Int.LemmasAux
 public import all Init.Data.UInt.Basic
 public import Init.Data.UInt.Lemmas
 public import Init.System.Platform
+import Init.Data.Order.Lemmas
 
 public section
 
+open Std
+
 open Lean in
 set_option hygiene false in
 macro "declare_int_theorems" typeName:ident _bits:term:arg : command => do
@@ -3025,6 +3028,56 @@ protected theorem Int64.lt_asymm {a b : Int64} : a < b → ¬b < a :=
 protected theorem ISize.lt_asymm {a b : ISize} : a < b → ¬b < a :=
   fun hab hba => ISize.lt_irrefl (ISize.lt_trans hab hba)
 
+instance Int8.instIsLinearOrder : IsLinearOrder Int8 := by
+  apply IsLinearOrder.of_le
+  case le_antisymm => constructor; apply Int8.le_antisymm
+  case le_total => constructor; apply Int8.le_total
+  case le_trans => constructor; apply Int8.le_trans
+
+instance : LawfulOrderLT Int8 where
+  lt_iff := by
+    simp [← Int8.not_le, Decidable.imp_iff_not_or, Std.Total.total]
+
+instance Int16.instIsLinearOrder : IsLinearOrder Int16 := by
+  apply IsLinearOrder.of_le
+  case le_antisymm => constructor; apply Int16.le_antisymm
+  case le_total => constructor; apply Int16.le_total
+  case le_trans => constructor; apply Int16.le_trans
+
+instance : LawfulOrderLT Int16 where
+  lt_iff := by
+    simp [← Int16.not_le, Decidable.imp_iff_not_or, Std.Total.total]
+
+instance Int32.instIsLinearOrder : IsLinearOrder Int32 := by
+  apply IsLinearOrder.of_le
+  case le_antisymm => constructor; apply Int32.le_antisymm
+  case le_total => constructor; apply Int32.le_total
+  case le_trans => constructor; apply Int32.le_trans
+
+instance : LawfulOrderLT Int32 where
+  lt_iff := by
+    simp [← Int32.not_le, Decidable.imp_iff_not_or, Std.Total.total]
+
+instance Int64.instIsLinearOrder : IsLinearOrder Int64 := by
+  apply IsLinearOrder.of_le
+  case le_antisymm => constructor; apply Int64.le_antisymm
+  case le_total => constructor; apply Int64.le_total
+  case le_trans => constructor; apply Int64.le_trans
+
+instance : LawfulOrderLT Int64 where
+  lt_iff := by
+    simp [← Int64.not_le, Decidable.imp_iff_not_or, Std.Total.total]
+
+instance ISize.instIsLinearOrder : IsLinearOrder ISize := by
+  apply IsLinearOrder.of_le
+  case le_antisymm => constructor; apply ISize.le_antisymm
+  case le_total => constructor; apply ISize.le_total
+  case le_trans => constructor; apply ISize.le_trans
+
+instance : LawfulOrderLT ISize where
+  lt_iff := by
+    simp [← ISize.not_le, Decidable.imp_iff_not_or, Std.Total.total]
+
 protected theorem Int8.add_neg_eq_sub {a b : Int8} : a + -b = a - b := Int8.toBitVec_inj.1 BitVec.add_neg_eq_sub
 protected theorem Int16.add_neg_eq_sub {a b : Int16} : a + -b = a - b := Int16.toBitVec_inj.1 BitVec.add_neg_eq_sub
 protected theorem Int32.add_neg_eq_sub {a b : Int32} : a + -b = a - b := Int32.toBitVec_inj.1 BitVec.add_neg_eq_sub

src/Init/Data/String/Basic.lean

@@ -485,6 +485,7 @@ Examples:
 * `"tea".firstDiffPos "teas" = ⟨3⟩`
 * `"teas".firstDiffPos "tea" = ⟨3⟩`
 -/
+@[expose]
 def firstDiffPos (a b : String) : Pos :=
   let stopPos := a.endPos.min b.endPos
   let rec loop (i : Pos) : Pos :=
@@ -511,7 +512,7 @@ Examples:
 * `"red green blue".extract ⟨4⟩ ⟨100⟩ = "green blue"`
 * `"L∃∀N".extract ⟨2⟩ ⟨100⟩ = "green blue"`
 -/
-@[extern "lean_string_utf8_extract"]
+@[extern "lean_string_utf8_extract", expose]
 def extract : (@& String) → (@& Pos) → (@& Pos) → String
   | ⟨s⟩, b, e => if b.byteIdx ≥ e.byteIdx then "" else ⟨go₁ s 0 b e⟩
 where

src/Init/Data/String/Lemmas.lean

@@ -6,11 +6,15 @@ Authors: Leonardo de Moura
 module
 
 prelude
+public import Init.Data.Char.Order
 public import Init.Data.Char.Lemmas
 public import Init.Data.List.Lex
+import Init.Data.Order.Lemmas
 
 public section
 
+open Std
+
 namespace String
 
 protected theorem data_eq_of_eq {a b : String} (h : a = b) : a.data = b.data :=
@@ -34,4 +38,14 @@ protected theorem ne_of_lt {a b : String} (h : a < b) : a ≠ b := by
   have := String.lt_irrefl a
   intro h; subst h; contradiction
 
+instance instIsLinearOrder : IsLinearOrder String := by
+  apply IsLinearOrder.of_le
+  case le_antisymm => constructor; apply String.le_antisymm
+  case le_trans => constructor; apply String.le_trans
+  case le_total => constructor; apply String.le_total
+
+instance : LawfulOrderLT String where
+  lt_iff a b := by
+    simp [← String.not_le, Decidable.imp_iff_not_or, Std.Total.total]
+
 end String

src/Init/Data/Subtype.lean

@@ -1,32 +1,11 @@
 /-
-Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl
+Authors: Paul Reichert
 -/
 module
 
 prelude
-public import Init.Ext
-public import Init.Core
-
-public section
-
-namespace Subtype
-
-universe u
-variable {α : Sort u} {p q : α → Prop}
-
-@[ext]
-protected theorem ext : ∀ {a1 a2 : { x // p x }}, (a1 : α) = (a2 : α) → a1 = a2
-  | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
-
-@[simp]
-protected theorem «forall» {q : { a // p a } → Prop} : (∀ x, q x) ↔ ∀ a b, q ⟨a, b⟩ :=
-  ⟨fun h a b ↦ h ⟨a, b⟩, fun h ⟨a, b⟩ ↦ h a b⟩
-
-@[simp]
-protected theorem «exists» {q : { a // p a } → Prop} :
-    (Exists fun x => q x) ↔ Exists fun a => Exists fun b => q ⟨a, b⟩ :=
-  ⟨fun ⟨⟨a, b⟩, h⟩ ↦ ⟨a, b, h⟩, fun ⟨a, b, h⟩ ↦ ⟨⟨a, b⟩, h⟩⟩
-
-end Subtype
+public import Init.Data.Subtype.Basic
+public import Init.Data.Subtype.Order
+public import Init.Data.Subtype.OrderExtra

src/Init/Data/Subtype/Basic.lean

@@ -0,0 +1,32 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl
+-/
+module
+
+prelude
+public import Init.Ext
+public import Init.Core
+
+public section
+
+namespace Subtype
+
+universe u
+variable {α : Sort u} {p q : α → Prop}
+
+@[ext]
+protected theorem ext : ∀ {a1 a2 : { x // p x }}, (a1 : α) = (a2 : α) → a1 = a2
+  | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
+
+@[simp]
+protected theorem «forall» {q : { a // p a } → Prop} : (∀ x, q x) ↔ ∀ a b, q ⟨a, b⟩ :=
+  ⟨fun h a b ↦ h ⟨a, b⟩, fun h ⟨a, b⟩ ↦ h a b⟩
+
+@[simp]
+protected theorem «exists» {q : { a // p a } → Prop} :
+    (Exists fun x => q x) ↔ Exists fun a => Exists fun b => q ⟨a, b⟩ :=
+  ⟨fun ⟨⟨a, b⟩, h⟩ ↦ ⟨a, b, h⟩, fun ⟨a, b, h⟩ ↦ ⟨⟨a, b⟩, h⟩⟩
+
+end Subtype

src/Init/Data/Subtype/Order.lean

@@ -0,0 +1,94 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+import Init.SimpLemmas
+public import Init.Data.Order.Classes
+public import Init.Data.Order.Lemmas
+import Init.Data.Order.Factories
+import Init.Data.Subtype.Basic
+
+namespace Std
+
+public instance {α : Type u} [LE α] {P : α → Prop} : LE (Subtype P) where
+  le a b := a.val ≤ b.val
+
+public instance {α : Type u} [LT α] {P : α → Prop} : LT (Subtype P) where
+  lt a b := a.val < b.val
+
+public instance {α : Type u} [LT α] [LE α] [LawfulOrderLT α]
+    {P : α → Prop} : LawfulOrderLT (Subtype P) where
+  lt_iff a b := by simp [LT.lt, LE.le, LawfulOrderLT.lt_iff]
+
+public instance {α : Type u} [BEq α] {P : α → Prop} : BEq (Subtype P) where
+  beq a b := a.val == b.val
+
+public instance {α : Type u} [Min α] [MinEqOr α] {P : α → Prop} : Min (Subtype P) where
+  min a b := ⟨Min.min a.val b.val, MinEqOr.elim a.property b.property⟩
+
+public instance {α : Type u} [Max α] [MaxEqOr α] {P : α → Prop} : Max (Subtype P) where
+  max a b := ⟨max a.val b.val, MaxEqOr.elim a.property b.property⟩
+
+public instance {α : Type u} [LE α] [i : Refl (α := α) (· ≤ ·)] {P : α → Prop} :
+    Refl (α := Subtype P) (· ≤ ·) where
+  refl a := i.refl a.val
+
+public instance {α : Type u} [LE α] [i : Antisymm (α := α) (· ≤ ·)] {P : α → Prop} :
+    Antisymm (α := Subtype P) (· ≤ ·) where
+  antisymm a b hab hba := private Subtype.ext <| i.antisymm a.val b.val hab hba
+
+public instance {α : Type u} [LE α] [i : Total (α := α) (· ≤ ·)] {P : α → Prop} :
+    Total (α := Subtype P) (· ≤ ·) where
+  total a b := i.total a.val b.val
+
+public instance {α : Type u} [LE α] [i : Trans (α := α) (· ≤ ·) (· ≤ ·) (· ≤ ·)]
+    {P : α → Prop} :
+    Trans (α := Subtype P) (· ≤ ·) (· ≤ ·) (· ≤ ·) where
+  trans := i.trans
+
+public instance {α : Type u} [Min α] [MinEqOr α] {P : α → Prop} :
+    MinEqOr (Subtype P) where
+  min_eq_or a b := by
+    cases min_eq_or (a := a.val) (b := b.val) <;> rename_i h
+    · exact Or.inl <| Subtype.ext h
+    · exact Or.inr <| Subtype.ext h
+
+public instance {α : Type u} [LE α] [Min α] [LawfulOrderMin α] {P : α → Prop} :
+    LawfulOrderMin (Subtype P) where
+  le_min_iff _ _ _ := by
+    exact le_min_iff (α := α)
+
+public instance {α : Type u} [Max α] [MaxEqOr α] {P : α → Prop} :
+    MaxEqOr (Subtype P) where
+  max_eq_or a b := by
+    cases max_eq_or (a := a.val) (b := b.val) <;> rename_i h
+    · exact Or.inl <| Subtype.ext h
+    · exact Or.inr <| Subtype.ext h
+
+public instance {α : Type u} [LE α] [Max α] [LawfulOrderMax α] {P : α → Prop} :
+    LawfulOrderMax (Subtype P) where
+  max_le_iff _ _ _ := by
+    open Classical.Order in
+    exact max_le_iff (α := α)
+
+public instance {α : Type u} [LE α] [IsPreorder α] {P : α → Prop} :
+    IsPreorder (Subtype P) :=
+  IsPreorder.of_le
+
+public instance {α : Type u} [LE α] [IsLinearPreorder α] {P : α → Prop} :
+    IsLinearPreorder (Subtype P) :=
+  IsLinearPreorder.of_le
+
+public instance {α : Type u} [LE α] [IsPartialOrder α] {P : α → Prop} :
+    IsPartialOrder (Subtype P) :=
+  IsPartialOrder.of_le
+
+public instance {α : Type u} [LE α] [IsLinearOrder α] {P : α → Prop} :
+    IsLinearOrder (Subtype P) :=
+  IsLinearOrder.of_le
+
+end Std

src/Init/Data/Subtype/OrderExtra.lean

@@ -0,0 +1,13 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+public import Init.Data.Subtype.Order
+public import Init.Data.Ord
+
+public instance {α : Type u} [Ord α] {P : α → Prop} : Ord (Subtype P) where
+  compare a b := compare a.val b.val

src/Init/Data/UInt/Basic.lean

@@ -8,9 +8,13 @@ module
 prelude
 public import Init.Data.UInt.BasicAux
 public import Init.Data.BitVec.Basic
+public import Init.Data.Order.Classes
+import Init.Data.Order.Factories
 
 @[expose] public section
 
+open Std
+
 set_option linter.missingDocs true
 
 open Nat

src/Init/Data/UInt/Lemmas.lean

@@ -15,9 +15,13 @@ public import all Init.Data.BitVec.Basic
 public import Init.Data.BitVec.Lemmas
 public import Init.Data.Nat.Div.Lemmas
 public import Init.System.Platform
+public import Init.Data.Order.Factories
+import Init.Data.Order.Lemmas
 
 public section
 
+open Std
+
 open Lean in
 set_option hygiene false in
 macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
@@ -206,6 +210,19 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
   protected theorem le_antisymm {a b : $typeName} (h₁ : a ≤ b) (h₂ : b ≤ a) : a = b :=
     le_antisymm_iff.2 ⟨h₁, h₂⟩
 
+  open $typeName renaming
+    le_refl → le_refl', le_antisymm → le_antisymm', le_total → le_total', le_trans → le_trans' in
+  instance instIsLinearOrder : IsLinearOrder $typeName := by
+    apply IsLinearOrder.of_le
+    case le_antisymm => constructor; apply le_antisymm'
+    case le_total => constructor; apply le_total'
+    case le_trans => constructor; apply le_trans'
+
+open $typeName renaming not_le → not_le'
+instance : LawfulOrderLT $typeName where
+  lt_iff _ _ := by
+    simp [← not_le', Decidable.imp_iff_not_or, Std.Total.total]
+
   @[simp] protected theorem ofNat_one : ofNat 1 = 1 := (rfl)
 
   @[simp] protected theorem ofNat_toNat {x : $typeName} : ofNat x.toNat = x := by

src/Init/Data/Vector/Lex.lean

@@ -11,15 +11,17 @@ public import Init.Data.Vector.Lemmas
 public import all Init.Data.Array.Lex.Basic
 public import Init.Data.Array.Lex.Lemmas
 import Init.Data.Range.Polymorphic.Lemmas
+import Init.Data.Order.Lemmas
 
 public section
 
+open Std
+
 set_option linter.listVariables true -- Enforce naming conventions for `List`/`Array`/`Vector` variables.
 set_option linter.indexVariables true -- Enforce naming conventions for index variables.
 
 namespace Vector
 
-
 /-! ### Lexicographic ordering -/
 
 @[simp] theorem lt_toArray [LT α] {xs ys : Vector α n} : xs.toArray < ys.toArray ↔ xs < ys := Iff.rfl
@@ -96,27 +98,35 @@ instance [LT α]
     Trans (· < · : Vector α n → Vector α n → Prop) (· < ·) (· < ·) where
   trans h₁ h₂ := Vector.lt_trans h₁ h₂
 
-protected theorem lt_of_le_of_lt [LT α]
-    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
-    [i₁ : Std.Asymm (· < · : α → α → Prop)]
-    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
-    [i₃ : Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
+protected theorem lt_of_le_of_lt [LT α] [LE α] [LawfulOrderLT α] [IsLinearOrder α]
     {xs ys zs : Vector α n} (h₁ : xs ≤ ys) (h₂ : ys < zs) : xs < zs :=
   Array.lt_of_le_of_lt h₁ h₂
 
-protected theorem le_trans [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
+@[deprecated Vector.lt_of_le_of_lt (since := "2025-08-01")]
+protected theorem lt_of_le_of_lt' [LT α]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
+    {xs ys zs : Vector α n} (h₁ : xs ≤ ys) (h₂ : ys < zs) : xs < zs :=
+  letI := LE.ofLT α
+  haveI : IsLinearOrder α := IsLinearOrder.of_lt
+  Array.lt_of_le_of_lt h₁ h₂
+
+protected theorem le_trans [LT α] [LE α] [LawfulOrderLT α] [IsLinearOrder α]
+    {xs ys zs : Vector α n} (h₁ : xs ≤ ys) (h₂ : ys ≤ zs) : xs ≤ zs :=
+  fun h₃ => h₁ (Vector.lt_of_le_of_lt h₂ h₃)
+
+@[deprecated Vector.le_trans (since := "2025-08-01")]
+protected theorem le_trans' [LT α]
     [Std.Asymm (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)]
     [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
     {xs ys zs : Vector α n} (h₁ : xs ≤ ys) (h₂ : ys ≤ zs) : xs ≤ zs :=
-  fun h₃ => h₁ (Vector.lt_of_le_of_lt h₂ h₃)
+  letI := LE.ofLT α
+  haveI : IsLinearOrder α := IsLinearOrder.of_lt
+  Array.le_trans h₁ h₂
 
-instance [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
-    [Std.Asymm (· < · : α → α → Prop)]
-    [Std.Antisymm (¬ · < · : α → α → Prop)]
-    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)] :
+instance [LT α] [LE α] [LawfulOrderLT α] [IsLinearOrder α] :
     Trans (· ≤ · : Vector α n → Vector α n → Prop) (· ≤ ·) (· ≤ ·) where
   trans h₁ h₂ := Vector.le_trans h₁ h₂
 
@@ -129,30 +139,44 @@ instance [LT α]
     Std.Asymm (· < · : Vector α n → Vector α n → Prop) where
   asymm _ _ := Vector.lt_asymm
 
-protected theorem le_total [LT α]
-    [i : Std.Total (¬ · < · : α → α → Prop)] (xs ys : Vector α n) : xs ≤ ys ∨ ys ≤ xs :=
+protected theorem le_total [LT α] [i : Std.Asymm (· < · : α → α → Prop)] (xs ys : Vector α n) :
+    xs ≤ ys ∨ ys ≤ xs :=
   Array.le_total _ _
 
-instance [LT α]
-    [Std.Total (¬ · < · : α → α → Prop)] :
+protected theorem le_antisymm [LT α] [LE α] [IsLinearOrder α] [LawfulOrderLT α]
+    {xs ys : Vector α n} (h₁ : xs ≤ ys) (h₂ : ys ≤ xs) : xs = ys :=
+  Vector.toArray_inj.mp <| Array.le_antisymm h₁ h₂
+
+instance [LT α] [Std.Asymm (· < · : α → α → Prop)] :
     Std.Total (· ≤ · : Vector α n → Vector α n → Prop) where
   total := Vector.le_total
 
+instance [LT α] [LE α] [IsLinearOrder α] [LawfulOrderLT α] :
+    IsLinearOrder (Vector α n) := by
+  apply IsLinearOrder.of_le
+  case le_antisymm => constructor; apply Vector.le_antisymm
+  case le_total => constructor; apply Vector.le_total
+  case le_trans => constructor; apply Vector.le_trans
+
 @[simp] protected theorem not_lt [LT α]
     {xs ys : Vector α n} : ¬ xs < ys ↔ ys ≤ xs := Iff.rfl
 
 @[simp] protected theorem not_le [LT α]
     {xs ys : Vector α n} : ¬ ys ≤ xs ↔ xs < ys := Classical.not_not
 
+instance [LT α] [Std.Asymm (· < · : α → α → Prop)] : LawfulOrderLT (Vector α n) where
+  lt_iff _ _ := by
+    open Classical in
+    simp [← Vector.not_le, Decidable.imp_iff_not_or, Std.Total.total]
+
 protected theorem le_of_lt [LT α]
-    [i : Std.Total (¬ · < · : α → α → Prop)]
+    [i : Std.Asymm (· < · : α → α → Prop)]
     {xs ys : Vector α n} (h : xs < ys) : xs ≤ ys :=
   Array.le_of_lt h
 
 protected theorem le_iff_lt_or_eq [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)]
-    [Std.Total (¬ · < · : α → α → Prop)]
     {xs ys : Vector α n} : xs ≤ ys ↔ xs < ys ∨ xs = ys := by
   simpa using Array.le_iff_lt_or_eq (xs := xs.toArray) (ys := ys.toArray)
 
@@ -222,7 +246,6 @@ protected theorem lt_iff_exists [LT α] {xs ys : Vector α n} :
   simp_all [Array.lt_iff_exists]
 
 protected theorem le_iff_exists [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
     [Std.Asymm (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)] {xs ys : Vector α n} :
     xs ≤ ys ↔
@@ -237,7 +260,6 @@ theorem append_left_lt [LT α] {xs : Vector α n} {ys ys' : Vector α m} (h : ys
   simpa using Array.append_left_lt h
 
 theorem append_left_le [LT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
     [Std.Asymm (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)]
     {xs : Vector α n} {ys ys' : Vector α m} (h : ys ≤ ys') :
@@ -250,10 +272,8 @@ protected theorem map_lt [LT α] [LT β]
   simpa using Array.map_lt w h
 
 protected theorem map_le [LT α] [LT β]
-    [Std.Irrefl (· < · : α → α → Prop)]
     [Std.Asymm (· < · : α → α → Prop)]
     [Std.Antisymm (¬ · < · : α → α → Prop)]
-    [Std.Irrefl (· < · : β → β → Prop)]
     [Std.Asymm (· < · : β → β → Prop)]
     [Std.Antisymm (¬ · < · : β → β → Prop)]
     {xs ys : Vector α n} {f : α → β} (w : ∀ x y, x < y → f x < f y) (h : xs ≤ ys) :

src/Init/Grind/Module/Basic.lean

@@ -20,6 +20,9 @@ class AddRightCancel (M : Type u) [Add M] where
   /-- Addition is right-cancellative. -/
   add_right_cancel : ∀ a b c : M, a + c = b + c → a = b
 
+/-- A type with zero and addition,
+where addition is commutative and associative,
+and the zero is the right identity for addition. -/
 class AddCommMonoid (M : Type u) extends Zero M, Add M where
   /-- Zero is the right identity for addition. -/
   add_zero : ∀ a : M, a + 0 = a
@@ -30,6 +33,9 @@ class AddCommMonoid (M : Type u) extends Zero M, Add M where
 
 attribute [instance 100] AddCommMonoid.toZero AddCommMonoid.toAdd
 
+/-- A type with zero, addition, negation, and subtraction,
+where addition is commutative and associative,
+and negation is the left inverse of addition. -/
 class AddCommGroup (M : Type u) extends AddCommMonoid M, Neg M, Sub M where
   /-- Negation is the left inverse of addition. -/
   neg_add_cancel : ∀ a : M, -a + a = 0

src/Init/Grind/Module/Envelope.lean

@@ -267,7 +267,7 @@ instance [NatModule α] [AddRightCancel α] [NoNatZeroDivisors α] : NoNatZeroDi
     replace h₂ := NoNatZeroDivisors.no_nat_zero_divisors k (a₁ + b₂) (a₂ + b₁) h₁ h₂
     apply Quot.sound; simp [r]; exists 0; simp [h₂]
 
-instance [Preorder α] [OrderedAdd α] : LE (OfNatModule.Q α) where
+instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : LE (OfNatModule.Q α) where
   le a b := Q.liftOn₂ a b (fun (a, b) (c, d) => a + d ≤ b + c)
     (by intro (a₁, b₁) (a₂, b₂) (a₃, b₃) (a₄, b₄)
         simp; intro k₁ h₁ k₂ h₂
@@ -283,11 +283,14 @@ instance [Preorder α] [OrderedAdd α] : LE (OfNatModule.Q α) where
         rw [this]; clear this
         rw [← OrderedAdd.add_le_left_iff])
 
-@[local simp] theorem mk_le_mk [Preorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
+instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : LT (OfNatModule.Q α) where
+  lt a b := a ≤ b ∧ ¬b ≤ a
+
+@[local simp] theorem mk_le_mk [LE α] [LT α] [Preorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
     Q.mk (a₁, a₂) ≤ Q.mk (b₁, b₂) ↔ a₁ + b₂ ≤ a₂ + b₁ := by
   rfl
 
-instance [Preorder α] [OrderedAdd α] : Preorder (OfNatModule.Q α) where
+instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : Preorder (OfNatModule.Q α) where
   le_refl a := by
     obtain ⟨⟨a₁, a₂⟩⟩ := a
     change Q.mk _ ≤ Q.mk _
@@ -308,24 +311,24 @@ instance [Preorder α] [OrderedAdd α] : Preorder (OfNatModule.Q α) where
 
 attribute [-simp] Q.mk
 
-@[local simp] private theorem mk_lt_mk [Preorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
+@[local simp] private theorem mk_lt_mk [LE α] [LT α] [Preorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
     Q.mk (a₁, a₂) < Q.mk (b₁, b₂) ↔ a₁ + b₂ < a₂ + b₁ := by
   simp [Preorder.lt_iff_le_not_le, AddCommMonoid.add_comm]
 
-@[local simp] private theorem mk_pos [Preorder α] [OrderedAdd α] {a₁ a₂ : α} :
+@[local simp] private theorem mk_pos [LE α] [LT α] [Preorder α] [OrderedAdd α] {a₁ a₂ : α} :
     0 < Q.mk (a₁, a₂) ↔ a₂ < a₁ := by
   change Q.mk (0,0) < _ ↔ _
   simp [mk_lt_mk, AddCommMonoid.zero_add]
 
 @[local simp]
-theorem toQ_le [Preorder α] [OrderedAdd α] {a b : α} : toQ a ≤ toQ b ↔ a ≤ b := by
+theorem toQ_le [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α} : toQ a ≤ toQ b ↔ a ≤ b := by
   simp
 
 @[local simp]
-theorem toQ_lt [Preorder α] [OrderedAdd α] {a b : α} : toQ a < toQ b ↔ a < b := by
+theorem toQ_lt [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α} : toQ a < toQ b ↔ a < b := by
   simp [Preorder.lt_iff_le_not_le]
 
-instance [Preorder α] [OrderedAdd α] : OrderedAdd (OfNatModule.Q α) where
+instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : OrderedAdd (OfNatModule.Q α) where
   add_le_left_iff := by
     intro a b c
     obtain ⟨⟨a₁, a₂⟩⟩ := a

src/Init/Grind/Ordered/Field.lean

@@ -15,7 +15,7 @@ namespace Lean.Grind
 
 namespace Field.IsOrdered
 
-variable {R : Type u} [Field R] [LinearOrder R] [OrderedRing R]
+variable {R : Type u} [Field R] [LE R] [LT R] [LinearOrder R] [OrderedRing R]
 
 open OrderedAdd
 open OrderedRing

src/Init/Grind/Ordered/Linarith.lean

@@ -254,17 +254,17 @@ open OrderedAdd
 Helper theorems for conflict resolution during model construction.
 -/
 
-private theorem le_add_le {α} [IntModule α] [Preorder α] [OrderedAdd α] {a b : α}
+private theorem le_add_le {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α}
     (h₁ : a ≤ 0) (h₂ : b ≤ 0) : a + b ≤ 0 := by
   replace h₁ := add_le_left h₁ b; simp at h₁
   exact Preorder.le_trans h₁ h₂
 
-private theorem le_add_lt {α} [IntModule α] [Preorder α] [OrderedAdd α] {a b : α}
+private theorem le_add_lt {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α}
     (h₁ : a ≤ 0) (h₂ : b < 0) : a + b < 0 := by
   replace h₁ := add_le_left h₁ b; simp at h₁
   exact Preorder.lt_of_le_of_lt h₁ h₂
 
-private theorem lt_add_lt {α} [IntModule α] [Preorder α] [OrderedAdd α] {a b : α}
+private theorem lt_add_lt {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α}
     (h₁ : a < 0) (h₂ : b < 0) : a + b < 0 := by
   replace h₁ := add_lt_left h₁ b; simp at h₁
   exact Preorder.lt_trans h₁ h₂
@@ -277,7 +277,7 @@ def le_le_combine_cert (p₁ p₂ p₃ : Poly) : Bool :=
   let a₂ := p₂.leadCoeff.natAbs
   p₃ == (p₁.mul a₂ |>.combine (p₂.mul a₁))
 
-theorem le_le_combine {α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
+theorem le_le_combine {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
     : le_le_combine_cert p₁ p₂ p₃ → p₁.denote' ctx ≤ 0 → p₂.denote' ctx ≤ 0 → p₃.denote' ctx ≤ 0 := by
   simp [le_le_combine_cert]; intro _ h₁ h₂; subst p₃; simp
   replace h₁ := zsmul_nonpos (coe_natAbs_nonneg p₂.leadCoeff) h₁
@@ -289,7 +289,7 @@ def le_lt_combine_cert (p₁ p₂ p₃ : Poly) : Bool :=
   let a₂ := p₂.leadCoeff.natAbs
   a₁ > (0 : Int) && p₃ == (p₁.mul a₂ |>.combine (p₂.mul a₁))
 
-theorem le_lt_combine {α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
+theorem le_lt_combine {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
     : le_lt_combine_cert p₁ p₂ p₃ → p₁.denote' ctx ≤ 0 → p₂.denote' ctx < 0 → p₃.denote' ctx < 0 := by
   simp [-Int.natAbs_pos, -Int.ofNat_pos, le_lt_combine_cert]; intro hp _ h₁ h₂; subst p₃; simp
   replace h₁ := zsmul_nonpos (coe_natAbs_nonneg p₂.leadCoeff) h₁
@@ -301,7 +301,7 @@ def lt_lt_combine_cert (p₁ p₂ p₃ : Poly) : Bool :=
   let a₂ := p₂.leadCoeff.natAbs
   a₂ > (0 : Int) && a₁ > (0 : Int) && p₃ == (p₁.mul a₂ |>.combine (p₂.mul a₁))
 
-theorem lt_lt_combine {α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
+theorem lt_lt_combine {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
     : lt_lt_combine_cert p₁ p₂ p₃ → p₁.denote' ctx < 0 → p₂.denote' ctx < 0 → p₃.denote' ctx < 0 := by
   simp [-Int.natAbs_pos, -Int.ofNat_pos, lt_lt_combine_cert]; intro hp₁ hp₂ _ h₁ h₂; subst p₃; simp
   replace h₁ := zsmul_neg_iff (↑p₂.leadCoeff.natAbs) h₁ |>.mpr hp₁
@@ -312,7 +312,7 @@ def diseq_split_cert (p₁ p₂ : Poly) : Bool :=
   p₂ == p₁.mul (-1)
 
 -- We need `LinearOrder` to use `trichotomy`
-theorem diseq_split {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly)
+theorem diseq_split {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly)
     : diseq_split_cert p₁ p₂ → p₁.denote' ctx ≠ 0 → p₁.denote' ctx < 0 ∨ p₂.denote' ctx < 0 := by
   simp [diseq_split_cert]; intro _ h₁; subst p₂; simp
   cases LinearOrder.trichotomy (p₁.denote ctx) 0
@@ -322,7 +322,7 @@ theorem diseq_split {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx :
     simp [h₁] at h
     rw [← neg_pos_iff, neg_zsmul, neg_neg, one_zsmul]; assumption
 
-theorem diseq_split_resolve {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly)
+theorem diseq_split_resolve {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly)
     : diseq_split_cert p₁ p₂ → p₁.denote' ctx ≠ 0 → ¬p₁.denote' ctx < 0 → p₂.denote' ctx < 0 := by
   intro h₁ h₂ h₃
   exact (diseq_split ctx p₁ p₂ h₁ h₂).resolve_left h₃
@@ -338,7 +338,7 @@ theorem eq_norm {α} [IntModule α] (ctx : Context α) (lhs rhs : Expr) (p : Pol
     : norm_cert lhs rhs p → lhs.denote ctx = rhs.denote ctx → p.denote' ctx = 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote, h₁, sub_self]
 
-theorem le_of_eq {α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem le_of_eq {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert lhs rhs p → lhs.denote ctx = rhs.denote ctx → p.denote' ctx ≤ 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote, h₁, sub_self]
   apply Preorder.le_refl
@@ -351,21 +351,21 @@ theorem diseq_norm {α} [IntModule α] (ctx : Context α) (lhs rhs : Expr) (p :
   rw [add_left_comm, ← sub_eq_add_neg, sub_self, add_zero] at h
   contradiction
 
-theorem le_norm {α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem le_norm {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert lhs rhs p → lhs.denote ctx ≤ rhs.denote ctx → p.denote' ctx ≤ 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote]
   replace h₁ := add_le_left h₁ (-rhs.denote ctx)
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem lt_norm {α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem lt_norm {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert lhs rhs p → lhs.denote ctx < rhs.denote ctx → p.denote' ctx < 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote]
   replace h₁ := add_lt_left h₁ (-rhs.denote ctx)
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem not_le_norm {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_le_norm {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert rhs lhs p → ¬ lhs.denote ctx ≤ rhs.denote ctx → p.denote' ctx < 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote]
   replace h₁ := LinearOrder.lt_of_not_le h₁
@@ -373,7 +373,7 @@ theorem not_le_norm {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx :
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem not_lt_norm {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_lt_norm {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert rhs lhs p → ¬ lhs.denote ctx < rhs.denote ctx → p.denote' ctx ≤ 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote]
   replace h₁ := LinearOrder.le_of_not_lt h₁
@@ -383,14 +383,14 @@ theorem not_lt_norm {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx :
 
 -- If the module does not have a linear order, we can still put the expressions in polynomial forms
 
-theorem not_le_norm' {α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_le_norm' {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert lhs rhs p → ¬ lhs.denote ctx ≤ rhs.denote ctx → ¬ p.denote' ctx ≤ 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote]; intro h
   replace h := add_le_right (rhs.denote ctx) h
   rw [sub_eq_add_neg, add_left_comm, ← sub_eq_add_neg, sub_self] at h; simp at h
   contradiction
 
-theorem not_lt_norm' {α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_lt_norm' {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : norm_cert lhs rhs p → ¬ lhs.denote ctx < rhs.denote ctx → ¬ p.denote' ctx < 0 := by
   simp [norm_cert]; intro _ h₁; subst p; simp [Expr.denote]; intro h
   replace h := add_lt_right (rhs.denote ctx) h
@@ -403,7 +403,7 @@ Equality detection
 def eq_of_le_ge_cert (p₁ p₂ : Poly) : Bool :=
   p₂ == p₁.mul (-1)
 
-theorem eq_of_le_ge {α} [IntModule α] [PartialOrder α] [OrderedAdd α] (ctx : Context α) (p₁ : Poly) (p₂ : Poly)
+theorem eq_of_le_ge {α} [IntModule α] [LE α] [LT α] [PartialOrder α] [OrderedAdd α] (ctx : Context α) (p₁ : Poly) (p₂ : Poly)
     : eq_of_le_ge_cert p₁ p₂ → p₁.denote' ctx ≤ 0 → p₂.denote' ctx ≤ 0 → p₁.denote' ctx = 0 := by
   simp [eq_of_le_ge_cert]
   intro; subst p₂; simp
@@ -419,7 +419,7 @@ Helper theorems for closing the goal
 theorem diseq_unsat {α} [IntModule α] (ctx : Context α) : (Poly.nil).denote ctx ≠ 0 → False := by
   simp [Poly.denote]
 
-theorem lt_unsat {α} [IntModule α] [Preorder α] (ctx : Context α) : (Poly.nil).denote ctx < 0 → False := by
+theorem lt_unsat {α} [IntModule α] [LE α] [LT α] [Preorder α] (ctx : Context α) : (Poly.nil).denote ctx < 0 → False := by
   simp [Poly.denote]; intro h
   have := Preorder.lt_iff_le_not_le.mp h
   simp at this
@@ -427,7 +427,7 @@ theorem lt_unsat {α} [IntModule α] [Preorder α] (ctx : Context α) : (Poly.ni
 def zero_lt_one_cert (p : Poly) : Bool :=
   p == .add (-1) 0 .nil
 
-theorem zero_lt_one {α} [Ring α] [Preorder α] [OrderedRing α] (ctx : Context α) (p : Poly)
+theorem zero_lt_one {α} [Ring α] [LE α] [LT α] [Preorder α] [OrderedRing α] (ctx : Context α) (p : Poly)
     : zero_lt_one_cert p → (0 : Var).denote ctx = One.one → p.denote' ctx < 0 := by
   simp [zero_lt_one_cert]; intro _ h; subst p; simp [Poly.denote, h, One.one, neg_zsmul]
   rw [neg_lt_iff, neg_zero]; apply OrderedRing.zero_lt_one
@@ -435,7 +435,7 @@ theorem zero_lt_one {α} [Ring α] [Preorder α] [OrderedRing α] (ctx : Context
 def zero_ne_one_cert (p : Poly) : Bool :=
   p == .add 1 0 .nil
 
-theorem zero_ne_one_of_ord_ring {α} [Ring α] [Preorder α] [OrderedRing α] (ctx : Context α) (p : Poly)
+theorem zero_ne_one_of_ord_ring {α} [Ring α] [LE α] [LT α] [Preorder α] [OrderedRing α] (ctx : Context α) (p : Poly)
     : zero_ne_one_cert p → (0 : Var).denote ctx = One.one → p.denote' ctx ≠ 0 := by
   simp [zero_ne_one_cert]; intro _ h; subst p; simp [Poly.denote, h, One.one]
   intro h; have := OrderedRing.zero_lt_one (R := α); simp [h, Preorder.lt_irrefl] at this
@@ -484,7 +484,7 @@ theorem eq_coeff {α} [IntModule α] [NoNatZeroDivisors α] (ctx : Context α) (
 def coeff_cert (p₁ p₂ : Poly) (k : Nat) :=
   k > 0 && p₁ == p₂.mul k
 
-theorem le_coeff {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
+theorem le_coeff {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
     : coeff_cert p₁ p₂ k → p₁.denote' ctx ≤ 0 → p₂.denote' ctx ≤ 0 := by
   simp [coeff_cert]; intro h _; subst p₁; simp
   have : ↑k > (0 : Int) := Int.natCast_pos.mpr h
@@ -493,7 +493,7 @@ theorem le_coeff {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx : Con
   replace h₂ := zsmul_pos_iff (↑k) h₂ |>.mpr this
   exact Preorder.lt_irrefl 0 (Preorder.lt_of_lt_of_le h₂ h₁)
 
-theorem lt_coeff {α} [IntModule α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
+theorem lt_coeff {α} [IntModule α] [LE α] [LT α] [LinearOrder α] [OrderedAdd α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
     : coeff_cert p₁ p₂ k → p₁.denote' ctx < 0 → p₂.denote' ctx < 0 := by
   simp [coeff_cert]; intro h _; subst p₁; simp
   have : ↑k > (0 : Int) := Int.natCast_pos.mpr h
@@ -544,7 +544,7 @@ def eq_le_subst_cert (x : Var) (p₁ p₂ p₃ : Poly) :=
   let b := p₂.coeff x
   a ≥ 0 && p₃ == (p₂.mul a |>.combine (p₁.mul (-b)))
 
-theorem eq_le_subst {α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
+theorem eq_le_subst {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
     : eq_le_subst_cert x p₁ p₂ p₃ → p₁.denote' ctx = 0 → p₂.denote' ctx ≤ 0 → p₃.denote' ctx ≤ 0 := by
   simp [eq_le_subst_cert]; intro h _ h₁ h₂; subst p₃; simp [h₁]
   exact zsmul_nonpos h h₂
@@ -554,7 +554,7 @@ def eq_lt_subst_cert (x : Var) (p₁ p₂ p₃ : Poly) :=
   let b := p₂.coeff x
   a > 0 && p₃ == (p₂.mul a |>.combine (p₁.mul (-b)))
 
-theorem eq_lt_subst {α} [IntModule α] [Preorder α] [OrderedAdd α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
+theorem eq_lt_subst {α} [IntModule α] [LE α] [LT α] [Preorder α] [OrderedAdd α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
     : eq_lt_subst_cert x p₁ p₂ p₃ → p₁.denote' ctx = 0 → p₂.denote' ctx < 0 → p₃.denote' ctx < 0 := by
   simp [eq_lt_subst_cert]; intro h _ h₁ h₂; subst p₃; simp [h₁]
   exact zsmul_neg_iff (p₁.coeff x) h₂ |>.mpr h

src/Init/Grind/Ordered/Module.lean

@@ -17,7 +17,7 @@ namespace Lean.Grind
 /--
 Addition is compatible with a preorder if `a ≤ b ↔ a + c ≤ b + c`.
 -/
-class OrderedAdd (M : Type u) [HAdd M M M] [Preorder M] where
+class OrderedAdd (M : Type u) [HAdd M M M] [LE M] [LT M] [Preorder M] where
   /-- `a + c ≤ b + c` iff `a ≤ b`. -/
   add_le_left_iff : ∀ {a b : M} (c : M), a ≤ b ↔ a + c ≤ b + c
 
@@ -30,7 +30,7 @@ open AddCommMonoid NatModule
 
 section
 
-variable {M : Type u} [Preorder M] [AddCommMonoid M] [OrderedAdd M]
+variable {M : Type u} [LE M] [LT M] [Preorder M] [AddCommMonoid M] [OrderedAdd M]
 
 theorem add_le_right_iff {a b : M} (c : M) : a ≤ b ↔ c + a ≤ c + b := by
   rw [add_comm c a, add_comm c b, add_le_left_iff]
@@ -73,7 +73,7 @@ end
 
 section
 
-variable {M : Type u} [Preorder M] [NatModule M] [OrderedAdd M]
+variable {M : Type u} [LE M] [LT M] [Preorder M] [NatModule M] [OrderedAdd M]
 
 theorem nsmul_le_nsmul {k : Nat} {a b : M} (h : a ≤ b) : k * a ≤ k * b := by
   induction k with
@@ -117,7 +117,7 @@ end
 section
 
 open AddCommGroup
-variable {M : Type u} [Preorder M] [AddCommGroup M] [OrderedAdd M]
+variable {M : Type u} [LE M] [LT M] [Preorder M] [AddCommGroup M] [OrderedAdd M]
 
 theorem neg_le_iff {a b : M} : -a ≤ b ↔ -b ≤ a := by
   rw [OrderedAdd.add_le_left_iff a, neg_add_cancel]
@@ -127,7 +127,7 @@ theorem neg_le_iff {a b : M} : -a ≤ b ↔ -b ≤ a := by
 end
 section
 
-variable {M : Type u} [Preorder M] [IntModule M] [OrderedAdd M]
+variable {M : Type u} [LE M] [LT M] [Preorder M] [IntModule M] [OrderedAdd M]
 open AddCommGroup IntModule
 
 theorem zsmul_pos_iff (k : Int) {x : M} (h : 0 < x) : 0 < k * x ↔ 0 < k :=
@@ -154,7 +154,7 @@ theorem zsmul_nonneg {k : Int} {x : M} (h : 0 ≤ k) (hx : 0 ≤ x) : 0 ≤ k *
 end
 
 section
-variable {M : Type u} [Preorder M] [AddCommGroup M] [OrderedAdd M]
+variable {M : Type u} [LE M] [LT M] [Preorder M] [AddCommGroup M] [OrderedAdd M]
 
 open AddCommGroup
 
@@ -186,7 +186,7 @@ end
 
 section
 
-variable {M : Type u} [Preorder M] [IntModule M] [OrderedAdd M]
+variable {M : Type u} [LE M] [LT M] [Preorder M] [IntModule M] [OrderedAdd M]
 open IntModule
 
 theorem zsmul_neg_iff (k : Int) {a : M} (h : a < 0) : k * a < 0 ↔ 0 < k := by

src/Init/Grind/Ordered/Order.lean

@@ -13,18 +13,17 @@ public section
 namespace Lean.Grind
 
 /-- A preorder is a reflexive, transitive relation `≤` with `a < b` defined in the obvious way. -/
-class Preorder (α : Type u) extends LE α, LT α where
+class Preorder (α : Type u) [LE α] [LT α] where
   /-- The less-than-or-equal relation is reflexive. -/
   le_refl : ∀ a : α, a ≤ a
   /-- The less-than-or-equal relation is transitive. -/
   le_trans : ∀ {a b c : α}, a ≤ b → b ≤ c → a ≤ c
-  lt := fun a b => a ≤ b ∧ ¬b ≤ a
   /-- The less-than relation is determined by the less-than-or-equal relation. -/
   lt_iff_le_not_le : ∀ {a b : α}, a < b ↔ a ≤ b ∧ ¬b ≤ a := by intros; rfl
 
 namespace Preorder
 
-variable {α : Type u} [Preorder α]
+variable {α : Type u} [LE α] [LT α] [Preorder α]
 
 theorem le_of_lt {a b : α} (h : a < b) : a ≤ b := (lt_iff_le_not_le.mp h).1
 
@@ -58,13 +57,13 @@ theorem not_gt_of_lt {a b : α} (h : a < b) : ¬a > b :=
 end Preorder
 
 /-- A partial order is a preorder with the additional property that `a ≤ b` and `b ≤ a` implies `a = b`. -/
-class PartialOrder (α : Type u) extends Preorder α where
+class PartialOrder (α : Type u) [LE α] [LT α] extends Preorder α where
   /-- The less-than-or-equal relation is antisymmetric. -/
   le_antisymm : ∀ {a b : α}, a ≤ b → b ≤ a → a = b
 
 namespace PartialOrder
 
-variable {α : Type u} [PartialOrder α]
+variable {α : Type u} [LE α] [LT α] [PartialOrder α]
 
 theorem le_iff_lt_or_eq {a b : α} : a ≤ b ↔ a < b ∨ a = b := by
   constructor
@@ -79,13 +78,13 @@ theorem le_iff_lt_or_eq {a b : α} : a ≤ b ↔ a < b ∨ a = b := by
 end PartialOrder
 
 /-- A linear order is a partial order with the additional property that every pair of elements is comparable. -/
-class LinearOrder (α : Type u) extends PartialOrder α where
+class LinearOrder (α : Type u) [LE α] [LT α] extends PartialOrder α where
   /-- For every two elements `a` and `b`, either `a ≤ b` or `b ≤ a`. -/
   le_total : ∀ a b : α, a ≤ b ∨ b ≤ a
 
 namespace LinearOrder
 
-variable {α : Type u} [LinearOrder α]
+variable {α : Type u} [LE α] [LT α] [LinearOrder α]
 
 theorem trichotomy (a b : α) : a < b ∨ a = b ∨ b < a := by
   cases LinearOrder.le_total a b with
@@ -100,12 +99,12 @@ theorem trichotomy (a b : α) : a < b ∨ a = b ∨ b < a := by
     | inl h => right; right; exact h
     | inr h => right; left; exact h.symm
 
-theorem le_of_not_lt {α} [LinearOrder α] {a b : α} (h : ¬ a < b) : b ≤ a := by
+theorem le_of_not_lt {a b : α} (h : ¬ a < b) : b ≤ a := by
   cases LinearOrder.trichotomy a b
   next => contradiction
   next h => apply PartialOrder.le_iff_lt_or_eq.mpr; cases h <;> simp [*]
 
-theorem lt_of_not_le {α} [LinearOrder α] {a b : α} (h : ¬ a ≤ b) : b < a := by
+theorem lt_of_not_le {a b : α} (h : ¬ a ≤ b) : b < a := by
   cases LinearOrder.trichotomy a b
   next h₁ h₂ => have := Preorder.lt_iff_le_not_le.mp h₂; simp [h] at this
   next h =>

src/Init/Grind/Ordered/Ring.lean

@@ -17,7 +17,7 @@ namespace Lean.Grind
 A ring which is also equipped with a preorder is considered a strict ordered ring if addition, negation,
 and multiplication are compatible with the preorder, and `0 < 1`.
 -/
-class OrderedRing (R : Type u) [Semiring R] [Preorder R] extends OrderedAdd R where
+class OrderedRing (R : Type u) [Semiring R] [LE R] [LT R] [Preorder R] extends OrderedAdd R where
   /-- In a strict ordered semiring, we have `0 < 1`. -/
   zero_lt_one : (0 : R) < 1
   /-- In a strict ordered semiring, we can multiply an inequality `a < b` on the left
@@ -33,7 +33,7 @@ variable {R : Type u} [Ring R]
 
 section Preorder
 
-variable [Preorder R] [OrderedRing R]
+variable [LE R] [LT R] [Preorder R] [OrderedRing R]
 
 theorem neg_one_lt_zero : (-1 : R) < 0 := by
   have h := zero_lt_one (R := R)
@@ -52,7 +52,7 @@ theorem ofNat_nonneg (x : Nat) : (OfNat.ofNat x : R) ≥ 0 := by
     have := Preorder.lt_of_lt_of_le this ih
     exact Preorder.le_of_lt this
 
-instance [Ring α] [Preorder α] [OrderedRing α] : IsCharP α 0 := IsCharP.mk' _ _ <| by
+instance [Ring R] [LE R] [LT R] [Preorder R] [OrderedRing R] : IsCharP R 0 := IsCharP.mk' _ _ <| by
   intro x
   simp only [Nat.mod_zero]; constructor
   next =>
@@ -64,11 +64,11 @@ instance [Ring α] [Preorder α] [OrderedRing α] : IsCharP α 0 := IsCharP.mk'
       replace h := congrArg (· - 1) h; simp at h
       rw [Ring.sub_eq_add_neg, Semiring.add_assoc, AddCommGroup.add_neg_cancel,
           Ring.sub_eq_add_neg, AddCommMonoid.zero_add, Semiring.add_zero] at h
-      have h₁ : (OfNat.ofNat x : α) < 0 := by
-        have := OrderedRing.neg_one_lt_zero (R := α)
+      have h₁ : (OfNat.ofNat x : R) < 0 := by
+        have := OrderedRing.neg_one_lt_zero (R := R)
         rw [h]; assumption
-      have h₂ := OrderedRing.ofNat_nonneg (R := α) x
-      have : (0 : α) < 0 := Preorder.lt_of_le_of_lt h₂ h₁
+      have h₂ := OrderedRing.ofNat_nonneg (R := R) x
+      have : (0 : R) < 0 := Preorder.lt_of_le_of_lt h₂ h₁
       simp
       exact (Preorder.lt_irrefl 0) this
   next => intro h; rw [OfNat.ofNat, h]; rfl
@@ -77,7 +77,7 @@ end Preorder
 
 section PartialOrder
 
-variable [PartialOrder R] [OrderedRing R]
+variable [LE R] [LT R] [PartialOrder R] [OrderedRing R]
 
 theorem zero_le_one : (0 : R) ≤ 1 := Preorder.le_of_lt zero_lt_one
 
@@ -158,7 +158,7 @@ end PartialOrder
 
 section LinearOrder
 
-variable [LinearOrder R] [OrderedRing R]
+variable [LE R] [LT R] [LinearOrder R] [OrderedRing R]
 
 theorem mul_nonneg_iff {a b : R} : 0 ≤ a * b ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 := by
   rcases LinearOrder.trichotomy 0 a with (ha | rfl | ha)

src/Init/Grind/Ring/Basic.lean

@@ -8,6 +8,7 @@ module
 prelude
 public import Init.Data.Zero
 public import Init.Data.Int.DivMod.Lemmas
+public import Init.Data.Int.LemmasAux
 public import Init.Data.Int.Pow
 public import Init.TacticsExtra
 public import Init.Grind.Module.Basic
@@ -147,6 +148,9 @@ open NatModule
 
 variable {α : Type u} [Semiring α]
 
+theorem natCast_eq_ofNat (n : Nat) : NatCast.natCast n = OfNat.ofNat (α := α) n := by
+  rw [ofNat_eq_natCast]
+
 theorem natCast_zero : ((0 : Nat) : α) = 0 := by
   rw [← ofNat_eq_natCast 0]
 theorem natCast_one : ((1 : Nat) : α) = 1 := (ofNat_eq_natCast 1).symm
@@ -220,6 +224,21 @@ theorem intCast_negSucc (n : Nat) : ((-(n + 1) : Int) : α) = -((n : α) + 1) :=
   rw [intCast_neg, ← Int.natCast_add_one, intCast_natCast, ofNat_eq_natCast, natCast_add]
 theorem intCast_nat_add {x y : Nat} : ((x + y : Int) : α) = ((x : α) + (y : α)) := by
   rw [Int.ofNat_add_ofNat, intCast_natCast, natCast_add]
+
+theorem intCast_eq_ofNat_of_nonneg (x : Int) (h : Int.ble' 0 x) : IntCast.intCast (R := α) x = OfNat.ofNat (α := α) x.toNat := by
+  show Int.cast x = _
+  rw [Int.ble'_eq_true] at h
+  have := Int.toNat_of_nonneg h
+  conv => lhs; rw [← this, Ring.intCast_natCast]
+  rw [Semiring.ofNat_eq_natCast]
+
+theorem intCast_eq_ofNat_of_nonpos (x : Int) (h : Int.ble' x 0) : IntCast.intCast (R := α) x = - OfNat.ofNat (α := α) x.natAbs := by
+  show Int.cast x = _
+  rw [Int.ble'_eq_true] at h
+  have := Int.eq_neg_natAbs_of_nonpos h
+  conv => lhs; rw [this]
+  rw [Ring.intCast_neg, Semiring.ofNat_eq_natCast, Ring.intCast_natCast]
+
 theorem intCast_nat_sub {x y : Nat} (h : x ≥ y) : (((x - y : Nat) : Int) : α) = ((x : α) - (y : α)) := by
   induction x with
   | zero =>

src/Init/Grind/Ring/Envelope.lean

@@ -359,7 +359,7 @@ instance {p} [Semiring α] [AddRightCancel α] [IsCharP α p] : IsCharP (OfSemir
       apply Quot.sound
       exists 0; simp [← Semiring.ofNat_eq_natCast, this]
 
-instance [Preorder α] [OrderedAdd α] : LE (OfSemiring.Q α) where
+instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : LE (OfSemiring.Q α) where
   le a b := Q.liftOn₂ a b (fun (a, b) (c, d) => a + d ≤ b + c)
     (by intro (a₁, b₁) (a₂, b₂) (a₃, b₃) (a₄, b₄)
         simp; intro k₁ h₁ k₂ h₂
@@ -375,11 +375,14 @@ instance [Preorder α] [OrderedAdd α] : LE (OfSemiring.Q α) where
         rw [this]; clear this
         rw [← OrderedAdd.add_le_left_iff])
 
-@[local simp] theorem mk_le_mk [Preorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
+instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : LT (OfSemiring.Q α) where
+  lt a b := a ≤ b ∧ ¬b ≤ a
+
+@[local simp] theorem mk_le_mk [LE α] [LT α] [Preorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
     Q.mk (a₁, a₂) ≤ Q.mk (b₁, b₂) ↔ a₁ + b₂ ≤ a₂ + b₁ := by
   rfl
 
-instance [Preorder α] [OrderedAdd α] : Preorder (OfSemiring.Q α) where
+instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : Preorder (OfSemiring.Q α) where
   le_refl a := by
     obtain ⟨⟨a₁, a₂⟩⟩ := a
     change Q.mk _ ≤ Q.mk _
@@ -398,23 +401,23 @@ instance [Preorder α] [OrderedAdd α] : Preorder (OfSemiring.Q α) where
     rw [this]; clear this
     exact OrderedAdd.add_le_add h₁ h₂
 
-@[local simp] private theorem mk_lt_mk [Preorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
+@[local simp] private theorem mk_lt_mk [LE α] [LT α] [Preorder α] [OrderedAdd α] {a₁ a₂ b₁ b₂ : α}  :
     Q.mk (a₁, a₂) < Q.mk (b₁, b₂) ↔ a₁ + b₂ < a₂ + b₁ := by
   simp [Preorder.lt_iff_le_not_le, Semiring.add_comm]
 
-@[local simp] private theorem mk_pos [Preorder α] [OrderedAdd α] {a₁ a₂ : α} :
+@[local simp] private theorem mk_pos [LE α] [LT α] [Preorder α] [OrderedAdd α] {a₁ a₂ : α} :
     0 < Q.mk (a₁, a₂) ↔ a₂ < a₁ := by
   simp [← toQ_ofNat, toQ, mk_lt_mk, AddCommMonoid.zero_add]
 
 @[local simp]
-theorem toQ_le [Preorder α] [OrderedAdd α] {a b : α} : toQ a ≤ toQ b ↔ a ≤ b := by
+theorem toQ_le [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α} : toQ a ≤ toQ b ↔ a ≤ b := by
   simp
 
 @[local simp]
-theorem toQ_lt [Preorder α] [OrderedAdd α] {a b : α} : toQ a < toQ b ↔ a < b := by
+theorem toQ_lt [LE α] [LT α] [Preorder α] [OrderedAdd α] {a b : α} : toQ a < toQ b ↔ a < b := by
   simp [Preorder.lt_iff_le_not_le]
 
-instance [Preorder α] [OrderedAdd α] : OrderedAdd (OfSemiring.Q α) where
+instance [LE α] [LT α] [Preorder α] [OrderedAdd α] : OrderedAdd (OfSemiring.Q α) where
   add_le_left_iff := by
     intro a b c
     obtain ⟨⟨a₁, a₂⟩⟩ := a
@@ -428,7 +431,7 @@ instance [Preorder α] [OrderedAdd α] : OrderedAdd (OfSemiring.Q α) where
     rw [← OrderedAdd.add_le_left_iff]
 
 -- This perhaps works in more generality than `ExistsAddOfLT`?
-instance [Preorder α] [OrderedRing α] [ExistsAddOfLT α] : OrderedRing (OfSemiring.Q α) where
+instance [LE α] [LT α] [Preorder α] [OrderedRing α] [ExistsAddOfLT α] : OrderedRing (OfSemiring.Q α) where
   zero_lt_one := by
     rw [← toQ_ofNat, ← toQ_ofNat, toQ_lt]
     exact OrderedRing.zero_lt_one

src/Init/Grind/Ring/Poly.lean

@@ -1616,21 +1616,21 @@ theorem diseq_norm {α} [CommRing α] (ctx : Context α) (lhs rhs : Expr) (p : P
 
 open OrderedAdd
 
-theorem le_norm {α} [CommRing α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem le_norm {α} [CommRing α] [LE α] [LT α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : core_cert lhs rhs p → lhs.denote ctx ≤ rhs.denote ctx → p.denoteAsIntModule ctx ≤ 0 := by
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h; subst p; simp [Expr.denote_toPoly, Expr.denote]
   replace h := add_le_left h ((-1) * rhs.denote ctx)
   rw [neg_mul, ← sub_eq_add_neg, one_mul, ← sub_eq_add_neg, sub_self] at h
   assumption
 
-theorem lt_norm {α} [CommRing α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem lt_norm {α} [CommRing α] [LE α] [LT α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : core_cert lhs rhs p → lhs.denote ctx < rhs.denote ctx → p.denoteAsIntModule ctx < 0 := by
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h; subst p; simp [Expr.denote_toPoly, Expr.denote]
   replace h := add_lt_left h ((-1) * rhs.denote ctx)
   rw [neg_mul, ← sub_eq_add_neg, one_mul, ← sub_eq_add_neg, sub_self] at h
   assumption
 
-theorem not_le_norm {α} [CommRing α] [LinearOrder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_le_norm {α} [CommRing α] [LE α] [LT α] [LinearOrder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : core_cert rhs lhs p → ¬ lhs.denote ctx ≤ rhs.denote ctx → p.denoteAsIntModule ctx < 0 := by
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h₁; subst p; simp [Expr.denote_toPoly, Expr.denote]
   replace h₁ := LinearOrder.lt_of_not_le h₁
@@ -1638,7 +1638,7 @@ theorem not_le_norm {α} [CommRing α] [LinearOrder α] [OrderedRing α] (ctx :
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem not_lt_norm {α} [CommRing α] [LinearOrder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_lt_norm {α} [CommRing α] [LE α] [LT α] [LinearOrder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : core_cert rhs lhs p → ¬ lhs.denote ctx < rhs.denote ctx → p.denoteAsIntModule ctx ≤ 0 := by
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h₁; subst p; simp [Expr.denote_toPoly, Expr.denote]
   replace h₁ := LinearOrder.le_of_not_lt h₁
@@ -1646,14 +1646,14 @@ theorem not_lt_norm {α} [CommRing α] [LinearOrder α] [OrderedRing α] (ctx :
   simp [← sub_eq_add_neg, sub_self] at h₁
   assumption
 
-theorem not_le_norm' {α} [CommRing α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_le_norm' {α} [CommRing α] [LE α] [LT α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : core_cert lhs rhs p → ¬ lhs.denote ctx ≤ rhs.denote ctx → ¬ p.denoteAsIntModule ctx ≤ 0 := by
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h₁; subst p; simp [Expr.denote_toPoly, Expr.denote]; intro h
   replace h : rhs.denote ctx + (lhs.denote ctx - rhs.denote ctx) ≤ _ := add_le_right (rhs.denote ctx) h
   rw [sub_eq_add_neg, add_left_comm, ← sub_eq_add_neg, sub_self] at h; simp [add_zero] at h
   contradiction
 
-theorem not_lt_norm' {α} [CommRing α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
+theorem not_lt_norm' {α} [CommRing α] [LE α] [LT α] [Preorder α] [OrderedRing α] (ctx : Context α) (lhs rhs : Expr) (p : Poly)
     : core_cert lhs rhs p → ¬ lhs.denote ctx < rhs.denote ctx → ¬ p.denoteAsIntModule ctx < 0 := by
   simp [core_cert, Poly.denoteAsIntModule_eq_denote]; intro _ h₁; subst p; simp [Expr.denote_toPoly, Expr.denote]; intro h
   replace h : rhs.denote ctx + (lhs.denote ctx - rhs.denote ctx) < _ := add_lt_right (rhs.denote ctx) h

src/Init/GrindInstances/Ring/BitVec.lean

@@ -7,6 +7,7 @@ module
 
 prelude
 public import Init.Grind.Ring.Basic
+public import Init.Grind.Ordered.Order
 public import Init.GrindInstances.ToInt
 public import all Init.Data.BitVec.Basic
 public import all Init.Grind.ToInt
@@ -53,4 +54,15 @@ example : ToInt.Sub (BitVec w) (.uint w) := inferInstance
 instance : ToInt.Pow (BitVec w) (.uint w) :=
   ToInt.pow_of_semiring (by simp)
 
+instance : Preorder (BitVec w) where
+  le_refl := BitVec.le_refl
+  le_trans := BitVec.le_trans
+  lt_iff_le_not_le {a b} := Std.LawfulOrderLT.lt_iff a b
+
+instance : PartialOrder (BitVec w) where
+  le_antisymm := BitVec.le_antisymm
+
+instance : LinearOrder (BitVec w) where
+  le_total := BitVec.le_total
+
 end Lean.Grind

src/Init/MetaTypes.lean

@@ -274,13 +274,18 @@ structure Config where
   -/
   letToHave : Bool := true
   /--
-  When `true` (default : `true`), `simp` tries to realize constant `f.congr_simp`
+  When `true` (default: `true`), `simp` tries to realize constant `f.congr_simp`
   when constructing an auxiliary congruence proof for `f`.
   This option exists because the termination prover uses `simp` and `withoutModifyingEnv`
   while constructing the termination proof. Thus, any constant realized by `simp`
   is deleted.
   -/
   congrConsts : Bool := true
+  /--
+  When `true` (default: `true`), the bitvector simprocs use `BitVec.ofNat` for representing
+  bitvector literals.
+  -/
+  bitVecOfNat : Bool := true
   deriving Inhabited, BEq
 
 -- Configuration object for `simp_all`

src/Init/Prelude.lean

@@ -3030,6 +3030,15 @@ internal detail that's not observable by Lean code.
 def Array.size {α : Type u} (a : @& Array α) : Nat :=
  a.toList.length
 
+/--
+Version of `Array.getInternal` that does not increment the reference count of its result.
+
+This is only intended for direct use by the compiler.
+-/
+@[extern "lean_array_fget_borrowed"]
+unsafe opaque Array.getInternalBorrowed {α : Type u} (a : @& Array α) (i : @& Nat) (h : LT.lt i a.size) : α :=
+  a.toList.get ⟨i, h⟩
+
 /--
 Use the indexing notation `a[i]` instead.
 
@@ -3059,6 +3068,14 @@ Examples:
 @[inline] abbrev Array.getD (a : Array α) (i : Nat) (v₀ : α) : α :=
   dite (LT.lt i a.size) (fun h => a.getInternal i h) (fun _ => v₀)
 
+/--
+Version of `Array.get!Internal` that does not increment the reference count of its result.
+
+This is only intended for direct use by the compiler.
+-/
+@[extern "lean_array_get_borrowed"]
+unsafe opaque Array.get!InternalBorrowed {α : Type u} [Inhabited α] (a : @& Array α) (i : @& Nat) : α
+
 /--
 Use the indexing notation `a[i]!` instead.
 

src/Init/Tactics.lean

@@ -713,7 +713,7 @@ A `simpArg` is either a `*`, `-lemma` or a simp lemma specification
 meta def simpArg := simpStar.binary `orelse (simpErase.binary `orelse simpLemma)
 
 /-- A simp args list is a list of `simpArg`. This is the main argument to `simp`. -/
-syntax simpArgs := " [" simpArg,* "]"
+syntax simpArgs := " [" simpArg,*,? "]"
 
 /--
 A `dsimpArg` is similar to `simpArg`, but it does not have the `simpStar` form
@@ -722,7 +722,7 @@ because it does not make sense to use hypotheses in `dsimp`.
 meta def dsimpArg := simpErase.binary `orelse simpLemma
 
 /-- A dsimp args list is a list of `dsimpArg`. This is the main argument to `dsimp`. -/
-syntax dsimpArgs := " [" dsimpArg,* "]"
+syntax dsimpArgs := " [" dsimpArg,*,? "]"
 
 /-- The common arguments of `simp?` and `simp?!`. -/
 syntax simpTraceArgsRest := optConfig (discharger)? (&" only")? (simpArgs)? (ppSpace location)?
@@ -2128,7 +2128,7 @@ macro (name := mintroMacro) (priority:=low) "mintro" : tactic =>
 `mspec` is an `apply`-like tactic that applies a Hoare triple specification to the target of the
 stateful goal.
 
-Given a stateful goal `H ⊢ₛ wp⟦prog⟧.apply Q'`, `mspec foo_spec` will instantiate
+Given a stateful goal `H ⊢ₛ wp⟦prog⟧ Q'`, `mspec foo_spec` will instantiate
 `foo_spec : ... → ⦃P⦄ foo ⦃Q⦄`, match `foo` against `prog` and produce subgoals for
 the verification conditions `?pre : H ⊢ₛ P` and `?post : Q ⊢ₚ Q'`.
 
@@ -2137,11 +2137,12 @@ the verification conditions `?pre : H ⊢ₛ P` and `?post : Q ⊢ₚ Q'`.
 * If `?pre` or `?post` follow by `.rfl`, then they are discharged automatically.
 * `?post` is automatically simplified into constituent `⊢ₛ` entailments on
   success and failure continuations.
-* `?pre` and `?post.*` goals introduce their stateful hypothesis as `h`.
+* `?pre` and `?post.*` goals introduce their stateful hypothesis under an inaccessible name.
+  You can give it a name with the `mrename_i` tactic.
 * Any uninstantiated MVar arising from instantiation of `foo_spec` becomes a new subgoal.
 * If the target of the stateful goal looks like `fun s => _` then `mspec` will first `mintro ∀s`.
 * If `P` has schematic variables that can be instantiated by doing `mintro ∀s`, for example
-  `foo_spec : ∀(n:Nat), ⦃⌜n = ‹Nat›ₛ⌝⦄ foo ⦃Q⦄`, then `mspec` will do `mintro ∀s` first to
+  `foo_spec : ∀(n:Nat), ⦃fun s => ⌜n = s⌝⦄ foo ⦃Q⦄`, then `mspec` will do `mintro ∀s` first to
   instantiate `n = s`.
 * Right before applying the spec, the `mframe` tactic is used, which has the following effect:
   Any hypothesis `Hᵢ` in the goal `h₁:H₁, h₂:H₂, ..., hₙ:Hₙ ⊢ₛ T` that is

src/Lean/AddDecl.lean

@@ -126,8 +126,10 @@ def addDecl (decl : Declaration) : CoreM Unit := do
     let cancelTk ← IO.CancelToken.new
     let checkAct ← Core.wrapAsyncAsSnapshot (cancelTk? := cancelTk) fun _ => doAddAndCommit
     let t ← BaseIO.mapTask checkAct env.checked
-    let endRange? := (← getRef).getTailPos?.map fun pos => ⟨pos, pos⟩
-    Core.logSnapshotTask { stx? := none, reportingRange? := endRange?, task := t, cancelTk? := cancelTk }
+    -- Do not display reporting range; most uses of `addDecl` are for registering auxiliary decls
+    -- users should not worry about and other callers can add a separate task with ranges
+    -- themselves, see `MutualDef`.
+    Core.logSnapshotTask { stx? := none, reportingRange := .skip, task := t, cancelTk? := cancelTk }
   else
     try
       doAddAndCommit
@@ -177,8 +179,8 @@ where
       catch _ => pure ()
 
 
-def addAndCompile (decl : Declaration) : CoreM Unit := do
+def addAndCompile (decl : Declaration) (logCompileErrors : Bool := true) : CoreM Unit := do
   addDecl decl
-  compileDecl decl
+  compileDecl decl (logErrors := logCompileErrors)
 
 end Lean

src/Lean/Compiler/IR/Borrow.lean

@@ -46,8 +46,8 @@ abbrev ParamMap := Std.HashMap Key (Array Param)
 def ParamMap.fmt (map : ParamMap) : Format :=
   let fmts := map.fold (fun fmt k ps =>
     let k := match k with
-      | ParamMap.Key.decl n  => format n
-      | ParamMap.Key.jp n id => format n ++ ":" ++ format id
+      | .decl n  => format n
+      | .jp n id => format n ++ ":" ++ format id
     fmt ++ Format.line ++ k ++ " -> " ++ formatParams ps)
    Format.nil
   "{" ++ (Format.nest 1 fmts) ++ "}"
@@ -70,21 +70,22 @@ def initBorrow (ps : Array Param) : Array Param :=
 def initBorrowIfNotExported (exported : Bool) (ps : Array Param) : Array Param :=
   if exported then ps else initBorrow ps
 
-partial def visitFnBody (fnid : FunId) : FnBody → StateM ParamMap Unit
-  | FnBody.jdecl j xs v b  => do
-    modify fun m => m.insert (ParamMap.Key.jp fnid j) (initBorrow xs)
+partial def visitFnBody (fnid : FunId) (b : FnBody) : StateM ParamMap Unit := do
+  match b with
+  | .jdecl j xs v b  =>
+    modify fun m => m.insert (.jp fnid j) (initBorrow xs)
     visitFnBody fnid v
     visitFnBody fnid b
-  | FnBody.case _ _ _ alts => alts.forM fun alt => visitFnBody fnid alt.body
-  | e => do
-    unless e.isTerminal do
-      visitFnBody fnid e.body
+  | .case _ _ _ alts => alts.forM fun alt => visitFnBody fnid alt.body
+  | _ => do
+    unless b.isTerminal do
+      visitFnBody fnid b.body
 
 def visitDecls (env : Environment) (decls : Array Decl) : StateM ParamMap Unit :=
   decls.forM fun decl => match decl with
     | .fdecl (f := f) (xs := xs) (body := b) .. => do
       let exported := isExport env f
-      modify fun m => m.insert (ParamMap.Key.decl f) (initBorrowIfNotExported exported xs)
+      modify fun m => m.insert (.decl f) (initBorrowIfNotExported exported xs)
       visitFnBody f b
     | _ => pure ()
 end InitParamMap
@@ -97,14 +98,14 @@ def mkInitParamMap (env : Environment) (decls : Array Decl) : ParamMap :=
 namespace ApplyParamMap
 
 partial def visitFnBody (fn : FunId) (paramMap : ParamMap) : FnBody → FnBody
-  | FnBody.jdecl j _  v b =>
+  | .jdecl j _  v b =>
     let v := visitFnBody fn paramMap v
     let b := visitFnBody fn paramMap b
-    match paramMap[ParamMap.Key.jp fn j]? with
-    | some ys => FnBody.jdecl j ys v b
+    match paramMap[Key.jp fn j]? with
+    | some ys => .jdecl j ys v b
     | none    => unreachable!
-  | FnBody.case tid x xType alts =>
-    FnBody.case tid x xType <| alts.map fun alt => alt.modifyBody (visitFnBody fn paramMap)
+  | .case tid x xType alts =>
+    .case tid x xType <| alts.map fun alt => alt.modifyBody (visitFnBody fn paramMap)
   | e =>
     if e.isTerminal then e
     else
@@ -114,10 +115,10 @@ partial def visitFnBody (fn : FunId) (paramMap : ParamMap) : FnBody → FnBody
 
 def visitDecls (decls : Array Decl) (paramMap : ParamMap) : Array Decl :=
   decls.map fun decl => match decl with
-    | Decl.fdecl f _  ty b info =>
+    | .fdecl f _  ty b info =>
       let b := visitFnBody f paramMap b
-      match paramMap[ParamMap.Key.decl f]? with
-      | some xs => Decl.fdecl f xs ty b info
+      match paramMap[Key.decl f]? with
+      | some xs => .fdecl f xs ty b info
       | none    => unreachable!
     | other => other
 
@@ -187,7 +188,7 @@ def getParamInfo (k : ParamMap.Key) : M (Array Param) := do
   | some ps => pure ps
   | none    =>
     match k with
-    | ParamMap.Key.decl fn => do
+    | .decl fn => do
       let ctx ← read
       match findEnvDecl ctx.env fn with
       | some decl => pure decl.params
@@ -231,53 +232,71 @@ def ownArgsIfParam (xs : Array Arg) : M Unit := do
     | .var x => if ctx.paramSet.contains x.idx then ownVar x
     | .erased => pure ()
 
-def collectExpr (z : VarId) : Expr → M Unit
-  | Expr.reset _ x      => ownVar z *> ownVar x
-  | Expr.reuse x _ _ ys => ownVar z *> ownVar x *> ownArgsIfParam ys
-  | Expr.ctor _ xs      => ownVar z *> ownArgsIfParam xs
-  | Expr.proj _ x       => do
+def collectExpr (z : VarId) (e : Expr) : M Unit := do
+  match e with
+  | .reset _ x =>
+    ownVar z
+    ownVar x
+  | .reuse x _ _ ys =>
+    ownVar z
+    ownVar x
+    ownArgsIfParam ys
+  | .ctor _ xs =>
+    ownVar z
+    ownArgsIfParam xs
+  | .proj _ x =>
     if (← isOwned x) then ownVar z
     if (← isOwned z) then ownVar x
-  | Expr.fap g xs       => do
-    let ps ← getParamInfo (ParamMap.Key.decl g)
-    ownVar z *> ownArgsUsingParams xs ps
-  | Expr.ap x ys        => ownVar z *> ownVar x *> ownArgs ys
-  | Expr.pap _ xs       => ownVar z *> ownArgs xs
-  | _                   => pure ()
+  | .fap g xs =>
+    let ps ← getParamInfo (.decl g)
+    ownVar z
+    ownArgsUsingParams xs ps
+  | .ap x ys =>
+    ownVar z
+    ownVar x
+    ownArgs ys
+  | .pap _ xs =>
+    ownVar z
+    ownArgs xs
+  | _ => pure ()
 
 def preserveTailCall (x : VarId) (v : Expr) (b : FnBody) : M Unit := do
   let ctx ← read
   match v, b with
-  | (Expr.fap g ys), (FnBody.ret (.var z)) =>
+  | (.fap g ys), (.ret (.var z)) =>
     -- NOTE: we currently support TCO for self-calls only
     if ctx.currFn == g && x == z then
-      let ps ← getParamInfo (ParamMap.Key.decl g)
+      let ps ← getParamInfo (.decl g)
       ownParamsUsingArgs ys ps
   | _, _ => pure ()
 
 def updateParamSet (ctx : BorrowInfCtx) (ps : Array Param) : BorrowInfCtx :=
   { ctx with paramSet := ps.foldl (fun s p => s.insert p.x.idx) ctx.paramSet }
 
-partial def collectFnBody : FnBody → M Unit
-  | FnBody.jdecl j ys v b => do
+partial def collectFnBody (b : FnBody) : M Unit := do
+  match b with
+  | .jdecl j ys v b =>
     withReader (fun ctx => updateParamSet ctx ys) (collectFnBody v)
     let ctx ← read
-    updateParamMap (ParamMap.Key.jp ctx.currFn j)
+    updateParamMap (.jp ctx.currFn j)
     collectFnBody b
-  | FnBody.vdecl x _ v b => collectFnBody b *> collectExpr x v *> preserveTailCall x v b
-  | FnBody.jmp j ys      => do
+  | .vdecl x _ v b =>
+    collectFnBody b
+    collectExpr x v
+    preserveTailCall x v b
+  | .jmp j ys =>
     let ctx ← read
-    let ps ← getParamInfo (ParamMap.Key.jp ctx.currFn j)
+    let ps ← getParamInfo (.jp ctx.currFn j)
     ownArgsUsingParams ys ps -- for making sure the join point can reuse
     ownParamsUsingArgs ys ps  -- for making sure the tail call is preserved
-  | FnBody.case _ _ _ alts => alts.forM fun alt => collectFnBody alt.body
-  | e                      => do unless e.isTerminal do collectFnBody e.body
+  | .case _ _ _ alts => alts.forM fun alt => collectFnBody alt.body
+  | _ => do unless b.isTerminal do collectFnBody b.body
 
 partial def collectDecl : Decl → M Unit
   | .fdecl (f := f) (xs := ys) (body := b) .. =>
     withReader (fun ctx => let ctx := updateParamSet ctx ys; { ctx with currFn := f }) do
       collectFnBody b
-      updateParamMap (ParamMap.Key.decl f)
+      updateParamMap (.decl f)
   | _ => pure ()
 
 /-- Keep executing `x` until it reaches a fixpoint -/

src/Lean/Compiler/IR/Format.lean

@@ -76,7 +76,7 @@ private partial def formatIRType : IRType → Format
     let _ : ToFormat IRType := ⟨formatIRType⟩
     "union " ++ Format.bracket "{" (Format.joinSep  tys.toList ", ") "}"
 
-instance : ToFormat IRType := ⟨formatIRType⟩
+instance : ToFormat IRType := ⟨private_decl% formatIRType⟩
 instance : ToString IRType := ⟨toString ∘ format⟩
 
 private def formatParam : Param → Format

src/Lean/Compiler/IR/RC.lean

@@ -8,7 +8,6 @@ module
 prelude
 public import Lean.Runtime
 public import Lean.Compiler.IR.CompilerM
-public import Lean.Compiler.IR.LiveVars
 
 public section
 
@@ -19,17 +18,111 @@ This transformation is applied before lower level optimizations
 that introduce the instructions `release` and `set`
 -/
 
+structure DerivedValInfo where
+  parent? : Option VarId
+  children : VarIdSet
+  deriving Inhabited
+
+abbrev DerivedValMap := Std.HashMap VarId DerivedValInfo
+
+namespace CollectDerivedValInfo
+
+structure State where
+  varMap : DerivedValMap := {}
+  borrowedParams : VarIdSet := {}
+
+abbrev M := StateM State
+
+private def visitParam (p : Param) : M Unit :=
+  modify fun s => { s with
+    varMap := s.varMap.insert p.x {
+      parent? := none
+      children := {}
+    }
+    borrowedParams :=
+      if p.borrow && p.ty.isPossibleRef then
+        s.borrowedParams.insert p.x
+      else s.borrowedParams
+  }
+
+private partial def addDerivedValue (parent : VarId) (child : VarId) : M Unit := do
+  modify fun s => { s with
+    varMap := s.varMap.modify parent fun info =>
+      { info with children := info.children.insert child }
+  }
+  modify fun s => { s with
+    varMap := s.varMap.insert child {
+      parent? := some parent
+      children := {}
+    }
+  }
+
+private partial def removeFromParent (child : VarId) : M Unit := do
+  if let some (some parent) := (← get).varMap.get? child |>.map (·.parent?) then
+    modify fun s => { s with
+      varMap := s.varMap.modify parent fun info =>
+        { info with children := info.children.erase child }
+    }
+
+private partial def visitFnBody (b : FnBody) : M Unit := do
+  match b with
+  | .vdecl x _ e b =>
+    match e with
+    | .proj _ parent =>
+      addDerivedValue parent x
+    | .fap ``Array.getInternal args =>
+      if let .var parent := args[1]! then
+        addDerivedValue parent x
+    | .fap ``Array.get!Internal args =>
+      if let .var parent := args[2]! then
+        addDerivedValue parent x
+    | .reset _ x =>
+      removeFromParent x
+    | _ => pure ()
+    visitFnBody b
+  | .jdecl _ ps v b =>
+    ps.forM visitParam
+    visitFnBody v
+    visitFnBody b
+  | .case _ _ _ alts => alts.forM (visitFnBody ·.body)
+  | _ => if !b.isTerminal then visitFnBody b.body
+
+private partial def collectDerivedValInfo (ps : Array Param) (b : FnBody)
+    : DerivedValMap × VarIdSet := Id.run do
+  let ⟨_, { varMap, borrowedParams }⟩ := go |>.run { }
+  return ⟨varMap, borrowedParams⟩
+where go : M Unit := do
+  ps.forM visitParam
+  visitFnBody b
+
+end CollectDerivedValInfo
+
 structure VarInfo where
-  type : IRType
+  isPossibleRef : Bool
+  isDefiniteRef: Bool
   persistent : Bool
-  inheritsBorrowFromParam : Bool
   deriving Inhabited
 
 abbrev VarMap := Std.TreeMap VarId VarInfo (fun x y => compare x.idx y.idx)
 
+structure LiveVars where
+  vars : VarIdSet
+  borrows : VarIdSet := {}
+  deriving Inhabited
+
+@[inline]
+def LiveVars.merge (liveVars1 liveVars2 : LiveVars) : LiveVars :=
+  let vars := liveVars1.vars.merge liveVars2.vars
+  let borrows := liveVars1.borrows.merge liveVars2.borrows
+  { vars, borrows }
+
+abbrev JPLiveVarMap := Std.TreeMap JoinPointId LiveVars (fun x y => compare x.idx y.idx)
+
 structure Context where
   env            : Environment
   decls          : Array Decl
+  borrowedParams : VarIdSet
+  derivedValMap  : DerivedValMap
   varMap         : VarMap := {}
   jpLiveVarMap   : JPLiveVarMap := {} -- map: join point => live variables
   localCtx       : LocalContext := {} -- we use it to store the join point declarations
@@ -43,31 +136,93 @@ def getVarInfo (ctx : Context) (x : VarId) : VarInfo :=
 def getJPParams (ctx : Context) (j : JoinPointId) : Array Param :=
   ctx.localCtx.getJPParams j |>.get!
 
-def getJPLiveVars (ctx : Context) (j : JoinPointId) : LiveVarSet :=
-  ctx.jpLiveVarMap.get? j |>.getD {}
+@[specialize]
+private partial def addDescendants (ctx : Context) (x : VarId) (s : VarIdSet)
+    (shouldAdd : VarId → Bool := fun _ => true) : VarIdSet :=
+  if let some info := ctx.derivedValMap.get? x then
+    info.children.foldl (init := s) fun s child =>
+      let s := if shouldAdd child then s.insert child else s
+      addDescendants ctx child s shouldAdd
+  else s
 
-def mustConsume (ctx : Context) (x : VarId) : Bool :=
-  let info := getVarInfo ctx x
-  info.type.isPossibleRef && !info.inheritsBorrowFromParam
+private def mkRetLiveVars (ctx : Context) : LiveVars :=
+  let borrows := ctx.borrowedParams.foldl (init := {}) fun borrows x =>
+    addDescendants ctx x (borrows.insert x)
+  { vars := {}, borrows }
+
+def getJPLiveVars (ctx : Context) (j : JoinPointId) : LiveVars :=
+  ctx.jpLiveVarMap.get! j
+
+@[specialize]
+private def useVar (ctx : Context) (x : VarId) (liveVars : LiveVars)
+    (shouldBorrow : VarId → Bool := fun _ => true) : LiveVars := Id.run do
+  let ⟨contains, vars⟩ := liveVars.vars.containsThenInsert x
+  let borrows := if contains then
+      liveVars.borrows
+    else
+      addDescendants ctx x liveVars.borrows fun y =>
+        !liveVars.vars.contains y && shouldBorrow y
+  return { vars, borrows }
+
+@[inline]
+private def bindVar (x : VarId) (liveVars : LiveVars) : LiveVars :=
+  let vars := liveVars.vars.erase x
+  let borrows := liveVars.borrows.erase x
+  { vars, borrows }
+
+@[inline]
+private def useArg (ctx : Context) (args : Array Arg) (arg : Arg) (liveVars : LiveVars) : LiveVars :=
+  match arg with
+  | .var x => useVar ctx x liveVars fun y =>
+    args.all fun arg =>
+      match arg with
+      | .var z => y != z
+      | .erased => true
+  | .erased => liveVars
+
+private def useArgs (ctx : Context) (args : Array Arg) (liveVars : LiveVars) : LiveVars :=
+  args.foldl (init := liveVars) fun liveVars arg => useArg ctx args arg liveVars
+
+private def useExpr (ctx : Context) (e : Expr) (liveVars : LiveVars) : LiveVars :=
+  match e with
+  | .proj _ x | .uproj _ x | .sproj _ _ x | .box _ x | .unbox x | .reset _ x | .isShared x =>
+    useVar ctx x liveVars
+  | .ctor _ ys | .fap _ ys | .pap _ ys =>
+    useArgs ctx ys liveVars
+  | .ap x ys | .reuse x _ _ ys =>
+    let liveVars := useVar ctx x liveVars
+    useArgs ctx ys liveVars
+  | .lit _ => liveVars
 
 @[inline] def addInc (ctx : Context) (x : VarId) (b : FnBody) (n := 1) : FnBody :=
   let info := getVarInfo ctx x
-  if n == 0 then b else .inc x n (!info.type.isDefiniteRef) info.persistent b
+  if n == 0 then b else .inc x n (!info.isDefiniteRef) info.persistent b
 
 @[inline] def addDec (ctx : Context) (x : VarId) (b : FnBody) : FnBody :=
   let info := getVarInfo ctx x
-  .dec x 1 (!info.type.isDefiniteRef) info.persistent b
+  .dec x 1 (!info.isDefiniteRef) info.persistent b
 
 private def updateRefUsingCtorInfo (ctx : Context) (x : VarId) (c : CtorInfo) : Context :=
   let m := ctx.varMap
   { ctx with
     varMap := match m.get? x with
-    | some info => m.insert x { info with type := c.type }
-    | none      => m }
+    | some info =>
+      let isPossibleRef := c.type.isPossibleRef
+      let isDefiniteRef := c.type.isDefiniteRef
+      m.insert x { info with isPossibleRef, isDefiniteRef }
+    | none => m
+  }
 
-private def addDecForAlt (ctx : Context) (caseLiveVars altLiveVars : LiveVarSet) (b : FnBody) : FnBody :=
-  caseLiveVars.foldl (init := b) fun b x =>
-    if !altLiveVars.contains x && mustConsume ctx x then addDec ctx x b else b
+private def addDecForAlt (ctx : Context) (caseLiveVars altLiveVars : LiveVars) (b : FnBody) : FnBody :=
+  caseLiveVars.vars.foldl (init := b) fun b x =>
+    let info := getVarInfo ctx x
+    if !altLiveVars.vars.contains x then
+      if info.isPossibleRef && !caseLiveVars.borrows.contains x then
+        addDec ctx x b
+      else b
+    else if caseLiveVars.borrows.contains x && !altLiveVars.borrows.contains x then
+      addInc ctx x b
+    else b
 
 /-- `isFirstOcc xs x i = true` if `xs[i]` is the first occurrence of `xs[i]` in `xs` -/
 private def isFirstOcc (xs : Array Arg) (i : Nat) : Bool :=
@@ -98,29 +253,29 @@ private def getNumConsumptions (x : VarId) (ys : Array Arg) (consumeParamPred :
     | .erased => n
     | .var y  => if x == y && consumeParamPred i then n+1 else n
 
-private def addIncBeforeAux (ctx : Context) (xs : Array Arg) (consumeParamPred : Nat → Bool) (b : FnBody) (liveVarsAfter : LiveVarSet) : FnBody :=
+private def addIncBeforeAux (ctx : Context) (xs : Array Arg) (consumeParamPred : Nat → Bool) (b : FnBody) (liveVarsAfter : LiveVars) : FnBody :=
   xs.size.fold (init := b) fun i _ b =>
     let x := xs[i]
     match x with
     | .erased => b
     | .var x =>
       let info := getVarInfo ctx x
-      if !info.type.isPossibleRef || !isFirstOcc xs i then b
+      if !info.isPossibleRef || !isFirstOcc xs i then b
       else
         let numConsumptions := getNumConsumptions x xs consumeParamPred
         let numIncs :=
-          if info.inheritsBorrowFromParam ||
-             liveVarsAfter.contains x ||          -- `x` is live after executing instruction
+          if liveVarsAfter.vars.contains x ||          -- `x` is live after executing instruction
+             liveVarsAfter.borrows.contains x ||
              isBorrowParamAux x xs consumeParamPred  -- `x` is used in a position that is passed as a borrow reference
           then numConsumptions
           else numConsumptions - 1
         addInc ctx x b numIncs
 
-private def addIncBefore (ctx : Context) (xs : Array Arg) (ps : Array Param) (b : FnBody) (liveVarsAfter : LiveVarSet) : FnBody :=
+private def addIncBefore (ctx : Context) (xs : Array Arg) (ps : Array Param) (b : FnBody) (liveVarsAfter : LiveVars) : FnBody :=
   addIncBeforeAux ctx xs (fun i => ! ps[i]!.borrow) b liveVarsAfter
 
 /-- See `addIncBeforeAux`/`addIncBefore` for the procedure that inserts `inc` operations before an application.  -/
-private def addDecAfterFullApp (ctx : Context) (xs : Array Arg) (ps : Array Param) (b : FnBody) (bLiveVars : LiveVarSet) : FnBody :=
+private def addDecAfterFullApp (ctx : Context) (xs : Array Arg) (ps : Array Param) (b : FnBody) (bLiveVars : LiveVars) : FnBody :=
   xs.size.fold (init := b) fun i _ b =>
     match xs[i] with
     | .erased => b
@@ -129,22 +284,27 @@ private def addDecAfterFullApp (ctx : Context) (xs : Array Arg) (ps : Array Para
         and it has been borrowed by the application.
         Remark: `x` may occur multiple times in the application (e.g., `f x y x`).
         This is why we check whether it is the first occurrence. -/
-      if mustConsume ctx x && isFirstOcc xs i && isBorrowParam x xs ps && !bLiveVars.contains x then
+      let info := getVarInfo ctx x
+      if info.isPossibleRef &&
+         isFirstOcc xs i &&
+         isBorrowParam x xs ps &&
+         !bLiveVars.vars.contains x &&
+         !bLiveVars.borrows.contains x then
         addDec ctx x b
       else b
 
-private def addIncBeforeConsumeAll (ctx : Context) (xs : Array Arg) (b : FnBody) (liveVarsAfter : LiveVarSet) : FnBody :=
+private def addIncBeforeConsumeAll (ctx : Context) (xs : Array Arg) (b : FnBody) (liveVarsAfter : LiveVars) : FnBody :=
   addIncBeforeAux ctx xs (fun _ => true) b liveVarsAfter
 
 /-- Add `dec` instructions for parameters that are references, are not alive in `b`, and are not borrow.
    That is, we must make sure these parameters are consumed. -/
-private def addDecForDeadParams (ctx : Context) (ps : Array Param) (b : FnBody) (bLiveVars : LiveVarSet) : FnBody × LiveVarSet :=
+private def addDecForDeadParams (ctx : Context) (ps : Array Param) (b : FnBody) (bLiveVars : LiveVars) : FnBody × LiveVars :=
   ps.foldl (init := ⟨b, bLiveVars⟩) fun ⟨b, bLiveVars⟩ p =>
     let b :=
-      if !p.borrow && p.ty.isPossibleRef && !bLiveVars.contains p.x then
+      if !p.borrow && p.ty.isPossibleRef && !bLiveVars.vars.contains p.x then
         addDec ctx p.x b
       else b
-    let bLiveVars := bLiveVars.erase p.x
+    let bLiveVars := bindVar p.x bLiveVars
     ⟨b, bLiveVars⟩
 
 private def isPersistent : Expr → Bool
@@ -165,53 +325,64 @@ private def typeForScalarBoxedInTaggedPtr? (v : Expr) : Option IRType :=
   | _ => none
 
 private def updateVarInfo (ctx : Context) (x : VarId) (t : IRType) (v : Expr) : Context :=
-  let inheritsBorrowFromParam :=
-    match v with
-    | .proj _ x => match ctx.varMap.get? x with
-      | some info => info.inheritsBorrowFromParam
-      | none => false
-    | _ => false
+  let type := typeForScalarBoxedInTaggedPtr? v |>.getD t
+  let isPossibleRef := type.isPossibleRef
+  let isDefiniteRef := type.isDefiniteRef
   { ctx with
     varMap := ctx.varMap.insert x {
-        type := typeForScalarBoxedInTaggedPtr? v |>.getD t
+        isPossibleRef
+        isDefiniteRef
         persistent := isPersistent v,
-        inheritsBorrowFromParam
     }
   }
 
-private def addDecIfNeeded (ctx : Context) (x : VarId) (b : FnBody) (bLiveVars : LiveVarSet) : FnBody :=
-  if mustConsume ctx x && !bLiveVars.contains x then addDec ctx x b else b
+private def addDecIfNeeded (ctx : Context) (x : VarId) (b : FnBody) (bLiveVars : LiveVars) : FnBody :=
+  let info := getVarInfo ctx x
+  if info.isPossibleRef &&
+     !bLiveVars.vars.contains x &&
+     !bLiveVars.borrows.contains x then
+    addDec ctx x b
+  else b
 
-private def processVDecl (ctx : Context) (z : VarId) (t : IRType) (v : Expr) (b : FnBody) (bLiveVars : LiveVarSet) : FnBody × LiveVarSet :=
+private def processVDecl (ctx : Context) (z : VarId) (t : IRType) (v : Expr) (b : FnBody) (bLiveVars : LiveVars) : FnBody × LiveVars :=
   let b := match v with
     | .ctor _ ys | .reuse _ _ _ ys | .pap _ ys =>
       addIncBeforeConsumeAll ctx ys (.vdecl z t v b) bLiveVars
     | .proj _ x =>
       let b := addDecIfNeeded ctx x b bLiveVars
-      let b := if !(getVarInfo ctx x).inheritsBorrowFromParam then addInc ctx z b else b
+      let b := if !bLiveVars.borrows.contains z then addInc ctx z b else b
       .vdecl z t v b
     | .uproj _ x | .sproj _ _ x | .unbox x =>
       .vdecl z t v (addDecIfNeeded ctx x b bLiveVars)
     | .fap f ys =>
       let ps := (getDecl ctx f).params
       let b  := addDecAfterFullApp ctx ys ps b bLiveVars
-      let b  := .vdecl z t v b
+      let v  :=
+        if f == ``Array.getInternal && bLiveVars.borrows.contains z then
+          .fap ``Array.getInternalBorrowed ys
+        else if f == ``Array.get!Internal && bLiveVars.borrows.contains z then
+          .fap ``Array.get!InternalBorrowed ys
+        else v
+      let b := .vdecl z t v b
       addIncBefore ctx ys ps b bLiveVars
     | .ap x ys =>
       let ysx := ys.push (.var x) -- TODO: avoid temporary array allocation
       addIncBeforeConsumeAll ctx ysx (.vdecl z t v b) bLiveVars
     | .lit _ | .box .. | .reset .. | .isShared _ =>
       .vdecl z t v b
-  let liveVars := updateLiveVars v bLiveVars
-  let liveVars := liveVars.erase z
+  let liveVars := useExpr ctx v bLiveVars
+  let liveVars := bindVar z liveVars
   ⟨b, liveVars⟩
 
 def updateVarInfoWithParams (ctx : Context) (ps : Array Param) : Context :=
   let m := ps.foldl (init := ctx.varMap) fun m p =>
-    m.insert p.x { type := p.ty, persistent := false, inheritsBorrowFromParam := p.borrow }
+    m.insert p.x {
+      isPossibleRef := p.ty.isPossibleRef
+      isDefiniteRef := p.ty.isDefiniteRef
+      persistent := false }
   { ctx with varMap := m }
 
-partial def visitFnBody (b : FnBody) (ctx : Context) : FnBody × LiveVarSet :=
+partial def visitFnBody (b : FnBody) (ctx : Context) : FnBody × LiveVars :=
   match b with
   | .vdecl x t v b =>
     let ctx := updateVarInfo ctx x t v
@@ -230,15 +401,15 @@ partial def visitFnBody (b : FnBody) (ctx : Context) : FnBody × LiveVarSet :=
   | .uset x i y b =>
     let ⟨b, s⟩ := visitFnBody b ctx
     -- We don't need to insert `y` since we only need to track live variables that are references at runtime
-    let s      := s.insert x
+    let s := useVar ctx x s
     ⟨.uset x i y b, s⟩
   | .sset x i o y t b =>
     let ⟨b, s⟩ := visitFnBody b ctx
     -- We don't need to insert `y` since we only need to track live variables that are references at runtime
-    let s      := s.insert x
+    let s := useVar ctx x s
     ⟨.sset x i o y t b, s⟩
   | .case tid x xType alts =>
-    let alts : Array (Alt × LiveVarSet) := alts.map fun alt => match alt with
+    let alts : Array (Alt × LiveVars) := alts.map fun alt => match alt with
       | .ctor c b =>
         let ctx := updateRefUsingCtorInfo ctx x c
         let ⟨b, altLiveVars⟩ := visitFnBody b ctx
@@ -246,9 +417,10 @@ partial def visitFnBody (b : FnBody) (ctx : Context) : FnBody × LiveVarSet :=
       | .default b =>
         let ⟨b, altLiveVars⟩ := visitFnBody b ctx
         ⟨.default b, altLiveVars⟩
-    let caseLiveVars : LiveVarSet := alts.foldl (init := {}) fun liveVars ⟨_, altLiveVars⟩ =>
-      liveVars.merge altLiveVars
-    let caseLiveVars := caseLiveVars.insert x
+    let caseLiveVars := alts.foldl (init := { vars := {}, borrows := {} })
+      fun liveVars ⟨_, altLiveVars⟩ =>
+        liveVars.merge altLiveVars
+    let caseLiveVars := useVar ctx x caseLiveVars
     let alts := alts.map fun ⟨alt, altLiveVars⟩ => match alt with
       | .ctor c b =>
         let ctx := updateRefUsingCtorInfo ctx x c
@@ -258,29 +430,32 @@ partial def visitFnBody (b : FnBody) (ctx : Context) : FnBody × LiveVarSet :=
         let b := addDecForAlt ctx caseLiveVars altLiveVars b
         .default b
     ⟨.case tid x xType alts, caseLiveVars⟩
-  | .ret x =>
-    match x with
-    | .var x =>
-      let info := getVarInfo ctx x
-      let b :=
-        if info.type.isPossibleRef && info.inheritsBorrowFromParam then
-          addInc ctx x b
-        else b
-      ⟨b, mkLiveVarSet x⟩
-    | .erased => ⟨b, {}⟩
   | .jmp j xs =>
     let jLiveVars := getJPLiveVars ctx j
     let ps        := getJPParams ctx j
     let b         := addIncBefore ctx xs ps b jLiveVars
-    let bLiveVars := collectLiveVars b ctx.jpLiveVarMap
+    let bLiveVars := useArgs ctx xs jLiveVars
     ⟨b, bLiveVars⟩
-  | .unreachable => ⟨.unreachable, {}⟩
-  | _ => ⟨b, {}⟩ -- unreachable if well-formed
+  | .ret x =>
+    let liveVars := mkRetLiveVars ctx
+    match x with
+    | .var x =>
+      let info := ctx.varMap.get! x
+      let liveVars := useVar ctx x liveVars
+      let b :=
+        if info.isPossibleRef && liveVars.borrows.contains x then
+          addInc ctx x b
+        else b
+      ⟨b, liveVars⟩
+    | .erased => ⟨b, liveVars⟩
+  | .unreachable => ⟨.unreachable, mkRetLiveVars ctx⟩
+  | .set .. | .setTag .. | .inc .. | .dec .. | .del .. => unreachable!
 
 partial def visitDecl (env : Environment) (decls : Array Decl) (d : Decl) : Decl :=
   match d with
   | .fdecl (xs := xs) (body := b) .. =>
-    let ctx := updateVarInfoWithParams { env, decls } xs
+    let ⟨derivedValMap, borrowedParams⟩ := CollectDerivedValInfo.collectDerivedValInfo xs b
+    let ctx := updateVarInfoWithParams { env, decls, borrowedParams, derivedValMap } xs
     let ⟨b, bLiveVars⟩ := visitFnBody b ctx
     let ⟨b, _⟩ := addDecForDeadParams ctx xs b bLiveVars
     d.updateBody! b

src/Lean/Compiler/InlineAttrs.lean

@@ -77,6 +77,9 @@ builtin_initialize inlineAttrs : EnumAttributes InlineAttributeKind ←
       if kind matches .macroInline then
         unless (← isValidMacroInline declName) do
           throwError "Cannot add `[macro_inline]` attribute to `{declName}`: This attribute does not support this kind of declaration; only non-recursive definitions are supported"
+        withExporting (isExporting := !isPrivateName declName) do
+          if !(← getConstInfo declName).isDefinition then
+            throwError "invalid `[macro_inline]` attribute, '{declName}' must be an exposed definition"
 
 def setInlineAttribute (env : Environment) (declName : Name) (kind : InlineAttributeKind) : Except String Environment :=
   inlineAttrs.setValue env declName kind

src/Lean/Compiler/LCNF/Basic.lean

@@ -715,7 +715,7 @@ partial def Code.collectUsed (code : Code) (s : FVarIdHashSet := {}) : FVarIdHas
   | .jmp fvarId args => collectArgs args <| s.insert fvarId
 end
 
-abbrev collectUsedAtExpr (s : FVarIdHashSet) (e : Expr) : FVarIdHashSet :=
+@[inline] def collectUsedAtExpr (s : FVarIdHashSet) (e : Expr) : FVarIdHashSet :=
   collectType e s
 
 /--

src/Lean/Compiler/LCNF/CompilerM.lean

@@ -23,7 +23,7 @@ inductive Phase where
   | base
   /-- In this phase polymorphism has been eliminated. -/
   | mono
-  deriving Inhabited
+  deriving Inhabited, BEq
 
 /--
 The state managed by the `CompilerM` `Monad`.

src/Lean/Compiler/LCNF/Main.lean

@@ -108,20 +108,31 @@ def run (declNames : Array Name) : CompilerM (Array IR.Decl) := withAtLeastMaxRe
       if let some info ← getDeclInfo? declName then
         if !(isValidMainType info.type) then
           throwError "`main` function must have type `(List String →)? IO (UInt32 | Unit | PUnit)`"
-  let mut decls ← declNames.mapM toDecl
-  decls := markRecDecls decls
+  let decls ← declNames.mapM toDecl
+  let decls := markRecDecls decls
   let manager ← getPassManager
   let isCheckEnabled := compiler.check.get (← getOptions)
-  for pass in manager.passes do
-    decls ← withTraceNode `Compiler (fun _ => return m!"compiler phase: {pass.phase}, pass: {pass.name}") do
-      withPhase pass.phase <| pass.run decls
-    withPhase pass.phaseOut <| checkpoint pass.name decls (isCheckEnabled || pass.shouldAlwaysRunCheck)
+  let decls ← profileitM Exception "compilation (LCNF base)" (← getOptions) do
+    let mut decls := decls
+    for pass in manager.basePasses do
+      decls ← withTraceNode `Compiler (fun _ => return m!"compiler phase: {pass.phase}, pass: {pass.name}") do
+        withPhase pass.phase <| pass.run decls
+      withPhase pass.phaseOut <| checkpoint pass.name decls (isCheckEnabled || pass.shouldAlwaysRunCheck)
+    return decls
+  let decls ← profileitM Exception "compilation (LCNF mono)" (← getOptions) do
+    let mut decls := decls
+    for pass in manager.monoPasses do
+      decls ← withTraceNode `Compiler (fun _ => return m!"compiler phase: {pass.phase}, pass: {pass.name}") do
+        withPhase pass.phase <| pass.run decls
+      withPhase pass.phaseOut <| checkpoint pass.name decls (isCheckEnabled || pass.shouldAlwaysRunCheck)
+    return decls
   if (← Lean.isTracingEnabledFor `Compiler.result) then
     for decl in decls do
       let decl ← normalizeFVarIds decl
       Lean.addTrace `Compiler.result m!"size: {decl.size}\n{← ppDecl' decl}"
-  let irDecls ← IR.toIR decls
-  IR.compile irDecls
+  profileitM Exception "compilation (IR)" (← getOptions) do
+    let irDecls ← IR.toIR decls
+    IR.compile irDecls
 
 end PassManager
 
@@ -134,9 +145,8 @@ def showDecl (phase : Phase) (declName : Name) : CoreM Format := do
 
 @[export lean_lcnf_compile_decls]
 def main (declNames : Array Name) : CoreM Unit := do
-  profileitM Exception "compilation" (← getOptions) do
-    withTraceNode `Compiler (fun _ => return m!"compiling: {declNames}") do
-      CompilerM.run <| discard <| PassManager.run declNames
+  withTraceNode `Compiler (fun _ => return m!"compiling: {declNames}") do
+    CompilerM.run <| discard <| PassManager.run declNames
 
 builtin_initialize
   registerTraceClass `Compiler.init (inherited := true)

src/Lean/Compiler/LCNF/PassManager.lean

@@ -73,6 +73,8 @@ Can be used to install, remove, replace etc. passes by tagging a declaration
 of type `PassInstaller` with the `cpass` attribute.
 -/
 structure PassInstaller where
+  /-- Affected phase. -/
+  phase : Phase
   /--
   When the installer is run this function will receive a list of all
   current `Pass`es and return a new one, this can modify the list (and
@@ -86,7 +88,8 @@ The `PassManager` used to store all `Pass`es that will be run within
 pipeline.
 -/
 structure PassManager where
-  passes : Array Pass
+  basePasses : Array Pass
+  monoPasses : Array Pass
   deriving Inhabited
 
 instance : ToString Phase where
@@ -106,40 +109,51 @@ end Pass
 
 namespace PassManager
 
-def validate (manager : PassManager) : CoreM Unit := do
-  let mut current := .base
-  for pass in manager.passes do
-    if ¬(current ≤ pass.phase) then
-      throwError s!"{pass.name} has phase {pass.phase} but should at least have {current}"
-    current := pass.phase
+private def validatePasses (phase : Phase) (passes : Array Pass) : CoreM Unit := do
+  for pass in passes do
+    if pass.phase != phase then
+      throwError s!"{pass.name} has phase {pass.phase} but should have {phase}"
 
-def findHighestOccurrence (targetName : Name) (passes : Array Pass) : CoreM Nat := do
+def validate (manager : PassManager) : CoreM Unit := do
+  validatePasses .base manager.basePasses
+  validatePasses .mono manager.monoPasses
+
+def findOccurrenceBounds (targetName : Name) (passes : Array Pass) : CoreM (Nat × Nat) := do
+  let mut lowest := none
   let mut highest := none
   for pass in passes do
       if pass.name == targetName then
+        lowest := if lowest.isNone then some pass.occurrence else lowest
         highest := some pass.occurrence
-  let some val := highest | throwError s!"Could not find any occurrence of {targetName}"
-  return val
+  let ⟨some lowestVal, some highestVal⟩ := Prod.mk lowest highest | throwError s!"Could not find any occurrence of {targetName}"
+  return ⟨lowestVal, highestVal⟩
 
 end PassManager
 
 namespace PassInstaller
 
-def installAtEnd (p : Pass) : PassInstaller where
+def installAtEnd (phase : Phase) (p : Pass) : PassInstaller where
+  phase
   install passes := return passes.push p
 
-def append (passesNew : Array Pass) : PassInstaller where
+def append (phase : Phase) (passesNew : Array Pass) : PassInstaller where
+  phase
   install passes := return passes ++ passesNew
 
-def withEachOccurrence (targetName : Name) (f : Nat → PassInstaller) : PassInstaller where
+def withEachOccurrence (phase : Phase) (targetName : Name) (f : Nat → PassInstaller) : PassInstaller where
+  phase
   install passes := do
-    let highestOccurrence ← PassManager.findHighestOccurrence targetName passes
+    let ⟨lowestOccurrence, highestOccurrence⟩ ← PassManager.findOccurrenceBounds targetName passes
     let mut passes := passes
-    for occurrence in *...=highestOccurrence do
-      passes ← f occurrence |>.install passes
+    for occurrence in lowestOccurrence...=highestOccurrence do
+      let installer := f occurrence
+      if installer.phase != phase then
+        panic! "phase mismatch"
+      passes ← installer.install passes
     return passes
 
-def installAfter (targetName : Name) (p : Pass → Pass) (occurrence : Nat := 0) : PassInstaller where
+def installAfter (phase : Phase) (targetName : Name) (p : Pass → Pass) (occurrence : Nat := 0) : PassInstaller where
+  phase
   install passes :=
     if let some idx := passes.findFinIdx? (fun p => p.name == targetName && p.occurrence == occurrence) then
       let passUnderTest := passes[idx]
@@ -147,10 +161,11 @@ def installAfter (targetName : Name) (p : Pass → Pass) (occurrence : Nat := 0)
     else
       throwError s!"Tried to insert pass after {targetName}, occurrence {occurrence} but {targetName} is not in the pass list"
 
-def installAfterEach (targetName : Name) (p : Pass → Pass) : PassInstaller :=
-    withEachOccurrence targetName (installAfter targetName p ·)
+def installAfterEach (phase : Phase) (targetName : Name) (p : Pass → Pass) : PassInstaller :=
+    withEachOccurrence phase targetName (installAfter phase targetName p ·)
 
-def installBefore (targetName : Name) (p : Pass → Pass) (occurrence : Nat := 0): PassInstaller where
+def installBefore (phase : Phase) (targetName : Name) (p : Pass → Pass) (occurrence : Nat := 0): PassInstaller where
+  phase
   install passes :=
     if let some idx := passes.findFinIdx? (fun p => p.name == targetName && p.occurrence == occurrence) then
       let passUnderTest := passes[idx]
@@ -158,19 +173,24 @@ def installBefore (targetName : Name) (p : Pass → Pass) (occurrence : Nat := 0
     else
       throwError s!"Tried to insert pass after {targetName}, occurrence {occurrence} but {targetName} is not in the pass list"
 
-def installBeforeEachOccurrence (targetName : Name) (p : Pass → Pass) : PassInstaller :=
-    withEachOccurrence targetName (installBefore targetName p ·)
+def installBeforeEachOccurrence (phase : Phase) (targetName : Name) (p : Pass → Pass) : PassInstaller :=
+    withEachOccurrence phase targetName (installBefore phase targetName p ·)
 
-def replacePass (targetName : Name) (p : Pass → Pass) (occurrence : Nat := 0) : PassInstaller where
+def replacePass (phase : Phase) (targetName : Name) (p : Pass → Pass) (occurrence : Nat := 0) : PassInstaller where
+  phase
   install passes := do
     let some idx := passes.findIdx? (fun p => p.name == targetName && p.occurrence == occurrence) | throwError s!"Tried to replace {targetName}, occurrence {occurrence} but {targetName} is not in the pass list"
     return passes.modify idx p
 
-def replaceEachOccurrence (targetName : Name) (p : Pass → Pass) : PassInstaller :=
-    withEachOccurrence targetName (replacePass targetName p ·)
+def replaceEachOccurrence (phase : Phase) (targetName : Name) (p : Pass → Pass) : PassInstaller :=
+    withEachOccurrence phase targetName (replacePass phase targetName p ·)
 
 def run (manager : PassManager) (installer : PassInstaller) : CoreM PassManager := do
-  return { manager with passes := (← installer.install manager.passes) }
+  match installer.phase with
+  | .base =>
+    return { manager with basePasses := (← installer.install manager.basePasses) }
+  | .mono =>
+    return { manager with monoPasses := (← installer.install manager.monoPasses) }
 
 private unsafe def getPassInstallerUnsafe (declName : Name) : CoreM PassInstaller := do
   ofExcept <| (← getEnv).evalConstCheck PassInstaller (← getOptions) ``PassInstaller declName
@@ -180,7 +200,7 @@ private opaque getPassInstaller (declName : Name) : CoreM PassInstaller
 
 def runFromDecl (manager : PassManager) (declName : Name) : CoreM PassManager := do
   let installer ← getPassInstaller declName
-  let newState ← installer.run manager
+  let newState ← PassInstaller.run manager installer
   newState.validate
   return newState
 

src/Lean/Compiler/LCNF/Passes.lean

@@ -69,7 +69,7 @@ end Pass
 open Pass
 
 def builtinPassManager : PassManager := {
-  passes := #[
+  basePasses := #[
     init,
     pullInstances,
     cse (shouldElimFunDecls := false),
@@ -93,6 +93,8 @@ def builtinPassManager : PassManager := {
     -- pass must be run for each phase; see `base/monoTransparentDeclsExt`
     inferVisibility (phase := .base),
     toMono,
+  ]
+  monoPasses := #[
     simp (occurrence := 3) (phase := .mono),
     reduceJpArity (phase := .mono),
     structProjCases,

src/Lean/Compiler/LCNF/Simp/InlineProj.lean

@@ -75,7 +75,7 @@ where
         let some decl ← getDecl? declName | failure
         match decl.value with
         | .code code =>
-          guard (decl.getArity == args.size)
+          guard (!decl.recursive && decl.getArity == args.size)
           let params := decl.instantiateParamsLevelParams us
           let code := code.instantiateValueLevelParams decl.levelParams us
           let code ← betaReduce params code args (mustInline := true)

src/Lean/Compiler/LCNF/Testing.lean

@@ -110,35 +110,35 @@ private def assertAfterTest (test : SimpleTest) : TestInstallerM (Pass → Pass)
 Install an assertion pass right after a specific occurrence of a pass,
 default is first.
 -/
-def assertAfter (test : SimpleTest) (occurrence : Nat := 0): TestInstaller := do
+def assertAfter (phase : Phase) (test : SimpleTest) (occurrence : Nat := 0): TestInstaller := do
   let passUnderTestName := (←read).passUnderTestName
   let assertion ← assertAfterTest test
-  return .installAfter passUnderTestName assertion occurrence
+  return .installAfter phase passUnderTestName assertion occurrence
 
 /--
 Install an assertion pass right after each occurrence of a pass.
 -/
-def assertAfterEachOccurrence (test : SimpleTest) : TestInstaller := do
+def assertAfterEachOccurrence (phase : Phase) (test : SimpleTest) : TestInstaller := do
   let passUnderTestName := (←read).passUnderTestName
   let assertion ← assertAfterTest test
-  return .installAfterEach passUnderTestName assertion
+  return .installAfterEach phase passUnderTestName assertion
 
 /--
 Install an assertion pass right after a specific occurrence of a pass,
 default is first. The assertion operates on a per declaration basis.
 -/
-def assertForEachDeclAfter (assertion : Pass → Decl → Bool) (msg : String) (occurrence : Nat := 0) : TestInstaller :=
+def assertForEachDeclAfter (phase : Phase) (assertion : Pass → Decl → Bool) (msg : String) (occurrence : Nat := 0) : TestInstaller :=
   let assertion := do
     let pass ← getPassUnderTest
     (←getDecls).forM (fun decl => assert (assertion pass decl) msg)
-  assertAfter assertion occurrence
+  assertAfter phase assertion occurrence
 
 /--
 Install an assertion pass right after the each occurrence of a pass. The
 assertion operates on a per declaration basis.
 -/
-def assertForEachDeclAfterEachOccurrence (assertion : Pass → Decl → Bool) (msg : String) : TestInstaller :=
-  assertAfterEachOccurrence <| do
+def assertForEachDeclAfterEachOccurrence (phase : Phase) (assertion : Pass → Decl → Bool) (msg : String) : TestInstaller :=
+  assertAfterEachOccurrence phase <| do
     let pass ← getPassUnderTest
     (←getDecls).forM (fun decl => assert (assertion pass decl) msg)
 
@@ -160,20 +160,20 @@ Replace a specific occurrence, default is first, of a pass with a wrapper one th
 the user to provide an assertion which takes into account both the
 declarations that were sent to and produced by the pass under test.
 -/
-def assertAround (test : InOutTest) (occurrence : Nat := 0) : TestInstaller := do
+def assertAround (phase : Phase) (test : InOutTest) (occurrence : Nat := 0) : TestInstaller := do
   let passUnderTestName := (←read).passUnderTestName
   let assertion ← assertAroundTest test
-  return .replacePass passUnderTestName assertion occurrence
+  return .replacePass phase passUnderTestName assertion occurrence
 
 /--
 Replace all occurrences of a pass with a wrapper one that allows
 the user to provide an assertion which takes into account both the
 declarations that were sent to and produced by the pass under test.
 -/
-def assertAroundEachOccurrence (test : InOutTest) : TestInstaller := do
+def assertAroundEachOccurrence (phase : Phase) (test : InOutTest) : TestInstaller := do
   let passUnderTestName := (←read).passUnderTestName
   let assertion ← assertAroundTest test
-  return .replaceEachOccurrence passUnderTestName assertion
+  return .replaceEachOccurrence phase passUnderTestName assertion
 
 private def throwFixPointError (err : String) (firstResult secondResult : Array Decl) : CompilerM Unit := do
   let mut err := err
@@ -189,7 +189,7 @@ Insert a pass after `passUnderTestName`, that ensures, that if
 `passUnderTestName` is executed twice in a row, no change in the resulting
 expression will occur, i.e. the pass is at a fix point.
 -/
-def assertIsAtFixPoint : TestInstaller :=
+def assertIsAtFixPoint (phase : Phase) : TestInstaller :=
   let test := do
     let passUnderTest ← getPassUnderTest
     let decls ← getDecls
@@ -203,51 +203,51 @@ def assertIsAtFixPoint : TestInstaller :=
     else if decls != secondResult then
       let err := s!"Pass {passUnderTest.name} did not reach a fixpoint, it either changed declarations or their order:\n"
       throwFixPointError err decls secondResult
-  assertAfterEachOccurrence test
+  assertAfterEachOccurrence phase test
 
 /--
 Compare the overall sizes of the input and output of `passUnderTest` with `assertion`.
 If `assertion inputSize outputSize` is `false` throw an exception with `msg`.
 -/
-def assertSize (assertion : Nat → Nat → Bool) (msg : String) : TestInstaller :=
+def assertSize (phase : Phase) (assertion : Nat → Nat → Bool) (msg : String) : TestInstaller :=
   let sumDeclSizes := fun decls => decls.map Decl.size |>.foldl (init := 0) (· + ·)
   let assertion := (fun inputS outputS => Testing.assert (assertion inputS outputS) s!"{msg}: input size {inputS} output size {outputS}")
-  assertAroundEachOccurrence (do assertion (sumDeclSizes (←getInputDecls)) (sumDeclSizes (←getOutputDecls)))
+  assertAroundEachOccurrence phase (do assertion (sumDeclSizes (←getInputDecls)) (sumDeclSizes (←getOutputDecls)))
 
 /--
 Assert that the overall size of the `Decl`s in the compilation pipeline does not change
 after `passUnderTestName`.
 -/
-def assertPreservesSize (msg : String) : TestInstaller :=
-  assertSize (· == ·) msg
+def assertPreservesSize (phase : Phase) (msg : String) : TestInstaller :=
+  assertSize phase (· == ·) msg
 
 /--
 Assert that the overall size of the `Decl`s in the compilation pipeline gets reduced by `passUnderTestName`.
 -/
-def assertReducesSize (msg : String) : TestInstaller :=
-  assertSize (· > ·) msg
+def assertReducesSize (phase : Phase) (msg : String) : TestInstaller :=
+  assertSize phase (· > ·) msg
 
 /--
 Assert that the overall size of the `Decl`s in the compilation pipeline gets reduced or stays unchanged
 by `passUnderTestName`.
 -/
-def assertReducesOrPreservesSize (msg : String) : TestInstaller :=
-  assertSize (· ≥ ·) msg
+def assertReducesOrPreservesSize (phase : Phase) (msg : String) : TestInstaller :=
+  assertSize phase (· ≥ ·) msg
 
 /--
 Assert that the pass under test produces `Decl`s that do not contain
 `Expr.const constName` in their `Code.let` values anymore.
 -/
-def assertDoesNotContainConstAfter (constName : Name) (msg : String) : TestInstaller :=
-  assertForEachDeclAfterEachOccurrence
+def assertDoesNotContainConstAfter (phase : Phase) (constName : Name) (msg : String) : TestInstaller :=
+  assertForEachDeclAfterEachOccurrence phase
     fun _ decl =>
       match decl.value with
       | .code c => !c.containsConst constName
       | .extern .. => true
     msg
 
-def assertNoFun : TestInstaller :=
-  assertAfter do
+def assertNoFun (phase : Phase) : TestInstaller :=
+  assertAfter phase do
     for decl in (← getDecls) do
       decl.value.forCodeM fun
         | .fun .. => throwError "declaration `{decl.name}` contains a local function declaration"

src/Lean/Compiler/LCNF/ToMono.lean

@@ -90,8 +90,18 @@ partial def LetValue.toMono (e : LetValue) (resultFVar : FVarId) : ToMonoM LetVa
       -- Decidable.decide is the identity function since Decidable
       -- and Bool have the same runtime representation.
       return args[1]!.toLetValue
-    else if declName == ``Quot.mk || declName == ``Quot.lcInv then
+    else if declName == ``Quot.mk then
       return args[2]!.toLetValue
+    else if declName == ``Quot.lcInv then
+      match args[2]! with
+      | .fvar fvarId =>
+        let mut extraArgs : Array Arg := .emptyWithCapacity (args.size - 3)
+        for i in 3...args.size do
+          let arg ← argToMono args[i]!
+          extraArgs := extraArgs.push arg
+        return .fvar fvarId extraArgs
+      | .erased | .type _ =>
+        return .erased
     else if declName == ``Nat.zero then
       return .lit (.nat 0)
     else if declName == ``Nat.succ then

src/Lean/Compiler/MetaAttr.lean

@@ -13,8 +13,9 @@ public section
 namespace Lean
 
 builtin_initialize metaExt : TagDeclarationExtension ←
-  -- set by `addPreDefinitions`
-  mkTagDeclarationExtension (asyncMode := .async .asyncEnv)
+  -- set by `addPreDefinitions`; if we ever make `def` elaboration async, it should be moved to
+  -- remain on the main environment branch
+  mkTagDeclarationExtension (asyncMode := .async .mainEnv)
 
 /-- Marks in the environment extension that the given declaration has been declared by the user as `meta`. -/
 def addMeta (env : Environment) (declName : Name) : Environment :=

src/Lean/CoreM.lean

@@ -570,8 +570,8 @@ register_builtin_option stderrAsMessages : Bool := {
 Creates snapshot reporting given `withIsolatedStreams` output and diagnostics and traces from the
 given state.
 -/
-def mkSnapshot (output : String) (ctx : Context) (st : State)
-    (desc : String := by exact decl_name%.toString) : BaseIO Language.SnapshotTree := do
+def mkSnapshot? (output : String) (ctx : Context) (st : State)
+    (desc : String := by exact decl_name%.toString) : BaseIO (Option Language.SnapshotTree) := do
   let mut msgs := st.messages
   if !output.isEmpty then
     msgs := msgs.add {
@@ -580,7 +580,9 @@ def mkSnapshot (output : String) (ctx : Context) (st : State)
       pos      := ctx.fileMap.toPosition <| ctx.ref.getPos?.getD 0
       data     := output
     }
-  return .mk {
+  if !msgs.hasUnreported && st.traceState.traces.isEmpty && st.snapshotTasks.isEmpty then
+    return none
+  return some <| .mk {
     desc
     diagnostics := (← Language.Snapshot.Diagnostics.ofMessageLog msgs)
     traces := st.traceState
@@ -617,7 +619,8 @@ def wrapAsyncAsSnapshot {α : Type} (act : α → CoreM Unit) (cancelTk? : Optio
   let ctx ← readThe Core.Context
   return fun a => do
     match (← (f a).toBaseIO) with
-    | .ok (output, st) => mkSnapshot output ctx st desc
+    | .ok (output, st) =>
+      return (← mkSnapshot? output ctx st desc).getD (toSnapshotTree (default : SnapshotLeaf))
     -- interrupt or abort exception as `try catch` above should have caught any others
     | .error _ => default
 
@@ -706,8 +709,10 @@ partial def compileDecls (decls : Array Name) (logErrors := true) : CoreM Unit :
     finally
       res.commitChecked (← getEnv)
   let t ← BaseIO.mapTask checkAct env.checked
-  let endRange? := (← getRef).getTailPos?.map fun pos => ⟨pos, pos⟩
-  Core.logSnapshotTask { stx? := none, reportingRange? := endRange?, task := t, cancelTk? := cancelTk }
+  -- Do not display reporting range; most uses of `addDecl` are for registering auxiliary decls
+  -- users should not worry about and other callers can add a separate task with ranges
+  -- themselves, see `MutualDef`.
+  Core.logSnapshotTask { stx? := none, reportingRange := .skip, task := t, cancelTk? := cancelTk }
 where doCompile := do
   -- don't compile if kernel errored; should be converted into a task dependency when compilation
   -- is made async as well

src/Lean/Data/Json/Basic.lean

@@ -203,7 +203,7 @@ private partial def beq' : Json → Json → Bool
   | _,      _      => false
 
 instance : BEq Json where
-  beq := beq'
+  beq := private beq'
 
 private partial def hash' : Json → UInt64
   | null   => 11
@@ -216,7 +216,7 @@ private partial def hash' : Json → UInt64
     mixHash 29 <| kvPairs.foldl (init := 7) fun r k v => mixHash r <| mixHash (hash k) (hash' v)
 
 instance : Hashable Json where
-  hash := hash'
+  hash := private hash'
 
 def mkObj (o : List (String × Json)) : Json :=
   obj <| Std.TreeMap.Raw.ofList o

src/Lean/Data/Trie.lean

@@ -199,8 +199,8 @@ private partial def toStringAux {α : Type} : Trie α → List Format
       [ format (repr c), (Format.group $ Format.nest 4 $ flip Format.joinSep Format.line $ toStringAux t) ]
     ) cs.toList ts.toList
 
-instance {α : Type} : ToString (Trie α) :=
-  ⟨fun t => (flip Format.joinSep Format.line $ toStringAux t).pretty⟩
+instance {α : Type} : ToString (Trie α) where
+  toString t := private (flip Format.joinSep Format.line $ toStringAux t).pretty
 
 end Trie
 

src/Lean/Data/Xml/Basic.lean

@@ -41,5 +41,5 @@ private partial def cToString : Content → String
 | Content.Character c => c
 
 end
-instance : ToString Element := ⟨eToString⟩
-instance : ToString Content := ⟨cToString⟩
+instance : ToString Element := ⟨private_decl% eToString⟩
+instance : ToString Content := ⟨private_decl% cToString⟩

src/Lean/Elab/BuiltinNotation.lean

@@ -556,13 +556,12 @@ def elabUnsafe : TermElab := fun stx expectedType? =>
     let .const unsafeFn unsafeLvls .. := t.getAppFn | unreachable!
     let .defnInfo unsafeDefn ← getConstInfo unsafeFn | unreachable!
     let implName ← mkAuxName `unsafe_impl
-    addDecl <| Declaration.defnDecl {
+    addDecl <| Declaration.opaqueDecl {
       name        := implName
       type        := unsafeDefn.type
       levelParams := unsafeDefn.levelParams
       value       := (← mkOfNonempty unsafeDefn.type)
-      hints       := .opaque
-      safety      := .safe
+      isUnsafe    := false
     }
     setImplementedBy implName unsafeFn
     return mkAppN (Lean.mkConst implName unsafeLvls) t.getAppArgs

src/Lean/Elab/DeclModifiers.lean

@@ -49,26 +49,21 @@ def checkNotAlreadyDeclared {m} [Monad m] [MonadEnv m] [MonadError m] [MonadFina
       addInfo declName
       throwError "a non-private declaration '{.ofConstName declName true}' has already been declared"
 
-/-- Declaration visibility modifier. That is, whether a declaration is regular, protected or private. -/
+/-- Declaration visibility modifier. That is, whether a declaration is public or private or inherits its visibility from the outer scope. -/
 inductive Visibility where
-  | regular | «protected» | «private» | «public»
+  | regular | «private» | «public»
   deriving Inhabited
 
 instance : ToString Visibility where
   toString
     | .regular   => "regular"
     | .private   => "private"
-    | .protected => "protected"
     | .public    => "public"
 
 def Visibility.isPrivate : Visibility → Bool
   | .private   => true
   | _          => false
 
-def Visibility.isProtected : Visibility → Bool
-  | .protected => true
-  | _          => false
-
 def Visibility.isPublic : Visibility → Bool
   | .public    => true
   | _          => false
@@ -92,6 +87,7 @@ structure Modifiers where
   stx             : TSyntax ``Parser.Command.declModifiers := ⟨.missing⟩
   docString?      : Option (TSyntax ``Parser.Command.docComment) := none
   visibility      : Visibility := Visibility.regular
+  isProtected     : Bool := false
   computeKind     : ComputeKind := .regular
   recKind         : RecKind := RecKind.default
   isUnsafe        : Bool := false
@@ -99,7 +95,6 @@ structure Modifiers where
   deriving Inhabited
 
 def Modifiers.isPrivate (m : Modifiers) : Bool := m.visibility.isPrivate
-def Modifiers.isProtected (m : Modifiers) : Bool := m.visibility.isProtected
 def Modifiers.isPublic (m : Modifiers) : Bool := m.visibility.isPublic
 def Modifiers.isInferredPublic (env : Environment) (m : Modifiers) : Bool :=
   m.visibility.isInferredPublic env
@@ -147,8 +142,8 @@ instance : ToFormat Modifiers := ⟨fun m =>
     ++ (match m.visibility with
      | .regular   => []
      | .private   => [f!"private"]
-     | .protected => [f!"protected"]
      | .public    => [f!"public"])
+    ++ (if m.isProtected then [f!"protected"] else [])
     ++ (match m.computeKind with | .regular => [] | .meta => [f!"meta"] | .noncomputable => [f!"noncomputable"])
     ++ (match m.recKind with | RecKind.partial => [f!"partial"] | RecKind.nonrec => [f!"nonrec"] | _ => [])
     ++ (if m.isUnsafe then [f!"unsafe"] else [])
@@ -176,18 +171,19 @@ def elabModifiers (stx : TSyntax ``Parser.Command.declModifiers) : m Modifiers :
   let docCommentStx := stx.raw[0]
   let attrsStx      := stx.raw[1]
   let visibilityStx := stx.raw[2]
+  let protectedStx  := stx.raw[3]
   let computeKind   :=
-    if stx.raw[3].isNone then
+    if stx.raw[4].isNone then
       .regular
-    else if stx.raw[3][0].getKind == ``Parser.Command.meta then
+    else if stx.raw[4][0].getKind == ``Parser.Command.meta then
       .meta
     else
       .noncomputable
-  let unsafeStx     := stx.raw[4]
+  let unsafeStx     := stx.raw[5]
   let recKind       :=
-    if stx.raw[5].isNone then
+    if stx.raw[6].isNone then
       RecKind.default
-    else if stx.raw[5][0].getKind == ``Parser.Command.partial then
+    else if stx.raw[6][0].getKind == ``Parser.Command.partial then
       RecKind.partial
     else
       RecKind.nonrec
@@ -197,14 +193,14 @@ def elabModifiers (stx : TSyntax ``Parser.Command.declModifiers) : m Modifiers :
     | some v =>
       match v with
       | `(Parser.Command.visibility| private) => pure .private
-      | `(Parser.Command.visibility| protected) => pure .protected
       | `(Parser.Command.visibility| public) => pure .public
       | _ => throwErrorAt v "unexpected visibility modifier"
+  let isProtected := !protectedStx.isNone
   let attrs ← match attrsStx.getOptional? with
     | none       => pure #[]
     | some attrs => elabDeclAttrs attrs
   return {
-    stx, docString?, visibility, computeKind, recKind, attrs,
+    stx, docString?, visibility, isProtected, computeKind, recKind, attrs,
     isUnsafe        := !unsafeStx.isNone
   }
 
@@ -213,12 +209,12 @@ Ensure the function has not already been declared, and apply the given visibilit
 If `private`, return the updated name using our internal encoding for private names.
 If `protected`, register `declName` as protected in the environment.
 -/
-def applyVisibility (visibility : Visibility) (declName : Name) : m Name := do
+def applyVisibility (modifiers : Modifiers) (declName : Name) : m Name := do
   let mut declName := declName
-  if !visibility.isInferredPublic (← getEnv) then
+  if !modifiers.visibility.isInferredPublic (← getEnv) then
     declName := mkPrivateName (← getEnv) declName
   checkNotAlreadyDeclared declName
-  if visibility matches .protected then
+  if modifiers.isProtected then
     modifyEnv fun env => addProtected env declName
   pure declName
 
@@ -246,16 +242,16 @@ def mkDeclName (currNamespace : Name) (modifiers : Modifiers) (shortName : Name)
     shortName := Name.mkSimple s
     currNamespace := p.replacePrefix `_root_ Name.anonymous
   checkIfShadowingStructureField declName
-  let declName ← applyVisibility modifiers.visibility declName
-  match modifiers.visibility with
-  | Visibility.protected =>
+  let declName ← applyVisibility modifiers declName
+  if modifiers.isProtected then
     match currNamespace with
     | .str _ s => return (declName, Name.mkSimple s ++ shortName)
     | _ =>
       if shortName.isAtomic then
         throwError "protected declarations must be in a namespace"
       return (declName, shortName)
-  | _ => return (declName, shortName)
+  else
+    return (declName, shortName)
 
 /--
   `declId` is of the form

src/Lean/Elab/Deriving/Basic.lean

@@ -6,8 +6,10 @@ Authors: Leonardo de Moura, Wojciech Nawrocki
 module
 
 prelude
+public import Lean.Elab.App
 public import Lean.Elab.Command
 public import Lean.Elab.DeclarationRange
+public import Lean.Elab.DeclNameGen
 public meta import Lean.Parser.Command
 
 public section
@@ -18,53 +20,189 @@ open Command
 namespace Term
 open Meta
 
-/-- Result for `mkInst?` -/
-structure MkInstResult where
-  instVal   : Expr
-  instType  : Expr
-  outParams : Array Expr := #[]
+/-- Result for `mkInst` -/
+private structure MkInstResult where
+  instType   : Expr
+  instVal    : Expr
+
+private def throwDeltaDeriveFailure (className declName : Name) (msg? : Option MessageData) (suffix : MessageData := "") : MetaM α :=
+  let suffix := if let some msg := msg? then m!", {msg}{suffix}" else m!".{suffix}"
+  throwError "Failed to delta derive `{.ofConstName className}` instance for `{.ofConstName declName}`{suffix}"
 
 /--
-  Construct an instance for `className out₁ ... outₙ type`.
-  The method support classes with a prefix of `outParam`s (e.g. `MonadReader`). -/
-private partial def mkInst? (className : Name) (type : Expr) : MetaM (Option MkInstResult) := do
-  let rec go? (instType instTypeType : Expr) (outParams : Array Expr) : MetaM (Option MkInstResult) := do
-    let instTypeType ← whnfD instTypeType
-    unless instTypeType.isForall do
-      return none
-    let d := instTypeType.bindingDomain!
-    if d.isOutParam then
-      let mvar ← mkFreshExprMVar d
-      go? (mkApp instType mvar) (instTypeType.bindingBody!.instantiate1 mvar) (outParams.push mvar)
-    else
-      unless (← isDefEqGuarded (← inferType type) d) do
-        return none
-      let instType ← instantiateMVars (mkApp instType type)
-      let instVal ← synthInstance instType
-      return some { instVal, instType, outParams }
-  let instType ← mkConstWithFreshMVarLevels className
-  go? instType (← inferType instType) #[]
+Constructs an instance of the class `classExpr` by figuring out the correct position to insert `val`
+to create a type `className ... val ...` such that there is already an instance for it.
+The `declVal` argument is the value to use in place of `val` when creating the new instance.
 
-def processDefDeriving (className : Name) (declName : Name) : TermElabM Bool := do
-  try
-    let ConstantInfo.defnInfo info ← getConstInfo declName | return false
-    let some result ← mkInst? className info.value | return false
-    let instTypeNew := mkApp result.instType.appFn! (Lean.mkConst declName (info.levelParams.map mkLevelParam))
-    Meta.check instTypeNew
-    let instName ← liftMacroM <| mkUnusedBaseName (declName.appendBefore "inst" |>.appendAfter className.getString!)
-    addAndCompile <| Declaration.defnDecl {
-      name        := instName
-      levelParams := info.levelParams
-      type        := (← instantiateMVars instTypeNew)
-      value       := (← instantiateMVars result.instVal)
-      hints       := info.hints
-      safety      := info.safety
-    }
-    addInstance instName AttributeKind.global (eval_prio default)
-    addDeclarationRangesFromSyntax instName (← getRef)
-    return true
-  catch _ =>
-    return false
+Heuristics:
+- `val` must not use an outParam.
+- `val` should use an explicit parameter, or a parameter that has already been given a value.
+- If there are multiple explicit parameters, we try each possibility.
+- If the class has instance arguments, we require that they be synthesizable while synthesizing this instance.
+  While we could allow synthesis failure and abstract such instances,
+  we leave such conditional instances to be defined by users.
+- If this all fails and `val` is a constant application, we try unfolding it once and try again.
+
+For example, when deriving `MonadReader (ρ : outParam (Type u)) (m : Type u → Type v)`,
+we will skip `ρ` and try using `m`.
+
+Note that we try synthesizing instances even if there are still metavariables in the type.
+If that succeeds, then one can abstract those metavariables and create a parameterized instance.
+The abstraction is not done by this function.
+
+Expects to be run with an empty message log.
+-/
+private partial def mkInst (classExpr : Expr) (declName : Name) (declVal val : Expr) : TermElabM MkInstResult := do
+  let classExpr ← whnfCore classExpr
+  let cls := classExpr.getAppFn
+  let (xs, bis, _) ← forallMetaTelescopeReducing (← inferType cls)
+  for x in xs, y in classExpr.getAppArgs do
+    x.mvarId!.assign y
+  let classExpr := mkAppN cls xs
+  let some className ← isClass? classExpr
+    | throwError "Failed to delta derive instance for `{.ofConstName declName}`, not a class:{indentExpr classExpr}"
+  let mut instMVars := #[]
+  for x in xs, bi in bis do
+    if !(← x.mvarId!.isAssigned) then
+      -- Assumption: assigned inst implicits are already either solved or registered as synthetic
+      if bi.isInstImplicit then
+        x.mvarId!.setKind .synthetic
+        instMVars := instMVars.push x.mvarId!
+  let instVal ← mkFreshExprMVar classExpr (kind := .synthetic)
+  instMVars := instMVars.push instVal.mvarId!
+  let rec go (val : Expr) : TermElabM MkInstResult := do
+    let val ← whnfCore val
+    trace[Elab.Deriving] "Looking for arguments to `{classExpr}` that can be used for the value{indentExpr val}"
+    -- Save the metacontext so that we can try each option in turn
+    let state ← saveState
+    let valTy ← inferType val
+    let mut anyDefEqSuccess := false
+    let mut messages : MessageLog := {}
+    for x in xs, bi in bis, i in 0...xs.size do
+      unless bi.isExplicit do
+        continue
+      let decl ← x.mvarId!.getDecl
+      if decl.type.isOutParam then
+        continue
+      unless ← isMVarApp x do
+        /-
+        This is an argument supplied by the user, and it's not a `_`.
+        This is to avoid counterintuitive behavior, like in the following example.
+        Because `MyNat` unifies with `Nat`, it would otherwise generate an `HAdd MyNat Nat Nat` instance.
+        Instead it generates an `HAdd Nat MyNat Nat` instance.
+        ```
+        def MyNat := Nat
+        deriving instance HAdd Nat for MyNat
+        ```
+        Likely neither of these is the intended result, but the second is more justifiable.
+        It's possible to have it return `MyNat` using `deriving instance HAdd Nat _ MyNat for MyNat`.
+        -/
+        continue
+      unless ← isDefEqGuarded decl.type valTy <&&> isDefEqGuarded x val do
+        restoreState state
+        continue
+      anyDefEqSuccess := true
+      trace[Elab.Deriving] "Argument {i} gives option{indentExpr classExpr}"
+      try
+        -- Finish elaboration
+        synthesizeAppInstMVars instMVars classExpr
+        Term.synthesizeSyntheticMVarsNoPostponing
+      catch ex =>
+        trace[Elab.Deriving] "Option for argument {i} failed"
+        logException ex
+        messages := messages ++ (← Core.getMessageLog)
+        restoreState state
+        continue
+      if (← MonadLog.hasErrors) then
+        -- Sometimes elaboration only logs errors
+        trace[Elab.Deriving] "Option for argument {i} failed, logged errors"
+        messages := messages ++ (← Core.getMessageLog)
+        restoreState state
+        continue
+      -- Success
+      trace[Elab.Deriving] "Argument {i} option succeeded{indentExpr classExpr}"
+      -- Create the type for the declaration itself.
+      let xs' := xs.set! i declVal
+      let instType := mkAppN cls xs'
+      return { instType, instVal }
+    try
+      if let some val' ← unfoldDefinition? val then
+        return ← withTraceNode `Elab.Deriving (fun _ => return m!"Unfolded value to {val'}") <| go val'
+    catch ex =>
+      if !messages.hasErrors then
+        throw ex
+      Core.resetMessageLog
+    if !anyDefEqSuccess then
+      throwDeltaDeriveFailure className declName (m!"the class has no explicit non-out-param parameters where\
+        {indentExpr declVal}\n\
+        can be inserted.")
+    else
+      Core.setMessageLog (messages ++ (← Core.getMessageLog))
+      throwDeltaDeriveFailure className declName none
+        (.note m!"Delta deriving tries the following strategies: \
+            (1) inserting the definition into each explicit non-out-param parameter of a class and \
+            (2) unfolding definitions further.")
+  go val
+
+/--
+Delta deriving handler. Creates an instance of class `classStx` for `decl`.
+The elaborated class expression may be underapplied (e.g. `Decidable` instead of `Decidable _`),
+and may be `decl`.
+If unfolding `decl` results in an underapplied lambda, then this enters the body of the lambda.
+We prevent `classStx` from referring to these local variables; instead it's expected that one uses section variables.
+
+This function can handle being run from within a nontrivial local context,
+and it uses `mkValueTypeClosure` to construct the final instance.
+-/
+def processDefDeriving (classStx : Syntax) (decl : Expr) : TermElabM Unit := do
+  let decl ← whnfCore decl
+  let .const declName _ := decl.getAppFn
+    | throwError "Failed to delta derive instance, expecting a term of the form `C ...` where `C` is a constant, given{indentExpr decl}"
+  -- When the definition is private, the deriving handler will need access to the private scope,
+  -- and we make sure to put the instance in the private scope.
+  withoutExporting (when := isPrivateName declName) do
+  let ConstantInfo.defnInfo info ← getConstInfo declName
+    | throwError "Failed to delta derive instance, `{declName}` is not a definition."
+  let value := info.value.beta decl.getAppArgs
+  let result : Closure.MkValueTypeClosureResult ←
+    -- Assumption: users intend delta deriving to apply to the body of a definition, even if in the source code
+    -- the function is written as a lambda expression.
+    -- Furthermore, we don't use `forallTelescope` because users want to derive instances for monads.
+    lambdaTelescope value fun xs value => withoutErrToSorry do
+      let decl := mkAppN decl xs
+      -- Make these local variables inaccessible.
+      let lctx ← xs.foldlM (init := ← getLCtx) fun lctx x => do
+        pure <| lctx.setUserName x.fvarId! (← mkFreshUserName <| (lctx.find? x.fvarId!).get!.userName)
+      withLCtx' lctx do
+        let msgLog ← Core.getMessageLog
+        Core.resetMessageLog
+        try
+          -- We need to elaborate the class within this context to ensure metavariables can unify with `xs`.
+          let classExpr ← elabTerm classStx none
+          synthesizeSyntheticMVars (postpone := .partial)
+          if (← MonadLog.hasErrors) then
+            throwAbortTerm
+          -- We allow `classExpr` to be a pi type, to support giving more hypotheses to the derived instance.
+          -- (Possibly `classExpr` is not a type due to being underapplied, but `forallTelescopeReducing` tolerates this.)
+          -- We don't reduce because of abbreviations such as `DecidableEq`
+          forallTelescope classExpr fun _ classExpr => do
+            let result ← mkInst classExpr declName decl value
+            Closure.mkValueTypeClosure result.instType result.instVal (zetaDelta := true)
+        finally
+          Core.setMessageLog (msgLog ++ (← Core.getMessageLog))
+  let env ← getEnv
+  let mut instName := (← getCurrNamespace) ++ (← NameGen.mkBaseNameWithSuffix "inst" result.type)
+  -- We don't have a facility to let users override derived names, so make an unused name if needed.
+  instName ← liftMacroM <| mkUnusedBaseName instName
+  -- Make the instance private if the declaration is private.
+  if isPrivateName declName then
+    instName := mkPrivateName env instName
+  let hints := ReducibilityHints.regular (getMaxHeight env result.value + 1)
+  let decl ← mkDefinitionValInferringUnsafe instName result.levelParams.toList result.type result.value hints
+  addAndCompile (logCompileErrors := !(← read).isNoncomputableSection) <| Declaration.defnDecl decl
+  trace[Elab.Deriving] "Derived instance `{.ofConstName instName}`"
+  addInstance instName AttributeKind.global (eval_prio default)
+  addDeclarationRangesFromSyntax instName (← getRef)
 
 end Term
 
@@ -85,39 +223,60 @@ def registerDerivingHandler (className : Name) (handler : DerivingHandler) : IO
     | some handlers => m.insert className (handler :: handlers)
     | none => m.insert className [handler]
 
-def defaultHandler (className : Name) (typeNames : Array Name) : CommandElabM Unit := do
-  throwError "default handlers have not been implemented yet, class: '{className}' types: {typeNames}"
-
 def applyDerivingHandlers (className : Name) (typeNames : Array Name) : CommandElabM Unit := do
   -- When any of the types are private, the deriving handler will need access to the private scope
   -- (and should also make sure to put its outputs in the private scope).
   withoutExporting (when := typeNames.any isPrivateName) do
-  withTraceNode `Elab.Deriving (fun _ => return m!"running deriving handlers for '{className}'") do
+  withTraceNode `Elab.Deriving (fun _ => return m!"running deriving handlers for `{.ofConstName className}`") do
     match (← derivingHandlersRef.get).find? className with
     | some handlers =>
       for handler in handlers do
         if (← handler typeNames) then
           return ()
-      defaultHandler className typeNames
-    | none => defaultHandler className typeNames
+      throwError "None of the deriving handlers for class `{.ofConstName className}` applied to \
+        {.andList <| typeNames.toList.map (m!"`{.ofConstName ·}`")}"
+    | none => throwError "No deriving handlers have been implemented for class `{.ofConstName className}`"
 
-private def tryApplyDefHandler (className : Name) (declName : Name) : CommandElabM Bool :=
-  liftTermElabM do
-    Term.processDefDeriving className declName
+private def applyDefHandler (classStx : Syntax) (declExpr : Expr) : TermElabM Unit :=
+  withTraceNode `Elab.Deriving (fun _ => return m!"running delta deriving handler for `{classStx}` and definition `{declExpr}`") do
+    Term.processDefDeriving classStx declExpr
+
+private def elabDefDeriving (classes decls : Array Syntax) :
+    CommandElabM Unit := runTermElabM fun _ => do
+  for decl in decls do
+    withRef decl <| withLogging do
+      let declExpr ←
+        if decl.isIdent then
+          let declName ← realizeGlobalConstNoOverload decl
+          let info ← getConstInfo declName
+          unless info.isDefinition do
+            throwError (m!"Declaration `{.ofConstName declName}` is not a definition."
+              ++ .note m!"When any declaration is a definition, this command goes into delta deriving mode, \
+                    which applies only to definitions. \
+                    Delta deriving unfolds definitions and infers pre-existing instances.")
+          -- Use the declaration's level parameters, to ensure the instance is fully universe polymorphic
+          mkConstWithLevelParams declName
+        else
+          Term.elabTermAndSynthesize decl none
+      for classStx in classes do
+        withLogging <| applyDefHandler classStx declExpr
 
 @[builtin_command_elab «deriving»] def elabDeriving : CommandElab
-  | `(deriving instance $[$classes],* for $[$declNames],*) => do
-     let declNames ← liftCoreM <| declNames.mapM realizeGlobalConstNoOverloadWithInfo
-     for cls in classes do
-       try
-         let className ← liftCoreM <| realizeGlobalConstNoOverloadWithInfo cls
-         withRef cls do
-           if declNames.size == 1 then
-             if (← tryApplyDefHandler className declNames[0]!) then
-               return ()
-           applyDerivingHandlers className declNames
-       catch ex =>
-         logException ex
+  | `(deriving instance $[$classes],* for $[$decls],*) => do
+    let decls : Array Syntax := decls
+    if decls.all Syntax.isIdent then
+      let declNames ← liftCoreM <| decls.mapM (realizeGlobalConstNoOverloadWithInfo ·)
+      -- If any of the declarations are definitions, then we commit to delta deriving.
+      let infos ← declNames.mapM getConstInfo
+      if infos.any (·.isDefinition) then
+        elabDefDeriving classes decls
+      else
+        -- Otherwise, we commit to using deriving handlers.
+        let classNames ← liftCoreM <| classes.mapM (realizeGlobalConstNoOverloadWithInfo ·)
+        for className in classNames, classIdent in classes do
+          withRef classIdent <| withLogging <| applyDerivingHandlers className declNames
+    else
+      elabDefDeriving classes decls
   | _ => throwUnsupportedSyntax
 
 structure DerivingClassView where

src/Lean/Elab/Deriving/DecEq.lean

@@ -135,15 +135,17 @@ def mkDecEq (declName : Name) : CommandElabM Bool := do
 
 partial def mkEnumOfNat (declName : Name) : MetaM Unit := do
   let indVal ← getConstInfoInduct declName
-  let enumType := mkConst declName
-  let ctors := indVal.ctors.toArray
+  let levels := indVal.levelParams.map Level.param
+  let enumType := mkConst declName levels
+  let u ← getLevel enumType
+  let ctors := indVal.ctors.toArray.map (mkConst · levels)
   withLocalDeclD `n (mkConst ``Nat) fun n => do
-    let cond := mkConst ``cond [1]
+    let cond := mkConst ``cond [u]
     let rec mkDecTree (low high : Nat) : Expr :=
       if low + 1 == high then
-        mkConst ctors[low]!
+        ctors[low]!
       else if low + 2 == high then
-        mkApp4 cond enumType (mkApp2 (mkConst ``Nat.beq) n (mkRawNatLit low)) (mkConst ctors[low]!) (mkConst ctors[low+1]!)
+        mkApp4 cond enumType (mkApp2 (mkConst ``Nat.beq) n (mkRawNatLit low)) ctors[low]! ctors[low+1]!
       else
         let mid := (low + high)/2
         let lowBranch := mkDecTree low mid
@@ -153,7 +155,7 @@ partial def mkEnumOfNat (declName : Name) : MetaM Unit := do
     let type ← mkArrow (mkConst ``Nat) enumType
     addAndCompile <| Declaration.defnDecl {
       name := Name.mkStr declName "ofNat"
-      levelParams := []
+      levelParams := indVal.levelParams
       safety := DefinitionSafety.safe
       hints  := ReducibilityHints.abbrev
       value, type
@@ -161,24 +163,26 @@ partial def mkEnumOfNat (declName : Name) : MetaM Unit := do
 
 def mkEnumOfNatThm (declName : Name) : MetaM Unit := do
   let indVal ← getConstInfoInduct declName
-  let toCtorIdx := mkConst (Name.mkStr declName "toCtorIdx")
-  let ofNat     := mkConst (Name.mkStr declName "ofNat")
-  let enumType  := mkConst declName
-  let eqEnum    := mkApp (mkConst ``Eq [levelOne]) enumType
-  let rflEnum   := mkApp (mkConst ``Eq.refl [levelOne]) enumType
+  let levels := indVal.levelParams.map Level.param
+  let toCtorIdx := mkConst (Name.mkStr declName "toCtorIdx") levels
+  let ofNat     := mkConst (Name.mkStr declName "ofNat") levels
+  let enumType  := mkConst declName levels
+  let u ← getLevel enumType
+  let eqEnum    := mkApp (mkConst ``Eq [u]) enumType
+  let rflEnum   := mkApp (mkConst ``Eq.refl [u]) enumType
   let ctors := indVal.ctors
   withLocalDeclD `x enumType fun x => do
     let resultType := mkApp2 eqEnum (mkApp ofNat (mkApp toCtorIdx x)) x
     let motive     ← mkLambdaFVars #[x] resultType
-    let casesOn    := mkConst (mkCasesOnName declName) [levelZero]
+    let casesOn    := mkConst (mkCasesOnName declName) (levelZero :: levels)
     let mut value  := mkApp2 casesOn motive x
     for ctor in ctors do
-      value := mkApp value (mkApp rflEnum (mkConst ctor))
+      value := mkApp value (mkApp rflEnum (mkConst ctor levels))
     value ← mkLambdaFVars #[x] value
     let type ← mkForallFVars #[x] resultType
     addAndCompile <| Declaration.thmDecl {
       name := Name.mkStr declName "ofNat_toCtorIdx"
-      levelParams := []
+      levelParams := indVal.levelParams
       value, type
     }
 

src/Lean/Elab/Inductive.lean

@@ -60,7 +60,7 @@ private def inductiveSyntaxToView (modifiers : Modifiers) (decl : Syntax) : Term
     checkValidCtorModifier ctorModifiers
     let ctorName := ctor.getIdAt 3
     let ctorName := declName ++ ctorName
-    let ctorName ← withRef ctor[3] <| applyVisibility ctorModifiers.visibility ctorName
+    let ctorName ← withRef ctor[3] <| applyVisibility ctorModifiers ctorName
     let (binders, type?) := expandOptDeclSig ctor[4]
     addDocString' ctorName ctorModifiers.docString?
     addDeclarationRangesFromSyntax ctorName ctor ctor[3]

src/Lean/Elab/MutualDef.lean

@@ -284,7 +284,7 @@ private def elabHeaders (views : Array DefView) (expandedDeclIds : Array ExpandD
         let cancelTk? := (← readThe Core.Context).cancelTk?
         let bodySnap := {
           stx? := view.value
-          reportingRange? :=
+          reportingRange := .ofOptionInheriting <|
             if newTacTask?.isSome then
               -- Only use first line of body as range when we have incremental tactics as otherwise we
               -- would cover their progress
@@ -1239,6 +1239,11 @@ where
       processDeriving #[header]
       async.commitCheckEnv (← getEnv)
     Core.logSnapshotTask { stx? := none, task := (← BaseIO.asTask (act ())), cancelTk? := cancelTk }
+    -- Also add explicit snapshot task for showing progress of kernel checking; `addDecl` does not
+    -- do this by default
+    Core.logSnapshotTask { stx? := none, cancelTk? := none, task := (← getEnv).checked.map fun _ =>
+      default
+    }
     applyAttributesAt declId.declName view.modifiers.attrs .afterTypeChecking
     applyAttributesAt declId.declName view.modifiers.attrs .afterCompilation
   finishElab headers (isExporting := false) := withFunLocalDecls headers fun funFVars => do
@@ -1303,12 +1308,24 @@ where
       addPreDefinitions preDefs
   processDeriving (headers : Array DefViewElabHeader) := do
     for header in headers, view in views do
-      if let some classNamesStx := view.deriving? then
-        for classNameStx in classNamesStx do
-          let className ← realizeGlobalConstNoOverload classNameStx
-          withRef classNameStx do
-            unless (← processDefDeriving className header.declName) do
-              throwError "failed to synthesize instance '{className}' for '{header.declName}'"
+      if let some classStxs := view.deriving? then
+        for classStx in classStxs do
+          withRef classStx <| withLogging <| withLCtx {} {} do
+            /-
+            Assumption: users intend delta deriving to apply to the body of a definition, even if in the source code
+            the function is written as a lambda expression.
+            Furthermore, we don't use `forallTelescope` because users want to derive instances for monads.
+
+            We enter the local context of this body, which is where `classStx` will be elaborated.
+
+            Small complication: we don't know the correlation between the section variables
+            and the parameters in the declaration, so for now we do not allow `classStx`
+            to refer to section variables that were not included.
+            -/
+            let info ← getConstInfo header.declName
+            lambdaTelescope info.value! fun xs _ => do
+              let decl := mkAppN (.const header.declName (info.levelParams.map mkLevelParam)) xs
+              processDefDeriving classStx decl
 
 /--
 Logs a snapshot task that waits for the entire snapshot tree in `defsParsedSnap` and then logs a
@@ -1353,8 +1370,7 @@ private def logGoalsAccomplishedSnapshotTask (views : Array DefView)
   let logGoalsAccomplishedTask ← BaseIO.mapTask (t := ← tree.waitAll) logGoalsAccomplishedAct
   Core.logSnapshotTask {
     stx? := none
-    -- Use first line of the mutual block to avoid covering the progress of the whole mutual block
-    reportingRange? := (← getRef).getPos?.map fun pos => ⟨pos, pos⟩
+    reportingRange := .skip
     task := logGoalsAccomplishedTask
     cancelTk? := none
   }
@@ -1374,7 +1390,9 @@ def elabMutualDef (ds : Array Syntax) : CommandElabM Unit := do
     let modifiers ← elabModifiers ⟨d[0]⟩
     if ds.size > 1 && modifiers.isNonrec then
       throwErrorAt d "invalid use of 'nonrec' modifier in 'mutual' block"
-    let mut view ← mkDefView modifiers d[1]
+    let mut view ←
+      withExporting (isExporting := modifiers.visibility.isInferredPublic (← getEnv)) do
+        mkDefView modifiers d[1]
     if view.kind != .example && view.value matches `(declVal| := rfl) then
       view := view.markDefEq
     let fullHeaderRef := mkNullNode #[d[0], view.headerRef]

src/Lean/Elab/MutualInductive.lean

@@ -558,7 +558,7 @@ This is likely a mistake. The correct solution would be `Type (max u 1)` rather
 but by this point it is impossible to rectify. So, for `u ≤ ?r + 1` we record the pair of `u` and `1`
 so that we can inform the user what they should have probably used instead.
 -/
-def accLevel (u : Level) (r : Level) (rOffset : Nat) : ExceptT MessageData (StateT AccLevelState Id) Unit := do
+private def accLevel (u : Level) (r : Level) (rOffset : Nat) : ExceptT MessageData (StateT AccLevelState Id) Unit := do
   go u rOffset
 where
   go (u : Level) (rOffset : Nat) : ExceptT MessageData (StateT AccLevelState Id) Unit := do
@@ -579,7 +579,7 @@ where
 /--
 Auxiliary function for `updateResultingUniverse`. Applies `accLevel` to the given constructor parameter.
 -/
-def accLevelAtCtor (ctorParam : Expr) (r : Level) (rOffset : Nat) : StateT AccLevelState TermElabM Unit := do
+private def accLevelAtCtor (ctorParam : Expr) (r : Level) (rOffset : Nat) : StateT AccLevelState TermElabM Unit := do
   let type ← inferType ctorParam
   let u ← instantiateLevelMVars (← getLevel type)
   match (← modifyGet fun s => accLevel u r rOffset |>.run |>.run s) with
@@ -1021,8 +1021,8 @@ private def applyComputedFields (indViews : Array InductiveView) : CommandElabM
     for {ref, fieldId, type, matchAlts, modifiers, ..} in indView.computedFields do
       computedFieldDefs := computedFieldDefs.push <| ← do
         let modifiers ← match modifiers with
-          | `(Lean.Parser.Command.declModifiersT| $[$doc:docComment]? $[$attrs:attributes]? $[$vis]? $[noncomputable]?) =>
-            `(Lean.Parser.Command.declModifiersT| $[$doc]? $[$attrs]? $[$vis]? noncomputable)
+          | `(Lean.Parser.Command.declModifiersT| $[$doc:docComment]? $[$attrs:attributes]? $[$vis]? $[protected%$protectedTk]? $[noncomputable]?) =>
+            `(Lean.Parser.Command.declModifiersT| $[$doc]? $[$attrs]? $[$vis]? $[protected%$protectedTk]? noncomputable)
           | _ => do
             withRef modifiers do logError "Unsupported modifiers for computed field"
             `(Parser.Command.declModifiersT| noncomputable)

src/Lean/Elab/StructInst.lean

@@ -502,7 +502,7 @@ private instance : ToMessageData ExpandedFieldVal where
 private instance : ToMessageData ExpandedField where
   toMessageData field := m!"field '{field.name}' is {field.val}"
 
-abbrev ExpandedFields := NameMap ExpandedField
+private abbrev ExpandedFields := NameMap ExpandedField
 
 /--
 Normalizes and expands the field views.

src/Lean/Elab/Structure.lean

@@ -233,11 +233,12 @@ private def expandCtor (structStx : Syntax) (structModifiers : Modifiers) (struc
     (forcePrivate : Bool) : TermElabM CtorView := do
   let useDefault := do
     let visibility := if forcePrivate then .private else .regular
+    let modifiers := { (default : Modifiers) with visibility }
     let declName := structDeclName ++ defaultCtorName
-    let declName ← applyVisibility visibility declName
+    let declName ← applyVisibility modifiers declName
     let ref := structStx[1].mkSynthetic
     addDeclarationRangesFromSyntax declName ref
-    pure { ref, declId := ref, modifiers := { (default : Modifiers) with visibility }, declName }
+    pure { ref, declId := ref, modifiers, declName }
   if structStx[4].isNone then
     useDefault
   else
@@ -273,7 +274,7 @@ private def expandCtor (structStx : Syntax) (structModifiers : Modifiers) (struc
         throwError m!"Constructor must be `private` because one or more of this structure's fields are `private`" ++ hint
       let name := ctor[1].getId
       let declName := structDeclName ++ name
-      let declName ← applyVisibility ctorModifiers.visibility declName
+      let declName ← applyVisibility ctorModifiers declName
       -- `binders` is type parameter binder overrides; this will be validated when the constructor is created in `Structure.mkCtor`.
       let binders := ctor[2]
       addDocString' declName ctorModifiers.docString?
@@ -379,7 +380,7 @@ private def expandFields (structStx : Syntax) (structModifiers : Modifiers) (str
       unless name.isAtomic do
         throwErrorAt ident "Invalid field name `{name.eraseMacroScopes}`: Field names must be atomic"
       let declName := structDeclName ++ name
-      let declName ← applyVisibility fieldModifiers.visibility declName
+      let declName ← applyVisibility fieldModifiers declName
       addDocString' declName fieldModifiers.docString?
       return views.push {
         ref        := ident
@@ -611,13 +612,11 @@ private def getFieldDefault? (structName : Name) (params : Array Expr) (fieldNam
   else
     return none
 
-private def toVisibility (fieldInfo : StructureFieldInfo) : CoreM Visibility := do
-  if isProtected (← getEnv) fieldInfo.projFn then
-    return Visibility.protected
-  else if isPrivateName fieldInfo.projFn then
-    return Visibility.private
-  else
-    return Visibility.regular
+private def toModifiers (fieldInfo : StructureFieldInfo) : CoreM Modifiers := do
+  return {
+    isProtected := isProtected (← getEnv) fieldInfo.projFn
+    visibility := if isPrivateName fieldInfo.projFn then .private else .regular
+  }
 
 mutual
 
@@ -654,7 +653,7 @@ private partial def withStructField (view : StructView) (sourceStructNames : Lis
        its default value is overridden, otherwise the `declName` is irrelevant, except to ensure a declaration is not already declared. -/
     let mut declName := view.declName ++ fieldName
     if inSubobject?.isNone then
-      declName ← applyVisibility (← toVisibility fieldInfo) declName
+      declName ← applyVisibility (← toModifiers fieldInfo) declName
       -- No need to validate links because this docstring was already added to the environment previously
       addDocStringCore' declName (← findDocString? (← getEnv) fieldInfo.projFn)
       addDeclarationRangesFromSyntax declName (← getRef)

src/Lean/Elab/Tactic/Config.lean

@@ -17,12 +17,12 @@ public section
 namespace Lean.Elab.Tactic
 open Meta Parser.Tactic Command
 
-private structure ConfigItemView where
+structure ConfigItemView where
   ref : Syntax
   option : Ident
   value : Term
   /-- Whether this was using `+`/`-`, to be able to give a better error message on type mismatch. -/
-  (bool : Bool := false)
+  bool : Bool := false
 
 /-- Interprets the `config` as an array of option/value pairs. -/
 def mkConfigItemViews (c : TSyntaxArray ``configItem) : Array ConfigItemView :=

src/Lean/Elab/Tactic/Do/Attr.lean

@@ -147,8 +147,7 @@ partial def computeMVarBetaPotentialForSPred (xs : Array Expr) (σs : Expr) (e :
     let s ← mkFreshExprMVar σ
     e := e.beta #[s]
     let (r, _) ← simp e ctx
-      -- In practice we only need to reduce `fun s => ...`, `SVal.curry` and functions that operate
-      -- on the state tuple bound by `SVal.curry`.
+      -- In practice we only need to reduce `fun s => ...` and `SPred.pure`.
       -- We could write a custom function should `simp` become a bottleneck.
     e := r.expr
     let count ← countBVarDependentMVars xs e

src/Lean/Elab/Tactic/Do/ProofMode/Exfalso.lean

@@ -20,7 +20,7 @@ open Lean Elab Tactic Meta
 -- set_option pp.all true in
 -- #check ⌜False⌝
 private def falseProp (u : Level) (σs : Expr) : Expr := -- ⌜False⌝ standing in for an empty conjunction of hypotheses
-  mkApp3 (mkConst ``SVal.curry [u]) (mkApp (mkConst ``ULift [u, 0]) (.sort .zero)) σs <| mkLambda `tuple .default (mkApp (mkConst ``SVal.StateTuple [u]) σs) (mkApp2 (mkConst ``ULift.up [u, 0]) (.sort .zero) (mkConst ``False))
+  SPred.mkPure u σs (mkConst ``False)
 
 @[builtin_tactic Lean.Parser.Tactic.mexfalso]
 def elabMExfalso : Tactic | _ => do

src/Lean/Elab/Tactic/Do/ProofMode/MGoal.lean

@@ -41,13 +41,10 @@ def SPred.mkType (u : Level) (σs : Expr) : Expr :=
 -- set_option pp.all true in
 -- #check ⌜True⌝
 def SPred.mkPure (u : Level) (σs : Expr) (p : Expr) : Expr :=
-  mkApp3 (mkConst ``SVal.curry [u]) (mkApp (mkConst ``ULift [u, 0]) (.sort .zero)) σs <|
-    mkLambda `tuple .default (mkApp (mkConst ``SVal.StateTuple [u]) σs) <|
-      mkApp2 (mkConst ``ULift.up [u, 0]) (.sort .zero) (Expr.liftLooseBVars p 0 1)
+  mkApp2 (mkConst ``SPred.pure [u]) σs p
 
 def SPred.isPure? : Expr → Option (Level × Expr × Expr)
-  | mkApp3 (.const ``SVal.curry [u]) (mkApp (.const ``ULift _) (.sort .zero)) σs <|
-      .lam _ _ (mkApp2 (.const ``ULift.up _) _ p) _ => some (u, σs, (Expr.lowerLooseBVars p 0 1))
+  | mkApp2 (.const ``SPred.pure [u]) σs p => some (u, σs, p)
   | _ => none
 
 def emptyHypName := `emptyHyp
@@ -91,10 +88,16 @@ def SPred.mkAnd (u : Level) (σs lhs rhs : Expr) : Expr × Expr :=
 def TypeList.mkType (u : Level) : Expr := mkApp (mkConst ``List [.succ u]) (mkSort (.succ u))
 def TypeList.mkNil (u : Level) : Expr := mkApp (mkConst ``List.nil [.succ u]) (mkSort (.succ u))
 def TypeList.mkCons (u : Level) (hd tl : Expr) : Expr := mkApp3 (mkConst ``List.cons [.succ u]) (mkSort (.succ u)) hd tl
+def TypeList.length (σs : Expr) : MetaM Nat := do
+  let mut σs ← whnfR σs
+  let mut n := 0
+  while σs.isAppOfArity ``List.cons 3 do
+    n := n+1
+    σs ← whnfR (σs.getArg! 2)
+  return n
 
 def parseAnd? (e : Expr) : Option (Level × Expr × Expr × Expr) :=
-      (e.getAppFn.constLevels![0]!, ·) <$> e.app3? ``SPred.and
-  <|> (0, TypeList.mkNil 0, ·) <$> e.app2? ``And
+  (e.getAppFn.constLevels![0]!, ·) <$> e.app3? ``SPred.and
 
 structure MGoal where
   u : Level
@@ -139,13 +142,20 @@ partial def MGoal.findHyp? (goal : MGoal) (name : Name) : Option (SubExpr.Pos ×
       else
         panic! "MGoal.findHyp?: hypothesis without proper metadata: {e}"
 
-def MGoal.checkProof (goal : MGoal) (prf : Expr) (suppressWarning : Bool := false) : MetaM Unit := do
-  check prf
-  let prf_type ← inferType prf
-  unless ← isDefEq goal.toExpr prf_type do
-    throwError "MGoal.checkProof: the proof and its supposed type did not match.\ngoal:  {goal.toExpr}\nproof: {prf_type}"
+def checkHasType (expr : Expr) (expectedType : Expr) (suppressWarning : Bool := false) : MetaM Unit := do
+  check expr
+  check expectedType
+  let exprType ← inferType expr
+  unless ← isDefEqGuarded exprType expectedType do
+    throwError "checkHasType: the expression's inferred type and its expected type did not match.\n
+      expr: {indentExpr expr}\n
+      has inferred type: {indentExpr exprType}\n
+      but the expected type was: {indentExpr expectedType}"
   unless suppressWarning do
-    logWarning m!"stray MGoal.checkProof {prf_type} {goal.toExpr}"
+    logWarning m!"stray checkHasType {expr} : {expectedType}"
+
+def MGoal.checkProof (goal : MGoal) (prf : Expr) (suppressWarning : Bool := false) : MetaM Unit := do
+  checkHasType prf goal.toExpr suppressWarning
 
 def getFreshHypName : TSyntax ``binderIdent → CoreM (Name × Syntax)
   | `(binderIdent| $name:ident) => pure (name.getId, name)

src/Lean/Elab/Tactic/Do/ProofMode/Pure.lean

@@ -9,6 +9,7 @@ prelude
 public import Std.Tactic.Do.Syntax
 public import Lean.Elab.Tactic.Do.ProofMode.MGoal
 public import Lean.Elab.Tactic.Do.ProofMode.Focus
+public import Lean.Elab.Tactic.Meta
 
 public section
 
@@ -53,3 +54,9 @@ def elabMPure : Tactic
   | _ => throwUnsupportedSyntax
 
 macro "mpure_intro" : tactic => `(tactic| apply Pure.intro)
+
+def MGoal.triviallyPure (goal : MGoal) : OptionT MetaM Expr := do
+  let mv ← mkFreshExprMVar goal.toExpr
+  let ([], _) ← try runTactic mv.mvarId! (← `(tactic| apply Pure.intro; trivial)) catch _ => failure
+    | failure
+  return mv

src/Lean/Elab/Tactic/Do/ProofMode/Refine.lean

@@ -48,16 +48,23 @@ partial def mRefineCore (goal : MGoal) (pat : MRefinePat) (k : MGoal → TSyntax
   | .tuple [p] => mRefineCore goal p k
   | .tuple (p::ps) => do
     let T ← whnfR goal.target
-    if let some (u, σs, T₁, T₂) := parseAnd? T.consumeMData then
+    let f := T.getAppFn'
+    let args := T.getAppArgs
+    trace[Meta.debug] "f: {f}, args: {args}"
+    if f.isConstOf ``SPred.and && args.size >= 3 then
+      let T₁ := args[1]!.beta args[3...*]
+      let T₂ := args[2]!.beta args[3...*]
       let prf₁ ← mRefineCore { goal with target := T₁ } p k
       let prf₂ ← mRefineCore { goal with target := T₂ } (.tuple ps) k
-      return mkApp6 (mkConst ``SPred.and_intro [u]) σs goal.hyps T₁ T₂ prf₁ prf₂
-    else if let some (α, σs, ψ) := T.app3? ``SPred.exists then
+      return mkApp6 (mkConst ``SPred.and_intro [goal.u]) goal.σs goal.hyps T₁ T₂ prf₁ prf₂
+    else if f.isConstOf ``SPred.exists && args.size >= 3 then
+      let α := args[0]!
+      let ψ := args[2]!
       let some witness ← patAsTerm p (some α) | throwError "pattern does not elaborate to a term to instantiate ψ"
-      let prf ← mRefineCore { goal with target := ψ.betaRev #[witness] } (.tuple ps) k
+      let prf ← mRefineCore { goal with target := ψ.beta (#[witness] ++ args[3...*]) } (.tuple ps) k
       let u ← getLevel α
-      return mkApp6 (mkConst ``SPred.exists_intro' [u, goal.u]) α σs goal.hyps ψ witness prf
-    else throwError "Neither a conjunction nor an existential quantifier {goal.target}"
+      return mkApp6 (mkConst ``SPred.exists_intro' [u, goal.u]) α goal.σs goal.hyps ψ witness prf
+    else throwError "Neither a conjunction nor an existential quantifier {T}"
 
 @[builtin_tactic Lean.Parser.Tactic.mrefine]
 def elabMRefine : Tactic

src/Lean/Elab/Tactic/Do/Spec.lean

@@ -96,11 +96,11 @@ partial def dischargeFailEntails (u : Level) (ps : Expr) (Q : Expr) (Q' : Expr)
   if ps.isAppOf ``PostShape.pure then
     return mkConst ``True.intro
   if ← isDefEq Q Q' then
-    return mkApp2 (mkConst ``FailConds.entails.refl [u]) ps Q
-  if ← isDefEq Q (mkApp (mkConst ``FailConds.false [u]) ps) then
-    return mkApp2 (mkConst ``FailConds.entails_false [u]) ps Q'
-  if ← isDefEq Q' (mkApp (mkConst ``FailConds.true [u]) ps) then
-    return mkApp2 (mkConst ``FailConds.entails_true [u]) ps Q
+    return mkApp2 (mkConst ``ExceptConds.entails.refl [u]) ps Q
+  if ← isDefEq Q (mkApp (mkConst ``ExceptConds.false [u]) ps) then
+    return mkApp2 (mkConst ``ExceptConds.entails_false [u]) ps Q'
+  if ← isDefEq Q' (mkApp (mkConst ``ExceptConds.true [u]) ps) then
+    return mkApp2 (mkConst ``ExceptConds.entails_true [u]) ps Q
   -- the remaining cases are recursive.
   if let some (_σ, ps) := ps.app2? ``PostShape.arg then
     return ← dischargeFailEntails u ps Q Q' goalTag
@@ -117,31 +117,29 @@ partial def dischargeFailEntails (u : Level) (ps : Expr) (Q : Expr) (Q' : Expr)
     let prf₂ ← dischargeFailEntails u ps (← mkProj' ``Prod 1 Q) (← mkProj' ``Prod 1 Q') (goalTag ++ `except)
     return ← mkAppM ``And.intro #[prf₁, prf₂] -- This is just a bit too painful to construct by hand
   -- This case happens when decomposing with unknown `ps : PostShape`
-  mkFreshExprSyntheticOpaqueMVar (mkApp3 (mkConst ``FailConds.entails [u]) ps Q Q') goalTag
+  mkFreshExprSyntheticOpaqueMVar (mkApp3 (mkConst ``ExceptConds.entails [u]) ps Q Q') goalTag
 end
 
 def dischargeMGoal (goal : MGoal) (goalTag : Name) : n Expr := do
   liftMetaM <| do trace[Elab.Tactic.Do.spec] "dischargeMGoal: {goal.target}"
   -- simply try one of the assumptions for now. Later on we might want to decompose conjunctions etc; full xsimpl
   -- The `withDefault` ensures that a hyp `⌜s = 4⌝` can be used to discharge `⌜s = 4⌝ s`.
-  -- (Recall that `⌜s = 4⌝ s` is `SVal.curry (σs:=[Nat]) (fun _ => s = 4) s` and `SVal.curry` is
+  -- (Recall that `⌜s = 4⌝ s` is `SPred.pure (σs:=[Nat]) (s = 4) s` and `SPred.pure` is
   -- semi-reducible.)
-  let some prf ← liftMetaM (withDefault <| goal.assumption <|> goal.assumptionPure)
+  -- We also try `mpure_intro; trivial` through `goal.triviallyPure` here because later on an
+  -- assignment like `⌜s = ?c⌝` becomes impossible to discharge because `?c` will get abstracted
+  -- over local bindings that depend on synthetic opaque MVars (such as loop invariants), and then
+  -- the type of the new `?c` will not be defeq to itself. A bug, but we need to work around it for
+  -- now.
+  let some prf ← liftMetaM (withDefault <| goal.assumption <|> goal.assumptionPure <|> goal.triviallyPure)
     | mkFreshExprSyntheticOpaqueMVar goal.toExpr goalTag
   liftMetaM <| do trace[Elab.Tactic.Do.spec] "proof: {prf}"
   return prf
 
-def mkPreTag (goalTag : Name) : Name := Id.run do
-  let dflt := goalTag ++ `pre1
-  let .str p s := goalTag | return dflt
-  unless "pre".isPrefixOf s do return dflt
-  let some n := (s.toSubstring.drop 3).toString.toNat? | return dflt
-  return .str p ("pre" ++ toString (n + 1))
-
 /--
   Returns the proof and the list of new unassigned MVars.
 -/
-def mSpec (goal : MGoal) (elabSpecAtWP : Expr → n SpecTheorem) (goalTag : Name) (mkPreTag := mkPreTag) : n Expr := do
+def mSpec (goal : MGoal) (elabSpecAtWP : Expr → n SpecTheorem) (goalTag : Name) : n Expr := do
   -- First instantiate `fun s => ...` in the target via repeated `mintro ∀s`.
   mIntroForallN goal goal.target.consumeMData.getNumHeadLambdas fun goal => do
   -- Elaborate the spec for the wp⟦e⟧ app in the target
@@ -151,11 +149,8 @@ def mSpec (goal : MGoal) (elabSpecAtWP : Expr → n SpecTheorem) (goalTag : Name
   let wp := T.getArg! 2
   let specThm ← elabSpecAtWP wp
 
-  -- The precondition of `specThm` might look like `⌜?n = ‹Nat›ₛ ∧ ?m = ‹Bool›ₛ⌝`, which expands to
-  -- `SVal.curry (fun tuple => ?n = SVal.uncurry (getThe Nat tuple) ∧ ?m = SVal.uncurry (getThe Bool tuple))`.
-  -- Note that the assignments for `?n` and `?m` depend on the bound variable `tuple`.
-  -- Here, we further eta expand and simplify according to `etaPotential` so that the solutions for
-  -- `?n` and `?m` do not depend on `tuple`.
+  -- The precondition of `specThm` might look like `⌜?n = nₛ ∧ ?m = b⌝`, which expands to
+  -- `SPred.pure (?n = n ∧ ?m = b)`.
   let residualEta := specThm.etaPotential - (T.getAppNumArgs - 4) -- 4 arguments expected for PredTrans.apply
   mIntroForallN goal residualEta fun goal => do
 
@@ -196,7 +191,7 @@ def mSpec (goal : MGoal) (elabSpecAtWP : Expr → n SpecTheorem) (goalTag : Name
   if !HPRfl then
     -- let P := (← reduceProjBeta? P).getD P
     -- Try to avoid creating a longer name if the postcondition does not need to create a goal
-    let tag := if !QQ'Rfl then mkPreTag goalTag else goalTag
+    let tag := if !QQ'Rfl then goalTag ++ `pre else goalTag
     let HPPrf ← dischargeMGoal { goal with target := P } tag
     prePrf := mkApp6 (mkConst ``SPred.entails.trans [u]) goal.σs goal.hyps P goal.target HPPrf