diff --git a/analysis/src/process_cmt.ml b/analysis/src/process_cmt.ml
index 36885df126..18d854a524 100644
--- a/analysis/src/process_cmt.ml
+++ b/analysis/src/process_cmt.ml
@@ -535,7 +535,9 @@ let rec for_structure_item ~(env : Shared_types.Env.t) ~(exported : Exported.t)
         |> List.iter (fun {Typedtree.tdp_pattern} ->
             handle_pattern [] tdp_pattern)
       | Tpat_variant (_, Some p, _) -> handle_pattern [] p
-      | Tpat_variant (_, None, _) | Tpat_any | Tpat_constant _ -> ()
+      | Tpat_variant (_, None, _) | Tpat_any | Tpat_constant _ | Tpat_interval _
+        ->
+        ()
     in
     List.iter
       (fun {Typedtree.vb_pat; vb_attributes} ->
diff --git a/changes/char-range-patterns.polish.md b/changes/char-range-patterns.polish.md
new file mode 100644
index 0000000000..8eb7ca148b
--- /dev/null
+++ b/changes/char-range-patterns.polish.md
@@ -0,0 +1 @@
+- Char range patterns such as `'\u{0}' .. '\u{10FFFF}'` compile as fast as a single character, and missing-case warnings show ranges instead of listing every character.
diff --git a/compiler/common/pattern_printer.ml b/compiler/common/pattern_printer.ml
index 62672ce0c9..934106b2c8 100644
--- a/compiler/common/pattern_printer.ml
+++ b/compiler/common/pattern_printer.ml
@@ -66,6 +66,8 @@ let untype typed =
     | Tpat_or (pa, pb, _) -> mkpat (Ppat_or (loop pa, loop pb))
     | Tpat_any | Tpat_var _ -> mkpat Ppat_any
     | Tpat_constant c -> mkpat (Ppat_constant (Untypeast.constant c))
+    | Tpat_interval (c1, c2) ->
+      mkpat (Ppat_interval (Untypeast.constant c1, Untypeast.constant c2))
     | Tpat_alias (p, _, _) -> loop p
     | Tpat_tuple lst -> mkpat (Ppat_tuple (List.map loop lst))
     | Tpat_construct (cstr_lid, cstr, lst) ->
@@ -109,9 +111,9 @@ let untype typed =
         | Tpat_construct (_, cstr, [value]) when cstr.cstr_name = "Some" ->
           Some
             {pdp_key = tdp_key; pdp_pattern = loop value; pdp_optional = false}
-        | Tpat_var _ | Tpat_alias _ | Tpat_constant _ | Tpat_tuple _
-        | Tpat_construct _ | Tpat_variant _ | Tpat_record _ | Tpat_dict _
-        | Tpat_array _ | Tpat_or _ ->
+        | Tpat_var _ | Tpat_alias _ | Tpat_constant _ | Tpat_interval _
+        | Tpat_tuple _ | Tpat_construct _ | Tpat_variant _ | Tpat_record _
+        | Tpat_dict _ | Tpat_array _ | Tpat_or _ ->
           Some
             {
               pdp_key = tdp_key;
diff --git a/compiler/ext/config.ml b/compiler/ext/config.ml
index 8b9658a611..86d5a2dcca 100644
--- a/compiler/ext/config.ml
+++ b/compiler/ext/config.ml
@@ -13,7 +13,7 @@ and ast0_impl_magic_number = "Caml1999M022"
 
 and ast0_intf_magic_number = "Caml1999N022"
 
-and cmt_magic_number = "Caml1999T045"
+and cmt_magic_number = "Caml1999T046"
 
 let get_load_path () = (Compiler_request_state.current ()).load_path
 let set_load_path path = (Compiler_request_state.current ()).load_path <- path
diff --git a/compiler/ml/dict_pattern.ml b/compiler/ml/dict_pattern.ml
index f2da66f3f5..a5259e65bd 100644
--- a/compiler/ml/dict_pattern.ml
+++ b/compiler/ml/dict_pattern.ml
@@ -9,7 +9,9 @@ open Typedtree
 let rec contains_dict p =
   match p.pat_desc with
   | Tpat_dict _ -> true
-  | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_, None, _) -> false
+  | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_interval _
+  | Tpat_variant (_, None, _) ->
+    false
   | Tpat_alias (p, _, _) | Tpat_variant (_, Some p, _) -> contains_dict p
   | Tpat_tuple ps | Tpat_construct (_, _, ps) | Tpat_array ps ->
     List.exists contains_dict ps
diff --git a/compiler/ml/matching.ml b/compiler/ml/matching.ml
index 0cdbb1b9fc..71643a0ab5 100644
--- a/compiler/ml/matching.ml
+++ b/compiler/ml/matching.ml
@@ -182,6 +182,16 @@ let ctx_matcher p =
         (p, args @ rem)
       | Tpat_any -> (p, omegas @ rem)
       | _ -> raise NoMatch)
+  | (Tpat_constant _ | Tpat_interval _) when Parmatch.int_range p <> None -> (
+    fun (* [p] is a piece of a split column; values matched by a context range
+       that overlaps it may reach it. *)
+          q
+      rem
+    ->
+      match q.pat_desc with
+      | (Tpat_constant _ | Tpat_interval _) when may_compat p q -> (p, rem)
+      | Tpat_any -> (p, rem)
+      | _ -> raise NoMatch)
   | Tpat_constant cst -> (
     fun q rem ->
       match q.pat_desc with
@@ -661,7 +671,8 @@ let rec extract_vars r p =
   | Tpat_array pats -> List.fold_left extract_vars r pats
   | Tpat_variant (_, Some p, _) -> extract_vars r p
   | Tpat_or (p, _, _) -> extract_vars r p
-  | Tpat_constant _ | Tpat_any | Tpat_variant (_, None, _) -> r
+  | Tpat_constant _ | Tpat_interval _ | Tpat_any | Tpat_variant (_, None, _) ->
+    r
 
 exception Cannot_flatten
 
@@ -701,7 +712,7 @@ let pat_as_constr = function
   | _ -> fatal_error "Matching.pat_as_constr"
 
 let group_constant = function
-  | {pat_desc = Tpat_constant _} -> true
+  | {pat_desc = Tpat_constant _ | Tpat_interval _} -> true
   | _ -> false
 
 and group_constructor = function
@@ -731,7 +742,7 @@ and group_array = function
 let get_group p =
   match p.pat_desc with
   | Tpat_any -> group_var
-  | Tpat_constant _ -> group_constant
+  | Tpat_constant _ | Tpat_interval _ -> group_constant
   | Tpat_construct _ -> group_constructor
   | Tpat_tuple _ -> group_tuple
   | Tpat_record _ -> group_record
@@ -739,9 +750,19 @@ let get_group p =
   | Tpat_variant (_, _, _) -> group_variant
   | _ -> fatal_error "Matching.get_group"
 
-let is_or p =
+(* A row starting with an or-pattern. An interval is precompiled like an
+   or-pattern of its values when the rest of its row tests something: that is
+   then compiled once, in a handler, instead of once per piece of the column. *)
+let is_or p ps =
   match p.pat_desc with
   | Tpat_or _ -> true
+  | Tpat_interval _ ->
+    List.exists
+      (fun q ->
+        match q.pat_desc with
+        | Tpat_any | Tpat_var _ -> false
+        | _ -> true)
+      ps
   | _ -> false
 
 (* Conditions for appending to the Or matrix *)
@@ -752,7 +773,7 @@ and condb (act : action) ps qs = act.guard = None && Parmatch.le_pats qs ps
 let or_ok p ps l =
   List.for_all
     (function
-      | ({pat_desc = Tpat_or _} as q) :: qs, act -> conda p q || condb act ps qs
+      | q :: qs, act when is_or q qs -> conda p q || condb act ps qs
       | _ -> true)
     l
 
@@ -772,7 +793,7 @@ let rec get_equiv p l =
 let insert_or_append p ps act ors no =
   let rec attempt seen = function
     | ((q :: qs, act_q) as cl) :: rem ->
-      if is_or q then
+      if is_or q qs then
         if may_compat p q then
           if
             Set_ident.is_empty (extract_vars Set_ident.empty p)
@@ -858,7 +879,7 @@ let rec split_or argo cls args def =
     | [] -> cons_next (List.rev before) (List.rev ors) (List.rev no)
     | ((p :: ps, act) as cl) :: rem ->
       if up_ok cl no then
-        if is_or p then
+        if is_or p ps then
           let ors, no = insert_or_append p ps act ors no in
           do_split before ors no rem
         else if up_ok cl ors then do_split (cl :: before) ors no rem
@@ -1067,7 +1088,7 @@ and precompile_or argo cls ors args def k =
   | [] -> split_constr cls args def k
   | _ ->
     let rec do_cases = function
-      | (({pat_desc = Tpat_or _} as orp) :: patl, action) :: rem ->
+      | (orp :: patl, action) :: rem when is_or orp patl ->
         let others, rem = get_equiv orp rem in
         let orpm =
           {
@@ -1202,16 +1223,32 @@ let divide_line make_ctx make get_args pat ctx pm =
    new  ``pattern_matching'' records.
 *)
 
-let rec matcher_const cst p rem =
+(* The key of a constant column is a range of constants: [(c, c)] for a
+   constant [c], and the bounds of a piece of a split interval column. *)
+let int_key = function
+  | ( (Asttypes.Const_int lo | Const_char lo),
+      (Asttypes.Const_int hi | Const_char hi) ) ->
+    Some (lo, hi)
+  | _ -> None
+
+let rec matcher_const ((c1, c2) as key) p rem =
   match p.pat_desc with
   | Tpat_or (p1, p2, _) -> (
-    try matcher_const cst p1 rem with NoMatch -> matcher_const cst p2 rem)
-  | Tpat_constant c1 when const_compare c1 cst = 0 -> rem
+    try matcher_const key p1 rem with NoMatch -> matcher_const key p2 rem)
+  | (Tpat_constant _ | Tpat_interval _) when Parmatch.int_range p <> None -> (
+    match (int_key key, Parmatch.int_range p) with
+    | Some (lo, hi), Some (a, b) ->
+      if a <= lo && hi <= b then rem
+      else if b < lo || hi < a then raise NoMatch
+      else fatal_error "Matching.matcher_const: range across a piece"
+    | _ -> raise NoMatch)
+  | Tpat_constant c when const_compare c c1 = 0 && const_compare c c2 = 0 -> rem
   | Tpat_any -> rem
   | _ -> raise NoMatch
 
 let get_key_constant caller = function
