From c9546f5cc7162c6d286396047b82247fc123c041 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 19 Jul 2022 17:05:52 +0200
Subject: [PATCH 01/11] Syntax: Don't highlight the LHS of type decl as types

I would expect 'ocamlTypeConstr' to apply only to type constructors
within type expressions, not to the identifier after 'type' in:

    type foo = 'a bar list

This makes the LHS of types, exceptions and constraints be matched as
'ocamlTypedef', which is not highlighted by default.

Variance and type variables on the LHS remain highlighted as before.
---
 syntax/ocaml.vim | 16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

diff --git a/syntax/ocaml.vim b/syntax/ocaml.vim
index c4bec3a..adbf366 100644
--- a/syntax/ocaml.vim
+++ b/syntax/ocaml.vim
@@ -472,13 +472,23 @@ syn region ocamlTypeSumAnnot contained
 \ contains=@ocamlTypeExpr,ocamlTypeRecordDecl,ocamlComment,ocamlPpx
 hi link ocamlTypeSumAnnot ocamlTypeCatchAll
 
+" RHS of a ocamlTypeDef
+syn region ocamlTypeDefImpl
+\ matchgroup=ocamlKeyword start="\(=\|:\|of\)"
+\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|)\|]\|}\|;\|;;\)\@="
+\ contained skipwhite skipempty
+\ contains=@ocamlTypeExpr,ocamlTypeEq,ocamlTypePrivate,ocamlTypeDefDots,ocamlTypeRecordDecl,ocamlTypeSumDecl,ocamlTypeDefAnd,ocamlComment,ocamlPpx
+hi link ocamlTypeDefImpl ocamlTypeCatchAll
+
 " Type context opened by “type” (type definition), “constraint” (type
 " constraint) and “exception” (exception definition)
 syn region ocamlTypeDef
 \ matchgroup=ocamlKeyword start="\<type\>\(\_s\+\<nonrec\>\)\?\|\<constraint\>\|\<exception\>"
-\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|)\|]\|}\|;\|;;\)\@="
-\ contains=@ocamlTypeExpr,ocamlTypeEq,ocamlTypePrivate,ocamlTypeDefDots,ocamlTypeRecordDecl,ocamlTypeSumDecl,ocamlTypeDefAnd,ocamlComment,ocamlPpx
-hi link ocamlTypeDef ocamlTypeCatchAll
+\ matchgroup=ocamlTypedef end="\<\(\w\|'\)*\>"
+\ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar
+\ skipwhite skipempty
+\ nextgroup=ocamlTypeDefImpl
+
 syn cluster ocamlTypeContained add=ocamlTypePrivate
 syn keyword ocamlTypePrivate contained private
 hi link ocamlTypePrivate ocamlKeyword

From 715285b82752eb697f13a868048e990056bab196 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 20 Jul 2022 10:48:36 +0200
Subject: [PATCH 02/11] Match exception declaration separately

Have stricter rules for the identifiers and allow exception constructors
to be highlighted as before.
---
 syntax/ocaml.vim | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/syntax/ocaml.vim b/syntax/ocaml.vim
index adbf366..14a377c 100644
--- a/syntax/ocaml.vim
+++ b/syntax/ocaml.vim
@@ -480,11 +480,21 @@ syn region ocamlTypeDefImpl
 \ contains=@ocamlTypeExpr,ocamlTypeEq,ocamlTypePrivate,ocamlTypeDefDots,ocamlTypeRecordDecl,ocamlTypeSumDecl,ocamlTypeDefAnd,ocamlComment,ocamlPpx
 hi link ocamlTypeDefImpl ocamlTypeCatchAll
 
-" Type context opened by “type” (type definition), “constraint” (type
-" constraint) and “exception” (exception definition)
+" Type context opened by “type” (type definition) and “constraint” (type
+" constraint).
+" Match the opening keyword and the identifier then jump into
+" ocamlTypeDefImpl.
 syn region ocamlTypeDef
