Add syntax hovers for oxcaml

src/analysis/syntax_doc.ml

@@ -155,11 +155,13 @@ let get_mod_bound_doc mod_bound =
     | Axis_pair (Modal (Comonadic _), _) ->
       Some
         (Format.asprintf
-           "Values of this type can cross to `%s` from weaker modes." mod_bound)
+           "Values of types of this kind can cross to `%s` from weaker modes."
+           mod_bound)
     | Axis_pair (Modal (Monadic _), _) ->
       Some
         (Format.asprintf
-           "Values of this type can cross from `%s` to stronger modes" mod_bound)
+           "Values of types of this kind can cross from `%s` to stronger modes"
+           mod_bound)
     | Axis_pair (Nonmodal Externality, Internal) ->
       Some "Values of types of this kind might be pointers to the OCaml heap"
     | Axis_pair (Nonmodal Externality, External64) ->
@@ -214,54 +216,56 @@ let get_mode_doc mode =
   let* description =
     match (axis, mode) with
     | Comonadic Areality, Local ->
-      Some "This value cannot escape the current region"
+      Some "Values with this mode cannot escape the current region"
     | Comonadic Areality, Regional -> None
-    | Comonadic Areality, Global -> Some "This value can escape any region"
+    | Comonadic Areality, Global ->
+      Some "Values with this mode can escape any region"
     | Monadic Contention, Contended ->
       Some
-        "This usage of the value cannot read or write the mutable parts of the \
-         value (unless they are atomic)"
+        "The mutable parts of values with this mode cannot be accessed (unless \
+         they are atomic)"
     | Monadic Contention, Shared ->
       Some
-        "This usage of the value can read but not write the mutable parts of \
-         the value (unless they are atomic)"
+        "The mutable parts of values with this mode can be read, but not \
+         written (unless they are atomic)"
     | Monadic Contention, Uncontended ->
-      Some
-        "This usage of the value can read and write the mutable parts of the \
-         value"
+      Some "The mutable parts of values with this mode can be fully accessed"
     | Comonadic Portability, Nonportable ->
       Some
-        "This value cannot be sent to other threads, in order to avoid data \
-         races."
+        "Values with this mode cannot be sent to other threads, in order to \
+         avoid data races."
     | Comonadic Portability, Portable ->
-      Some "This value can be sent to other threads without causing data races"
+      Some
+        "Values with this mode can be sent to other threads without causing \
+         data races"
     | Monadic Uniqueness, Aliased ->
-      Some "This usage of the value might not be the only usage of the value"
+      Some "There may be multiple pointers to values with this mode"
     | Monadic Uniqueness, Unique ->
-      Some "This usage of the value is the only usage of the value."
-    | Comonadic Linearity, Once -> Some "This value can be used at most once"
-    | Comonadic Linearity, Many -> Some "This value can be used many times"
-    | Comonadic Yielding, Yielding -> Some "This value can perform an effect"
+      Some
+        "It is guaranteed that there is only one pointer to values with this \
+         mode"
+    | Comonadic Linearity, Once ->
+      Some "Functions with this mode can only be called once"
+    | Comonadic Linearity, Many ->
+      Some "Functions with this mode can be called any number of times"
+    | Comonadic Yielding, Yielding ->
+      Some "Functions with this mode can jump to effect handlers"
     | Comonadic Yielding, Unyielding ->
-      Some "This value cannot perform an effect"
+      Some "Functions within this value will never jump to an effect handler"
     | Monadic Visibility, Immutable ->
-      Some
-        "This usage of the value cannot read or write the mutable parts of the \
-         value"
+      Some "The mutable parts of values with this mode cannot be accessed"
     | Monadic Visibility, Read ->
       Some
-        "This usage of the value can read but not write the mutable parts of \
-         the value"
+        "The mutable parts of values with this mode can be read, but not \
+         written"
     | Monadic Visibility, Read_write ->
-      Some
-        "This usage of the value can read and write the mutable parts of the \
-         value"
+      Some "The mutable parts of values with this mode can be fully accessed"
     | Comonadic Statefulness, Stateful ->
-      Some "This value can read and write mutable data"
+      Some "Functions with this mode can read and write mutable data"
     | Comonadic Statefulness, Observing ->
-      Some "This value can read but not write mutable data"
+      Some "Functions with this mode can read but not write mutable data"
     | Comonadic Statefulness, Stateless ->
-      Some "This value cannot read or write mutable data"
+      Some "Functions with this mode cannot access mutable data"
   in
   let doc_url =
     let subpage =
@@ -291,13 +295,13 @@ let get_modality_doc modality =
     match axis with
     | Comonadic _ ->
       Format.asprintf