-  | {pat_desc = Tpat_constant cst} -> cst
+  | {pat_desc = Tpat_constant cst} -> (cst, cst)
+  | {pat_desc = Tpat_interval (lo, hi)} -> (lo, hi)
   | p ->
     prerr_endline ("BAD: " ^ caller);
     pretty_pat p;
@@ -1226,16 +1263,94 @@ let make_constant_matching p def ctx = function
     and ctx = filter_ctx p ctx in
     {pm = {cases = []; args = argl; default = def}; ctx; pat = normalize_pat p}
 
+(* The int and char ranges of the first column of the cases and of the default
+   matrices, when one of them is an interval. *)
+let column_int_ranges m =
+  let has_interval = ref false in
+  let rec heads p acc =
+    match p.pat_desc with
+    | Tpat_alias (p, _, _) -> heads p acc
+    | Tpat_or (p1, p2, _) -> heads p1 (heads p2 acc)
+    | _ -> (
+      (match p.pat_desc with
+      | Tpat_interval _ -> has_interval := true
+      | _ -> ());
+      match Parmatch.int_range p with
+      | Some r -> r :: acc
+      | None -> acc)
+  in
+  let rows acc pss =
+    List.fold_left
+      (fun acc -> function
+        | p :: _ -> heads p acc
+        | [] -> acc)
+      acc pss
+  in
+  let ranges = rows [] (List.map fst m.cases) in
+  let ranges =
+    List.fold_left (fun acc (pss, _) -> rows acc pss) ranges m.default
+  in
+  if !has_interval then Some ranges else None
+
+(* Divides a column with intervals into pieces cut at the bounds of all its
+   ranges, so that each range covers whole pieces. A case goes to every piece
+   its head covers; the number of pieces depends on the number of patterns,
+   not on the width of the ranges. *)
+let divide_constant_ranges ranges ctx m =
+  let cuts =
+    List.fold_left (fun acc (lo, hi) -> lo :: (hi + 1) :: acc) [] ranges
+    |> List.sort_uniq compare |> Array.of_list
+  in
+  let n = Array.length cuts - 1 in
+  let index x =
+    (* position of [x] in [cuts] *)
+    let rec search lo hi =
+      let mid = (lo + hi) / 2 in
+      if cuts.(mid) = x then mid
+      else if cuts.(mid) < x then search (mid + 1) hi
+      else search lo (mid - 1)
+    in
+    search 0 n
+  in
+  let rows = Array.make n [] and heads = Array.make n None in
+  List.iter
+    (fun (patl, action) ->
+      match patl with
+      | p :: patl -> (
+        match Parmatch.int_range p with
+        | Some (lo, hi) ->
+          for i = index lo to index (hi + 1) - 1 do
+            rows.(i) <- (get_args_constant p patl, action) :: rows.(i);
+            if heads.(i) = None then heads.(i) <- Some p
+          done
+        | None -> ignore (get_key_constant "divide" p))
+      | [] -> fatal_error "Matching.divide_constant_ranges")
+    m.cases;
+  let cells = ref [] in
+  for i = n - 1 downto 0 do
+    match heads.(i) with
+    | Some p ->
+      let p = Parmatch.make_int_range p cuts.(i) (cuts.(i + 1) - 1) in
+      let cell = make_constant_matching p m.default ctx m.args in
+      cell.pm.cases <- List.rev rows.(i);
+      cells := (get_key_constant "divide" p, cell) :: !cells
+    | None -> ()
+  done;
+  !cells
+
 let divide_constant ctx m =
-  divide
-    ~hash_key:(function
-      | (Asttypes.Const_int _ | Const_char _ | Const_string _) as c ->
-        Some (Parmatch.const_key c)
-      | Const_float _ | Const_bigint _ -> None)
-    make_constant_matching
-    (fun c d -> const_compare c d = 0)
-    (get_key_constant "divide")
-    get_args_constant ctx m
+  match column_int_ranges m with
+  | Some ranges -> divide_constant_ranges ranges ctx m
+  | None ->
+    divide
+      ~hash_key:(function
+        | ((Asttypes.Const_int _ | Const_char _ | Const_string _) as c), _ ->
+          Some (Parmatch.const_key c)
+        | (Const_float _ | Const_bigint _), _ -> None)
+      make_constant_matching
+      (fun (c, _) (d, _) -> const_compare c d = 0)
+      (get_key_constant "divide")
+      get_args_constant ctx m
 
 (* Matching against a constructor *)
 
@@ -1355,7 +1470,7 @@ let make_constr_matching p def ctx = function
    untagged case binds its argument only once its type test has passed. *)
 let rec rejects_nested_some p =
   match p.pat_desc with