-\ matchgroup=ocamlKeyword start="\<type\>\(\_s\+\<nonrec\>\)\?\|\<constraint\>\|\<exception\>"
-\ matchgroup=ocamlTypedef end="\<\(\w\|'\)*\>"
+\ matchgroup=ocamlKeyword start="\<type\>\(\_s\+\<nonrec\>\)\?\|\<constraint\>"
+\ matchgroup=ocamlLCIdentifier end="\<\l\(\w\|'\)*\>"
+\ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar
+\ skipwhite skipempty
+\ nextgroup=ocamlTypeDefImpl
+
+" Exception definitions. Like ocamlTypeDef, jump into ocamlTypeDefImpl.
+syn region ocamlExceptionDef
+\ matchgroup=ocamlKeyword start="\<exception\>"
+\ matchgroup=ocamlConstructor end="\u\(\w\|'\)*\>"
 \ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar
 \ skipwhite skipempty
 \ nextgroup=ocamlTypeDefImpl

From 32619c5ddbf7c1e9fba1440b667d6e82404e7be1 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 20 Jul 2022 12:29:38 +0200
Subject: [PATCH 03/11] Fix highlighting of and-types

A new region is used to avoid matching the 'and' keyword too often (that
would interfere with let-and and module-rec-and.
---
 syntax/ocaml.vim | 32 +++++++++++++++++++++-----------
 1 file changed, 21 insertions(+), 11 deletions(-)

diff --git a/syntax/ocaml.vim b/syntax/ocaml.vim
index 14a377c..4bd2564 100644
--- a/syntax/ocaml.vim
+++ b/syntax/ocaml.vim
@@ -6,6 +6,7 @@
 "               Issac Trotts      <ijtrotts@ucdavis.edu>
 " URL:          https://github.com/ocaml/vim-ocaml
 " Last Change:
+"               2022 Jul 20 - Improved highlighting of type decl (Jules Aguillon)
 "               2019 Nov 05 - Accurate type highlighting (Maëlan)
 "               2018 Nov 08 - Improved highlighting of operators (Maëlan)
 "               2018 Apr 22 - Improved support for PPX (Andrey Popp)
@@ -339,10 +340,6 @@ syn match ocamlTypeVariance contained "[-+!]\ze *\('\|\<_\>\)"
 syn match ocamlTypeVariance contained "[-+] *!\+\ze *\('\|\<_\>\)"
 syn match ocamlTypeVariance contained "! *[-+]\+\ze *\('\|\<_\>\)"
 
-syn cluster ocamlTypeContained add=ocamlTypeEq
-syn match    ocamlTypeEq       contained  "[+:]\?="
-hi link ocamlTypeEq ocamlKeyChar
-
 syn cluster ocamlTypeExpr add=ocamlTypeVar,ocamlTypeConstr,ocamlTypeAnyVar,ocamlTypeBuiltin
 syn match    ocamlTypeVar      contained   "'\(\l\|_\)\(\w\|'\)*\>"
 syn match    ocamlTypeConstr   contained  "\<\(\l\|_\)\(\w\|'\)*\>"
@@ -474,10 +471,15 @@ hi link ocamlTypeSumAnnot ocamlTypeCatchAll
 
 " RHS of a ocamlTypeDef
 syn region ocamlTypeDefImpl
-\ matchgroup=ocamlKeyword start="\(=\|:\|of\)"
+\ matchgroup=ocamlKeyword start="\<of\>"
+\ matchgroup=ocamlKeyChar start=":="
+\ matchgroup=ocamlKeyChar start=":"
+\ matchgroup=ocamlKeyChar start="="
 \ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|)\|]\|}\|;\|;;\)\@="
+\ matchgroup=NONE end="\(\<and\>\)\@="
 \ contained skipwhite skipempty
-\ contains=@ocamlTypeExpr,ocamlTypeEq,ocamlTypePrivate,ocamlTypeDefDots,ocamlTypeRecordDecl,ocamlTypeSumDecl,ocamlTypeDefAnd,ocamlComment,ocamlPpx
+\ contains=@ocamlTypeExpr,ocamlTypePrivate,ocamlTypeDefDots,ocamlTypeRecordDecl,ocamlTypeSumDecl,ocamlComment,ocamlPpx
+\ nextgroup=ocamlTypeDefAnd
 hi link ocamlTypeDefImpl ocamlTypeCatchAll
 
 " Type context opened by “type” (type definition) and “constraint” (type
@@ -489,7 +491,18 @@ syn region ocamlTypeDef
 \ matchgroup=ocamlLCIdentifier end="\<\l\(\w\|'\)*\>"
 \ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar
 \ skipwhite skipempty