-        "This value is always at least as strong as `%s`, even if the \
-         container has a weaker mode."
+        "The annotated value's mode is always at least as strong as `%s`, even \
+         if its container's mode is weaker."
         modality
     | Monadic _ ->
       Format.asprintf
-        "This value is always at least as weak as `%s`, even if the container \
-         has a stronger mode."
+        "The annotated value's mode is always at least as weak as `%s`, even \
+         if its container's mode is a stronger."
         modality
   in
   (Some
@@ -382,24 +386,26 @@ let get_oxcaml_syntax_doc cursor_loc nodes : syntax_info =
         | "opt" ->
           Some
             { name = "Zero-alloc opt annotation";
-              description = "Same as [@zero_alloc] in optimized builds only.";
+              description =
+                "Same as [@zero_alloc], but checks during optimized builds \
+                 only.";
               documentation = doc_url;
               level = Advanced
             }
         | "assume" ->
           Some
             { name = "Zero-alloc assume annotation";
               description =
-                "This function is assumed to be \"zero_alloc\" but the \
-                 compiler does not guarantee it.";
+                "This function is assumed to be zero-alloc, but the compiler \
+                 does not guarantee it.";
               documentation = doc_url;
               level = Advanced
             }
         | "assume_unless_opt" ->
           Some
             { name = "Zero-alloc assume_unless_opt annotation";
               description =
-                "Same as [@zero_alloc opt]  in optimized builds. Same as \
+                "Same as [@zero_alloc opt] in optimized builds. Same as \
                  [@zero_alloc assume] in non-optimized builds.";
               documentation = doc_url;
               level = Advanced
@@ -409,7 +415,7 @@ let get_oxcaml_syntax_doc cursor_loc nodes : syntax_info =
             { name = "Zero-alloc strict annotation";
               description =
                 "This function does not allocate on the OCaml heap (both \
-                 normal and exception returns).";
+                 normal and exceptional returns).";
               documentation = doc_url;
               level = Advanced
             }
@@ -474,12 +480,8 @@ let get_oxcaml_syntax_doc cursor_loc nodes : syntax_info =
           Some
             { name = "Inline never annotation";
               description =
-                "On a function declaration, causes the function to never be \
-                 inlined at any call site (can be overridden by [@inlined]).  \
-                 Further, this prevents inlining into any other source file \
-                 (even if explicitly requested at a call site in such file; \
-                 call sites within the same source file can use [@inlined] to \
-                 override)";
+                "This function will not be inlined. In this file (only), this \
+                 can be overridden at call sites with [@inlined].";
               documentation = builtin_attrs_doc_url;
               level = Advanced
             }
@@ -508,13 +510,13 @@ let get_oxcaml_syntax_doc cursor_loc nodes : syntax_info =
         Some
           { name = "Inlined always annotation";
             description =
-              "On a function call site, causes the function to be inlined.  \
-               The function must be known to the optimizer (i.e. not an \
-               indirect call; and if in another source file, the .cmx for that \
-               file must be available and the function available for inlining \
-               e.g. by [@inline always] or [@inline available] or the decision \
-               of the optimizer).  This attribute can override [@inline never] \
-               but only within the same source file.";
+              "If possible, this function call will be inlined.  The function \
+               must be known to the optimizer (i.e. not an indirect call; and \
+               if in another source file, the .cmx for that file must be \
+               available and the function available for inlining e.g. by \
+               [@inline always] or [@inline available] or the decision of the \
+               optimizer).  This attribute can override [@inline never] but \
+               only within the same source file.";
             documentation = builtin_attrs_doc_url;
             level = Advanced
           }
@@ -537,19 +539,18 @@ let get_oxcaml_syntax_doc cursor_loc nodes : syntax_info =
           Some
             { name = "Inlined never annotation";
               description =
-                "On a function call site, causes the function to never be \
-                 inlined, overriding any attribute on the function's \
-                 declaration.";
+                "This function call will not be inlined, overriding any \
+                 attribute on the function's declaration.";
               documentation = builtin_attrs_doc_url;
               level = Advanced
             }
         | "hint" ->
           Some
             { name = "Inlined hint annotation";
               description =
-                "On a function call site, causes the function to be inlined if \
-                 possible (like [@inlined always]) but suppresses the warning \
-                 when it is not possible.";
+                "If possible, this function call will be inlined, like \
+                 [@inlined always]. However, no warning is emitted when \
+                 inlining is not possible.";
               documentation = None;
               level = Advanced
             }
@@ -622,7 +623,9 @@ let get_oxcaml_syntax_doc cursor_loc nodes : syntax_info =
     | { attr_name = { txt = "nontail"; _ }; _ } ->
       Some
         { name = "nontail annotation";
-          description = "Prevent this function call from being tail-called";
+          description =
+            "This function call will be called normally (with a fresh stack \
+             frame), despite appearing in tail position";
           documentation = stack_allocation_url;
           level = Advanced
         }
@@ -687,7 +690,9 @@ let get_oxcaml_syntax_doc cursor_loc nodes : syntax_info =
     | Before ->
       Some
         { name = "Module strengthening";
-          description = "";
+          description =
+            "Mark each type in this module type as equal to the corresponding \
+             type in the given module";
           documentation =
             syntax_doc_url Oxcaml
               "miscellaneous-extensions/module-strengthening/";
@@ -698,7 +703,9 @@ let get_oxcaml_syntax_doc cursor_loc nodes : syntax_info =
   | Expression { exp_desc = Texp_exclave _; _ } :: _ ->
     Some
       { name = "exclave_";
-        description = "Delete the current region and excute the following code";
+        description =
+          "End the current region; the following code allocates in the outer \
+           region";
         documentation = stack_allocation_url;
         level = Advanced
       }

tests/test-dirs/syntax-document/language-extensions.t/run.t

@@ -273,18 +273,27 @@ on (module S : Set.S with type elt = s)
   > -filename ./first-class-modules.ml < ./first-class-modules.ml | jq '.value.name'
   "First class module"
 
-  $ syn_doc_name () {
+  $ call_syntax_doc_and_extract_field () {
   >   file="$1"
   >   line="$2"
   >   col="$3"
+  >   field="$4"
   >   
   >   # Print the line, with a ^ underneath pointing at the character
   >   sed -n "${line}p" "$file"
   >   printf "%*s^\n" "$col" ""
   >   
   >   # Call merlin on the position
   >   "$MERLIN" single syntax-document -position  "$line:$col" -filename "$file" < "$file" \
-  >     | jq 'if (.value | type) == "string" then .value else .value.name end' -r
+  >     | jq "if (.value | type) == \"string\" then .value else .value.$field end" -r
+  > }
+
+  $ syn_doc_name () {
+  >   call_syntax_doc_and_extract_field "$1" "$2" "$3" name
+  > }
+
+  $ syn_doc_desc () {
+  >   call_syntax_doc_and_extract_field "$1" "$2" "$3" description
   > }
 
 Convenience function to ensure we haven't made any syntax errors.
@@ -367,6 +376,11 @@ Convenience function to ensure we haven't made any syntax errors.
                    ^
   No documentation found
 
+  $ syn_doc_desc modes.ml 5 17
+  let x : int @ local = 10
+                   ^
+  No documentation found
+
 // Modalities
 # CR-someday: Add raw modalities (and @@?) to typedtree so this information can be recovered
 
@@ -420,6 +434,11 @@ Convenience function to ensure we haven't made any syntax errors.
                               ^
   Record Type
 
+  $ syn_doc_desc modalities.ml 5 28
+  type t = { foo : int @@ contended }
+                              ^
+  Defines variants with a fixed set of fields
+
 // Kinds
 
   $ cat > kinds.ml << EOF
@@ -509,6 +528,21 @@ Convenience function to ensure we haven't made any syntax errors.
                               ^
   Mod-bound
 
+  $ syn_doc_desc kinds.ml 7 13
+  type t : float64 mod everything
+               ^
+  The layout of types represented by a 64-bit machine float.
+
+  $ syn_doc_desc kinds.ml 7 28
+  type t : float64 mod everything
+                              ^
+  Synonym for "global aliased many contended portable unyielding immutable stateless external_", convenient for describing immediates.
+
+  $ syn_doc_desc kinds.ml 1 40
+  type ('a : immediate) t : value mod portable with 'a @@ global
+                                          ^
+  Values of this type can cross to `portable` from weaker modes.
+
 // include functor
 
   $ cat > include_functor.ml << EOF
@@ -840,3 +874,26 @@ Convenience function to ensure we haven't made any syntax errors.
   module type S = S with M
                          ^
   No documentation found
+
+Validate that docstrings, URLs, and levels are being created correctly
+
+  $ cat > validate.ml << EOF
+  > let rec name1 = 1 :: name2 and name2 = 2 :: name1
+  > type t : value
+  > EOF
+
+  $ $MERLIN single syntax-document -position 1:6 -filename validate.ml < validate.ml | jq .value
+  {
+    "name": "Recursive value definition",
+    "description": "Supports a certain class of recursive definitions of non-functional values.",
+    "url": "https://ocaml.org/manual/5.2/letrecvalues.html",
+    "level": "simple"
+  }
+
+  $ $MERLIN single syntax-document -position 2:11 -filename validate.ml < validate.ml | jq .value
+  {
+    "name": "Kind abbreviation",
+    "description": "The kind of ordinary OCaml types",
+    "url": "https://oxcaml.org/documentation/kinds/syntax/",
+    "level": "advanced"
+  }