-  | Tpat_any | Tpat_constant _ -> true
+  | Tpat_any | Tpat_constant _ | Tpat_interval _ -> true
   | Tpat_or (p1, p2, _) -> rejects_nested_some p1 && rejects_nested_some p2
   | Tpat_construct (_, cstr, _) -> (
     match cstr.cstr_kind with
@@ -1816,19 +1931,22 @@ open Switch
 
 let rec last def = function
   | [] -> def
-  | [(x, _)] -> x
+  | [(_, x, _)] -> x
   | _ :: rem -> last def rem
 
 let get_edges low high l =
   match l with
   | [] -> (low, high)
-  | (x, _) :: _ -> (x, last high l)
+  | (x, _, _) :: _ -> (x, last high l)
 
 let as_interval_canfail fail low high l =
   let store = Store_exp.mk_store () in
 
-  let do_store _tag act =
-    let i = store.act_store act in
+  (* The action of a range [i .. j] is used for each of its values. Storing it
+     as shared emits it once, as an expanded range sharing the action of each
+     value used to; copies would declare its variables twice. *)
+  let do_store _tag i j act =
+    let i = if i < j then store.act_store_shared act else store.act_store act in
     (*
     eprintf "STORE [%s] %i %s\n" tag i (string_of_lam act) ;
 *)
@@ -1839,37 +1957,37 @@ let as_interval_canfail fail low high l =
     | [] ->
       if cur_high = high then [(cur_low, cur_high, cur_act)]
       else [(cur_low, cur_high, cur_act); (cur_high + 1, high, 0)]
-    | (i, act_i) :: rem as all ->
-      let act_index = do_store "NO" act_i in
+    | (i, j, act_i) :: rem as all ->
+      let act_index = do_store "NO" i j act_i in
       if cur_high + 1 = i then
-        if act_index = cur_act then nofail_rec cur_low i cur_act rem
-        else if act_index = 0 then (cur_low, i - 1, cur_act) :: fail_rec i i rem
-        else (cur_low, i - 1, cur_act) :: nofail_rec i i act_index rem
+        if act_index = cur_act then nofail_rec cur_low j cur_act rem
+        else if act_index = 0 then (cur_low, i - 1, cur_act) :: fail_rec i j rem
+        else (cur_low, i - 1, cur_act) :: nofail_rec i j act_index rem
       else if act_index = 0 then
         (cur_low, cur_high, cur_act)
         :: fail_rec (cur_high + 1) (cur_high + 1) all
       else
         (cur_low, cur_high, cur_act)
         :: (cur_high + 1, i - 1, 0)
-        :: nofail_rec i i act_index rem
+        :: nofail_rec i j act_index rem
   and fail_rec cur_low cur_high = function
     | [] -> [(cur_low, cur_high, 0)]
-    | (i, act_i) :: rem ->
-      let index = do_store "YES" act_i in
-      if index = 0 then fail_rec cur_low i rem
-      else (cur_low, i - 1, 0) :: nofail_rec i i index rem
+    | (i, j, act_i) :: rem ->
+      let index = do_store "YES" i j act_i in
+      if index = 0 then fail_rec cur_low j rem
+      else (cur_low, i - 1, 0) :: nofail_rec i j index rem
   in
 
   let init_rec = function
     | [] -> [(low, high, 0)]
-    | (i, act_i) :: rem ->
-      let index = do_store "INIT" act_i in
-      if index = 0 then fail_rec low i rem
-      else if low < i then (low, i - 1, 0) :: nofail_rec i i index rem
-      else nofail_rec i i index rem
+    | (i, j, act_i) :: rem ->
+      let index = do_store "INIT" i j act_i in
+      if index = 0 then fail_rec low j rem
+      else if low < i then (low, i - 1, 0) :: nofail_rec i j index rem
+      else nofail_rec i j index rem
   in
 
-  assert (do_store "FAIL" fail = 0);
+  assert (do_store "FAIL" 0 0 fail = 0);
   (* fail has action index 0 *)
   let r = init_rec l in
   (Array.of_list r, store)
@@ -1878,28 +1996,30 @@ let as_interval_nofail l =
   let store = Store_exp.mk_store () in
   let rec some_hole = function
     | [] | [_] -> false
-    | (i, _) :: ((j, _) :: _ as rem) -> j > i + 1 || some_hole rem
+    | (_, i, _) :: ((j, _, _) :: _ as rem) -> j > i + 1 || some_hole rem
   in
   let rec i_rec cur_low cur_high cur_act = function
     | [] -> [(cur_low, cur_high, cur_act)]
-    | (i, act) :: rem ->
-      let act_index = store.act_store act in
-      if act_index = cur_act then i_rec cur_low i cur_act rem
-      else (cur_low, cur_high, cur_act) :: i_rec i i act_index rem
+    | (i, j, act) :: rem ->
+      let act_index =
+        if i < j then store.act_store_shared act else store.act_store act
+      in
+      if act_index = cur_act then i_rec cur_low j cur_act rem
+      else (cur_low, cur_high, cur_act) :: i_rec i j act_index rem
   in
   let inters =
     match l with
-    | (i, act) :: rem ->
+    | (i, j, act) :: rem ->
       let act_index =
         (* In case there is some hole and that a switch is emitted,
            action 0 will be used as the action of unreachable
            cases (cf. switch.ml, make_switch).
            Hence, this action will be shared *)
-        if some_hole rem then store.act_store_shared act
+        if some_hole rem || i < j then store.act_store_shared act
         else store.act_store act
       in
       assert (act_index = 0);
-      i_rec i i act_index rem
+      i_rec i j act_index rem
     | _ -> assert false
   in
 
@@ -1910,17 +2030,27 @@ let sort_int_lambda_list l =
     (fun (i1, _) (i2, _) -> if i1 < i2 then -1 else if i2 < i1 then 1 else 0)
     l
 
-let as_interval fail low high l =
-  let l = sort_int_lambda_list l in
+(* [l] maps disjoint ranges [lo .. hi] to actions *)
+let as_interval_ranges fail low high l =
+  let l = List.sort (fun (i1, _, _) (i2, _, _) -> compare i1 i2) l in
   ( get_edges low high l,
     match fail with
     | None -> as_interval_nofail l
     | Some act -> as_interval_canfail act low high l )
 
-let call_switcher fail arg low high int_lambda_list =
-  let edges, (cases, actions) = as_interval fail low high int_lambda_list in
+let as_interval fail low high l =
+  as_interval_ranges fail low high (List.map (fun (i, act) -> (i, i, act)) l)
+
+let call_switcher_ranges fail arg low high range_lambda_list =
+  let edges, (cases, actions) =
+    as_interval_ranges fail low high range_lambda_list
+  in
   Switch.zyva edges arg cases actions
 
+let call_switcher fail arg low high int_lambda_list =
+  call_switcher_ranges fail arg low high
+    (List.map (fun (i, act) -> (i, i, act)) int_lambda_list)
+
 let rec list_as_pat = function
   | [] -> fatal_error "Matching.list_as_pat"
   | [pat] -> pat
@@ -2003,24 +2133,29 @@ let combine_constant loc arg cst partial ctx def
   let lambda1 =
     match (cst : Asttypes.constant) with
     | Const_int _ | Const_char _ ->
-      (* [char] is an alias of [int], so a column can mix both. *)
-      let int_lambda_list =
+      (* [char] is an alias of [int], so a column can mix both. Its keys are
+         ranges. *)
+      let range_lambda_list =
         List.map
-          (function
-            | (Asttypes.Const_int n | Const_char n), l -> (n, l)
-            | _ -> assert false)
+          (fun (key, l) ->
+            match int_key key with
+            | Some (lo, hi) -> (lo, hi, l)
+            | None -> assert false)
           const_lambda_list
       in
       (* Match intervals must use ReScript's int32 bounds, not the host's.
          Otherwise the upper fail interval starts at 2147483648, which wraps
          when converted to a Lambda integer constant. *)
-      call_switcher fail arg int32_low int32_high int_lambda_list
+      call_switcher_ranges fail arg int32_low int32_high range_lambda_list
     | Const_string _ ->
       (* Note as the bytecode compiler may resort to dichotomic search,
          the clauses of stringswitch  are sorted with duplicates removed.
          This partly applies to the native code compiler, which requires
          no duplicates *)
-      let const_lambda_list = sort_lambda_list const_lambda_list in
+      let const_lambda_list =
+        sort_lambda_list
+          (List.map (fun ((c, _), l) -> (c, l)) const_lambda_list)
+      in
       let sw =
         List.map
           (fun (c, act) ->
@@ -2033,10 +2168,10 @@ let combine_constant loc arg cst partial ctx def
       hs (stringswitch arg sw fail)
     | Const_float _ ->
       make_test_sequence loc fail (Pfloatcomp Cneq) (Pfloatcomp Clt) arg
-        const_lambda_list
+        (List.map (fun ((c, _), l) -> (c, l)) const_lambda_list)
     | Const_bigint _ ->
       make_test_sequence loc fail (Pbigintcomp Cneq) (Pbigintcomp Clt) arg
-        const_lambda_list
+        (List.map (fun ((c, _), l) -> (c, l)) const_lambda_list)
   in
   (lambda1, jumps_union local_jumps total)
 
@@ -2691,7 +2826,7 @@ and do_compile_matching repr partial ctx arg pmh =
       compile_no_test
         (divide_record lbl.lbl_all (normalize_pat pat))
         ctx_combine repr partial ctx pm
-    | Tpat_constant cst ->
+    | Tpat_constant cst | Tpat_interval (cst, _) ->
       compile_test
         (compile_match repr partial)
         partial divide_constant
@@ -2763,7 +2898,8 @@ let find_in_pat pred =
     | Tpat_dict entries ->
       List.exists (fun {tdp_pattern} -> find_rec tdp_pattern) entries
     | Tpat_or (p, q, _) -> find_rec p || find_rec q
-    | Tpat_constant _ | Tpat_var _ | Tpat_any | Tpat_variant (_, None, _) ->
+    | Tpat_constant _ | Tpat_interval _ | Tpat_var _ | Tpat_any
+    | Tpat_variant (_, None, _) ->
       false
   in
   find_rec
@@ -2778,8 +2914,8 @@ let have_mutable_field p =
         | Immutable -> false)
       lps
   | Tpat_alias _ | Tpat_variant _ | Tpat_tuple _ | Tpat_construct _
-  | Tpat_dict _ | Tpat_array _ | Tpat_or _ | Tpat_constant _ | Tpat_var _
-  | Tpat_any ->
+  | Tpat_dict _ | Tpat_array _ | Tpat_or _ | Tpat_constant _ | Tpat_interval _
+  | Tpat_var _ | Tpat_any ->
     false
 
 let is_mutable p = find_in_pat have_mutable_field p
diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml
index 643be60632..39b8ccf23f 100644
--- a/compiler/ml/parmatch.ml
+++ b/compiler/ml/parmatch.ml
@@ -116,6 +116,55 @@ let zero = make_pat (Tpat_constant (Const_int 0)) Ctype.none Env.empty
    when an "incoherence" is not detected by this check.
 *)
 