-\ nextgroup=ocamlTypeDefImpl
+\ nextgroup=ocamlTypeDefImpl,ocamlTypeDefAnd
+
+" Type context opened by “type” (type definition) and “constraint” (type
+" constraint).
+" Match the opening keyword and the identifier then jump into
+" ocamlTypeDefImpl.
+syn region ocamlTypeDefAnd
+\ matchgroup=ocamlKeyword start="\<and\>"
+\ matchgroup=ocamlLCIdentifier end="\<\l\(\w\|'\)*\>"
+\ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar
+\ skipwhite skipempty
+\ nextgroup=ocamlTypeDefImpl,ocamlTypeDefAnd
 
 " Exception definitions. Like ocamlTypeDef, jump into ocamlTypeDefImpl.
 syn region ocamlExceptionDef
@@ -502,9 +515,6 @@ syn region ocamlExceptionDef
 syn cluster ocamlTypeContained add=ocamlTypePrivate
 syn keyword ocamlTypePrivate contained private
 hi link ocamlTypePrivate ocamlKeyword
-syn cluster ocamlTypeContained add=ocamlTypeDefAnd
-syn keyword ocamlTypeDefAnd contained and
-hi link ocamlTypeDefAnd ocamlKeyword
 syn cluster ocamlTypeContained add=ocamlTypeDefDots
 syn match ocamlTypeDefDots contained "\.\."
 hi link ocamlTypeDefDots ocamlKeyChar
@@ -520,7 +530,7 @@ syn match ocamlKeyword "(\_s*exception\>"lc=1
 " Type context opened by “:” (countless kinds of type annotations) and “:>”
 " (type coercions)
 syn region ocamlTypeAnnot matchgroup=ocamlKeyChar start=":\(>\|\_s*type\>\|[>:=]\@!\)"
-\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|)\|]\|}\|;\|;;\)\@="
+\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|\<and\>\|)\|]\|}\|;\|;;\)\@="
 \ matchgroup=NONE end="\(;\|}\)\@="
 \ matchgroup=NONE end="\(=\|:>\)\@="
 \ contains=@ocamlTypeExpr,ocamlComment,ocamlPpx

From 6dce80560a3750d6c4caa6e091854d9fdfe340f5 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 21 Jul 2022 11:29:27 +0200
Subject: [PATCH 04/11] Syntax: Dedicated group for type decl identifiers

---
 syntax/ocaml.vim | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/syntax/ocaml.vim b/syntax/ocaml.vim
