Add syntax for tables

src/ast.ml

@@ -9,6 +9,7 @@
 
 type 'a with_location = 'a Loc.with_location
 type style = [ `Bold | `Italic | `Emphasis | `Superscript | `Subscript ]
+type alignment = [ `Left | `Center | `Right ]
 
 type reference_kind = [ `Simple | `With_text ]
 (** References in doc comments can be of two kinds: [{!simple}] or [{{!ref}With text}]. *)
@@ -29,6 +30,11 @@ type inline_element =
     text. Similarly the [`Link] constructor has the link itself as first parameter
     and the second is the replacement text. *)
 
+type 'a cell = 'a with_location list * [ `Header | `Data ]
+type 'a row = 'a cell list
+type 'a grid = 'a row list
+type 'a abstract_table = 'a grid * alignment option list option
+
 type nestable_block_element =
   [ `Paragraph of inline_element with_location list
   | `Code_block of
@@ -41,13 +47,16 @@ type nestable_block_element =
     [ `Unordered | `Ordered ]
     * [ `Light | `Heavy ]
     * nestable_block_element with_location list list
+  | `Table of table
   | `Math_block of string  (** @since 2.0.0 *) ]
 (** Some block elements may be nested within lists or tags, but not all.
     The [`List] constructor has a parameter of type [\[`Light | `Heavy\]].
     This corresponds to the syntactic constructor used (see the
     {{:https://ocaml.org/releases/4.12/htmlman/ocamldoc.html#sss:ocamldoc-list}manual}).
     *)
 
+and table = nestable_block_element abstract_table * [ `Light | `Heavy ]
+
 type internal_tag =
   [ `Canonical of string with_location | `Inline | `Open | `Closed ]
 (** Internal tags are used to exercise fine control over the output of odoc. They

src/compat.ml

@@ -0,0 +1,32 @@
+module Option = struct
+  type 'a t = 'a option = None | Some of 'a
+
+  let is_some = function None -> false | Some _ -> true
+  let value ~default = function None -> default | Some x -> x
+
+  let join_list l =
+    let rec loop acc = function
+      | [] -> Some (List.rev acc)
+      | Some a :: q -> loop (a :: acc) q
+      | None :: _ -> None
+    in
+    loop [] l
+end
+
+module Char = struct
+  include Char
+
+  let equal (x : char) y = x = y
+end
+
+module String = struct
+  include String
+
+  let for_all f str =
+    let rec aux i =
+      if i >= String.length str then true
+      else if f (String.get str i) then aux (i + 1)
+      else false
+    in
+    aux 0
+end

src/compat.mli

@@ -0,0 +1,26 @@
+(** @since 4.08 *)
+module Option : sig
+  type 'a t = 'a option = None | Some of 'a
+
+  val is_some : 'a option -> bool
+  (** [is_some o] is [true] if and only if [o] is [Some o]. *)
+
+  val value : default:'a -> 'a option -> 'a
+  val join_list : 'a option list -> 'a list option
+end
+
+module Char : sig
+  include module type of Char
+
+  val equal : t -> t -> bool
+  (** The equal function for chars.
+      @since 4.03.0 *)
+end
+
+module String : sig
+  include module type of String
+
+  val for_all : (char -> bool) -> string -> bool
+  (** [for_all p s] checks if all characters in [s] satisfy the preficate [p].
+      @since 4.13.0 *)
+end

src/lexer.mll

@@ -244,7 +244,7 @@ let heading_level input level =
 
 
 let markup_char =
-  ['{' '}' '[' ']' '@']
+  ['{' '}' '[' ']' '@' '|']
 let space_char =
   [' ' '\t' '\n' '\r']
 let bullet_char =
@@ -289,6 +289,9 @@ rule token input = parse
   | (horizontal_space* (newline horizontal_space*)? as p) '}'
     { emit input `Right_brace ~adjust_start_by:p }
 
+  | '|'
+    { emit input `Bar }
+
   | word_char (word_char | bullet_char | '@')*
   | bullet_char (word_char | bullet_char | '@')+ as w
     { emit input (`Word (unescape_word w)) }
@@ -398,6 +401,21 @@ rule token input = parse
   | "{-"
     { emit input (`Begin_list_item `Dash) }
 
+  | "{table"
+    { emit input (`Begin_table_heavy) }
+
+  | "{t"
+    { emit input (`Begin_table_light) }
+
+  | "{tr"
+    { emit input `Begin_table_row }
+
+  | "{th"
+    { emit input (`Begin_table_cell `Header) }
+
+  | "{td"
+    { emit input (`Begin_table_cell `Data) }
+
   | '{' (['0'-'9']+ as level) ':' (([^ '}'] # space_char)* as label)
     { emit
         input (`Begin_section_heading (heading_level input level, Some label)) }

src/loc.ml

@@ -22,3 +22,11 @@ let span spans =
 
 let nudge_start offset span =
   { span with start = { span.start with column = span.start.column + offset } }
+
+let spans_multiple_lines = function
+  | {
+      location =
+        { start = { line = start_line; _ }; end_ = { line = end_line; _ }; _ };
+      _;
+    } ->
+      end_line > start_line

src/loc.mli

@@ -39,3 +39,7 @@ val map : ('a -> 'b) -> 'a with_location -> 'b with_location
 val same : _ with_location -> 'b -> 'b with_location
 (** [same x y] retuns the value y wrapped in a {!with_location} whose
     location is that of [x] *)
+
+val spans_multiple_lines : _ with_location -> bool
+(** [spans_multiple_lines x] checks to see whether [x] is located
+    on a single line or whether it covers more than one. *)