+(* The values matched by an int or char constant or interval, as bounds. *)
+let int_range p =
+  match p.pat_desc with
+  | Tpat_constant (Const_int i | Const_char i) -> Some (i, i)
+  | Tpat_interval
+      ((Const_int lo | Const_char lo), (Const_int hi | Const_char hi)) ->
+    Some (lo, hi)
+  | _ -> None
+
+(* A constant or interval for [lo .. hi], of the same kind as [p]: chars when
+   [p] starts with a char and the bounds can be written as char literals. *)
+let make_int_range p lo hi =
+  let chars =
+    Uchar.is_valid lo && Uchar.is_valid hi
+    &&
+    match p.pat_desc with
+    | Tpat_constant (Const_char _) | Tpat_interval (Const_char _, _) -> true
+    | _ -> false
+  in
+  let const i = if chars then Const_char i else Const_int i in
+  let desc =
+    if lo = hi then Tpat_constant (const lo)
+    else Tpat_interval (const lo, const hi)
+  in
+  {p with pat_desc = desc; pat_extra = []}
+
+(* Splits interval [q] at the bounds of the ranges in [column], so that each
+   piece is either inside or outside each of them. A constant is one piece. *)
+let split_int_range q column =
+  match (q.pat_desc, int_range q) with
+  | Tpat_interval _, Some (lo, hi) ->
+    let cuts =
+      List.fold_left
+        (fun cuts p ->
+          match int_range p with
+          | Some (a, b) ->
+            let cuts = if lo < a && a <= hi then a :: cuts else cuts in
+            if b < hi && lo <= b then (b + 1) :: cuts else cuts
+          | None -> cuts)
+        [] column
+      |> List.sort_uniq compare
+    in
+    let rec pieces lo = function
+      | [] -> [make_int_range q lo hi]
+      | c :: cuts -> make_int_range q lo (c - 1) :: pieces c cuts
+    in
+    pieces lo cuts
+  | _ -> [q]
+
 let simplify_head_pat p k =
   let rec simplify_head_pat p k =
     match p.pat_desc with
@@ -164,6 +213,9 @@ let all_coherent column =
           | Const_string _ ),
           _ ) ->
         false)
+    | (Tpat_constant _ | Tpat_interval _), (Tpat_constant _ | Tpat_interval _)
+      ->
+      int_range hp1 <> None && int_range hp2 <> None
     | Tpat_tuple l1, Tpat_tuple l2 -> List.length l1 = List.length l2
     | ( Tpat_record ((_, lbl1, _, _) :: _, _, _),
         Tpat_record ((_, lbl2, _, _) :: _, _, _) ) ->
@@ -315,6 +367,11 @@ module Compat = struct
     | Tpat_variant (l1, op1, _), Tpat_variant (l2, op2, _) ->
       l1 = l2 && ocompat ~equal_cd op1 op2
     | Tpat_constant c1, Tpat_constant c2 -> const_compare c1 c2 = 0
+    | (Tpat_constant _ | Tpat_interval _), (Tpat_constant _ | Tpat_interval _)
+      -> (
+      match (int_range p, int_range q) with
+      | Some (lo1, hi1), Some (lo2, hi2) -> lo1 <= hi2 && lo2 <= hi1
+      | _ -> false)
     | Tpat_tuple ps, Tpat_tuple qs -> compats ~equal_cd ps qs
     | Tpat_record (l1, _, _), Tpat_record (l2, _, _) ->
       let ps, qs = records_args l1 l2 in
@@ -397,6 +454,8 @@ let rec pretty_val ppf v =
     | Tpat_any -> fprintf ppf "_"
     | Tpat_var (x, _) -> fprintf ppf "%s" (Ident.name x)
     | Tpat_constant c -> fprintf ppf "%s" (pretty_const c)
+    | Tpat_interval (c1, c2) ->
+      fprintf ppf "%s .. %s" (pretty_const c1) (pretty_const c2)
     | Tpat_tuple vs -> fprintf ppf "@[(%a)@]" (pretty_vals ",") vs
     | Tpat_construct (_, cstr, []) -> fprintf ppf "%s" cstr.cstr_name
     | Tpat_construct (_, cstr, [w]) ->
@@ -515,6 +574,13 @@ let simple_match p1 p2 =
     Types.same_constructor c1 c2
   | Tpat_variant (l1, _, _), Tpat_variant (l2, _, _) -> l1 = l2
   | Tpat_constant c1, Tpat_constant c2 -> const_compare c1 c2 = 0
+  | (Tpat_constant _ | Tpat_interval _), (Tpat_constant _ | Tpat_interval _)
+    -> (
+    (* [p1] is a piece of a column split by [split_int_range], so it is either
+       inside or outside [p2] *)
+    match (int_range p1, int_range p2) with
+    | Some (lo1, hi1), Some (lo2, hi2) -> lo2 <= lo1 && hi1 <= hi2
+    | _ -> false)
   | Tpat_record _, Tpat_record _ -> true
   | Tpat_tuple p1s, Tpat_tuple p2s | Tpat_array p1s, Tpat_array p2s ->
     List.length p1s = List.length p2s
@@ -577,7 +643,7 @@ let rec simple_match_args p1 p2 =
 
 let rec normalize_pat q =
   match q.pat_desc with
-  | Tpat_any | Tpat_constant _ -> q
+  | Tpat_any | Tpat_constant _ | Tpat_interval _ -> q
   | Tpat_var _ -> make_pat Tpat_any q.pat_type q.pat_env
   | Tpat_alias (p, _, _) -> normalize_pat p
   | Tpat_tuple args ->
@@ -685,7 +751,7 @@ let do_set_args erase_mutable q r =
   | {pat_desc = Tpat_array omegas} ->
     let args, rest = read_args omegas r in
     make_pat (Tpat_array args) q.pat_type q.pat_env :: rest
-  | {pat_desc = Tpat_constant _ | Tpat_any} ->
+  | {pat_desc = Tpat_constant _ | Tpat_interval _ | Tpat_any} ->
     q :: r (* case any is used in matching.ml *)
   | _ -> fatal_error "Parmatch.set_args"
 
@@ -752,6 +818,7 @@ let filter_all pat0 pss =
      range, linear instead of quadratic. The tables are only created when needed,
      as most calls are on small matrices. *)
   let const_groups = lazy (Hashtbl.create 16) in
+  let interval_groups = lazy (Hashtbl.create 16) in
   let variant_groups = lazy (Hashtbl.create 16) in
   let add_row (q0, rows) q qs =
     rows := (simple_match_args q0 q @ qs) :: !rows
@@ -773,6 +840,9 @@ let filter_all pat0 pss =
     match q.pat_desc with
     | Tpat_constant ((Const_int _ | Const_char _ | Const_string _) as c) ->
       find_or_add const_groups (const_key c) q qs
+    | Tpat_interval (c1, c2) ->
+      (* Grouped by equal bounds; [build_other] then sees every interval. *)
+      find_or_add interval_groups (const_key c1, const_key c2) q qs
     | Tpat_variant (l, _, _) -> find_or_add variant_groups l q qs
     | _ -> (
       match List.find_opt (fun (q0, _) -> simple_match q0 q) !groups with
@@ -897,7 +967,7 @@ let full_match closing env =
            (fun (tag, f) ->
              Btype.row_field_repr f = Rabsent || List.mem tag fields)
            row.row_fields
-  | ({pat_desc = Tpat_constant _}, _) :: _ -> false
+  | ({pat_desc = Tpat_constant _ | Tpat_interval _}, _) :: _ -> false
   | ({pat_desc = Tpat_tuple _}, _) :: _ -> true
   | ({pat_desc = Tpat_record _}, _) :: _ -> true
   | ({pat_desc = Tpat_array _}, _) :: _ -> false
@@ -920,8 +990,8 @@ let should_extend ext env =
         let path = get_type_path p.pat_type p.pat_env in
         Path.same path ext
       | Tpat_construct (_, {cstr_kind = Extension_constructor _}, _) -> false
-      | Tpat_constant _ | Tpat_tuple _ | Tpat_variant _ | Tpat_record _
-      | Tpat_array _ ->
+      | Tpat_constant _ | Tpat_interval _ | Tpat_tuple _ | Tpat_variant _
+      | Tpat_record _ | Tpat_array _ ->
         false
       | Tpat_any | Tpat_var _ | Tpat_alias _ | Tpat_or _ | Tpat_dict _ ->
         assert false))
@@ -1065,19 +1135,23 @@ let build_other ext env : Typedtree.pattern =
         (fun p_res pat ->
           make_pat (Tpat_or (pat, p_res, None)) p.pat_type p.pat_env)
         pat other_pats)
-  | (({pat_desc = Tpat_constant ((Const_int _ | Const_char _) as c)} as p), _)
+  | ( ({pat_desc = Tpat_constant (Const_int _ | Const_char _) | Tpat_interval _}
+       as p),
+      _ )
     :: _ ->