index 4bd2564..09330d8 100644
--- a/syntax/ocaml.vim
+++ b/syntax/ocaml.vim
@@ -37,6 +37,8 @@ setlocal iskeyword+=`
 " OCaml is case sensitive.
 syn case match
 
+syn match ocamlWhite /[ \t\n\r]*/
+
 " Access to the method of an object
 syn match    ocamlMethod       "#"
 
@@ -488,8 +490,8 @@ hi link ocamlTypeDefImpl ocamlTypeCatchAll
 " ocamlTypeDefImpl.
 syn region ocamlTypeDef
 \ matchgroup=ocamlKeyword start="\<type\>\(\_s\+\<nonrec\>\)\?\|\<constraint\>"
-\ matchgroup=ocamlLCIdentifier end="\<\l\(\w\|'\)*\>"
-\ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar
+\ matchgroup=ocamlTypeIdentifier end="\<\l\(\w\|'\)*\>"
+\ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar,ocamlWhite
 \ skipwhite skipempty
 \ nextgroup=ocamlTypeDefImpl,ocamlTypeDefAnd
 
@@ -499,8 +501,8 @@ syn region ocamlTypeDef
 " ocamlTypeDefImpl.
 syn region ocamlTypeDefAnd
 \ matchgroup=ocamlKeyword start="\<and\>"
-\ matchgroup=ocamlLCIdentifier end="\<\l\(\w\|'\)*\>"
-\ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar
+\ matchgroup=ocamlTypeIdentifier end="\<\l\(\w\|'\)*\>"
+\ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar,ocamlWhite
 \ skipwhite skipempty
 \ nextgroup=ocamlTypeDefImpl,ocamlTypeDefAnd
 
@@ -512,6 +514,7 @@ syn region ocamlExceptionDef
 \ skipwhite skipempty
 \ nextgroup=ocamlTypeDefImpl
 
+hi link ocamlTypeIdentifier ocamlLCIdentifier
 syn cluster ocamlTypeContained add=ocamlTypePrivate
 syn keyword ocamlTypePrivate contained private
 hi link ocamlTypePrivate ocamlKeyword

From 0f91255c306598b1348dc0b111730c7acbaea065 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 21 Jul 2022 11:59:36 +0200
Subject: [PATCH 05/11] Syntax: Fixes to type declarations

Fix tupled type params, += and whitespaces around keywords.
Add examples to the test file.
---
 syntax/ocaml.vim    | 11 ++++++-----
 type-linter-test.ml | 23 +++++++++++++++++++++++
 2 files changed, 29 insertions(+), 5 deletions(-)

diff --git a/syntax/ocaml.vim b/syntax/ocaml.vim
index 09330d8..64e7aa6 100644
--- a/syntax/ocaml.vim
+++ b/syntax/ocaml.vim
@@ -475,13 +475,14 @@ hi link ocamlTypeSumAnnot ocamlTypeCatchAll
 syn region ocamlTypeDefImpl
 \ matchgroup=ocamlKeyword start="\<of\>"
 \ matchgroup=ocamlKeyChar start=":="
+\ matchgroup=ocamlKeyChar start="+="
 \ matchgroup=ocamlKeyChar start=":"
 \ matchgroup=ocamlKeyChar start="="
-\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|)\|]\|}\|;\|;;\)\@="
+\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|)\|]\|}\|;\|;;\|=\)\@="
 \ matchgroup=NONE end="\(\<and\>\)\@="
 \ contained skipwhite skipempty
 \ contains=@ocamlTypeExpr,ocamlTypePrivate,ocamlTypeDefDots,ocamlTypeRecordDecl,ocamlTypeSumDecl,ocamlComment,ocamlPpx
-\ nextgroup=ocamlTypeDefAnd
+\ nextgroup=ocamlTypeDefImpl,ocamlTypeDefAnd
 hi link ocamlTypeDefImpl ocamlTypeCatchAll
 
 " Type context opened by “type” (type definition) and “constraint” (type
@@ -491,7 +492,7 @@ hi link ocamlTypeDefImpl ocamlTypeCatchAll
 syn region ocamlTypeDef
 \ matchgroup=ocamlKeyword start="\<type\>\(\_s\+\<nonrec\>\)\?\|\<constraint\>"
 \ matchgroup=ocamlTypeIdentifier end="\<\l\(\w\|'\)*\>"
-\ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar,ocamlWhite
+\ contains=@ocamlTypeExpr,@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar,ocamlPpx,ocamlWhite
 \ skipwhite skipempty
 \ nextgroup=ocamlTypeDefImpl,ocamlTypeDefAnd
 
@@ -502,7 +503,7 @@ syn region ocamlTypeDef
 syn region ocamlTypeDefAnd
 \ matchgroup=ocamlKeyword start="\<and\>"
 \ matchgroup=ocamlTypeIdentifier end="\<\l\(\w\|'\)*\>"
-\ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar,ocamlWhite
+\ contains=@ocamlTypeExpr,@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar,ocamlPpx,ocamlWhite
 \ skipwhite skipempty
 \ nextgroup=ocamlTypeDefImpl,ocamlTypeDefAnd
 
@@ -510,7 +511,7 @@ syn region ocamlTypeDefAnd
 syn region ocamlExceptionDef
 \ matchgroup=ocamlKeyword start="\<exception\>"
 \ matchgroup=ocamlConstructor end="\u\(\w\|'\)*\>"
-\ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar
+\ contains=@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar,ocamlPpx
 \ skipwhite skipempty
 \ nextgroup=ocamlTypeDefImpl
 
diff --git a/type-linter-test.ml b/type-linter-test.ml
index ff33cd2..8f852ea 100644
--- a/type-linter-test.ml
+++ b/type-linter-test.ml
@@ -23,6 +23,8 @@
   type u = char
   type v = string
   type w = bytes
+  type abstract
+  type !+_ abstract'
 
   (* type expressions with arrows, tuples, 0-ary type constructors *)
   type t = t0 * t0 -> t0
@@ -166,6 +168,24 @@
   (* definition of an empty type *)
   type t = |
 
+  (* Constraints *)
+  type 'a foo := 'a bar
+
+(* RECURSION *)
+
+  type foo = bar
+  and bar
+  and baz = foo
+
+  ;;
+  let foo = 1
+  and bar = 2 in
+  ()
+
+  (* FIXME: 'and' part not matched by module decl (maybe matched by types decl ?). *)
+  module rec Foo : sig end = struct end
+  and Bar : sig end = struct end
+
 (* TYPE ANNOTATIONS *)
 
   (* annotations on let binders *)
@@ -318,6 +338,9 @@
     end
   end
 
+  (* FIXME: ':=' not recognized and RHS highlighted as constructor. *)
+  module Foo := Bar
+
 (* ATTRIBUTES AND COMMENTS *)
 
   exception[@my.attr "payld"] (*c*) E [@my.attr "payld"] (*c*)

From 921eed7b60fa0632a98017b98a166b1d0a8f80bb Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 21 Jul 2022 13:54:51 +0200
Subject: [PATCH 06/11] More accurate date for the last syntax changes

Using the commit date instead of the author date.
---
 syntax/ocaml.vim | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/syntax/ocaml.vim b/syntax/ocaml.vim
index 64e7aa6..f06c052 100644
--- a/syntax/ocaml.vim
+++ b/syntax/ocaml.vim
@@ -7,8 +7,8 @@
 " URL:          https://github.com/ocaml/vim-ocaml
 " Last Change:
 "               2022 Jul 20 - Improved highlighting of type decl (Jules Aguillon)
-"               2019 Nov 05 - Accurate type highlighting (Maëlan)
-"               2018 Nov 08 - Improved highlighting of operators (Maëlan)
+"               2022 Jul 18 - Accurate type highlighting (Maëlan)
+"               2019 Feb 21 - Improved highlighting of operators (Maëlan)
 "               2018 Apr 22 - Improved support for PPX (Andrey Popp)
 "               2018 Mar 16 - Remove raise, lnot and not from keywords (Étienne Millon, "copy")
 "               2017 Apr 11 - Improved matching of negative numbers (MM)

From 62f63bda34ceb15fec29e0e73c5a5551540213b5 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 20 Jun 2023 11:37:24 +0200
Subject: [PATCH 07/11] Fix type decl RHS interfering with expressions

It's a `contained` region but was not added to `ocamlContained`.
---
 syntax/ocaml.vim | 1 +
 1 file changed, 1 insertion(+)

diff --git a/syntax/ocaml.vim b/syntax/ocaml.vim
index f06c052..116b9f5 100644
--- a/syntax/ocaml.vim
+++ b/syntax/ocaml.vim
@@ -484,6 +484,7 @@ syn region ocamlTypeDefImpl
 \ contains=@ocamlTypeExpr,ocamlTypePrivate,ocamlTypeDefDots,ocamlTypeRecordDecl,ocamlTypeSumDecl,ocamlComment,ocamlPpx
 \ nextgroup=ocamlTypeDefImpl,ocamlTypeDefAnd
 hi link ocamlTypeDefImpl ocamlTypeCatchAll
+syn cluster ocamlContained add=ocamlTypeDefImpl
 
 " Type context opened by “type” (type definition) and “constraint” (type
 " constraint).

From 31acc7b8d8e8c1e213b68f4e730c814ece2059ae Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 20 Jun 2023 11:38:23 +0200
Subject: [PATCH 08/11] Merge matchgroups of the same name

This is a styling change.
---
 syntax/ocaml.vim | 16 ++++------------
 1 file changed, 4 insertions(+), 12 deletions(-)

diff --git a/syntax/ocaml.vim b/syntax/ocaml.vim
index 116b9f5..ec35d7c 100644
--- a/syntax/ocaml.vim
+++ b/syntax/ocaml.vim
@@ -465,21 +465,15 @@ syn cluster ocamlTypeContained add=ocamlTypeSumAnnot
 syn region ocamlTypeSumAnnot contained
 \ matchgroup=ocamlKeyword start="\<of\>"
 \ matchgroup=ocamlKeyChar start=":"
-\ matchgroup=NONE end="|\@="
-\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|)\|]\|}\|;\|;;\)\@="
-\ matchgroup=NONE end="\(\<and\>\)\@="
+\ matchgroup=NONE end="\(|\|\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|\<and\>\|)\|]\|}\|;\|;;\)\@="
 \ contains=@ocamlTypeExpr,ocamlTypeRecordDecl,ocamlComment,ocamlPpx
 hi link ocamlTypeSumAnnot ocamlTypeCatchAll
 
 " RHS of a ocamlTypeDef
 syn region ocamlTypeDefImpl
 \ matchgroup=ocamlKeyword start="\<of\>"
-\ matchgroup=ocamlKeyChar start=":="
-\ matchgroup=ocamlKeyChar start="+="
-\ matchgroup=ocamlKeyChar start=":"
-\ matchgroup=ocamlKeyChar start="="
-\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|)\|]\|}\|;\|;;\|=\)\@="
-\ matchgroup=NONE end="\(\<and\>\)\@="
+\ matchgroup=ocamlKeyChar start=":=\|+=\|:\|="
+\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|\<and\>\|)\|]\|}\|;\|;;\|=\)\@="
 \ contained skipwhite skipempty
 \ contains=@ocamlTypeExpr,ocamlTypePrivate,ocamlTypeDefDots,ocamlTypeRecordDecl,ocamlTypeSumDecl,ocamlComment,ocamlPpx
 \ nextgroup=ocamlTypeDefImpl,ocamlTypeDefAnd
@@ -535,9 +529,7 @@ syn match ocamlKeyword "(\_s*exception\>"lc=1
 " Type context opened by “:” (countless kinds of type annotations) and “:>”
 " (type coercions)
 syn region ocamlTypeAnnot matchgroup=ocamlKeyChar start=":\(>\|\_s*type\>\|[>:=]\@!\)"
-\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|\<and\>\|)\|]\|}\|;\|;;\)\@="
-\ matchgroup=NONE end="\(;\|}\)\@="
-\ matchgroup=NONE end="\(=\|:>\)\@="
+\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|\<and\>\|)\|]\|}\|;\|;;\|=\|:>\)\@="
 \ contains=@ocamlTypeExpr,ocamlComment,ocamlPpx
 hi link ocamlTypeAnnot ocamlTypeCatchAll
 

From 22e88da2255545b334fa47413b7f1879d3e594a0 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 3 Jul 2023 18:29:17 +0200
Subject: [PATCH 09/11] syntax: Handle comments in type decl

---
 syntax/ocaml.vim    | 14 +++++++-------
 type-linter-test.ml |  2 ++
 2 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/syntax/ocaml.vim b/syntax/ocaml.vim
index ec35d7c..db76090 100644
--- a/syntax/ocaml.vim
+++ b/syntax/ocaml.vim
@@ -47,6 +47,7 @@ syn match    ocamlScript "^#\<\(quit\|labels\|warnings\|warn_error\|directory\|r
 
 " lowercase identifier - the standard way to match
 syn match    ocamlLCIdentifier /\<\(\l\|_\)\(\w\|'\)*\>/
+syn match    ocamlTypeIdentifier /\<\(\l\|_\)\(\w\|'\)*\>/
 
 " Errors
 syn match    ocamlBraceErr   "}"
@@ -476,7 +477,6 @@ syn region ocamlTypeDefImpl
 \ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|\<and\>\|)\|]\|}\|;\|;;\|=\)\@="
 \ contained skipwhite skipempty
 \ contains=@ocamlTypeExpr,ocamlTypePrivate,ocamlTypeDefDots,ocamlTypeRecordDecl,ocamlTypeSumDecl,ocamlComment,ocamlPpx
-\ nextgroup=ocamlTypeDefImpl,ocamlTypeDefAnd
 hi link ocamlTypeDefImpl ocamlTypeCatchAll
 syn cluster ocamlContained add=ocamlTypeDefImpl
 
@@ -486,10 +486,10 @@ syn cluster ocamlContained add=ocamlTypeDefImpl
 " ocamlTypeDefImpl.
 syn region ocamlTypeDef
 \ matchgroup=ocamlKeyword start="\<type\>\(\_s\+\<nonrec\>\)\?\|\<constraint\>"
-\ matchgroup=ocamlTypeIdentifier end="\<\l\(\w\|'\)*\>"
-\ contains=@ocamlTypeExpr,@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar,ocamlPpx,ocamlWhite
+\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|\<and\>\)\@="
+\ contains=@ocamlTypeExpr,@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar,ocamlPpx,ocamlWhite,ocamlTypeIdentifier,ocamlTypeDefImpl
 \ skipwhite skipempty
-\ nextgroup=ocamlTypeDefImpl,ocamlTypeDefAnd
+\ nextgroup=ocamlTypeDefAnd
 
 " Type context opened by “type” (type definition) and “constraint” (type
 " constraint).
@@ -497,10 +497,10 @@ syn region ocamlTypeDef
 " ocamlTypeDefImpl.
 syn region ocamlTypeDefAnd
 \ matchgroup=ocamlKeyword start="\<and\>"
-\ matchgroup=ocamlTypeIdentifier end="\<\l\(\w\|'\)*\>"
-\ contains=@ocamlTypeExpr,@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar,ocamlPpx,ocamlWhite
+\ matchgroup=NONE end="\(\<type\>\|\<exception\>\|\<val\>\|\<module\>\|\<class\>\|\<method\>\|\<constraint\>\|\<inherit\>\|\<object\>\|\<struct\>\|\<open\>\|\<include\>\|\<let\>\|\<external\>\|\<in\>\|\<end\>\|\<and\>\)\@="
+\ contains=@ocamlTypeExpr,@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar,ocamlPpx,ocamlWhite,ocamlTypeIdentifier,ocamlTypeDefImpl
 \ skipwhite skipempty
-\ nextgroup=ocamlTypeDefImpl,ocamlTypeDefAnd
+\ nextgroup=ocamlTypeDefAnd
 
 " Exception definitions. Like ocamlTypeDef, jump into ocamlTypeDefImpl.
 syn region ocamlExceptionDef
diff --git a/type-linter-test.ml b/type-linter-test.ml
index 8f852ea..d784c51 100644
--- a/type-linter-test.ml
+++ b/type-linter-test.ml
@@ -353,6 +353,8 @@
   type t = [ `A of int [@my.attr "payld"] (*c*) | (*c*) `B (*c*) of (*c*) int (*c*) ]
   type t = | A of int [@my.attr "payld"] (*c*) | (*c*) B (*c*) of (*c*) int (*c*)
   let _ : unit [@my.attr "payld"] (*c*) = ()
+  type t (*c*) = int
+  and u (*c*) = float
 
 (* VARIOUS TRAPS *)
 

From 0871d88e29bfa2d5b33e6a160ddf3af6c5c33fd5 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 5 Jul 2023 11:15:02 +0200
Subject: [PATCH 10/11] Fix and-type interaction with modules

---
 syntax/ocaml.vim | 1 +
 1 file changed, 1 insertion(+)

diff --git a/syntax/ocaml.vim b/syntax/ocaml.vim
index db76090..88d347d 100644
--- a/syntax/ocaml.vim
+++ b/syntax/ocaml.vim
@@ -501,6 +501,7 @@ syn region ocamlTypeDefAnd
 \ contains=@ocamlTypeExpr,@ocamlAllErrs,ocamlComment,ocamlTypeVariance,ocamlTypeVar,ocamlPpx,ocamlWhite,ocamlTypeIdentifier,ocamlTypeDefImpl
 \ skipwhite skipempty
 \ nextgroup=ocamlTypeDefAnd
+syn cluster ocamlTypeContained add=ocamlTypeDefAnd
 
 " Exception definitions. Like ocamlTypeDef, jump into ocamlTypeDefImpl.
 syn region ocamlExceptionDef

From 817e8f75a8d1324b2d28c0958534a742656d8350 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 5 Jul 2023 11:18:19 +0200
Subject: [PATCH 11/11] Fix type identifiers being recognized in lets

It was missing from the ocamlTypeContained group.
---
 syntax/ocaml.vim | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/syntax/ocaml.vim b/syntax/ocaml.vim
index 88d347d..b91b7f7 100644
--- a/syntax/ocaml.vim
+++ b/syntax/ocaml.vim
@@ -48,6 +48,7 @@ syn match    ocamlScript "^#\<\(quit\|labels\|warnings\|warn_error\|directory\|r
 " lowercase identifier - the standard way to match
 syn match    ocamlLCIdentifier /\<\(\l\|_\)\(\w\|'\)*\>/
 syn match    ocamlTypeIdentifier /\<\(\l\|_\)\(\w\|'\)*\>/
+syn cluster ocamlTypeContained add=ocamlTypeIdentifier
 
 " Errors
 syn match    ocamlBraceErr   "}"
@@ -511,7 +512,6 @@ syn region ocamlExceptionDef
 \ skipwhite skipempty
 \ nextgroup=ocamlTypeDefImpl
 
-hi link ocamlTypeIdentifier ocamlLCIdentifier
 syn cluster ocamlTypeContained add=ocamlTypePrivate
 syn keyword ocamlTypePrivate contained private
 hi link ocamlTypePrivate ocamlKeyword