-    (* Int and char constants can share a column; the example takes the kind
-       of the first one. *)
-    build_other_constant
-      (function
-        | Tpat_constant (Const_int i | Const_char i) -> i
-        | _ -> assert false)
-      (fun i ->
-        match c with
-        | Const_char _ -> Tpat_constant (Const_char i)
-        | _ -> Tpat_constant (Const_int i))
-      0 succ p env
+    (* Int and char constants and intervals can share a column; the example is
+       the least value from 0 up that no range covers, of the kind of the
+       first pattern. Ranges sorted by lower bound are skipped in one pass. *)
+    let ranges =
+      List.filter_map (fun (q, _) -> int_range q) env
+      |> List.sort (fun (lo1, _) (lo2, _) -> compare lo1 lo2)
+    in
+    let other =
+      List.fold_left
+        (fun i (lo, hi) -> if lo <= i && i <= hi then hi + 1 else i)
+        0 ranges
+    in
+    make_int_range p other other
   | (({pat_desc = Tpat_constant (Const_bigint _)} as p), _) :: _ ->
     build_other_constant
       (function
@@ -1134,7 +1208,9 @@ let build_other ext env : Typedtree.pattern =
 let rec has_instance p =
   match p.pat_desc with
   | Tpat_variant (l, _, r) when is_absent l r -> false
-  | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_, None, _) -> true
+  | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_interval _
+  | Tpat_variant (_, None, _) ->
+    true
   | Tpat_alias (p, _, _) | Tpat_variant (_, Some p, _) -> has_instance p
   | Tpat_or (p1, p2, _) -> has_instance p1 || has_instance p2
   | Tpat_construct (_, _, ps) | Tpat_tuple ps | Tpat_array ps ->
@@ -1188,10 +1264,14 @@ let rec satisfiable pss qs =
           else satisfiable (filter_extra pss) qs)
     | {pat_desc = Tpat_variant (l, _, r)} :: _ when is_absent l r -> false
     | q :: qs ->
-      if not (all_coherent (q :: simplified_first_col pss)) then false
+      let column = simplified_first_col pss in
+      if not (all_coherent (q :: column)) then false
       else
         let q0 = discr_pat q pss in
-        satisfiable (filter_one q0 pss) (simple_match_args q0 q @ qs))
+        List.exists
+          (fun q0 ->
+            satisfiable (filter_one q0 pss) (simple_match_args q0 q @ qs))
+          (split_int_range q0 column))
 
 (* Also return the remaining cases, to enable GADT handling
 
@@ -1236,11 +1316,15 @@ let rec satisfiables pss qs =
             | _ -> wild omega))
     | {pat_desc = Tpat_variant (l, _, r)} :: _ when is_absent l r -> []
     | q :: qs ->
-      if not (all_coherent (q :: simplified_first_col pss)) then []
+      let column = simplified_first_col pss in
+      if not (all_coherent (q :: column)) then []
       else
         let q0 = discr_pat q pss in
-        List.map (set_args q0)
-          (satisfiables (filter_one q0 pss) (simple_match_args q0 q @ qs)))
+        List.concat_map
+          (fun q0 ->
+            List.map (set_args q0)
+              (satisfiables (filter_one q0 pss) (simple_match_args q0 q @ qs)))
+          (split_int_range q0 column))
 
 (*
   Now another satisfiable function that additionally
@@ -1553,6 +1637,37 @@ let union_res r1 r2 =
   | _, Used -> r1
   | Upartial u1, Upartial u2 -> Upartial (u1 @ u2)
 
+(* An interval split into pieces is used when one of its pieces is. An
+   or-pattern below it is unused when every used piece reports it unused. *)
+let pieces_res rs =
+  let used =
+    List.filter
+      (function
+        | Unused -> false
+        | _ -> true)
+      rs
+  in
+  if used = [] then Unused
+  else if
+    List.exists
+      (function
+        | Used -> true
+        | _ -> false)
+      used
+  then Used
+  else
+    let partials =
+      List.map
+        (function
+          | Upartial u -> u
+          | _ -> [])
+        used
+    in
+    match partials with
+    | [] -> Used
+    | u :: us ->
+      Upartial (List.filter (fun p -> List.for_all (List.memq p) us) u)
+
 (* propose or pats for expansion *)
 let extract_elements qs =
   let rec do_rec seen = function
@@ -1631,16 +1746,21 @@ let rec every_satisfiables pss qs =
     | Tpat_variant (l, _, r) when is_absent l r ->
       (* Ah Jacques... *)
       Unused
-    | _ ->
+    | _ -> (
       (* standard case, filter matrix *)
       (* The handling of incoherent matrices is kept in line with
                 [satisfiable] *)
-      if not (all_coherent (uq :: simplified_first_usefulness_col pss)) then
-        Unused
+      let column = simplified_first_usefulness_col pss in
+      if not (all_coherent (uq :: column)) then Unused
       else
         let q0 = discr_pat q pss in
-        every_satisfiables (filter_one q0 pss)
-          {qs with active = simple_match_args q0 q @ rem})
+        let piece q0 =
+          every_satisfiables (filter_one q0 pss)
+            {qs with active = simple_match_args q0 q @ rem}
+        in
+        match split_int_range q0 column with
+        | [q0] -> piece q0
+        | q0s -> pieces_res (List.map piece q0s)))
 
 (*
   This function ``every_both'' performs the usefulness check
@@ -1678,6 +1798,11 @@ let rec le_pat p q =
   | Tpat_alias (p, _, _), _ -> le_pat p q
   | _, Tpat_alias (q, _, _) -> le_pat p q
   | Tpat_constant c1, Tpat_constant c2 -> const_compare c1 c2 = 0
+  | (Tpat_constant _ | Tpat_interval _), (Tpat_constant _ | Tpat_interval _)
+    -> (
+    match (int_range p, int_range q) with
+    | Some (lo1, hi1), Some (lo2, hi2) -> lo1 <= lo2 && hi2 <= hi1
+    | _ -> false)
   | Tpat_construct (_, c1, ps), Tpat_construct (_, c2, qs) ->
     Types.same_constructor c1 c2 && le_pats ps qs
   | Tpat_variant (l1, Some p1, _), Tpat_variant (l2, Some p2, _) ->
@@ -1763,6 +1888,12 @@ let rec lub p q =
   | Tpat_or (p1, p2, _), _ -> orlub p1 p2 q
   | _, Tpat_or (q1, q2, _) -> orlub q1 q2 p (* Thanks god, lub is commutative *)
   | Tpat_constant c1, Tpat_constant c2 when const_compare c1 c2 = 0 -> p
+  | (Tpat_constant _ | Tpat_interval _), (Tpat_constant _ | Tpat_interval _)
+    -> (
+    match (int_range p, int_range q) with
+    | Some (lo1, hi1), Some (lo2, hi2) when max lo1 lo2 <= min hi1 hi2 ->
+      make_int_range p (max lo1 lo2) (min hi1 hi2)
+    | _ -> raise Empty)
   | Tpat_tuple ps, Tpat_tuple qs ->
     let rs = lubs ps qs in
     make_pat (Tpat_tuple rs) p.pat_type p.pat_env
@@ -1943,6 +2074,8 @@ module Conv = struct
         mkpat (Ppat_var nm)
       | Tpat_any | Tpat_var _ -> mkpat Ppat_any
       | Tpat_constant c -> mkpat (Ppat_constant (Untypeast.constant c))
+      | Tpat_interval (c1, c2) ->
+        mkpat (Ppat_interval (Untypeast.constant c1, Untypeast.constant c2))
       | Tpat_alias (p, _, _) -> loop p
       | Tpat_tuple lst -> mkpat (Ppat_tuple (List.map loop lst))
       | Tpat_construct (cstr_lid, cstr, lst) ->
@@ -2135,7 +2268,9 @@ let rec collect_paths_from_pat r p =
     List.fold_left collect_paths_from_pat
       (if extendable_path path then add_path path r else r)
       ps
-  | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_, None, _) -> r
+  | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_interval _
+  | Tpat_variant (_, None, _) ->
+    r
   | Tpat_tuple ps
   | Tpat_array ps
   | Tpat_construct (_, {cstr_kind = Extension_constructor _}, ps) ->
diff --git a/compiler/ml/parmatch.mli b/compiler/ml/parmatch.mli
index 0ae793005b..2fa7d16a3a 100644
--- a/compiler/ml/parmatch.mli
+++ b/compiler/ml/parmatch.mli
@@ -37,6 +37,13 @@ val const_compare : constant -> constant -> int
 (* A hash key agreeing with [const_compare]: char constants map to ints. *)
 val const_key : constant -> constant
 
+(* The bounds of an int or char constant or interval pattern *)
+val int_range : pattern -> (int * int) option
+
+(* An int or char constant or interval for the given bounds, of the kind and
+   type of the pattern *)
+val make_int_range : pattern -> int -> int -> pattern
+
 val le_pat : pattern -> pattern -> bool
 val le_pats : pattern list -> pattern list -> bool
 
diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml
index 3023a2054e..e329c40bfa 100644
--- a/compiler/ml/printtyped.ml
+++ b/compiler/ml/printtyped.ml
@@ -220,6 +220,8 @@ and pattern i ppf x =
       line i ppf "Tpat_alias \"%a\"\n" fmt_ident s;
       pattern i ppf p
     | Tpat_constant c -> line i ppf "Tpat_constant %a\n" fmt_constant c
+    | Tpat_interval (c1, c2) ->
+      line i ppf "Tpat_interval %a .. %a\n" fmt_constant c1 fmt_constant c2
     | Tpat_tuple l ->
       line i ppf "Tpat_tuple\n";
       list i pattern ppf l
diff --git a/compiler/ml/rec_check.ml b/compiler/ml/rec_check.ml
index c0c0909158..228f0dfb1e 100644
--- a/compiler/ml/rec_check.ml
+++ b/compiler/ml/rec_check.ml
@@ -151,7 +151,7 @@ let rec pattern_variables : Typedtree.pattern -> Ident.t list =
   | Tpat_any -> []
   | Tpat_var (id, _) -> [id]
   | Tpat_alias (pat, id, _) -> id :: pattern_variables pat
-  | Tpat_constant _ -> []
+  | Tpat_constant _ | Tpat_interval _ -> []
   | Tpat_tuple pats -> List.concat (List.map pattern_variables pats)
   | Tpat_construct (_, _, pats) -> List.concat (List.map pattern_variables pats)
   | Tpat_variant (_, Some pat, _) -> pattern_variables pat
@@ -465,7 +465,7 @@ and is_destructuring_pattern : Typedtree.pattern -> bool =
   | Tpat_any -> false
   | Tpat_var (_, _) -> false
   | Tpat_alias (pat, _, _) -> is_destructuring_pattern pat
-  | Tpat_constant _ -> true
+  | Tpat_constant _ | Tpat_interval _ -> true
   | Tpat_tuple _ -> true
   | Tpat_construct (_, _, _) -> true
   | Tpat_variant _ -> true
diff --git a/compiler/ml/tast_iterator.ml b/compiler/ml/tast_iterator.ml
index 9cdacdf910..0768ca4f0e 100644
--- a/compiler/ml/tast_iterator.ml
+++ b/compiler/ml/tast_iterator.ml
@@ -124,7 +124,7 @@ let pat sub {pat_extra; pat_desc; pat_env; _} =
   match pat_desc with
   | Tpat_any -> ()
   | Tpat_var _ -> ()
-  | Tpat_constant _ -> ()
+  | Tpat_constant _ | Tpat_interval _ -> ()
   | Tpat_tuple l -> List.iter (sub.pat sub) l
   | Tpat_construct (_, _, l) -> List.iter (sub.pat sub) l
   | Tpat_variant (_, po, _) -> Option.iter (sub.pat sub) po
diff --git a/compiler/ml/tast_mapper.ml b/compiler/ml/tast_mapper.ml
index d979e6411f..dbbda981a8 100644
--- a/compiler/ml/tast_mapper.ml
+++ b/compiler/ml/tast_mapper.ml
@@ -165,7 +165,7 @@ let pat sub x =
   let pat_extra = List.map (tuple3 extra id id) x.pat_extra in
   let pat_desc =
     match x.pat_desc with
-    | (Tpat_any | Tpat_var _ | Tpat_constant _) as d -> d
+    | (Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_interval _) as d -> d
     | Tpat_tuple l -> Tpat_tuple (List.map (sub.pat sub) l)
     | Tpat_construct (loc, cd, l) ->
       Tpat_construct (loc, cd, List.map (sub.pat sub) l)
diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml
index dd0fab1812..cc3c0a4dfd 100644
--- a/compiler/ml/typecore.ml
+++ b/compiler/ml/typecore.ml
@@ -601,7 +601,8 @@ let rec build_as_type env p =
     | Some row ->
       let row = row_repr row in
       newty (Tvariant {row with row_closed = false; row_more = newvar ()}))
-  | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_dict _ | Tpat_array _ ->
+  | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_interval _ | Tpat_dict _
+  | Tpat_array _ ->
     p.pat_type
 
 let build_or_pat env loc lid =
@@ -1423,20 +1424,17 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
         pat_env = !env;
       }
   | Ppat_interval (Pconst_char {semantic = c1}, Pconst_char {semantic = c2}) ->
-    let open Ast_helper.Pat in
-    let gloc = {loc with Location.loc_ghost = true} in
-    let char semantic =
-      Pconst_char
-        {source = String_literal.encode_char_source semantic; semantic}
-    in
-    let rec loop c1 c2 =
-      if c1 = c2 then constant ~loc:gloc (char c1)
-      else or_ ~loc:gloc (constant ~loc:gloc (char c1)) (loop (c1 + 1) c2)
-    in
-    let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in
-    let p = {p with ppat_loc = loc} in
-    type_pat ~explode:0 p expected_ty k
-    (* TODO: record 'extra' to remember about interval *)
+    let lo = Const_char (min c1 c2) and hi = Const_char (max c1 c2) in
+    unify_pat_types loc !env (type_constant lo) expected_ty;
+    rp k
+      {
+        pat_desc = (if c1 = c2 then Tpat_constant lo else Tpat_interval (lo, hi));
+        pat_loc = loc;
+        pat_extra = [];
+        pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
+        pat_env = !env;
+      }
   | Ppat_interval _ -> raise (Error (loc, !env, Invalid_interval))
   | Ppat_tuple spl ->
     assert (List.length spl >= 2);
diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml
index 6d5a4a5516..1de2e84818 100644
--- a/compiler/ml/typedtree.ml
+++ b/compiler/ml/typedtree.ml
@@ -52,6 +52,7 @@ and pattern_desc =
   | Tpat_var of Ident.t * string loc
   | Tpat_alias of pattern * Ident.t * string loc
   | Tpat_constant of constant
+  | Tpat_interval of constant * constant
   | Tpat_tuple of pattern list
   | Tpat_construct of Longident.t loc * constructor_description * pattern list
   | Tpat_variant of label * pattern option * row_desc ref
@@ -473,7 +474,7 @@ let iter_pattern_desc f = function
   | Tpat_or (p1, p2, _) ->
     f p1;
     f p2
-  | Tpat_any | Tpat_var _ | Tpat_constant _ -> ()
+  | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_interval _ -> ()
 
 let map_pattern_desc f d =
   match d with
@@ -491,7 +492,9 @@ let map_pattern_desc f d =
   | Tpat_array pats -> Tpat_array (List.map f pats)
   | Tpat_variant (x1, Some p1, x2) -> Tpat_variant (x1, Some (f p1), x2)
   | Tpat_or (p1, p2, path) -> Tpat_or (f p1, f p2, path)
-  | Tpat_var _ | Tpat_constant _ | Tpat_any | Tpat_variant (_, None, _) -> d
+  | Tpat_var _ | Tpat_constant _ | Tpat_interval _ | Tpat_any
+  | Tpat_variant (_, None, _) ->
+    d
 
 (* List the identifiers bound by a pattern or a let *)
 
diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli
index a65edca088..03022eec12 100644
--- a/compiler/ml/typedtree.mli
+++ b/compiler/ml/typedtree.mli
@@ -72,6 +72,10 @@ and pattern_desc =
   | Tpat_var of Ident.t * string loc  (** x *)
   | Tpat_alias of pattern * Ident.t * string loc  (** P as a *)
   | Tpat_constant of constant  (** 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+  | Tpat_interval of constant * constant
+      (** 'a' .. 'z'
+
+          Both bounds are int or char constants, the first one lower. *)
   | Tpat_tuple of pattern list
       (** (P1, ..., Pn)
 
diff --git a/compiler/ml/typedtree_iter.ml b/compiler/ml/typedtree_iter.ml
index 175a3d84f8..3cb6db8c6a 100644
--- a/compiler/ml/typedtree_iter.ml
+++ b/compiler/ml/typedtree_iter.ml
@@ -188,7 +188,7 @@ end = struct
     | Tpat_any -> ()
     | Tpat_var _ -> ()
     | Tpat_alias (pat1, _, _) -> iter_pattern pat1
-    | Tpat_constant _ -> ()
+    | Tpat_constant _ | Tpat_interval _ -> ()
     | Tpat_tuple list -> List.iter iter_pattern list
     | Tpat_construct (_, _, args) -> List.iter iter_pattern args
     | Tpat_variant (_, pato, _) -> (
diff --git a/tests/build_tests/super_errors/expected/warning_11_char_range_covered.res.expected b/tests/build_tests/super_errors/expected/warning_11_char_range_covered.res.expected
new file mode 100644
index 0000000000..753d643ee6
--- /dev/null
+++ b/tests/build_tests/super_errors/expected/warning_11_char_range_covered.res.expected
@@ -0,0 +1,11 @@
+
+  Warning number 11
+  /.../fixtures/warning_11_char_range_covered.res:6:5-14
+
+  4 ┆ | 'a' .. 'm' => 1
+  5 ┆ | 'n' .. 'z' => 2
+  6 ┆ | 'c' .. 'x' => 3
+  7 ┆ | _ => 4
+  8 ┆ }
+
+  this match case is unused.
\ No newline at end of file
diff --git a/tests/build_tests/super_errors/expected/warning_8_char_range_beyond.res.expected b/tests/build_tests/super_errors/expected/warning_8_char_range_beyond.res.expected
new file mode 100644
index 0000000000..8c5be428a0
--- /dev/null
+++ b/tests/build_tests/super_errors/expected/warning_8_char_range_beyond.res.expected
@@ -0,0 +1,13 @@
+
+  Warning number 8
+  /.../fixtures/warning_8_char_range_beyond.res:3:3-5:3
+
+  1 │ // All char literals are covered, so the example is an int beyond them.
+  2 │ let f = c =>
+  3 │   switch c {
+  4 │   | '\u{0}' .. '\u{10FFFF}' => 1
+  5 │   }
+  6 │ 
+
+  You forgot to handle a possible case here, for example: 
+  | 1114112
\ No newline at end of file
diff --git a/tests/build_tests/super_errors/expected/warning_8_char_range_example.res.expected b/tests/build_tests/super_errors/expected/warning_8_char_range_example.res.expected
new file mode 100644
index 0000000000..e46f429f0b
--- /dev/null
+++ b/tests/build_tests/super_errors/expected/warning_8_char_range_example.res.expected
@@ -0,0 +1,14 @@
+
+  Warning number 8
+  /.../fixtures/warning_8_char_range_example.res:3:3-6:3
+
+  1 │ // The missing case is shown as a range, not one case per character.
+  2 │ let f = (a, b) =>
+  3 │   switch (a, b) {
+  4 │   | ('a' .. 'z', 'a' .. 'z') => 1
+  5 │   | (_, '\u{0}' .. '`') => 2
+  6 │   }
+  7 │ 
+
+  You forgot to handle a possible case here, for example: 
+  | ('a' .. 'z', '{') | ('\x00', 'a')
\ No newline at end of file
diff --git a/tests/build_tests/super_errors/fixtures/warning_11_char_range_covered.res b/tests/build_tests/super_errors/fixtures/warning_11_char_range_covered.res
new file mode 100644
index 0000000000..f9e1d17678
--- /dev/null
+++ b/tests/build_tests/super_errors/fixtures/warning_11_char_range_covered.res
@@ -0,0 +1,8 @@
+// The last range is covered by the two before it together.
+let f = c =>
+  switch c {
+  | 'a' .. 'm' => 1
+  | 'n' .. 'z' => 2
+  | 'c' .. 'x' => 3
+  | _ => 4
+  }
diff --git a/tests/build_tests/super_errors/fixtures/warning_8_char_range_beyond.res b/tests/build_tests/super_errors/fixtures/warning_8_char_range_beyond.res
new file mode 100644
index 0000000000..a9cc900f40
--- /dev/null
+++ b/tests/build_tests/super_errors/fixtures/warning_8_char_range_beyond.res
@@ -0,0 +1,5 @@
+// All char literals are covered, so the example is an int beyond them.
+let f = c =>
+  switch c {
+  | '\u{0}' .. '\u{10FFFF}' => 1
+  }
diff --git a/tests/build_tests/super_errors/fixtures/warning_8_char_range_example.res b/tests/build_tests/super_errors/fixtures/warning_8_char_range_example.res
new file mode 100644
index 0000000000..7e95040c71
--- /dev/null
+++ b/tests/build_tests/super_errors/fixtures/warning_8_char_range_example.res
@@ -0,0 +1,6 @@
+// The missing case is shown as a range, not one case per character.
+let f = (a, b) =>
+  switch (a, b) {
+  | ('a' .. 'z', 'a' .. 'z') => 1
+  | (_, '\u{0}' .. '`') => 2
+  }
diff --git a/tests/tests/src/char_range_test.mjs b/tests/tests/src/char_range_test.mjs
index da8a00368f..7fe09cefeb 100644
--- a/tests/tests/src/char_range_test.mjs
+++ b/tests/tests/src/char_range_test.mjs
@@ -7,6 +7,14 @@ function isCjk(c) {
   return !(c > 40959 || c < 19968);
 }
 
+function isCodePoint(c) {
+  if (c >= 0) {
+    return c < 1114112;
+  } else {
+    return false;
+  }
+}
+
 function classify(c) {
   if (c >= 95) {
     if (c < 123) {
@@ -37,28 +45,149 @@ function classify(c) {
   }
 }
 
+function overlap(c) {
+  if (c > 109 || c < 97) {
+    if (c > 122 || c < 110) {
+      return "other";
+    } else {
+      return "h-z";
+    }
+  } else if (c !== 101) {
+    return "a-m";
+  } else {
+    return "e";
+  }
+}
+
+function guarded(c, allow) {
+  if (c >= 110) {
+    if (c >= 123 || !allow) {
+      return "other";
+    } else {
+      return "allowed";
+    }
+  } else if (c >= 97) {
+    if (allow) {
+      return "allowed";
+    } else {
+      return "a-m";
+    }
+  } else {
+    return "other";
+  }
+}
+
+function grid(a, b) {
+  let exit = 0;
+  if (a >= 97) {
+    if (a >= 65536) {
+      if (a >= 1114112) {
+        exit = 2;
+      } else if (b >= 65536 && b < 1114112) {
+        return 4;
+      }
+    } else if (a >= 100) {
+      exit = 2;
+    } else {
+      if (!(b > 122 || b < 120)) {
+        return 1;
+      }
+      exit = 2;
+    }
+  } else {
+    exit = 2;
+  }
+  if (exit === 2 && !(a > 100 || a < 98)) {
+    return 2;
+  }
+  if (b >= 99) {
+    if (b !== 121) {
+      return 5;
+    } else {
+      return 3;
+    }
+  } else if (b >= 97) {
+    return 3;
+  } else {
+    return 5;
+  }
+}
+
+function option(c) {
+  if (c !== undefined) {
+    if (c > 57 || c < 48) {
+      return "other";
+    } else {
+      return "digit";
+    }
+  } else {
+    return "none";
+  }
+}
+
 Mocha.describe("Char_range_test", () => {
   Mocha.test("large range", () => {
-    Test_utils.eq("File \"char_range_test.res\", line 23, characters 7-14", false, false);
-    Test_utils.eq("File \"char_range_test.res\", line 24, characters 7-14", true, true);
-    Test_utils.eq("File \"char_range_test.res\", line 25, characters 7-14", true, true);
-    Test_utils.eq("File \"char_range_test.res\", line 26, characters 7-14", true, true);
-    Test_utils.eq("File \"char_range_test.res\", line 27, characters 7-14", false, false);
+    Test_utils.eq("File \"char_range_test.res\", line 62, characters 7-14", false, false);
+    Test_utils.eq("File \"char_range_test.res\", line 63, characters 7-14", true, true);
+    Test_utils.eq("File \"char_range_test.res\", line 64, characters 7-14", true, true);
+    Test_utils.eq("File \"char_range_test.res\", line 65, characters 7-14", true, true);
+    Test_utils.eq("File \"char_range_test.res\", line 66, characters 7-14", false, false);
+    Test_utils.eq("File \"char_range_test.res\", line 67, characters 7-14", true, true);
+    Test_utils.eq("File \"char_range_test.res\", line 68, characters 7-14", true, true);
+    Test_utils.eq("File \"char_range_test.res\", line 69, characters 7-14", true, true);
+    Test_utils.eq("File \"char_range_test.res\", line 70, characters 7-14", false, false);
+    Test_utils.eq("File \"char_range_test.res\", line 71, characters 7-14", false, false);
   });
   Mocha.test("several ranges", () => {
-    Test_utils.eq("File \"char_range_test.res\", line 31, characters 7-14", classify(/* 'q' */113), "lower");
-    Test_utils.eq("File \"char_range_test.res\", line 32, characters 7-14", classify(/* 'Q' */81), "upper");
-    Test_utils.eq("File \"char_range_test.res\", line 33, characters 7-14", classify(/* '7' */55), "word");
-    Test_utils.eq("File \"char_range_test.res\", line 34, characters 7-14", classify(/* '_' */95), "word");
-    Test_utils.eq("File \"char_range_test.res\", line 35, characters 7-14", classify(/* 'ō' */333), "bmp");
-    Test_utils.eq("File \"char_range_test.res\", line 36, characters 7-14", classify(/* '￿' */65535), "bmp");
-    Test_utils.eq("File \"char_range_test.res\", line 37, characters 7-14", classify(/* '𐀀' */65536), "other");
-    Test_utils.eq("File \"char_range_test.res\", line 38, characters 7-14", classify(/* '!' */33), "other");
+    Test_utils.eq("File \"char_range_test.res\", line 75, characters 7-14", classify(/* 'q' */113), "lower");
+    Test_utils.eq("File \"char_range_test.res\", line 76, characters 7-14", classify(/* 'Q' */81), "upper");
+    Test_utils.eq("File \"char_range_test.res\", line 77, characters 7-14", classify(/* '7' */55), "word");
+    Test_utils.eq("File \"char_range_test.res\", line 78, characters 7-14", classify(/* '_' */95), "word");
+    Test_utils.eq("File \"char_range_test.res\", line 79, characters 7-14", classify(/* 'ō' */333), "bmp");
+    Test_utils.eq("File \"char_range_test.res\", line 80, characters 7-14", classify(/* '￿' */65535), "bmp");
+    Test_utils.eq("File \"char_range_test.res\", line 81, characters 7-14", classify(/* '𐀀' */65536), "other");
+    Test_utils.eq("File \"char_range_test.res\", line 82, characters 7-14", classify(/* '!' */33), "other");
+  });
+  Mocha.test("overlapping ranges", () => {
+    Test_utils.eq("File \"char_range_test.res\", line 86, characters 7-14", overlap(/* 'a' */97), "a-m");
+    Test_utils.eq("File \"char_range_test.res\", line 87, characters 7-14", overlap(/* 'e' */101), "e");
+    Test_utils.eq("File \"char_range_test.res\", line 88, characters 7-14", overlap(/* 'h' */104), "a-m");
+    Test_utils.eq("File \"char_range_test.res\", line 89, characters 7-14", overlap(/* 'm' */109), "a-m");
+    Test_utils.eq("File \"char_range_test.res\", line 90, characters 7-14", overlap(/* 'n' */110), "h-z");
+    Test_utils.eq("File \"char_range_test.res\", line 91, characters 7-14", overlap(/* 'z' */122), "h-z");
+    Test_utils.eq("File \"char_range_test.res\", line 92, characters 7-14", overlap(/* '{' */123), "other");
+  });
+  Mocha.test("guards", () => {
+    Test_utils.eq("File \"char_range_test.res\", line 96, characters 7-14", guarded(/* 'c' */99, true), "allowed");
+    Test_utils.eq("File \"char_range_test.res\", line 97, characters 7-14", guarded(/* 'c' */99, false), "a-m");
+    Test_utils.eq("File \"char_range_test.res\", line 98, characters 7-14", guarded(/* 'q' */113, false), "other");
+    Test_utils.eq("File \"char_range_test.res\", line 99, characters 7-14", guarded(/* 'Q' */81, true), "other");
+  });
+  Mocha.test("several columns", () => {
+    Test_utils.eq("File \"char_range_test.res\", line 103, characters 7-14", grid(/* 'a' */97, /* 'y' */121), 1);
+    Test_utils.eq("File \"char_range_test.res\", line 104, characters 7-14", grid(/* 'c' */99, /* 'z' */122), 1);
+    Test_utils.eq("File \"char_range_test.res\", line 105, characters 7-14", grid(/* 'd' */100, /* 'z' */122), 2);
+    Test_utils.eq("File \"char_range_test.res\", line 106, characters 7-14", grid(/* 'b' */98, /* 'b' */98), 2);
+    Test_utils.eq("File \"char_range_test.res\", line 107, characters 7-14", grid(/* 'e' */101, /* 'b' */98), 3);
+    Test_utils.eq("File \"char_range_test.res\", line 108, characters 7-14", grid(/* 'e' */101, /* 'y' */121), 3);
+    Test_utils.eq("File \"char_range_test.res\", line 109, characters 7-14", grid(/* '😀' */128512, /* '😀' */128512), 4);
+    Test_utils.eq("File \"char_range_test.res\", line 110, characters 7-14", grid(/* '😀' */128512, /* 'q' */113), 5);
+    Test_utils.eq("File \"char_range_test.res\", line 111, characters 7-14", grid(/* 'e' */101, /* 'q' */113), 5);
+  });
+  Mocha.test("option", () => {
+    Test_utils.eq("File \"char_range_test.res\", line 115, characters 7-14", option(/* '5' */53), "digit");
+    Test_utils.eq("File \"char_range_test.res\", line 116, characters 7-14", option(/* 'x' */120), "other");
+    Test_utils.eq("File \"char_range_test.res\", line 117, characters 7-14", option(undefined), "none");
   });
 });
 
 export {
   isCjk,
+  isCodePoint,
   classify,
+  overlap,
+  guarded,
+  grid,
+  option,
 }
 /*  Not a pure module */
diff --git a/tests/tests/src/char_range_test.res b/tests/tests/src/char_range_test.res
index 0475a5faeb..3e53e54f11 100644
--- a/tests/tests/src/char_range_test.res
+++ b/tests/tests/src/char_range_test.res
@@ -1,14 +1,20 @@
 open Mocha
 open Test_utils
 
-// A range is expanded into one alternative per character. This one has about
-// 21,000, which used to take a minute and many GB of memory to compile.
+// A range is one pattern, however many characters it covers, so this one
+// compiles as fast as a single character.
 let isCjk = c =>
   switch c {
   | '\u{4E00}' .. '\u{9FFF}' => true
   | _ => false
   }
 
+let isCodePoint = c =>
+  switch c {
+  | '\u{0}' .. '\u{10FFFF}' => true
+  | _ => false
+  }
+
 let classify = c =>
   switch c {
   | 'a' .. 'z' => "lower"
@@ -18,6 +24,39 @@ let classify = c =>
   | _ => "other"
   }
 
+// Overlapping ranges: the first one that matches wins.
+let overlap = c =>
+  switch c {
+  | 'e' => "e"
+  | 'a' .. 'm' => "a-m"
+  | 'h' .. 'z' => "h-z"
+  | _ => "other"
+  }
+
+let guarded = (c, allow) =>
+  switch c {
+  | 'a' .. 'z' if allow => "allowed"
+  | 'a' .. 'm' => "a-m"
+  | _ => "other"
+  }
+
+// Ranges in several columns
+let grid = (a, b) =>
+  switch (a, b) {
+  | ('a' .. 'c', 'x' .. 'z') => 1
+  | ('b' .. 'd', _) => 2
+  | (_, 'a' .. 'b' | 'y') => 3
+  | ('\u{10000}' .. '\u{10FFFF}', '\u{10000}' .. '\u{10FFFF}') => 4
+  | _ => 5
+  }
+
+let option = c =>
+  switch c {
+  | Some('0' .. '9') => "digit"
+  | Some(_) => "other"
+  | None => "none"
+  }
+
 describe(__MODULE__, () => {
   test("large range", () => {
     eq(__LOC__, isCjk('\u{4DFF}'), false)
@@ -25,6 +64,11 @@ describe(__MODULE__, () => {
     eq(__LOC__, isCjk('中'), true)
     eq(__LOC__, isCjk('\u{9FFF}'), true)
     eq(__LOC__, isCjk('\u{A000}'), false)
+    eq(__LOC__, isCodePoint('\u{0}'), true)
+    eq(__LOC__, isCodePoint('😀'), true)
+    eq(__LOC__, isCodePoint('\u{10FFFF}'), true)
+    eq(__LOC__, isCodePoint(0x110000), false)
+    eq(__LOC__, isCodePoint(-1), false)
   })
 
   test("several ranges", () => {
@@ -37,4 +81,39 @@ describe(__MODULE__, () => {
     eq(__LOC__, classify('\u{10000}'), "other")
     eq(__LOC__, classify('!'), "other")
   })
+
+  test("overlapping ranges", () => {
+    eq(__LOC__, overlap('a'), "a-m")
+    eq(__LOC__, overlap('e'), "e")
+    eq(__LOC__, overlap('h'), "a-m")
+    eq(__LOC__, overlap('m'), "a-m")
+    eq(__LOC__, overlap('n'), "h-z")
+    eq(__LOC__, overlap('z'), "h-z")
+    eq(__LOC__, overlap('{'), "other")
+  })
+
+  test("guards", () => {
+    eq(__LOC__, guarded('c', true), "allowed")
+    eq(__LOC__, guarded('c', false), "a-m")
+    eq(__LOC__, guarded('q', false), "other")
+    eq(__LOC__, guarded('Q', true), "other")
+  })
+
+  test("several columns", () => {
+    eq(__LOC__, grid('a', 'y'), 1)
+    eq(__LOC__, grid('c', 'z'), 1)
+    eq(__LOC__, grid('d', 'z'), 2)
+    eq(__LOC__, grid('b', 'b'), 2)
+    eq(__LOC__, grid('e', 'b'), 3)
+    eq(__LOC__, grid('e', 'y'), 3)
+    eq(__LOC__, grid('😀', '😀'), 4)
+    eq(__LOC__, grid('😀', 'q'), 5)
+    eq(__LOC__, grid('e', 'q'), 5)
+  })
+
+  test("option", () => {
+    eq(__LOC__, option(Some('5')), "digit")
+    eq(__LOC__, option(Some('x')), "other")
+    eq(__LOC__, option(None), "none")
+  })
 })