diff --git a/src/document/ML.ml b/src/document/ML.ml index 2af28bed4f..d99c823383 100644 --- a/src/document/ML.ml +++ b/src/document/ML.ml @@ -4,7 +4,7 @@ open O.Infix module ML = Generator.Make (struct module Obj = struct - let close_tag_closed = ">" + let close_tag_closed = " >" let close_tag_extendable = ".. >" @@ -18,11 +18,11 @@ module ML = Generator.Make (struct module Type = struct let annotation_separator = " : " - let handle_params name args = O.span (args ++ O.txt " " ++ name) + let handle_params name args = O.span (args ++ O.sp ++ name) let handle_constructor_params = handle_params - let handle_substitution_params = handle_params + let handle_substitution_params name args = O.span (args ++ O.txt " " ++ name) let handle_format_params p = p @@ -37,7 +37,7 @@ module ML = Generator.Make (struct end module Tuple = struct - let element_separator = " * " + let element_separator = O.sp ++ O.txt "* " let always_parenthesize = false end diff --git a/src/document/codefmt.ml b/src/document/codefmt.ml index a62709edf0..a66f3496d7 100644 --- a/src/document/codefmt.ml +++ b/src/document/codefmt.ml @@ -3,23 +3,36 @@ open Types type out = Source.t module State = struct - type t = { context : (out * Source.tag) Stack.t; mutable current : out } + type t = { + context : (out * Source.tag) Stack.t; + mutable current : out; + mutable ignore_all : int; + } - let create () = { context = Stack.create (); current = [] } + let create () = { context = Stack.create (); current = []; ignore_all = 0 } - let push state elt = state.current <- elt :: state.current + let push state elt = + if state.ignore_all = 0 then state.current <- elt :: state.current + + let push_ignore state = state.ignore_all <- state.ignore_all + 1 + + let pop_ignore state = + state.ignore_all <- + (if state.ignore_all > 0 then state.ignore_all - 1 else 0) let enter state tag = - let previous_elt = state.current in - Stack.push (previous_elt, tag) state.context; - state.current <- []; - () + if state.ignore_all = 0 then ( + let previous_elt = state.current in + Stack.push (previous_elt, tag) state.context; + state.current <- []; + ()) let leave state = - let current_elt = List.rev state.current in - let previous_elt, tag = Stack.pop state.context in - state.current <- Tag (tag, current_elt) :: previous_elt; - () + if state.ignore_all = 0 then ( + let current_elt = List.rev state.current in + let previous_elt, tag = Stack.pop state.context in + state.current <- Tag (tag, current_elt) :: previous_elt; + ()) let rec flush state = if Stack.is_empty state.context then List.rev state.current @@ -36,6 +49,7 @@ module Tag = struct type Format.stag += | Elt of Inline.t | Tag of Source.tag + | Ignore let setup_tags formatter state0 = let stag_functions = @@ -44,11 +58,13 @@ module Tag = struct | Tag tag -> State.enter state0 tag; "" | Format.String_tag "" -> State.enter state0 None; "" | Format.String_tag tag -> State.enter state0 (Some tag); "" + | Ignore -> State.push_ignore state0; "" | _ -> "" and mark_close_stag = function | Elt _ -> "" | Tag _ | Format.String_tag _ -> State.leave state0; "" + | Ignore -> State.pop_ignore state0; "" | _ -> "" in {Format. print_open_stag = (fun _ -> ()); @@ -62,8 +78,13 @@ module Tag = struct let elt ppf elt = Format.pp_open_stag ppf (Elt elt); + Format.pp_print_as ppf (Utils.compute_length_inline elt) ""; Format.pp_close_stag ppf () + let ignore ppf txt = + Format.pp_open_stag ppf Ignore; + Format.fprintf ppf "%t" txt; + Format.pp_close_stag ppf () end *) @@ -73,15 +94,19 @@ module Tag = struct let setup_tags formatter state0 = let tag_functions = let get_tag s = - let prefix_tag = "tag:" in + let prefix_tag = "tag:" and prefix_ignore = "ignore-tag" in let l = String.length prefix_tag in if String.length s > l && String.sub s 0 l = prefix_tag then let elt : Inline.t = Marshal.from_string s l in `Elt elt + else if s = prefix_ignore then `Ignore else `String s in let mark_open_tag s = match get_tag s with + | `Ignore -> + State.push_ignore state0; + "" | `Elt elt -> State.push state0 (Elt elt); "" @@ -93,6 +118,9 @@ module Tag = struct "" and mark_close_tag s = match get_tag s with + | `Ignore -> + State.pop_ignore state0; + "" | `Elt _ -> "" | `String _ -> State.leave state0; @@ -110,15 +138,20 @@ module Tag = struct () let elt ppf (elt : Inline.t) = - Format.fprintf ppf "@{@}" (Marshal.to_string elt []) + Format.fprintf ppf "@{%t@}" (Marshal.to_string elt []) (fun fmt -> + Format.pp_print_as fmt (Utils.compute_length_inline elt) "") + + let ignore ppf txt = Format.fprintf ppf "@{%t@}" txt end [@@alert "-deprecated--deprecated"] +type t = Format.formatter -> unit + let make () = let open Inline in let state0 = State.create () in let push elt = State.push state0 (Elt elt) in - let push_text s = push [ inline @@ Text s ] in + let push_text s = if state0.ignore_all = 0 then push [ inline @@ Text s ] in let formatter = let out_string s i j = push_text (String.sub s i j) in @@ -137,6 +170,7 @@ let make () = * in * let formatter = Format.formatter_of_out_functions out_functions in *) Tag.setup_tags formatter state0; + Format.pp_set_margin formatter 80; ( (fun () -> Format.pp_print_flush formatter (); State.flush state0), @@ -148,11 +182,11 @@ let spf fmt = let pf = Format.fprintf -(** Transitory hackish API *) +let elt t ppf = Tag.elt ppf t -let elt = Tag.elt +let entity e ppf = elt [ inline @@ Inline.Entity e ] ppf -let entity e ppf = elt ppf [ inline @@ Inline.Entity e ] +let ignore t ppf = Tag.ignore ppf t let ( ++ ) f g ppf = f ppf; @@ -170,8 +204,6 @@ let cut = break 0 0 let sp = break 1 0 -let ( ! ) (pp : _ Fmt.t) x ppf = pp ppf x - let rec list ?sep ~f = function | [] -> noop | [ x ] -> f x @@ -180,7 +212,11 @@ let rec list ?sep ~f = function let tl = list ?sep ~f xs in match sep with None -> hd ++ tl | Some sep -> hd ++ sep ++ tl) -let render f = spf "@[%t@]" (span f) +let box_hv t ppf = pf ppf "@[%t@]" t + +let box_hv_no_indent t ppf = pf ppf "@[%t@]" t + +let render f = spf "@[%t@]" (span f) let code ?attr f = [ inline ?attr @@ Inline.Source (render f) ] @@ -191,7 +227,5 @@ let codeblock ?attr f = [ block ?attr @@ Block.Source (render f) ] let keyword keyword ppf = pf ppf "@{%s@}" keyword module Infix = struct - let ( ! ) = ( ! ) - let ( ++ ) = ( ++ ) end diff --git a/src/document/codefmt.mli b/src/document/codefmt.mli new file mode 100644 index 0000000000..6f405172e4 --- /dev/null +++ b/src/document/codefmt.mli @@ -0,0 +1,39 @@ +open Types + +type t + +val elt : Inline.t -> t + +val entity : Inline.entity -> t + +val ignore : t -> t + +val span : ?attr:string -> t -> t + +val txt : string -> t + +val noop : t + +val cut : t + +val sp : t + +val list : ?sep:t -> f:('a -> t) -> 'a list -> t + +val box_hv : t -> t + +val box_hv_no_indent : t -> t + +val render : t -> Source.t + +val code : ?attr:string list -> t -> Inline.t + +val documentedSrc : t -> DocumentedSrc.t + +val codeblock : ?attr:Class.t -> t -> Block.t + +val keyword : string -> t + +module Infix : sig + val ( ++ ) : t -> t -> t +end diff --git a/src/document/dune b/src/document/dune index 80112ebcce..b4f0b06513 100644 --- a/src/document/dune +++ b/src/document/dune @@ -3,4 +3,4 @@ (public_name odoc.document) (instrumentation (backend bisect_ppx)) - (libraries odoc_model fmt fpath)) + (libraries odoc_model fpath)) diff --git a/src/document/generator.ml b/src/document/generator.ml index 028da6e014..8bb05eaa2b 100644 --- a/src/document/generator.ml +++ b/src/document/generator.ml @@ -41,26 +41,26 @@ let make_name_from_path { Url.Path.name; parent; _ } = | None -> name | Some p -> Printf.sprintf "%s.%s" p.name name -let label t ppf = +let label t = match t with - | Odoc_model.Lang.TypeExpr.Label s -> O.pf ppf "%s" s - | Optional s -> O.pf ppf "?%s" s + | Odoc_model.Lang.TypeExpr.Label s -> O.txt s + | Optional s -> O.txt "?" ++ O.txt s -let tag tag t ppf = O.pf ppf "@{<%s>%t@}" tag t +let tag tag t = O.span ~attr:tag t let type_var tv = tag "type-var" (O.txt tv) -let enclose ~l ~r x = O.span (fun ppf -> O.pf ppf "%s%t%s" l x r) +let enclose ~l ~r x = O.span (O.txt l ++ x ++ O.txt r) let path p txt = - !O.elt + O.elt [ inline @@ InternalLink (InternalLink.Resolved (Url.from_path p, txt)) ] let resolved p txt = - !O.elt [ inline @@ InternalLink (InternalLink.Resolved (p, txt)) ] + O.elt [ inline @@ InternalLink (InternalLink.Resolved (p, txt)) ] let unresolved txt = - !O.elt [ inline @@ InternalLink (InternalLink.Unresolved txt) ] + O.elt [ inline @@ InternalLink (InternalLink.Unresolved txt) ] let path_to_id path = match Url.Anchor.from_identifier (path :> Paths.Identifier.t) with @@ -235,9 +235,8 @@ module Make (Syntax : SYNTAX) = struct let first = match first with | Odoc_model.Lang.TypeExpr.Polymorphic_variant.Type te -> - let res = type_expr te in - if add_pipe then O.txt " " ++ O.span (O.txt "| " ++ res) - else res + let res = O.box_hv @@ type_expr te in + if add_pipe then O.sp ++ O.span (O.txt "| " ++ res) else res | Constructor { constant; name; arguments; _ } -> let constr = let name = "`" ^ name in @@ -245,37 +244,42 @@ module Make (Syntax : SYNTAX) = struct else O.txt name in let res = - match arguments with - | [] -> constr - | _ -> - let arguments = style_arguments ~constant arguments in - O.span - (if Syntax.Type.Variant.parenthesize_params then - constr ++ arguments - else constr ++ O.txt " of " ++ arguments) + O.box_hv + (match arguments with + | [] -> constr + | _ -> + let arguments = style_arguments ~constant arguments in + O.span + (if Syntax.Type.Variant.parenthesize_params then + constr ++ arguments + else constr ++ O.txt " of" ++ O.sp ++ arguments)) in - if add_pipe then O.txt " " ++ res else res + if add_pipe then O.sp ++ res else res in first ++ style_elements ~add_pipe:true rest in let elements = style_elements ~add_pipe:false t.elements in - O.span - (match t.kind with - | Fixed -> O.txt "[ " ++ elements ++ O.txt " ]" - | Open -> O.txt "[> " ++ elements ++ O.txt " ]" - | Closed [] -> O.txt "[< " ++ elements ++ O.txt " ]" - | Closed lst -> - let constrs = String.concat " " lst in - O.txt "[< " ++ elements ++ O.txt (" " ^ constrs ^ " ]")) + O.box_hv_no_indent + @@ O.span + (match t.kind with + | Fixed -> O.txt "[ " ++ elements ++ O.txt " ]" + | Open -> O.txt "[> " ++ elements ++ O.txt " ]" + | Closed [] -> O.txt "[< " ++ elements ++ O.txt " ]" + | Closed lst -> + let constrs = String.concat " " lst in + O.txt "[< " ++ elements ++ O.txt (" " ^ constrs ^ " ]")) and te_object (t : Odoc_model.Lang.TypeExpr.Object.t) = let fields = - O.list t.fields ~f:(function - | Odoc_model.Lang.TypeExpr.Object.Method { name; type_ } -> - O.txt (name ^ Syntax.Type.annotation_separator) - ++ type_expr type_ - ++ O.txt Syntax.Obj.field_separator - | Inherit type_ -> type_expr type_ ++ O.txt Syntax.Obj.field_separator) + O.list + ~sep:(O.sp ++ O.txt Syntax.Obj.field_separator) + t.fields + ~f:(function + | Odoc_model.Lang.TypeExpr.Object.Method { name; type_ } -> + O.box_hv_no_indent + @@ O.txt (name ^ Syntax.Type.annotation_separator) + ++ O.cut ++ type_expr type_ + | Inherit type_ -> O.box_hv_no_indent @@ type_expr type_) in let open_tag = if t.open_ then O.txt Syntax.Obj.open_tag_extendable @@ -289,6 +293,8 @@ module Make (Syntax : SYNTAX) = struct and format_type_path ~delim (params : Odoc_model.Lang.TypeExpr.t list) (path : text) : text = + O.box_hv + @@ match params with | [] -> path | [ param ] -> @@ -300,13 +306,13 @@ module Make (Syntax : SYNTAX) = struct in Syntax.Type.handle_constructor_params path args | params -> - let params = O.list params ~sep:(O.txt ",\194\160") ~f:type_expr in + let params = O.list params ~sep:(O.txt "," ++ O.sp) ~f:type_expr in let params = match delim with - | `parens -> enclose ~l:"(" params ~r:")" - | `brackets -> enclose ~l:"[" params ~r:"]" + | `parens -> enclose ~l:"( " params ~r:" )" + | `brackets -> enclose ~l:"[ " params ~r:" ]" in - Syntax.Type.handle_constructor_params path params + Syntax.Type.handle_constructor_params path (O.box_hv params) and type_expr ?(needs_parentheses = false) (t : Odoc_model.Lang.TypeExpr.t) = @@ -319,25 +325,27 @@ module Make (Syntax : SYNTAX) = struct | Arrow (None, src, dst) -> let res = O.span - (type_expr ~needs_parentheses:true src + ((O.box_hv @@ type_expr ~needs_parentheses:true src) ++ O.txt " " ++ Syntax.Type.arrow) - ++ O.txt " " ++ type_expr dst + ++ O.sp ++ type_expr dst + (* ++ O.end_hv *) in - if not needs_parentheses then res else enclose ~l:"(" res ~r:")" + if not needs_parentheses then res else enclose ~l:"( " res ~r:" )" | Arrow (Some lbl, src, dst) -> let res = O.span - (label lbl ++ O.txt ":" - ++ type_expr ~needs_parentheses:true src - ++ O.sp ++ Syntax.Type.arrow) + ((O.box_hv + @@ label lbl ++ O.txt ":" ++ O.cut + ++ (O.box_hv @@ type_expr ~needs_parentheses:true src)) + ++ O.txt " " ++ Syntax.Type.arrow) ++ O.sp ++ type_expr dst in - if not needs_parentheses then res else enclose ~l:"(" res ~r:")" + if not needs_parentheses then res else enclose ~l:"( " res ~r:" )" | Tuple lst -> let res = - O.list lst - ~sep:(O.txt Syntax.Type.Tuple.element_separator) - ~f:(type_expr ~needs_parentheses:true) + O.box_hv_no_indent + (O.list lst ~sep:Syntax.Type.Tuple.element_separator + ~f:(type_expr ~needs_parentheses:true)) in if Syntax.Type.Tuple.always_parenthesize || needs_parentheses then enclose ~l:"(" res ~r:")" @@ -351,7 +359,7 @@ module Make (Syntax : SYNTAX) = struct format_type_path ~delim:`brackets args (Link.from_path (path :> Paths.Path.t)) | Poly (polyvars, t) -> - O.txt (String.concat " " polyvars ^ ". ") ++ type_expr t + O.txt ("'" ^ String.concat " '" polyvars ^ ". ") ++ type_expr t | Package pkg -> enclose ~l:"(" ~r:")" (O.keyword "module" ++ O.txt " " @@ -359,17 +367,21 @@ module Make (Syntax : SYNTAX) = struct ++ match pkg.substitutions with | [] -> O.noop - | lst -> - O.txt " " ++ O.keyword "with" ++ O.txt " " - ++ O.list - ~sep:(O.txt " " ++ O.keyword "and" ++ O.txt " ") - lst ~f:package_subst) + | fst :: lst -> + O.sp + ++ O.box_hv (O.keyword "with" ++ O.txt " " ++ package_subst fst) + ++ O.list lst ~f:(fun s -> + O.cut + ++ (O.box_hv + @@ O.txt " " ++ O.keyword "and" ++ O.txt " " + ++ package_subst s))) and package_subst ((frag_typ, te) : Paths.Fragment.Type.t * Odoc_model.Lang.TypeExpr.t) : text = let typath = Link.from_fragment (frag_typ :> Paths.Fragment.leaf) in - O.keyword "type" ++ O.txt " " ++ typath ++ O.txt " = " ++ type_expr te + O.keyword "type" ++ O.txt " " ++ typath ++ O.txt " =" ++ O.sp + ++ type_expr te end open Type_expression @@ -464,8 +476,7 @@ module Make (Syntax : SYNTAX) = struct | Tuple [] -> O.documentedSrc (cstr ++ ret_type) | Tuple lst -> let params = - O.list lst - ~sep:(O.txt Syntax.Type.Tuple.element_separator) + O.list lst ~sep:Syntax.Type.Tuple.element_separator ~f:(type_expr ~needs_parentheses:is_gadt) in O.documentedSrc @@ -558,11 +569,13 @@ module Make (Syntax : SYNTAX) = struct DocumentedSrc.Nested { anchor; attrs; code; doc; markers } let extension (t : Odoc_model.Lang.Extension.t) = + let prefix = + O.keyword "type" ++ O.txt " " + ++ Link.from_path (t.type_path :> Paths.Path.t) + ++ O.txt " +=" ++ O.sp + in let content = - O.documentedSrc - (O.keyword "type" ++ O.txt " " - ++ Link.from_path (t.type_path :> Paths.Path.t) - ++ O.txt " += ") + O.documentedSrc prefix @ List.map extension_constructor t.constructors @ O.documentedSrc (if Syntax.Type.type_def_semicolon then O.txt ";" else O.noop) @@ -610,7 +623,10 @@ module Make (Syntax : SYNTAX) = struct else fun x -> type_expr x in let params = - O.list arguments ~sep:(O.txt " & ") ~f:wrapped_type_expr + O.box_hv + @@ O.list arguments + ~sep:(O.txt " &" ++ O.sp) + ~f:wrapped_type_expr in let params = if constant then O.txt "& " ++ params else params @@ -619,7 +635,7 @@ module Make (Syntax : SYNTAX) = struct (O.txt cstr ++ if Syntax.Type.Variant.parenthesize_params then params - else O.txt " " ++ O.keyword "of" ++ O.txt " " ++ params)), + else O.txt " " ++ O.keyword "of" ++ O.sp ++ params)), match doc with [] -> None | _ -> Some (Comment.to_ir doc) )) in let markers = Syntax.Comment.markers in @@ -686,8 +702,12 @@ module Make (Syntax : SYNTAX) = struct let format_constraints constraints = O.list constraints ~f:(fun (t1, t2) -> - O.txt " " ++ O.keyword "constraint" ++ O.txt " " ++ type_expr t1 - ++ O.txt " = " ++ type_expr t2) + O.sp + ++ (O.box_hv + @@ O.keyword "constraint" ++ O.sp + ++ O.box_hv_no_indent (type_expr t1) + ++ O.txt " =" ++ O.sp + ++ O.box_hv_no_indent (type_expr t2))) let format_manifest : 'inner_row 'outer_row. @@ -703,7 +723,8 @@ module Make (Syntax : SYNTAX) = struct | None -> (O.noop, private_) | Some t -> let manifest = - O.txt (if is_substitution then " := " else " = ") + O.txt (if is_substitution then " :=" else " =") + ++ O.sp ++ (if private_ then O.keyword Syntax.Type.private_keyword ++ O.txt " " else O.noop) @@ -713,9 +734,23 @@ module Make (Syntax : SYNTAX) = struct let type_decl ?(is_substitution = false) ((recursive, t) : Lang.Signature.recursive * Lang.TypeDecl.t) = + let keyword' = + match recursive with + | Ordinary | Rec -> O.keyword "type" + | And -> O.keyword "and" + | Nonrec -> O.keyword "type" ++ O.txt " " ++ O.keyword "nonrec" + in let tyname = Paths.Identifier.name t.id in + let tconstr = + match t.equation.params with + | [] -> O.txt tyname + | l -> + let params = format_params l in + Syntax.Type.handle_constructor_params (O.txt tyname) params + in + let intro = keyword' ++ O.txt " " ++ tconstr in let constraints = format_constraints t.equation.constraints in - let manifest, need_private = + let manifest, need_private, long_prefix = match t.equation.manifest with | Some (Odoc_model.Lang.TypeExpr.Polymorphic_variant variant) -> let code = @@ -725,19 +760,22 @@ module Make (Syntax : SYNTAX) = struct in let manifest = O.documentedSrc - (O.txt (if is_substitution then " := " else " = ") + (O.ignore intro + ++ O.txt (if is_substitution then " :=" else " =") + ++ O.sp ++ if t.equation.private_ then O.keyword Syntax.Type.private_keyword ++ O.txt " " else O.noop) @ code in - (manifest, false) + (manifest, false, O.noop) | _ -> let manifest, need_private = format_manifest ~is_substitution t.equation in - (O.documentedSrc manifest, need_private) + let text = O.ignore intro ++ manifest in + (O.documentedSrc @@ text, need_private, text) in let representation = match t.representation with @@ -751,7 +789,7 @@ module Make (Syntax : SYNTAX) = struct in if List.length content > 0 then O.documentedSrc - (O.txt " = " + (O.ignore long_prefix ++ O.txt " =" ++ O.sp ++ if need_private then O.keyword Syntax.Type.private_keyword ++ O.txt " " @@ -759,22 +797,8 @@ module Make (Syntax : SYNTAX) = struct @ content else [] in - let tconstr = - match t.equation.params with - | [] -> O.txt tyname - | l -> - let params = format_params l in - Syntax.Type.handle_constructor_params (O.txt tyname) params - in let content = - let keyword' = - match recursive with - | Ordinary | Rec -> O.keyword "type" - | And -> O.keyword "and" - | Nonrec -> O.keyword "type" ++ O.txt " " ++ O.keyword "nonrec" - in - O.documentedSrc (keyword' ++ O.txt " " ++ tconstr) - @ manifest @ representation + O.documentedSrc intro @ manifest @ representation @ O.documentedSrc constraints @ O.documentedSrc (if Syntax.Type.type_def_semicolon then O.txt ";" else O.noop) @@ -799,11 +823,12 @@ module Make (Syntax : SYNTAX) = struct let name = Paths.Identifier.name t.id in let content = O.documentedSrc - (O.keyword Syntax.Value.variable_keyword - ++ O.txt " " ++ O.txt name - ++ O.txt Syntax.Type.annotation_separator - ++ type_expr t.type_ - ++ if semicolon then O.txt ";" else O.noop) + (O.box_hv + @@ O.keyword Syntax.Value.variable_keyword + ++ O.txt " " ++ O.txt name + ++ O.txt Syntax.Type.annotation_separator + ++ O.cut ++ type_expr t.type_ + ++ if semicolon then O.txt ";" else O.noop) in let attr = [ "value" ] @ extra_attr in let anchor = path_to_id t.id in @@ -1188,7 +1213,8 @@ module Make (Syntax : SYNTAX) = struct let path = Link.from_path (t.manifest :> Paths.Path.t) in let content = O.documentedSrc - (O.keyword "module" ++ O.txt " " ++ O.txt name ++ O.txt " := " ++ path) + (O.keyword "module" ++ O.txt " " ++ O.txt name ++ O.txt " :=" ++ O.sp + ++ path) in let attr = [ "module-substitution" ] in let anchor = path_to_id t.id in @@ -1197,14 +1223,17 @@ module Make (Syntax : SYNTAX) = struct and module_type_substitution (t : Odoc_model.Lang.ModuleTypeSubstitution.t) = + let prefix = + O.keyword "module" ++ O.txt " " ++ O.keyword "type" ++ O.txt " " + in let modname = Paths.Identifier.name t.id in let modname, expansion_doc, mty = module_type_manifest ~subst:true modname t.id t.doc (Some t.manifest) + prefix in let content = - O.documentedSrc - (O.keyword "module" ++ O.txt " " ++ O.keyword "type" ++ O.txt " ") - @ modname @ mty + O.documentedSrc (prefix ++ modname) + @ mty @ O.documentedSrc (if Syntax.Mod.close_tag_semicolon then O.txt ";" else O.noop) in @@ -1298,7 +1327,7 @@ module Make (Syntax : SYNTAX) = struct in let modname, status, expansion, expansion_doc = match expansion with - | None -> (O.documentedSrc (O.txt modname), `Default, None, None) + | None -> (O.txt modname, `Default, None, None) | Some (expansion_doc, items) -> let status = match t.type_ with @@ -1311,17 +1340,17 @@ module Make (Syntax : SYNTAX) = struct make_expansion_page modname `Mod url [ t.doc; expansion_doc ] items in - (O.documentedSrc link, status, Some page, Some expansion_doc) + (link, status, Some page, Some expansion_doc) in - let summary = mdexpr_in_decl t.id t.type_ in + let intro = O.keyword "module" ++ O.txt " " ++ modname in + let summary = O.ignore intro ++ mdexpr_in_decl t.id t.type_ in let modexpr = attach_expansion ~status (Syntax.Type.annotation_separator, "sig", "end") expansion summary in let content = - O.documentedSrc (O.keyword "module" ++ O.txt " ") - @ modname @ modexpr + O.documentedSrc intro @ modexpr @ O.documentedSrc (if Syntax.Mod.close_tag_semicolon then O.txt ";" else O.noop) in @@ -1341,12 +1370,12 @@ module Make (Syntax : SYNTAX) = struct and mdexpr_in_decl (base : Paths.Identifier.Module.t) md = let sig_dotdotdot = O.txt Syntax.Type.annotation_separator - ++ Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag + ++ O.cut ++ Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag in match md with | Alias (_, Some se) -> simple_expansion_in_decl base se | Alias (p, _) when not Paths.Path.(is_hidden (p :> t)) -> - O.txt " = " ++ mdexpr md + O.txt " =" ++ O.sp ++ mdexpr md | Alias _ -> sig_dotdotdot | ModuleType mt -> mty_in_decl (base :> Paths.Identifier.Signature.t) mt @@ -1354,7 +1383,7 @@ module Make (Syntax : SYNTAX) = struct | Alias (mod_path, _) -> Link.from_path (mod_path :> Paths.Path.t) | ModuleType mt -> mty mt - and module_type_manifest ~subst modname id doc manifest = + and module_type_manifest ~subst modname id doc manifest prefix = let expansion = match manifest with | None -> None @@ -1362,33 +1391,38 @@ module Make (Syntax : SYNTAX) = struct in let modname, expansion, expansion_doc = match expansion with - | None -> (O.documentedSrc @@ O.txt modname, None, None) + | None -> (O.txt modname, None, None) | Some (expansion_doc, items) -> let url = Url.Path.from_identifier id in let link = path url [ inline @@ Text modname ] in let page = make_expansion_page modname `Mty url [ doc; expansion_doc ] items in - (O.documentedSrc link, Some page, Some expansion_doc) + (link, Some page, Some expansion_doc) in let summary = match manifest with | None -> O.noop - | Some expr -> (if subst then O.txt " := " else O.txt " = ") ++ mty expr + | Some expr -> + O.ignore (prefix ++ modname) + ++ (if subst then O.txt " :=" ++ O.sp else O.txt " =" ++ O.sp) + ++ mty expr in ( modname, expansion_doc, attach_expansion (" = ", "sig", "end") expansion summary ) and module_type (t : Odoc_model.Lang.ModuleType.t) = + let prefix = + O.keyword "module" ++ O.txt " " ++ O.keyword "type" ++ O.txt " " + in let modname = Paths.Identifier.name t.id in let modname, expansion_doc, mty = - module_type_manifest ~subst:false modname t.id t.doc t.expr + module_type_manifest ~subst:false modname t.id t.doc t.expr prefix in let content = - O.documentedSrc - (O.keyword "module" ++ O.txt " " ++ O.keyword "type" ++ O.txt " ") - @ modname @ mty + O.documentedSrc (prefix ++ modname) + @ mty @ O.documentedSrc (if Syntax.Mod.close_tag_semicolon then O.txt ";" else O.noop) in @@ -1414,9 +1448,9 @@ module Make (Syntax : SYNTAX) = struct | _ -> false and mty_with subs expr = - umty expr ++ O.txt " " ++ O.keyword "with" ++ O.txt " " + umty expr ++ O.sp ++ O.keyword "with" ++ O.txt " " ++ O.list - ~sep:(O.txt " " ++ O.keyword "and" ++ O.txt " ") + ~sep:(O.cut ++ O.txt " " ++ O.keyword "and" ++ O.txt " ") ~f:(fun x -> O.span (substitution x)) subs @@ -1462,7 +1496,7 @@ module Make (Syntax : SYNTAX) = struct | Functor (Unit, expr) -> (if Syntax.Mod.functor_keyword then O.keyword "functor" else O.noop) ++ O.span (O.txt " () " ++ Syntax.Type.arrow) - ++ O.txt " " ++ mty expr + ++ O.sp ++ mty expr | Functor (Named arg, expr) -> let arg_expr = arg.expr in let stop_before = expansion_of_module_type_expr arg_expr = None in @@ -1476,15 +1510,16 @@ module Make (Syntax : SYNTAX) = struct | Ok href -> resolved href [ inline @@ Text name ] in (if Syntax.Mod.functor_keyword then O.keyword "functor" else O.noop) - ++ O.span - (O.txt " (" ++ name - ++ O.txt Syntax.Type.annotation_separator - ++ mty arg_expr ++ O.txt ")" ++ O.txt " " ++ Syntax.Type.arrow - ) - ++ O.txt " " ++ mty expr + ++ (O.box_hv @@ O.span + @@ O.txt " (" ++ name + ++ O.txt Syntax.Type.annotation_separator + ++ mty arg_expr ++ O.txt ")" ++ O.txt " " ++ Syntax.Type.arrow + ) + ++ O.sp ++ mty expr | With { w_expr; _ } when is_elidable_with_u w_expr -> Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag - | With { w_substitutions; w_expr; _ } -> mty_with w_substitutions w_expr + | With { w_substitutions; w_expr; _ } -> + O.box_hv @@ mty_with w_substitutions w_expr | TypeOf { t_desc; _ } -> mty_typeof t_desc | Signature _ -> Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag @@ -1494,9 +1529,9 @@ module Make (Syntax : SYNTAX) = struct = fun base -> function | (Path _ | Signature _ | With _ | TypeOf _) as m -> - O.txt Syntax.Type.annotation_separator ++ mty m + O.txt Syntax.Type.annotation_separator ++ O.cut ++ mty m | Functor _ as m when not Syntax.Mod.functor_contraction -> - O.txt Syntax.Type.annotation_separator ++ mty m + O.txt Syntax.Type.annotation_separator ++ O.cut ++ mty m | Functor (arg, expr) -> let text_arg = match arg with @@ -1516,11 +1551,12 @@ module Make (Syntax : SYNTAX) = struct | Error _ -> O.txt name | Ok href -> resolved href [ inline @@ Text name ] in - O.txt "(" ++ name - ++ O.txt Syntax.Type.annotation_separator - ++ mty arg.expr ++ O.txt ")" + O.box_hv + @@ O.txt "(" ++ name + ++ O.txt Syntax.Type.annotation_separator + ++ O.cut ++ mty arg.expr ++ O.txt ")" in - O.txt " " ++ text_arg ++ mty_in_decl base expr + O.sp ++ text_arg ++ mty_in_decl base expr (* TODO : Centralize the list juggling for type parameters *) and type_expr_in_subst td typath = @@ -1532,35 +1568,42 @@ module Make (Syntax : SYNTAX) = struct and substitution : Odoc_model.Lang.ModuleType.substitution -> text = function | ModuleEq (frag_mod, md) -> - O.keyword "module" ++ O.sp - ++ Link.from_fragment (frag_mod :> Paths.Fragment.leaf) - ++ O.sp ++ O.txt "= " ++ mdexpr md + O.box_hv + @@ O.keyword "module" ++ O.txt " " + ++ Link.from_fragment (frag_mod :> Paths.Fragment.leaf) + ++ O.txt " =" ++ O.sp ++ mdexpr md | ModuleTypeEq (frag_mty, md) -> - O.keyword "module" ++ O.txt " " ++ O.keyword "type" ++ O.txt " " - ++ Link.from_fragment (frag_mty :> Paths.Fragment.leaf) - ++ O.txt " = " ++ mty md + O.box_hv + @@ O.keyword "module" ++ O.txt " " ++ O.keyword "type" ++ O.txt " " + ++ Link.from_fragment (frag_mty :> Paths.Fragment.leaf) + ++ O.txt " =" ++ O.sp ++ mty md | TypeEq (frag_typ, td) -> - O.keyword "type" ++ O.sp - ++ type_expr_in_subst td (frag_typ :> Paths.Fragment.leaf) - ++ fst (format_manifest td) - ++ format_constraints td.Odoc_model.Lang.TypeDecl.Equation.constraints + O.box_hv + @@ O.keyword "type" ++ O.txt " " + ++ type_expr_in_subst td (frag_typ :> Paths.Fragment.leaf) + ++ fst (format_manifest td) + ++ format_constraints + td.Odoc_model.Lang.TypeDecl.Equation.constraints | ModuleSubst (frag_mod, mod_path) -> - O.keyword "module" ++ O.sp - ++ Link.from_fragment (frag_mod :> Paths.Fragment.leaf) - ++ O.sp ++ O.txt ":= " - ++ Link.from_path (mod_path :> Paths.Path.t) + O.box_hv + @@ O.keyword "module" ++ O.txt " " + ++ Link.from_fragment (frag_mod :> Paths.Fragment.leaf) + ++ O.txt " :=" ++ O.sp + ++ Link.from_path (mod_path :> Paths.Path.t) | ModuleTypeSubst (frag_mty, md) -> - O.keyword "module" ++ O.txt " " ++ O.keyword "type" ++ O.txt " " - ++ Link.from_fragment (frag_mty :> Paths.Fragment.leaf) - ++ O.txt " := " ++ mty md + O.box_hv + @@ O.keyword "module" ++ O.txt " " ++ O.keyword "type" ++ O.txt " " + ++ Link.from_fragment (frag_mty :> Paths.Fragment.leaf) + ++ O.txt " :=" ++ O.sp ++ mty md | TypeSubst (frag_typ, td) -> ( - O.keyword "type" ++ O.sp - ++ type_expr_in_subst td (frag_typ :> Paths.Fragment.leaf) - ++ O.sp ++ O.txt ":= " - ++ - match td.Lang.TypeDecl.Equation.manifest with - | None -> assert false (* cf loader/cmti *) - | Some te -> type_expr te) + O.box_hv + @@ O.keyword "type" ++ O.txt " " + ++ type_expr_in_subst td (frag_typ :> Paths.Fragment.leaf) + ++ O.txt " :=" ++ O.sp + ++ + match td.Lang.TypeDecl.Equation.manifest with + | None -> assert false (* cf loader/cmti *) + | Some te -> type_expr te) and include_ (t : Odoc_model.Lang.Include.t) = let decl_hidden = diff --git a/src/document/generator_signatures.ml b/src/document/generator_signatures.ml index 9e7ab23fa4..32d2ddd811 100644 --- a/src/document/generator_signatures.ml +++ b/src/document/generator_signatures.ml @@ -3,7 +3,7 @@ module Lang = Odoc_model.Lang type rendered_item = DocumentedSrc.t -type text = Format.formatter -> unit +type text = Codefmt.t (** HTML generation syntax customization module. See {!ML} and {!Reason}. *) @@ -40,7 +40,7 @@ module type SYNTAX = sig end module Tuple : sig - val element_separator : string + val element_separator : text val always_parenthesize : bool end diff --git a/src/document/reason.ml b/src/document/reason.ml index 2801a351ca..8e124a9e59 100644 --- a/src/document/reason.ml +++ b/src/document/reason.ml @@ -35,7 +35,7 @@ module Reason = Generator.Make (struct end module Tuple = struct - let element_separator = ", " + let element_separator = O.txt ", " let always_parenthesize = true end diff --git a/src/document/utils.ml b/src/document/utils.ml index 7ccbfd970f..e2497ac752 100644 --- a/src/document/utils.ml +++ b/src/document/utils.ml @@ -19,3 +19,27 @@ let split_at ~f lst = | hd :: tl -> loop (hd :: acc) tl in loop [] lst + +let rec compute_length_source (t : Types.Source.t) : int = + let f (acc : int) = function + | Types.Source.Elt t -> acc + compute_length_inline t + | Types.Source.Tag (_, t) -> acc + compute_length_source t + in + List.fold_left f 0 t + +and compute_length_inline (t : Types.Inline.t) : int = + let f (acc : int) { Types.Inline.desc; _ } = + match desc with + | Text s -> acc + String.length s + | Entity _e -> acc + 1 + | Linebreak -> 0 (* TODO *) + | Styled (_, t) + | Link (_, t) + | InternalLink (Resolved (_, t)) + | InternalLink (Unresolved t) -> + acc + compute_length_inline t + | Source s -> acc + compute_length_source s + | Raw_markup _ -> assert false + (* TODO *) + in + List.fold_left f 0 t diff --git a/src/odoc/etc/odoc.css b/src/odoc/etc/odoc.css index cc5625ed77..ca52c34446 100644 --- a/src/odoc/etc/odoc.css +++ b/src/odoc/etc/odoc.css @@ -153,7 +153,7 @@ body { } body { - max-width: 90ex; + max-width: 100ex; margin-left: calc(10vw + 20ex); margin-right: 4ex; margin-top: 20px; @@ -403,6 +403,10 @@ p a > code { color: var(--link-color); } +code { + white-space: pre-wrap; +} + /* Code blocks (e.g. Examples) */ pre code { diff --git a/test/generators/html/Alias.html b/test/generators/html/Alias.html index d6e742f8b6..8b1900a638 100644 --- a/test/generators/html/Alias.html +++ b/test/generators/html/Alias.html @@ -14,8 +14,9 @@

Module Alias

- module - X + + module X + : sig ... end diff --git a/test/generators/html/Functor.html b/test/generators/html/Functor.html index 5fae9d0284..6ec1ff4001 100644 --- a/test/generators/html/Functor.html +++ b/test/generators/html/Functor.html @@ -18,7 +18,8 @@

Module Functor

module type - S + S + = sig ... end @@ -31,7 +32,8 @@

Module Functor

module type - S1 + S1 + = functor (_ : S) @@ -44,8 +46,10 @@

Module Functor

- module - F1 + + module + F1 + (Arg : S) : S @@ -56,8 +60,10 @@

Module Functor

- module - F2 + + module + F2 + (Arg : S) : S @@ -73,8 +79,10 @@

Module Functor

- module - F3 + + module + F3 + (Arg : S) : sig ... end @@ -85,8 +93,10 @@

Module Functor

- module - F4 + + module + F4 + (Arg : S) : S @@ -97,9 +107,10 @@

Module Functor

- module - F5 - () : S + + module + F5 + () : S
diff --git a/test/generators/html/Functor2.html b/test/generators/html/Functor2.html index 01b52ebb80..cd3780c871 100644 --- a/test/generators/html/Functor2.html +++ b/test/generators/html/Functor2.html @@ -18,7 +18,8 @@

Module Functor2

module type - S + S +
= sig ... end @@ -28,8 +29,10 @@

Module Functor2

- module - X + + module + X + (Y : S) ( Z : @@ -45,7 +48,8 @@

Module Functor2

module type - XF + XF +
= functor (Y : S) diff --git a/test/generators/html/Include.html b/test/generators/html/Include.html index 768fddb0b6..bbeab178b9 100644 --- a/test/generators/html/Include.html +++ b/test/generators/html/Include.html @@ -18,8 +18,7 @@

Module Include

module type - - Not_inlined + Not_inlined = sig ... end @@ -50,8 +49,8 @@

Module Include

module type + Inlined - Inlined = sig ... end @@ -73,8 +72,6 @@

Module Include

module type - - Not_inlined_and_closed @@ -111,8 +108,6 @@

Module Include

module type - - Not_inlined_and_opened @@ -149,8 +144,6 @@

Module Include

module type - - Inherent_Module = sig ... @@ -178,8 +171,6 @@

Module Include

module type - - Dorminant_Module diff --git a/test/generators/html/Include2.html b/test/generators/html/Include2.html index 7442071db2..48ca8e68e7 100644 --- a/test/generators/html/Include2.html +++ b/test/generators/html/Include2.html @@ -15,8 +15,10 @@

Module Include2

- module - X + + module + X + : sig ... end @@ -52,8 +54,10 @@

Module Include2

- module - Y + + module + Y + : sig ... end @@ -63,8 +67,9 @@

Module Include2

- module - Y_include_synopsis + + module + Y_include_synopsis : sig ... end @@ -80,8 +85,10 @@

Module Include2

- module - Y_include_doc + + module + Y_include_doc + : sig ... end diff --git a/test/generators/html/Include_sections.html b/test/generators/html/Include_sections.html index 81d5e6aea1..55574d4a76 100644 --- a/test/generators/html/Include_sections.html +++ b/test/generators/html/Include_sections.html @@ -39,8 +39,6 @@

Module Include_sections

module type - - Something = sig ... diff --git a/test/generators/html/Labels.html b/test/generators/html/Labels.html index 5cc413ec29..61cec92c38 100644 --- a/test/generators/html/Labels.html +++ b/test/generators/html/Labels.html @@ -21,8 +21,9 @@

Attached to nothing

- module - A + + module A + : sig ... end @@ -61,7 +62,8 @@

Attached to nothing

module type - S + S + = sig ... end diff --git a/test/generators/html/Markup.html b/test/generators/html/Markup.html index c8d3d2c841..d17a5cf7ce 100644 --- a/test/generators/html/Markup.html +++ b/test/generators/html/Markup.html @@ -248,8 +248,9 @@

Modules

- module - X + + module X + : sig ... end @@ -259,8 +260,9 @@

Modules

- module - Y + + module Y + : sig ... end diff --git a/test/generators/html/Module-module-type-S.html b/test/generators/html/Module-module-type-S.html index 239371f0e5..473074b065 100644 --- a/test/generators/html/Module-module-type-S.html +++ b/test/generators/html/Module-module-type-S.html @@ -44,8 +44,10 @@

Module type Module.S

- module - M + + module + M + : sig ... end diff --git a/test/generators/html/Module-module-type-S3.html b/test/generators/html/Module-module-type-S3.html index 2e7c8b0a6f..cc286c7352 100644 --- a/test/generators/html/Module-module-type-S3.html +++ b/test/generators/html/Module-module-type-S3.html @@ -48,8 +48,10 @@

Module type Module.S3

- module - M + + module + M + : sig ... end diff --git a/test/generators/html/Module-module-type-S4.html b/test/generators/html/Module-module-type-S4.html index 8f5b23708d..90cf75a2c5 100644 --- a/test/generators/html/Module-module-type-S4.html +++ b/test/generators/html/Module-module-type-S4.html @@ -38,8 +38,10 @@

Module type Module.S4

- module - M + + module + M + : sig ... end diff --git a/test/generators/html/Module-module-type-S5.html b/test/generators/html/Module-module-type-S5.html index a1fa8d8ee5..756276bca7 100644 --- a/test/generators/html/Module-module-type-S5.html +++ b/test/generators/html/Module-module-type-S5.html @@ -37,8 +37,10 @@

Module type Module.S5

- module - M + + module + M + : sig ... end diff --git a/test/generators/html/Module-module-type-S6.html b/test/generators/html/Module-module-type-S6.html index 38a6fb40b2..4ba1eaff17 100644 --- a/test/generators/html/Module-module-type-S6.html +++ b/test/generators/html/Module-module-type-S6.html @@ -36,8 +36,10 @@

Module type Module.S6

- module - M + + module + M + : sig ... end diff --git a/test/generators/html/Module-module-type-S7.html b/test/generators/html/Module-module-type-S7.html index b913b805f0..ceb39ddc9e 100644 --- a/test/generators/html/Module-module-type-S7.html +++ b/test/generators/html/Module-module-type-S7.html @@ -44,7 +44,7 @@

Module type Module.S7

- module M + module M = M'
diff --git a/test/generators/html/Module.html b/test/generators/html/Module.html index 9712f85bdc..04ddcfefe4 100644 --- a/test/generators/html/Module.html +++ b/test/generators/html/Module.html @@ -31,7 +31,8 @@

Module Module

Foo.

module type - S + S + = sig ... end @@ -43,8 +44,8 @@

Module Module

Foo.

module - type - S1 + type S1 +
@@ -53,9 +54,8 @@

Module Module

Foo.

module - type - S2 - = S + type S2 + = S
@@ -65,7 +65,8 @@

Module Module

Foo.

module type - S3 + S3 + = S with type @@ -84,7 +85,8 @@

Module Module

Foo.

module type - S4 + S4 +
= S with type @@ -100,7 +102,8 @@

Module Module

Foo.

module type - S5 + S5 +
= S with type @@ -126,15 +129,16 @@

Module Module

Foo.

module type - S6 + S6 +
= S with type ('a, 'b) w := - ('a,  - 'b) + ( 'a, + 'b ) result @@ -145,8 +149,10 @@

Module Module

Foo.

- module - M' + + module + M' + : sig ... end @@ -159,7 +165,8 @@

Module Module

Foo.

module type - S7 + S7 + = S with module @@ -176,7 +183,8 @@

Module Module

Foo.

module type - S8 + S8 +
= S with module @@ -193,7 +201,8 @@

Module Module

Foo.

module type - S9 + S9 +
= module type of M' @@ -204,8 +213,10 @@

Module Module

Foo.

- module - Mutually + + module + Mutually + : sig ... end @@ -215,8 +226,10 @@

Module Module

Foo.

- module - Recursive + + module + Recursive + : sig ... end diff --git a/test/generators/html/Module_type_alias.html b/test/generators/html/Module_type_alias.html index 0f8dba29ed..783e186e20 100644 --- a/test/generators/html/Module_type_alias.html +++ b/test/generators/html/Module_type_alias.html @@ -19,8 +19,8 @@

Module Module_type_alias

module type + A - A = sig ... end @@ -33,8 +33,8 @@

Module Module_type_alias

module type + B - B = functor ( C @@ -52,8 +52,8 @@

Module Module_type_alias

module - type - D + type D +
= A
@@ -64,8 +64,8 @@

Module Module_type_alias

module type + E - E = functor ( F @@ -83,8 +83,8 @@

Module Module_type_alias

module type + G - G = functor ( H @@ -101,8 +101,8 @@

Module Module_type_alias

module - type - I + type I +
= B
diff --git a/test/generators/html/Module_type_subst-Basic-module-type-a.html b/test/generators/html/Module_type_subst-Basic-module-type-a.html index 81cafa5d2b..3b03a68837 100644 --- a/test/generators/html/Module_type_subst-Basic-module-type-a.html +++ b/test/generators/html/Module_type_subst-Basic-module-type-a.html @@ -21,8 +21,8 @@

Module type Basic.a

module - type - b + type b + = s
@@ -30,8 +30,9 @@

Module type Basic.a

- module - M + + module + M : b diff --git a/test/generators/html/Module_type_subst-Basic-module-type-c.html b/test/generators/html/Module_type_subst-Basic-module-type-c.html index 4085525c8c..92bbe54e91 100644 --- a/test/generators/html/Module_type_subst-Basic-module-type-c.html +++ b/test/generators/html/Module_type_subst-Basic-module-type-c.html @@ -19,8 +19,9 @@

Module type Basic.c

- module - M + + module + M : s diff --git a/test/generators/html/Module_type_subst-Basic-module-type-u.html b/test/generators/html/Module_type_subst-Basic-module-type-u.html index f70afa5353..067b41ac1d 100644 --- a/test/generators/html/Module_type_subst-Basic-module-type-u.html +++ b/test/generators/html/Module_type_subst-Basic-module-type-u.html @@ -22,8 +22,6 @@

Module type Basic.u

module type - - T diff --git a/test/generators/html/Module_type_subst-Basic-module-type-u2.html b/test/generators/html/Module_type_subst-Basic-module-type-u2.html index 4130492379..924a82d5a0 100644 --- a/test/generators/html/Module_type_subst-Basic-module-type-u2.html +++ b/test/generators/html/Module_type_subst-Basic-module-type-u2.html @@ -22,8 +22,6 @@

Module type Basic.u2

module type - - T @@ -36,8 +34,9 @@

Module type Basic.u2

diff --git a/test/generators/html/Module_type_subst-Basic-module-type-with_2.html b/test/generators/html/Module_type_subst-Basic-module-type-with_2.html index 0159488bb6..0277847489 100644 --- a/test/generators/html/Module_type_subst-Basic-module-type-with_2.html +++ b/test/generators/html/Module_type_subst-Basic-module-type-with_2.html @@ -22,8 +22,6 @@

Module type Basic.with_2

module type - - T @@ -38,8 +36,9 @@

Module type Basic.with_2

- module - M + + module + M : Module Module_type_subst.Basic module type + u - u = sig ... end @@ -35,8 +35,6 @@

Module Module_type_subst.Basic

module type - - with_ = u @@ -56,8 +54,7 @@

Module Module_type_subst.Basic

module type - - u2 + u2 = sig ... end @@ -71,8 +68,6 @@

Module Module_type_subst.Basic

module type - - with_2 = u2 @@ -93,8 +88,8 @@

Module Module_type_subst.Basic

module type + a - a = sig ... end @@ -107,8 +102,8 @@

Module Module_type_subst.Basic

module type + c - c = a with module diff --git a/test/generators/html/Module_type_subst-Local.html b/test/generators/html/Module_type_subst-Local.html index adf4b5d1e0..964ade6f63 100644 --- a/test/generators/html/Module_type_subst-Local.html +++ b/test/generators/html/Module_type_subst-Local.html @@ -29,8 +29,6 @@

Module Module_type_subst.Local

module type - - local := sig ... @@ -44,8 +42,8 @@

Module Module_type_subst.Local

module - type - w + type w +
= local @@ -58,8 +56,8 @@

Module Module_type_subst.Local

module type + s - s = sig ... end diff --git a/test/generators/html/Module_type_subst-Nested-module-type-nested-N.html b/test/generators/html/Module_type_subst-Nested-module-type-nested-N.html index 8bf6aef18d..0923e87450 100644 --- a/test/generators/html/Module_type_subst-Nested-module-type-nested-N.html +++ b/test/generators/html/Module_type_subst-Nested-module-type-nested-N.html @@ -25,8 +25,6 @@

Module nested.N

module type - - t diff --git a/test/generators/html/Module_type_subst-Nested-module-type-nested.html b/test/generators/html/Module_type_subst-Nested-module-type-nested.html index 7be1046745..64891911f3 100644 --- a/test/generators/html/Module_type_subst-Nested-module-type-nested.html +++ b/test/generators/html/Module_type_subst-Nested-module-type-nested.html @@ -19,8 +19,8 @@

Module type Nested.nested

- module - + + module N : sig ... diff --git a/test/generators/html/Module_type_subst-Nested-module-type-with_-N.html b/test/generators/html/Module_type_subst-Nested-module-type-with_-N.html index 4d47318dd2..8e0188672c 100644 --- a/test/generators/html/Module_type_subst-Nested-module-type-with_-N.html +++ b/test/generators/html/Module_type_subst-Nested-module-type-with_-N.html @@ -24,8 +24,8 @@

Module with_.N

module - type - t + type t +
= s
diff --git a/test/generators/html/Module_type_subst-Nested-module-type-with_.html b/test/generators/html/Module_type_subst-Nested-module-type-with_.html index da3557dc4c..fec32fd31d 100644 --- a/test/generators/html/Module_type_subst-Nested-module-type-with_.html +++ b/test/generators/html/Module_type_subst-Nested-module-type-with_.html @@ -19,8 +19,9 @@

Module type Nested.with_

- module - N + + module + N : sig ... end diff --git a/test/generators/html/Module_type_subst-Nested-module-type-with_subst.html b/test/generators/html/Module_type_subst-Nested-module-type-with_subst.html index 46221a98a9..3c83bf7d5c 100644 --- a/test/generators/html/Module_type_subst-Nested-module-type-with_subst.html +++ b/test/generators/html/Module_type_subst-Nested-module-type-with_subst.html @@ -19,8 +19,8 @@

Module type Nested.with_subst

- module - + + module N : sig ... diff --git a/test/generators/html/Module_type_subst-Nested.html b/test/generators/html/Module_type_subst-Nested.html index 595f94c686..ceb4edd764 100644 --- a/test/generators/html/Module_type_subst-Nested.html +++ b/test/generators/html/Module_type_subst-Nested.html @@ -21,8 +21,6 @@

Module Module_type_subst.Nested

module type - - nested = sig ... @@ -37,8 +35,6 @@

Module Module_type_subst.Nested

module type - - with_ = @@ -61,8 +57,6 @@

Module Module_type_subst.Nested

module type - - with_subst diff --git a/test/generators/html/Module_type_subst-Structural-module-type-u-module-type-a-module-type-b.html b/test/generators/html/Module_type_subst-Structural-module-type-u-module-type-a-module-type-b.html index 0f7e91c8a7..c681a6ad71 100644 --- a/test/generators/html/Module_type_subst-Structural-module-type-u-module-type-a-module-type-b.html +++ b/test/generators/html/Module_type_subst-Structural-module-type-u-module-type-a-module-type-b.html @@ -27,8 +27,6 @@

Module type a.b

module type - - c diff --git a/test/generators/html/Module_type_subst-Structural-module-type-u-module-type-a.html b/test/generators/html/Module_type_subst-Structural-module-type-u-module-type-a.html index 5b3ae2ad83..80af85b047 100644 --- a/test/generators/html/Module_type_subst-Structural-module-type-u-module-type-a.html +++ b/test/generators/html/Module_type_subst-Structural-module-type-u-module-type-a.html @@ -25,8 +25,6 @@

Module type u.a

module type - -
b diff --git a/test/generators/html/Module_type_subst-Structural-module-type-u.html b/test/generators/html/Module_type_subst-Structural-module-type-u.html index 09edfdcca0..058dd16129 100644 --- a/test/generators/html/Module_type_subst-Structural-module-type-u.html +++ b/test/generators/html/Module_type_subst-Structural-module-type-u.html @@ -23,8 +23,6 @@

Module type Structural.u

module type - -
a diff --git a/test/generators/html/Module_type_subst-Structural-module-type-w-module-type-a-module-type-b.html b/test/generators/html/Module_type_subst-Structural-module-type-w-module-type-a-module-type-b.html index c50e901da7..25bf254340 100644 --- a/test/generators/html/Module_type_subst-Structural-module-type-w-module-type-a-module-type-b.html +++ b/test/generators/html/Module_type_subst-Structural-module-type-w-module-type-a-module-type-b.html @@ -27,8 +27,6 @@

Module type a.b

module type - -
c diff --git a/test/generators/html/Module_type_subst-Structural-module-type-w-module-type-a.html b/test/generators/html/Module_type_subst-Structural-module-type-w-module-type-a.html index 3d1e11d555..150fc0fa21 100644 --- a/test/generators/html/Module_type_subst-Structural-module-type-w-module-type-a.html +++ b/test/generators/html/Module_type_subst-Structural-module-type-w-module-type-a.html @@ -25,8 +25,6 @@

Module type w.a

module type - -
b diff --git a/test/generators/html/Module_type_subst-Structural-module-type-w.html b/test/generators/html/Module_type_subst-Structural-module-type-w.html index 4fb488248c..f315f4e021 100644 --- a/test/generators/html/Module_type_subst-Structural-module-type-w.html +++ b/test/generators/html/Module_type_subst-Structural-module-type-w.html @@ -23,8 +23,6 @@

Module type Structural.w

module type - -
a diff --git a/test/generators/html/Module_type_subst-Structural.html b/test/generators/html/Module_type_subst-Structural.html index cdf826b885..ba1c690565 100644 --- a/test/generators/html/Module_type_subst-Structural.html +++ b/test/generators/html/Module_type_subst-Structural.html @@ -21,8 +21,7 @@

Module Module_type_subst.Structural

module type - -
u + u
= sig ... end @@ -36,8 +35,7 @@

Module Module_type_subst.Structural

module type - - w + w = u diff --git a/test/generators/html/Module_type_subst.html b/test/generators/html/Module_type_subst.html index c7283c0365..e7cee85ab3 100644 --- a/test/generators/html/Module_type_subst.html +++ b/test/generators/html/Module_type_subst.html @@ -15,8 +15,10 @@

Module Module_type_subst

- module - Local + + module + Local + : sig ... end @@ -29,8 +31,8 @@

Module Module_type_subst

module type + s - s = sig ... end @@ -40,8 +42,10 @@

Module Module_type_subst

- module - Basic + + module + Basic + : sig ... end @@ -51,8 +55,10 @@

Module Module_type_subst

- module - Nested + + module + Nested + : sig ... end @@ -62,8 +68,10 @@

Module Module_type_subst

- module - Structural + + module + Structural + : sig ... end diff --git a/test/generators/html/Nested.html b/test/generators/html/Nested.html index d0bba79df9..dd019b5c53 100644 --- a/test/generators/html/Nested.html +++ b/test/generators/html/Nested.html @@ -23,8 +23,9 @@

Module

- module - X + + module X + : sig ... end @@ -39,7 +40,8 @@

Module type module type - Y + Y + = sig ... end @@ -49,8 +51,9 @@

Module type
- module - F + + module F + (Arg1 : Y) ( Arg2 : diff --git a/test/generators/html/Ocamlary-Aliases-Foo.html b/test/generators/html/Ocamlary-Aliases-Foo.html index de9dd9c1fe..02ba7a8529 100644 --- a/test/generators/html/Ocamlary-Aliases-Foo.html +++ b/test/generators/html/Ocamlary-Aliases-Foo.html @@ -19,8 +19,10 @@

Module Aliases.Foo

- module - A + + module + A + : sig ... end @@ -30,8 +32,10 @@

Module Aliases.Foo

- module - B + + module + B + : sig ... end @@ -41,8 +45,10 @@

Module Aliases.Foo

- module - C + + module + C + : sig ... end @@ -52,8 +58,10 @@

Module Aliases.Foo

- module - D + + module + D + : sig ... end @@ -63,8 +71,10 @@

Module Aliases.Foo

- module - E + + module + E + : sig ... end diff --git a/test/generators/html/Ocamlary-Aliases-P1.html b/test/generators/html/Ocamlary-Aliases-P1.html index 9bc2b6c87e..663ea97c6f 100644 --- a/test/generators/html/Ocamlary-Aliases-P1.html +++ b/test/generators/html/Ocamlary-Aliases-P1.html @@ -19,8 +19,10 @@

Module Aliases.P1

- module - Y + + module + Y + : sig ... end diff --git a/test/generators/html/Ocamlary-Aliases-P2.html b/test/generators/html/Ocamlary-Aliases-P2.html index bc449ed336..44204fc66b 100644 --- a/test/generators/html/Ocamlary-Aliases-P2.html +++ b/test/generators/html/Ocamlary-Aliases-P2.html @@ -19,7 +19,7 @@

Module Aliases.P2

- module Z + module Z = Z
diff --git a/test/generators/html/Ocamlary-Aliases-Std.html b/test/generators/html/Ocamlary-Aliases-Std.html index 0385efc02e..afdc32979b 100644 --- a/test/generators/html/Ocamlary-Aliases-Std.html +++ b/test/generators/html/Ocamlary-Aliases-Std.html @@ -19,7 +19,7 @@

Module Aliases.Std

- module A + module A = Foo.A
@@ -27,7 +27,7 @@

Module Aliases.Std

- module B + module B = Foo.B
@@ -35,7 +35,7 @@

Module Aliases.Std

- module C + module C = Foo.C
@@ -43,7 +43,7 @@

Module Aliases.Std

- module D + module D = Foo.D
@@ -51,7 +51,7 @@

Module Aliases.Std

- module E + module E = Foo.E
diff --git a/test/generators/html/Ocamlary-Aliases.html b/test/generators/html/Ocamlary-Aliases.html index 3add6bc2cf..ee5369d7ad 100644 --- a/test/generators/html/Ocamlary-Aliases.html +++ b/test/generators/html/Ocamlary-Aliases.html @@ -21,8 +21,10 @@

Module Ocamlary.Aliases

- module - Foo + + module + Foo + : sig ... end @@ -32,7 +34,7 @@

Module Ocamlary.Aliases

- module A' + module A' = Foo.A
@@ -81,8 +83,10 @@

Module Ocamlary.Aliases

- module - Std + + module + Std + : sig ... end @@ -115,7 +119,7 @@

Module Ocamlary.Aliases

- module A + module A = Foo.A
@@ -123,7 +127,7 @@

Module Ocamlary.Aliases

- module B + module B = Foo.B
@@ -131,7 +135,7 @@

Module Ocamlary.Aliases

- module C + module C = Foo.C
@@ -139,7 +143,7 @@

Module Ocamlary.Aliases

- module D + module D = Foo.D
@@ -147,8 +151,10 @@

Module Ocamlary.Aliases

- module - E + + module + E + : sig ... end @@ -173,8 +179,10 @@

Module Ocamlary.Aliases

- module - P1 + + module + P1 + : sig ... end @@ -184,8 +192,10 @@

Module Ocamlary.Aliases

- module - P2 + + module + P2 + : sig ... end @@ -195,7 +205,7 @@

Module Ocamlary.Aliases

- module X1 + module X1 = P2.Z
@@ -203,7 +213,7 @@

Module Ocamlary.Aliases

- module X2 + module X2 = P2.Z
diff --git a/test/generators/html/Ocamlary-CanonicalTest-Base.html b/test/generators/html/Ocamlary-CanonicalTest-Base.html index 619b2537e5..26fe220c0e 100644 --- a/test/generators/html/Ocamlary-CanonicalTest-Base.html +++ b/test/generators/html/Ocamlary-CanonicalTest-Base.html @@ -19,8 +19,10 @@

Module CanonicalTest.Base

- module - List + + module + List + : sig ... end diff --git a/test/generators/html/Ocamlary-CanonicalTest-Base_Tests.html b/test/generators/html/Ocamlary-CanonicalTest-Base_Tests.html index 7b5568b8d1..5a2b73964a 100644 --- a/test/generators/html/Ocamlary-CanonicalTest-Base_Tests.html +++ b/test/generators/html/Ocamlary-CanonicalTest-Base_Tests.html @@ -20,8 +20,10 @@

Module CanonicalTest.Base_Tests

- module - C + + module + C + : module type of Base.List @@ -32,7 +34,7 @@

Module CanonicalTest.Base_Tests

- module L + module L = Base.List diff --git a/test/generators/html/Ocamlary-CanonicalTest.html b/test/generators/html/Ocamlary-CanonicalTest.html index c1015381c2..419cf98f33 100644 --- a/test/generators/html/Ocamlary-CanonicalTest.html +++ b/test/generators/html/Ocamlary-CanonicalTest.html @@ -18,8 +18,10 @@

Module Ocamlary.CanonicalTest

- module - Base + + module + Base + : sig ... end @@ -29,8 +31,9 @@

Module Ocamlary.CanonicalTest

- module - Base_Tests + + module + Base_Tests : sig ... end @@ -41,8 +44,9 @@

Module Ocamlary.CanonicalTest

- module - List_modif + + module + List_modif : module type of diff --git a/test/generators/html/Ocamlary-CollectionModule-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-CollectionModule-InnerModuleA-InnerModuleA'.html index 1f857bbcc0..da20b21aba 100644 --- a/test/generators/html/Ocamlary-CollectionModule-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-CollectionModule-InnerModuleA-InnerModuleA'.html @@ -26,7 +26,7 @@

Module InnerModuleA.InnerModuleA'

type t = - (unit, unit) + ( unit, unit ) a_function diff --git a/test/generators/html/Ocamlary-CollectionModule-InnerModuleA.html b/test/generators/html/Ocamlary-CollectionModule-InnerModuleA.html index 5b693cac67..a6f06a4f5f 100644 --- a/test/generators/html/Ocamlary-CollectionModule-InnerModuleA.html +++ b/test/generators/html/Ocamlary-CollectionModule-InnerModuleA.html @@ -33,8 +33,8 @@

Module CollectionModule.InnerModuleA

- module - Y - : S + + module + Y + : S
diff --git a/test/generators/html/Ocamlary-Dep1.html b/test/generators/html/Ocamlary-Dep1.html index aec92c5aab..f87082b287 100644 --- a/test/generators/html/Ocamlary-Dep1.html +++ b/test/generators/html/Ocamlary-Dep1.html @@ -21,7 +21,8 @@

Module Ocamlary.Dep1

module type - S + S + = sig ... end @@ -31,8 +32,10 @@

Module Ocamlary.Dep1

- module - X + + module + X + : sig ... end diff --git a/test/generators/html/Ocamlary-Dep11.html b/test/generators/html/Ocamlary-Dep11.html index c3a3ae2132..8698fae22c 100644 --- a/test/generators/html/Ocamlary-Dep11.html +++ b/test/generators/html/Ocamlary-Dep11.html @@ -21,7 +21,8 @@

Module Ocamlary.Dep11

module type - S + S + = sig ... end diff --git a/test/generators/html/Ocamlary-Dep12-argument-1-Arg.html b/test/generators/html/Ocamlary-Dep12-argument-1-Arg.html index a89d3566ae..910f6e42c9 100644 --- a/test/generators/html/Ocamlary-Dep12-argument-1-Arg.html +++ b/test/generators/html/Ocamlary-Dep12-argument-1-Arg.html @@ -21,8 +21,8 @@

Parameter Dep12.1-Arg

module - type - S + type S +
diff --git a/test/generators/html/Ocamlary-Dep12.html b/test/generators/html/Ocamlary-Dep12.html index 1791e1c3ee..42661b5ec4 100644 --- a/test/generators/html/Ocamlary-Dep12.html +++ b/test/generators/html/Ocamlary-Dep12.html @@ -39,8 +39,8 @@

Signature

module - type - T + type T + = Arg.S diff --git a/test/generators/html/Ocamlary-Dep2-A.html b/test/generators/html/Ocamlary-Dep2-A.html index 6562b58e53..feb3f0f338 100644 --- a/test/generators/html/Ocamlary-Dep2-A.html +++ b/test/generators/html/Ocamlary-Dep2-A.html @@ -19,7 +19,7 @@

Module Dep2.A

- module Y + module Y : Arg.S diff --git a/test/generators/html/Ocamlary-Dep2-argument-1-Arg-X.html b/test/generators/html/Ocamlary-Dep2-argument-1-Arg-X.html index 4d5e226430..6c00cfa200 100644 --- a/test/generators/html/Ocamlary-Dep2-argument-1-Arg-X.html +++ b/test/generators/html/Ocamlary-Dep2-argument-1-Arg-X.html @@ -20,7 +20,7 @@

Module 1-Arg.X

- module Y + module Y : S diff --git a/test/generators/html/Ocamlary-Dep2-argument-1-Arg.html b/test/generators/html/Ocamlary-Dep2-argument-1-Arg.html index 66a138f7ee..921e410f27 100644 --- a/test/generators/html/Ocamlary-Dep2-argument-1-Arg.html +++ b/test/generators/html/Ocamlary-Dep2-argument-1-Arg.html @@ -21,16 +21,18 @@

Parameter Dep2.1-Arg

module - type - S + type S +
- module - X + + module + X + : sig ... end diff --git a/test/generators/html/Ocamlary-Dep2.html b/test/generators/html/Ocamlary-Dep2.html index 5a25a2bf7d..371fd0b2de 100644 --- a/test/generators/html/Ocamlary-Dep2.html +++ b/test/generators/html/Ocamlary-Dep2.html @@ -37,8 +37,10 @@

Signature

- module - A + + module + A + : sig ... end @@ -48,7 +50,7 @@

Signature

- module B + module B = A.Y
diff --git a/test/generators/html/Ocamlary-Dep4-module-type-S.html b/test/generators/html/Ocamlary-Dep4-module-type-S.html index 0e6f6712de..6b26f1e092 100644 --- a/test/generators/html/Ocamlary-Dep4-module-type-S.html +++ b/test/generators/html/Ocamlary-Dep4-module-type-S.html @@ -19,17 +19,20 @@

Module type Dep4.S

- module - X - : T + + module + X + : T
- module - Y + + module + Y + : sig ... end diff --git a/test/generators/html/Ocamlary-Dep4.html b/test/generators/html/Ocamlary-Dep4.html index 57a3cb810d..40a3c71bc7 100644 --- a/test/generators/html/Ocamlary-Dep4.html +++ b/test/generators/html/Ocamlary-Dep4.html @@ -21,7 +21,8 @@

Module Ocamlary.Dep4

module type - T + T + = sig ... end @@ -34,7 +35,8 @@

Module Ocamlary.Dep4

module type - S + S + = sig ... end @@ -44,9 +46,10 @@

Module Ocamlary.Dep4

- module - X - : T + + module + X + : T
diff --git a/test/generators/html/Ocamlary-Dep5-Z.html b/test/generators/html/Ocamlary-Dep5-Z.html index b3c7396566..9bb0347c60 100644 --- a/test/generators/html/Ocamlary-Dep5-Z.html +++ b/test/generators/html/Ocamlary-Dep5-Z.html @@ -19,7 +19,7 @@

Module Dep5.Z

- module X + module X : Arg.T @@ -29,7 +29,7 @@

Module Dep5.Z

- module Y + module Y = Dep3
diff --git a/test/generators/html/Ocamlary-Dep5-argument-1-Arg-module-type-S.html b/test/generators/html/Ocamlary-Dep5-argument-1-Arg-module-type-S.html index a6a207b329..95d8f599a7 100644 --- a/test/generators/html/Ocamlary-Dep5-argument-1-Arg-module-type-S.html +++ b/test/generators/html/Ocamlary-Dep5-argument-1-Arg-module-type-S.html @@ -20,7 +20,7 @@

Module type 1-Arg.S

- module X + module X : T @@ -30,8 +30,9 @@

Module type 1-Arg.S

- module - Y + + module + Y : sig ... end diff --git a/test/generators/html/Ocamlary-Dep5-argument-1-Arg.html b/test/generators/html/Ocamlary-Dep5-argument-1-Arg.html index 2abf89ffb6..9701c238fc 100644 --- a/test/generators/html/Ocamlary-Dep5-argument-1-Arg.html +++ b/test/generators/html/Ocamlary-Dep5-argument-1-Arg.html @@ -21,8 +21,8 @@

Parameter Dep5.1-Arg

module - type - T + type T +
@@ -32,8 +32,7 @@

Parameter Dep5.1-Arg

module type - - S + S = sig ... end @@ -44,7 +43,7 @@

Parameter Dep5.1-Arg

- module X + module X : T
diff --git a/test/generators/html/Ocamlary-Dep5.html b/test/generators/html/Ocamlary-Dep5.html index fc3fb69db0..2efd5e6c38 100644 --- a/test/generators/html/Ocamlary-Dep5.html +++ b/test/generators/html/Ocamlary-Dep5.html @@ -37,8 +37,10 @@

Signature

- module - Z + + module + Z + : Arg.S with diff --git a/test/generators/html/Ocamlary-Dep6-X.html b/test/generators/html/Ocamlary-Dep6-X.html index 4c70ff907b..418d622c81 100644 --- a/test/generators/html/Ocamlary-Dep6-X.html +++ b/test/generators/html/Ocamlary-Dep6-X.html @@ -21,18 +21,18 @@

Module Dep6.X

module - type - R - = S + type R +
= S
- module - Y - : R + + module + Y + : R
diff --git a/test/generators/html/Ocamlary-Dep6-module-type-T.html b/test/generators/html/Ocamlary-Dep6-module-type-T.html index 29a63de801..f6183741c1 100644 --- a/test/generators/html/Ocamlary-Dep6-module-type-T.html +++ b/test/generators/html/Ocamlary-Dep6-module-type-T.html @@ -21,18 +21,18 @@

Module type Dep6.T

module - type - R - = S + type R + = S
- module - Y - : R + + module + Y + : R
diff --git a/test/generators/html/Ocamlary-Dep6.html b/test/generators/html/Ocamlary-Dep6.html index e4ad138f16..719786e2eb 100644 --- a/test/generators/html/Ocamlary-Dep6.html +++ b/test/generators/html/Ocamlary-Dep6.html @@ -21,7 +21,8 @@

Module Ocamlary.Dep6

module type - S + S + = sig ... end @@ -34,7 +35,8 @@

Module Ocamlary.Dep6

module type - T + T + = sig ... end @@ -44,9 +46,10 @@

Module Ocamlary.Dep6

- module - X - : T + + module + X + : T
diff --git a/test/generators/html/Ocamlary-Dep7-M.html b/test/generators/html/Ocamlary-Dep7-M.html index 2b39ed237d..6aa3a46857 100644 --- a/test/generators/html/Ocamlary-Dep7-M.html +++ b/test/generators/html/Ocamlary-Dep7-M.html @@ -21,8 +21,8 @@

Module Dep7.M

module - type - R + type R + = Arg.S @@ -32,7 +32,7 @@

Module Dep7.M

- module Y + module Y : R diff --git a/test/generators/html/Ocamlary-Dep7-argument-1-Arg-X.html b/test/generators/html/Ocamlary-Dep7-argument-1-Arg-X.html index 1869a8090e..a22f7b8ada 100644 --- a/test/generators/html/Ocamlary-Dep7-argument-1-Arg-X.html +++ b/test/generators/html/Ocamlary-Dep7-argument-1-Arg-X.html @@ -22,8 +22,8 @@

Module 1-Arg.X

module - type - R + type R + = S @@ -33,7 +33,7 @@

Module 1-Arg.X

- module Y + module Y : R diff --git a/test/generators/html/Ocamlary-Dep7-argument-1-Arg-module-type-T.html b/test/generators/html/Ocamlary-Dep7-argument-1-Arg-module-type-T.html index 98c423b466..8028c2c609 100644 --- a/test/generators/html/Ocamlary-Dep7-argument-1-Arg-module-type-T.html +++ b/test/generators/html/Ocamlary-Dep7-argument-1-Arg-module-type-T.html @@ -22,8 +22,8 @@

Module type 1-Arg.T

module - type - R + type R + = S @@ -33,7 +33,7 @@

Module type 1-Arg.T

- module Y + module Y : R diff --git a/test/generators/html/Ocamlary-Dep7-argument-1-Arg.html b/test/generators/html/Ocamlary-Dep7-argument-1-Arg.html index 40c16373c4..0bae0cff62 100644 --- a/test/generators/html/Ocamlary-Dep7-argument-1-Arg.html +++ b/test/generators/html/Ocamlary-Dep7-argument-1-Arg.html @@ -21,8 +21,8 @@

Parameter Dep7.1-Arg

module - type - S + type S +
@@ -32,8 +32,7 @@

Parameter Dep7.1-Arg

module type - - T + T = sig ... end @@ -44,8 +43,10 @@

Parameter Dep7.1-Arg

- module - X + + module + X + : T diff --git a/test/generators/html/Ocamlary-Dep7.html b/test/generators/html/Ocamlary-Dep7.html index b09252563b..0852e49660 100644 --- a/test/generators/html/Ocamlary-Dep7.html +++ b/test/generators/html/Ocamlary-Dep7.html @@ -37,8 +37,10 @@

Signature

- module - M + + module + M + : Arg.T diff --git a/test/generators/html/Ocamlary-Dep8.html b/test/generators/html/Ocamlary-Dep8.html index d399453d9d..862192d6ff 100644 --- a/test/generators/html/Ocamlary-Dep8.html +++ b/test/generators/html/Ocamlary-Dep8.html @@ -21,7 +21,8 @@

Module Ocamlary.Dep8

module type - T + T + = sig ... end diff --git a/test/generators/html/Ocamlary-Dep9-argument-1-X.html b/test/generators/html/Ocamlary-Dep9-argument-1-X.html index 114febdd82..c13518518f 100644 --- a/test/generators/html/Ocamlary-Dep9-argument-1-X.html +++ b/test/generators/html/Ocamlary-Dep9-argument-1-X.html @@ -21,8 +21,8 @@

Parameter Dep9.1-X

module - type - T + type T +
diff --git a/test/generators/html/Ocamlary-Dep9.html b/test/generators/html/Ocamlary-Dep9.html index bdbeb8f5cf..d733a95962 100644 --- a/test/generators/html/Ocamlary-Dep9.html +++ b/test/generators/html/Ocamlary-Dep9.html @@ -39,8 +39,8 @@

Signature

module - type - T + type T + = X.T diff --git a/test/generators/html/Ocamlary-DoubleInclude1.html b/test/generators/html/Ocamlary-DoubleInclude1.html index 6d55cef4f4..d4b0715bff 100644 --- a/test/generators/html/Ocamlary-DoubleInclude1.html +++ b/test/generators/html/Ocamlary-DoubleInclude1.html @@ -18,8 +18,8 @@

Module Ocamlary.DoubleInclude1

- module - + + module DoubleInclude2 diff --git a/test/generators/html/Ocamlary-DoubleInclude3.html b/test/generators/html/Ocamlary-DoubleInclude3.html index 9a1ddf5f0c..bea58db2f7 100644 --- a/test/generators/html/Ocamlary-DoubleInclude3.html +++ b/test/generators/html/Ocamlary-DoubleInclude3.html @@ -29,8 +29,8 @@

Module Ocamlary.DoubleInclude3

- module - + + module DoubleInclude2 diff --git a/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA-InnerModuleA'.html index f30c36fbaf..4d3c688450 100644 --- a/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA-InnerModuleA'.html @@ -32,7 +32,7 @@

Module InnerModuleA.InnerModuleA'

type t = - (unit, unit) + ( unit, unit ) a_function diff --git a/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA.html b/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA.html index d6ef6c1117..19a61238d3 100644 --- a/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA.html +++ b/test/generators/html/Ocamlary-FunctorTypeOf-argument-1-Collection-InnerModuleA.html @@ -38,8 +38,8 @@

Module 1-Collection.InnerModuleA

module type - - IncludeInclude2 @@ -37,8 +35,8 @@

Module Ocamlary.IncludeInclude1

- module - + + module IncludeInclude2_M diff --git a/test/generators/html/Ocamlary-Recollection-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-Recollection-InnerModuleA-InnerModuleA'.html index 34e74424c2..bb55e52862 100644 --- a/test/generators/html/Ocamlary-Recollection-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-Recollection-InnerModuleA-InnerModuleA'.html @@ -26,7 +26,7 @@

Module InnerModuleA.InnerModuleA'

type t = - (unit, unit) + ( unit, unit ) a_function diff --git a/test/generators/html/Ocamlary-Recollection-InnerModuleA.html b/test/generators/html/Ocamlary-Recollection-InnerModuleA.html index d29934368f..4c39fb5fce 100644 --- a/test/generators/html/Ocamlary-Recollection-InnerModuleA.html +++ b/test/generators/html/Ocamlary-Recollection-InnerModuleA.html @@ -32,8 +32,8 @@

Module Recollection.InnerModuleA

- module - + + module InnerModuleA' @@ -54,8 +54,6 @@

Module Recollection.InnerModuleA

module type - - InnerModuleTypeA' diff --git a/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA-InnerModuleA'.html index c86da615ed..7fca8028d7 100644 --- a/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA-InnerModuleA'.html @@ -29,7 +29,7 @@

Module InnerModuleA.InnerModuleA'

type t = - (unit, unit) + ( unit, unit ) a_function diff --git a/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA.html b/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA.html index 394be23187..1cfe9f1270 100644 --- a/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA.html +++ b/test/generators/html/Ocamlary-Recollection-argument-1-C-InnerModuleA.html @@ -36,8 +36,8 @@

Module 1-C.InnerModuleA

- module - + + module InnerModuleA' @@ -59,8 +59,6 @@

Module 1-C.InnerModuleA

module type - -
InnerModuleTypeA' diff --git a/test/generators/html/Ocamlary-Recollection-argument-1-C.html b/test/generators/html/Ocamlary-Recollection-argument-1-C.html index 8066fb1a6c..1b77ab6dae 100644 --- a/test/generators/html/Ocamlary-Recollection-argument-1-C.html +++ b/test/generators/html/Ocamlary-Recollection-argument-1-C.html @@ -34,8 +34,8 @@

Parameter Recollection.1-C

- module - + + module InnerModuleA @@ -55,8 +55,8 @@

Parameter Recollection.1-C

module - type - InnerModuleTypeA + type InnerModuleTypeA +
= Signature
- module - + + module InnerModuleA : sig ... @@ -84,8 +84,8 @@

Signature

module - type - InnerModuleTypeA + type InnerModuleTypeA +
= module - type - S + type S +
diff --git a/test/generators/html/Ocamlary-With10-module-type-T.html b/test/generators/html/Ocamlary-With10-module-type-T.html index 1461f0012a..0574863253 100644 --- a/test/generators/html/Ocamlary-With10-module-type-T.html +++ b/test/generators/html/Ocamlary-With10-module-type-T.html @@ -20,8 +20,10 @@

Module type With10.T

- module - M + + module + M + : sig ... end @@ -31,7 +33,7 @@

Module type With10.T

- module N + module N : M.S diff --git a/test/generators/html/Ocamlary-With10.html b/test/generators/html/Ocamlary-With10.html index a7b06d6921..dafb57d1f9 100644 --- a/test/generators/html/Ocamlary-With10.html +++ b/test/generators/html/Ocamlary-With10.html @@ -21,7 +21,8 @@

Module Ocamlary.With10

module type - T + T + = sig ... end diff --git a/test/generators/html/Ocamlary-With2.html b/test/generators/html/Ocamlary-With2.html index f2f0ca1842..70cc761b31 100644 --- a/test/generators/html/Ocamlary-With2.html +++ b/test/generators/html/Ocamlary-With2.html @@ -21,7 +21,8 @@

Module Ocamlary.With2

module type - S + S + = sig ... end diff --git a/test/generators/html/Ocamlary-With3.html b/test/generators/html/Ocamlary-With3.html index 82c9a90ff7..fe8609d920 100644 --- a/test/generators/html/Ocamlary-With3.html +++ b/test/generators/html/Ocamlary-With3.html @@ -18,7 +18,7 @@

Module Ocamlary.With3

- module M + module M = With2
@@ -26,8 +26,10 @@

Module Ocamlary.With3

- module - N + + module + N + : M.S
diff --git a/test/generators/html/Ocamlary-With4.html b/test/generators/html/Ocamlary-With4.html index 3a174b59dd..da2e3bb205 100644 --- a/test/generators/html/Ocamlary-With4.html +++ b/test/generators/html/Ocamlary-With4.html @@ -18,8 +18,10 @@

Module Ocamlary.With4

- module - N + + module + N + : With2.S
diff --git a/test/generators/html/Ocamlary-With5.html b/test/generators/html/Ocamlary-With5.html index 74f7ab702d..6ed1c55bd3 100644 --- a/test/generators/html/Ocamlary-With5.html +++ b/test/generators/html/Ocamlary-With5.html @@ -21,7 +21,8 @@

Module Ocamlary.With5

module type - S + S + = sig ... end @@ -31,8 +32,10 @@

Module Ocamlary.With5

- module - N + + module + N + : S
diff --git a/test/generators/html/Ocamlary-With6-module-type-T-M.html b/test/generators/html/Ocamlary-With6-module-type-T-M.html index b644573a06..365323f0ba 100644 --- a/test/generators/html/Ocamlary-With6-module-type-T-M.html +++ b/test/generators/html/Ocamlary-With6-module-type-T-M.html @@ -21,15 +21,15 @@ module - type - S + type S +
- module N + module N : S
diff --git a/test/generators/html/Ocamlary-With6-module-type-T.html b/test/generators/html/Ocamlary-With6-module-type-T.html index 093ab7625b..dc69e6be6e 100644 --- a/test/generators/html/Ocamlary-With6-module-type-T.html +++ b/test/generators/html/Ocamlary-With6-module-type-T.html @@ -19,8 +19,10 @@

Module type With6.T

- module - M + + module + M + : sig ... end diff --git a/test/generators/html/Ocamlary-With6.html b/test/generators/html/Ocamlary-With6.html index ccafe0a4b9..506d01ba5f 100644 --- a/test/generators/html/Ocamlary-With6.html +++ b/test/generators/html/Ocamlary-With6.html @@ -21,7 +21,8 @@

Module Ocamlary.With6

module type - T + T + = sig ... end diff --git a/test/generators/html/Ocamlary-With7-argument-1-X.html b/test/generators/html/Ocamlary-With7-argument-1-X.html index 3cdc65fe6e..ac5c5e9b1a 100644 --- a/test/generators/html/Ocamlary-With7-argument-1-X.html +++ b/test/generators/html/Ocamlary-With7-argument-1-X.html @@ -21,8 +21,8 @@

Parameter With7.1-X

module - type - T + type T +
diff --git a/test/generators/html/Ocamlary-With7.html b/test/generators/html/Ocamlary-With7.html index 4e408b2cc0..8376558df3 100644 --- a/test/generators/html/Ocamlary-With7.html +++ b/test/generators/html/Ocamlary-With7.html @@ -39,8 +39,8 @@

Signature

module - type - T + type T + = X.T diff --git a/test/generators/html/Ocamlary-With9.html b/test/generators/html/Ocamlary-With9.html index 6deb4c8863..d4ff16d40a 100644 --- a/test/generators/html/Ocamlary-With9.html +++ b/test/generators/html/Ocamlary-With9.html @@ -21,7 +21,8 @@

Module Ocamlary.With9

module type - S + S + = sig ... end diff --git a/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA-InnerModuleA'.html index 03563b2b73..582b910a10 100644 --- a/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA-InnerModuleA'.html @@ -26,7 +26,7 @@

Module InnerModuleA.InnerModuleA'

type t = - (unit, unit) + ( unit, unit ) a_function diff --git a/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA.html b/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA.html index ad88ec9a48..777d7b2c2c 100644 --- a/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA.html +++ b/test/generators/html/Ocamlary-module-type-A-Q-InnerModuleA.html @@ -32,8 +32,8 @@

Module Q.InnerModuleA

- module - + + module InnerModuleA' @@ -54,8 +54,6 @@

Module Q.InnerModuleA

module type - - InnerModuleTypeA' diff --git a/test/generators/html/Ocamlary-module-type-A-Q.html b/test/generators/html/Ocamlary-module-type-A-Q.html index 4bd33f49c9..075620c0f0 100644 --- a/test/generators/html/Ocamlary-module-type-A-Q.html +++ b/test/generators/html/Ocamlary-module-type-A-Q.html @@ -33,8 +33,8 @@
- module - + + module InnerModuleA : sig ... @@ -52,8 +52,8 @@ module - type - InnerModuleTypeA + type InnerModuleTypeA + = Module type Ocamlary.A
- module - Q + + module + Q + : COLLECTION diff --git a/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA-InnerModuleA'.html index df9c3a0e8a..b13a64f76e 100644 --- a/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA-InnerModuleA'.html @@ -26,7 +26,7 @@

Module InnerModuleA.InnerModuleA'

type t = - (unit, unit) + ( unit, unit ) a_function diff --git a/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA.html b/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA.html index c1dc5670ea..7b4503145c 100644 --- a/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA.html +++ b/test/generators/html/Ocamlary-module-type-B-Q-InnerModuleA.html @@ -32,8 +32,8 @@

Module Q.InnerModuleA

- module - + + module InnerModuleA' @@ -54,8 +54,6 @@

Module Q.InnerModuleA

module type - - InnerModuleTypeA' diff --git a/test/generators/html/Ocamlary-module-type-B-Q.html b/test/generators/html/Ocamlary-module-type-B-Q.html index 19e2bc028d..4af918690a 100644 --- a/test/generators/html/Ocamlary-module-type-B-Q.html +++ b/test/generators/html/Ocamlary-module-type-B-Q.html @@ -33,8 +33,8 @@
- module - + + module InnerModuleA : sig ... @@ -52,8 +52,8 @@ module - type - InnerModuleTypeA + type InnerModuleTypeA + = Module type Ocamlary.B
- module - Q + + module + Q + : COLLECTION diff --git a/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA-InnerModuleA'.html index 71cce80691..bfbed08486 100644 --- a/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA-InnerModuleA'.html @@ -26,7 +26,7 @@

Module InnerModuleA.InnerModuleA'

type t = - (unit, unit) + ( unit, unit ) a_function diff --git a/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA.html b/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA.html index f900f05e92..a30f152b5b 100644 --- a/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA.html +++ b/test/generators/html/Ocamlary-module-type-C-Q-InnerModuleA.html @@ -32,8 +32,8 @@

Module Q.InnerModuleA

- module - + + module InnerModuleA' @@ -54,8 +54,6 @@

Module Q.InnerModuleA

module type - - InnerModuleTypeA' diff --git a/test/generators/html/Ocamlary-module-type-C-Q.html b/test/generators/html/Ocamlary-module-type-C-Q.html index d8a3924361..f65e8ccbbc 100644 --- a/test/generators/html/Ocamlary-module-type-C-Q.html +++ b/test/generators/html/Ocamlary-module-type-C-Q.html @@ -33,8 +33,8 @@
- module - + + module InnerModuleA : sig ... @@ -52,8 +52,8 @@ module - type - InnerModuleTypeA + type InnerModuleTypeA + = Module type Ocamlary.C
- module - Q + + module + Q + : COLLECTION diff --git a/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA-InnerModuleA'.html index 8efe44ee53..1a0ee22b8d 100644 --- a/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA-InnerModuleA'.html @@ -27,7 +27,7 @@

Module InnerModuleA.InnerModuleA'

type t = - (unit, unit) + ( unit, unit ) a_function diff --git a/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA.html b/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA.html index 525a59ba1a..0312fc4534 100644 --- a/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA.html +++ b/test/generators/html/Ocamlary-module-type-COLLECTION-InnerModuleA.html @@ -34,8 +34,8 @@

Module COLLECTION.InnerModuleA

- module - + + module InnerModuleA' @@ -57,8 +57,6 @@

Module COLLECTION.InnerModuleA

module type - -
InnerModuleTypeA' diff --git a/test/generators/html/Ocamlary-module-type-COLLECTION.html b/test/generators/html/Ocamlary-module-type-COLLECTION.html index ff50d0913b..0e37510ec8 100644 --- a/test/generators/html/Ocamlary-module-type-COLLECTION.html +++ b/test/generators/html/Ocamlary-module-type-COLLECTION.html @@ -34,8 +34,8 @@

Module type Ocamlary.COLLECTION

- module - + + module InnerModuleA @@ -55,8 +55,8 @@

Module type Ocamlary.COLLECTION

module - type - InnerModuleTypeA + type InnerModuleTypeA +
= Module InnerModuleA.InnerModuleA' type t = - (unit, unit) + ( unit, unit ) a_function diff --git a/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA.html b/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA.html index 0828616565..a95a360d20 100644 --- a/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA.html +++ b/test/generators/html/Ocamlary-module-type-MMM-C-InnerModuleA.html @@ -33,8 +33,8 @@

Module C.InnerModuleA

- module - + + module InnerModuleA' @@ -55,8 +55,6 @@

Module C.InnerModuleA

module type - - InnerModuleTypeA' diff --git a/test/generators/html/Ocamlary-module-type-MMM-C.html b/test/generators/html/Ocamlary-module-type-MMM-C.html index 8dab8ba47a..a134924f81 100644 --- a/test/generators/html/Ocamlary-module-type-MMM-C.html +++ b/test/generators/html/Ocamlary-module-type-MMM-C.html @@ -34,8 +34,8 @@

Module MMM.C

- module - + + module InnerModuleA @@ -54,8 +54,8 @@

Module MMM.C

module - type - InnerModuleTypeA + type InnerModuleTypeA +
= Module type Ocamlary.MMM
- module - C + + module + C + : COLLECTION diff --git a/test/generators/html/Ocamlary-module-type-NestedInclude1.html b/test/generators/html/Ocamlary-module-type-NestedInclude1.html index 90b5ca4973..a4c32fed88 100644 --- a/test/generators/html/Ocamlary-module-type-NestedInclude1.html +++ b/test/generators/html/Ocamlary-module-type-NestedInclude1.html @@ -22,8 +22,6 @@

Module type Ocamlary.NestedInclude1

module type - - NestedInclude2 diff --git a/test/generators/html/Ocamlary-module-type-RECOLLECTION.html b/test/generators/html/Ocamlary-module-type-RECOLLECTION.html index 4eb2c029bd..e52212b42b 100644 --- a/test/generators/html/Ocamlary-module-type-RECOLLECTION.html +++ b/test/generators/html/Ocamlary-module-type-RECOLLECTION.html @@ -18,7 +18,7 @@

Module type Ocamlary.RECOLLECTION

- module C + module C = Recollection(CollectionModule) diff --git a/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA-InnerModuleA'.html b/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA-InnerModuleA'.html index e90391fda5..def625bb2e 100644 --- a/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA-InnerModuleA'.html +++ b/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA-InnerModuleA'.html @@ -29,7 +29,7 @@

Module InnerModuleA.InnerModuleA'

type t = - (unit, unit) + ( unit, unit ) a_function diff --git a/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA.html b/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA.html index a691525116..50bf7edae9 100644 --- a/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA.html +++ b/test/generators/html/Ocamlary-module-type-RecollectionModule-InnerModuleA.html @@ -35,8 +35,8 @@

Module RecollectionModule.InnerModuleA

- module - + + module InnerModuleA' @@ -58,8 +58,6 @@

Module RecollectionModule.InnerModuleA

module type - -
InnerModuleTypeA' diff --git a/test/generators/html/Ocamlary-module-type-RecollectionModule.html b/test/generators/html/Ocamlary-module-type-RecollectionModule.html index 929b64b42e..5f52c18323 100644 --- a/test/generators/html/Ocamlary-module-type-RecollectionModule.html +++ b/test/generators/html/Ocamlary-module-type-RecollectionModule.html @@ -44,8 +44,8 @@

Module type Ocamlary.RecollectionModule

- module - + + module InnerModuleA @@ -65,8 +65,8 @@

Module type Ocamlary.RecollectionModule

module - type - InnerModuleTypeA + type InnerModuleTypeA +
= Module SigForMod.Inner module type - - Empty diff --git a/test/generators/html/Ocamlary-module-type-SigForMod.html b/test/generators/html/Ocamlary-module-type-SigForMod.html index f0641485f8..1ca3c4a8b1 100644 --- a/test/generators/html/Ocamlary-module-type-SigForMod.html +++ b/test/generators/html/Ocamlary-module-type-SigForMod.html @@ -19,8 +19,9 @@

Module type Ocamlary.SigForMod

- module - Inner + + module + Inner : sig ... end diff --git a/test/generators/html/Ocamlary-module-type-SuperSig-module-type-SubSigA.html b/test/generators/html/Ocamlary-module-type-SuperSig-module-type-SubSigA.html index 21941969cb..ef9c353895 100644 --- a/test/generators/html/Ocamlary-module-type-SuperSig-module-type-SubSigA.html +++ b/test/generators/html/Ocamlary-module-type-SuperSig-module-type-SubSigA.html @@ -35,8 +35,8 @@

A Labeled Section
- module - + + module SubSigAMod diff --git a/test/generators/html/Ocamlary-module-type-SuperSig.html b/test/generators/html/Ocamlary-module-type-SuperSig.html index c41801a8c6..82f752bc58 100644 --- a/test/generators/html/Ocamlary-module-type-SuperSig.html +++ b/test/generators/html/Ocamlary-module-type-SuperSig.html @@ -21,8 +21,6 @@

Module type Ocamlary.SuperSig

module type - -
SubSigA @@ -39,8 +37,6 @@

Module type Ocamlary.SuperSig

module type - - SubSigB @@ -57,8 +53,6 @@

Module type Ocamlary.SuperSig

module type - - EmptySig @@ -75,8 +69,6 @@

Module type Ocamlary.SuperSig

module type - - One = sig ... @@ -91,8 +83,6 @@

Module type Ocamlary.SuperSig

module type - - SuperSig diff --git a/test/generators/html/Ocamlary-module-type-ToInclude.html b/test/generators/html/Ocamlary-module-type-ToInclude.html index 6cda1a90d1..e0a96de239 100644 --- a/test/generators/html/Ocamlary-module-type-ToInclude.html +++ b/test/generators/html/Ocamlary-module-type-ToInclude.html @@ -18,8 +18,8 @@

Module type Ocamlary.ToInclude

- module - + + module IncludedA : sig ... @@ -34,8 +34,6 @@

Module type Ocamlary.ToInclude

module type - - IncludedB diff --git a/test/generators/html/Ocamlary-module-type-With1-M.html b/test/generators/html/Ocamlary-module-type-With1-M.html index 3e43a6e799..d0a263fc61 100644 --- a/test/generators/html/Ocamlary-module-type-With1-M.html +++ b/test/generators/html/Ocamlary-module-type-With1-M.html @@ -21,8 +21,8 @@

Module With1.M

module - type - S + type S +
diff --git a/test/generators/html/Ocamlary-module-type-With1.html b/test/generators/html/Ocamlary-module-type-With1.html index 621adab527..bd56b0aff9 100644 --- a/test/generators/html/Ocamlary-module-type-With1.html +++ b/test/generators/html/Ocamlary-module-type-With1.html @@ -18,8 +18,10 @@

Module type Ocamlary.With1

- module - M + + module + M + : sig ... end @@ -29,7 +31,7 @@

Module type Ocamlary.With1

- module N + module N : M.S diff --git a/test/generators/html/Ocamlary-module-type-With11.html b/test/generators/html/Ocamlary-module-type-With11.html index 13884b1e67..db4f75c94f 100644 --- a/test/generators/html/Ocamlary-module-type-With11.html +++ b/test/generators/html/Ocamlary-module-type-With11.html @@ -18,7 +18,7 @@

Module type Ocamlary.With11

- module M + module M = With9
@@ -26,8 +26,10 @@

Module type Ocamlary.With11

- module - N + + module + N + : M.S with type diff --git a/test/generators/html/Ocamlary-module-type-With8-M.html b/test/generators/html/Ocamlary-module-type-With8-M.html index 86d810c765..84b89fdb0f 100644 --- a/test/generators/html/Ocamlary-module-type-With8-M.html +++ b/test/generators/html/Ocamlary-module-type-With8-M.html @@ -21,8 +21,8 @@

Module With8.M

module - type - S + type S +
= With5.S
@@ -30,8 +30,10 @@

Module With8.M

- module - N + + module + N + : module type of struct diff --git a/test/generators/html/Ocamlary-module-type-With8.html b/test/generators/html/Ocamlary-module-type-With8.html index 5c90f33d9b..681ac51ccf 100644 --- a/test/generators/html/Ocamlary-module-type-With8.html +++ b/test/generators/html/Ocamlary-module-type-With8.html @@ -18,8 +18,10 @@

Module type Ocamlary.With8

- module - M + + module + M + : module type of struct diff --git a/test/generators/html/Ocamlary.html b/test/generators/html/Ocamlary.html index 7902fbe371..45c4028f81 100644 --- a/test/generators/html/Ocamlary.html +++ b/test/generators/html/Ocamlary.html @@ -101,8 +101,10 @@

- module - Empty + + module + Empty + : sig ... end @@ -115,7 +117,8 @@

module type - Empty + Empty + = sig ... end @@ -130,8 +133,6 @@

module type - - MissingComment = sig ... @@ -144,8 +145,7 @@

- module - EmptyAlias + module EmptyAlias = Empty
@@ -159,8 +159,8 @@

EmptySig

module type + EmptySig - EmptySig = sig ... end @@ -173,8 +173,8 @@

EmptySig

module - type - EmptySigAlias + type EmptySigAlias + = EmptySig @@ -185,8 +185,8 @@

EmptySig

- module - + + module ModuleWithSignature : EmptySig @@ -204,8 +204,8 @@

EmptySig

- module - + + module ModuleWithSignatureAlias @@ -219,8 +219,10 @@

EmptySig

- module - One + + module + One + : sig ... end @@ -233,8 +235,7 @@

EmptySig

module type - - SigForMod + SigForMod = sig ... end @@ -251,8 +252,8 @@

EmptySig

module type + SuperSig - SuperSig = sig ... end @@ -276,8 +277,10 @@

EmptySig

- module - Buffer + + module + Buffer + : sig ... end @@ -409,14 +412,15 @@

val fun_fun_fun : + - ( - (int, int) + ( + ( int, int ) a_function - ,  - (unit, unit) + , + ( unit, unit ) a_function - ) + ) a_function @@ -628,8 +632,9 @@

- module - CollectionModule + + module + CollectionModule : sig ... end @@ -646,8 +651,7 @@

module type - - COLLECTION + COLLECTION = module type of @@ -659,12 +663,19 @@

- module - Recollection - (C - : COLLECTION - ) : COLLECTION - with + + module + Recollection + + + + (C : + COLLECTION) + : + + COLLECTION + + with type collection @@ -674,7 +685,9 @@

C.element list - and + + + and type element = @@ -692,7 +705,8 @@

module type - MMM + MMM + = sig ... end @@ -705,8 +719,7 @@

module type - - RECOLLECTION + RECOLLECTION = MMM with @@ -726,8 +739,6 @@

module type - - RecollectionModule @@ -744,7 +755,8 @@

module type - A + A + = sig ... end @@ -757,7 +769,8 @@

module type - B + B + = sig ... end @@ -770,7 +783,8 @@

module type - C + C + = sig ... end @@ -782,15 +796,20 @@

- module - FunctorTypeOf - ( + + module + FunctorTypeOf + + + + ( Collection : module type of CollectionModule - ) : sig ... - end + ) : + + sig ... end
@@ -805,8 +824,6 @@

module type - - IncludeModuleType @@ -826,8 +843,7 @@

module type - - ToInclude + ToInclude = sig ... end @@ -847,8 +863,10 @@

- module - IncludedA + + module + IncludedA + : sig ... end @@ -861,8 +879,7 @@

module type - - IncludedB + IncludedB = sig ... end @@ -961,7 +978,7 @@

- nihilate : a. + nihilate : 'a. 'a -> unit; @@ -1080,7 +1097,7 @@

| Tag : - (unit, unit) + ( unit, unit ) full_gadt @@ -1094,7 +1111,7 @@

First : 'a -> - ('a, unit) + ( 'a, unit ) full_gadt @@ -1108,7 +1125,7 @@

Second : 'a -> - (unit, 'a) + ( unit, 'a ) full_gadt @@ -1122,7 +1139,7 @@

Exist : 'a * 'b -> - ('b, unit) + ( 'b, unit ) full_gadt @@ -1173,10 +1190,10 @@

| ExistGadtTag : - ( + ( 'a -> - 'b) + 'b ) -> 'a partial_gadt @@ -1535,8 +1552,8 @@

= - ('a,  - 'b) + ( 'a, + 'b ) full_gadt = @@ -1547,7 +1564,7 @@

| Tag : - (unit, unit) + ( unit, unit ) full_gadt_alias @@ -1561,7 +1578,7 @@

First : 'a -> - ('a, unit) + ( 'a, unit ) full_gadt_alias @@ -1575,7 +1592,7 @@

Second : 'a -> - (unit, 'a) + ( unit, 'a ) full_gadt_alias @@ -1589,7 +1606,7 @@

Exist : 'a * 'b -> - ('b, unit) + ( 'b, unit ) full_gadt_alias @@ -1646,10 +1663,10 @@

| ExistGadtTag : - ( + ( 'a -> - 'b) + 'b ) -> 'a partial_gadt_alias @@ -1766,9 +1783,9 @@

type rec_obj = - < f : int; g : - unit -> unit; - h : rec_obj; > + < f : int ; g : + unit -> unit ; + h : rec_obj > @@ -1780,9 +1797,8 @@

type 'a open_obj = - < f : int; g : - unit -> unit; - .. > + < f : int ; g : + unit -> unit.. > as 'a @@ -1793,7 +1809,7 @@

type 'a oof = - < a : unit; .. > + < a : unit.. > as 'a -> 'a @@ -1815,7 +1831,7 @@

type empty_obj - = < > + = < >

@@ -1823,7 +1839,7 @@

type one_meth - = < meth : unit; > + = < meth : unit >

@@ -2009,8 +2025,10 @@

- module - ExtMod + + module + ExtMod + : sig ... end @@ -2168,8 +2186,10 @@

- module - Dep1 + + module + Dep1 + : sig ... end @@ -2179,8 +2199,10 @@

- module - Dep2 + + module + Dep2 + (Arg : sig ... end ) : sig ... @@ -2202,8 +2224,10 @@

- module - Dep3 + + module + Dep3 + : sig ... end @@ -2213,8 +2237,10 @@

- module - Dep4 + + module + Dep4 + : sig ... end @@ -2224,8 +2250,10 @@

- module - Dep5 + + module + Dep5 + (Arg : sig ... end ) : sig ... @@ -2256,8 +2284,10 @@

- module - Dep6 + + module + Dep6 + : sig ... end @@ -2267,8 +2297,10 @@

- module - Dep7 + + module + Dep7 + (Arg : sig ... end ) : sig ... @@ -2291,8 +2323,10 @@

- module - Dep8 + + module + Dep8 + : sig ... end @@ -2302,8 +2336,10 @@

- module - Dep9 + + module + Dep9 + (X : sig ... end ) : sig ... @@ -2318,7 +2354,8 @@

module type - Dep10 + Dep10 + = Dep9(Dep8).T with type @@ -2331,8 +2368,10 @@

- module - Dep11 + + module + Dep11 + : sig ... end @@ -2342,8 +2381,10 @@

- module - Dep12 + + module + Dep12 + (Arg : sig ... end ) : sig ... @@ -2355,8 +2396,10 @@

- module - Dep13 + + module + Dep13 + : Dep12(Dep11).T @@ -2376,7 +2419,8 @@

module type - With1 + With1 + = sig ... end @@ -2386,8 +2430,10 @@

- module - With2 + + module + With2 + : sig ... end @@ -2397,8 +2443,10 @@

- module - With3 + + module + With3 + : With1 with module @@ -2420,8 +2468,10 @@

- module - With4 + + module + With4 + : With1 with module @@ -2443,8 +2493,10 @@

- module - With5 + + module + With5 + : sig ... end @@ -2454,8 +2506,10 @@

- module - With6 + + module + With6 + : sig ... end @@ -2465,8 +2519,10 @@

- module - With7 + + module + With7 + (X : sig ... end ) : sig ... @@ -2481,8 +2537,11 @@

module type - With8 - = With7(With6).T + With8 + + = + + With7(With6).T with module M = @@ -2499,8 +2558,10 @@

- module - With9 + + module + With9 + : sig ... end @@ -2510,8 +2571,10 @@

- module - With10 + + module + With10 + : sig ... end @@ -2524,8 +2587,8 @@

module type + With11 - With11 = With7(With10).T with @@ -2548,8 +2611,6 @@

module type - - NestedInclude1 = sig ... @@ -2574,8 +2635,6 @@

module type - - NestedInclude2 @@ -2616,8 +2675,10 @@

- module - DoubleInclude1 + + module + DoubleInclude1 + : sig ... end @@ -2627,8 +2688,10 @@

- module - DoubleInclude3 + + module + DoubleInclude3 + : sig ... end @@ -2660,8 +2723,9 @@

- module - IncludeInclude1 + + module + IncludeInclude1 : sig ... end @@ -2687,8 +2751,6 @@

module type - - IncludeInclude2 @@ -2701,8 +2763,9 @@

- module - IncludeInclude2_M + + module + IncludeInclude2_M : sig ... end @@ -2772,8 +2835,10 @@

- module - CanonicalTest + + module + CanonicalTest + : sig ... end @@ -2798,8 +2863,10 @@

Aliases again

- module - Aliases + + module + Aliases + : sig ... end @@ -2849,7 +2916,8 @@

module type - M + M + = sig ... end @@ -2859,8 +2927,10 @@

- module - M + + module + M + : sig ... end @@ -2878,8 +2948,10 @@

- module - Only_a_module + + module + Only_a_module + : sig ... end @@ -2914,8 +2986,8 @@

module type + TypeExt - TypeExt = sig ... end @@ -2955,8 +3027,6 @@

module type - - TypeExtPruned = TypeExt diff --git a/test/generators/html/Recent-Z-Y.html b/test/generators/html/Recent-Z-Y.html index 89b9d20e8c..8ffae7a0d7 100644 --- a/test/generators/html/Recent-Z-Y.html +++ b/test/generators/html/Recent-Z-Y.html @@ -17,8 +17,10 @@
- module - X + + module + X + : sig ... end diff --git a/test/generators/html/Recent-Z.html b/test/generators/html/Recent-Z.html index abe9373fd4..17575b8145 100644 --- a/test/generators/html/Recent-Z.html +++ b/test/generators/html/Recent-Z.html @@ -17,8 +17,10 @@

Module Recent.Z

- module - Y + + module + Y + : sig ... end diff --git a/test/generators/html/Recent.html b/test/generators/html/Recent.html index 0750f9290f..925d34138a 100644 --- a/test/generators/html/Recent.html +++ b/test/generators/html/Recent.html @@ -17,7 +17,8 @@

Module Recent

module type - S + S + = sig ... end @@ -30,7 +31,8 @@

Module Recent

module type - S1 + S1 + = functor (_ : S) @@ -299,8 +301,9 @@

Module Recent

- module - Z + + module Z + : sig ... end @@ -310,8 +313,9 @@

Module Recent

- module - X + + module X + : sig ... end @@ -324,7 +328,8 @@

Module Recent

module type - PolyS + PolyS + = sig ... end diff --git a/test/generators/html/Recent_impl-Foo.html b/test/generators/html/Recent_impl-Foo.html index 43e90bffa3..e0dffafb93 100644 --- a/test/generators/html/Recent_impl-Foo.html +++ b/test/generators/html/Recent_impl-Foo.html @@ -18,8 +18,10 @@

Module Recent_impl.Foo

- module - A + + module + A + : sig ... end @@ -29,8 +31,10 @@

Module Recent_impl.Foo

- module - B + + module + B + : sig ... end diff --git a/test/generators/html/Recent_impl-module-type-S.html b/test/generators/html/Recent_impl-module-type-S.html index 3e2079f91a..8f9fe023ca 100644 --- a/test/generators/html/Recent_impl-module-type-S.html +++ b/test/generators/html/Recent_impl-module-type-S.html @@ -18,8 +18,10 @@

Module type Recent_impl.S

- module - F + + module + F + (_ : sig ... end) : sig @@ -31,8 +33,10 @@

Module type Recent_impl.S

- module - X + + module + X + : sig ... end diff --git a/test/generators/html/Recent_impl.html b/test/generators/html/Recent_impl.html index d2b2aa062c..e8bf6687b2 100644 --- a/test/generators/html/Recent_impl.html +++ b/test/generators/html/Recent_impl.html @@ -15,8 +15,10 @@

Module Recent_impl

- module - Foo + + module + Foo + : sig ... end @@ -26,8 +28,10 @@

Module Recent_impl

- module - B + + module + B + : sig ... end @@ -46,7 +50,8 @@

Module Recent_impl

module type - S + S + = sig ... end @@ -56,7 +61,7 @@

Module Recent_impl

- module B' + module B' = Foo.B
diff --git a/test/generators/html/Stop.html b/test/generators/html/Stop.html index 2857f1cea2..ea577eec90 100644 --- a/test/generators/html/Stop.html +++ b/test/generators/html/Stop.html @@ -32,8 +32,9 @@

Module Stop

- module - N + + module N + : sig ... end diff --git a/test/generators/html/Stop_dead_link_doc.html b/test/generators/html/Stop_dead_link_doc.html index 172b3c466b..193bfc3ae0 100644 --- a/test/generators/html/Stop_dead_link_doc.html +++ b/test/generators/html/Stop_dead_link_doc.html @@ -15,8 +15,10 @@

Module Stop_dead_link_doc

- module - Foo + + module + Foo + : sig ... end diff --git a/test/generators/html/Toplevel_comments.html b/test/generators/html/Toplevel_comments.html index 40370cc488..b71979456d 100644 --- a/test/generators/html/Toplevel_comments.html +++ b/test/generators/html/Toplevel_comments.html @@ -21,8 +21,8 @@

Module Toplevel_comments

module type + T - T = sig ... end @@ -32,8 +32,8 @@

Module Toplevel_comments

- module - + + module Include_inline : sig ... @@ -45,8 +45,8 @@

Module Toplevel_comments

- module - + + module Include_inline' : sig ... @@ -64,8 +64,6 @@

Module Toplevel_comments

module type - - Include_inline_T @@ -83,8 +81,6 @@

Module Toplevel_comments

module type - - Include_inline_T' @@ -101,8 +97,10 @@

Module Toplevel_comments

- module - M + + module + M + : sig ... end @@ -112,8 +110,10 @@

Module Toplevel_comments

- module - M' + + module + M' + : sig ... end @@ -124,8 +124,10 @@

Module Toplevel_comments

- module - M'' + + module + M'' + : sig ... end @@ -135,8 +137,10 @@

Module Toplevel_comments

- module - Alias + + module + Alias + : T

Doc of Alias.

@@ -179,8 +183,8 @@

Module Toplevel_comments

- module - + + module Ref_in_synopsis : sig ... diff --git a/test/generators/html/Type.html b/test/generators/html/Type.html index cbb262f0d5..64e6d6ee3b 100644 --- a/test/generators/html/Type.html +++ b/test/generators/html/Type.html @@ -57,7 +57,7 @@

Module Type

type higher_order = - (int -> int) + ( int -> int ) -> int @@ -89,11 +89,12 @@

Module Type

type labeled_higher_order = - (l:int -> int) + ( l:int -> int ) -> - (?l:int -> int) + ( ?l:int -> + int ) -> int @@ -145,40 +146,53 @@

Module Type

type long - = + = + labeled_higher_order -> - + + [ `Bar | `Baz of triple ] -> - + + pair -> - + + labeled -> - + + higher_order -> - + + - (string -> int) + ( string -> + int ) -> - + + (int * float * char * string * char * unit) option -> - + + nested_pair -> - + + arrow -> - string -> - nested_pair array + + + string -> + + nested_pair array
@@ -394,7 +408,7 @@

Module Type

- e : a. 'a; + e : 'a. 'a; } @@ -523,7 +537,7 @@

Module Type

type object_ - = < a : int; b : int; c : int; > + = < a : int ; b : int ; c : int >
@@ -533,7 +547,8 @@

Module Type

module type - X + X + = sig ... end @@ -609,7 +624,7 @@

Module Type

type using_binary = - (int, int) binary + ( int, int ) binary @@ -710,7 +725,7 @@

Module Type

= 'a constraint 'a = - < a : int; b : int; > + < a : int ; b : int >
@@ -723,7 +738,7 @@

Module Type

= 'a constraint 'a = - < a : int; b : int; .. > + < a : int ; b : int.. >
@@ -736,7 +751,7 @@

Module Type

= 'a constraint 'a = - < a : a. 'a; > + < a : 'a. 'a >
diff --git a/test/generators/latex/Ocamlary.FunctorTypeOf.tex b/test/generators/latex/Ocamlary.FunctorTypeOf.tex index e5ac1b7326..c36e86c811 100644 --- a/test/generators/latex/Ocamlary.FunctorTypeOf.tex +++ b/test/generators/latex/Ocamlary.FunctorTypeOf.tex @@ -9,7 +9,7 @@ \subsection{Parameters\label{parameters}}% \label{module-Ocamlary-module-FunctorTypeOf-argument-1-Collection-type-element}\ocamlcodefragment{\ocamltag{keyword}{type} element}\\ \label{module-Ocamlary-module-FunctorTypeOf-argument-1-Collection-module-InnerModuleA}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-FunctorTypeOf-argument-1-Collection-module-InnerModuleA]{\ocamlinlinecode{InnerModuleA}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-FunctorTypeOf-argument-1-Collection-module-InnerModuleA-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = \hyperref[module-Ocamlary-module-FunctorTypeOf-argument-1-Collection-type-collection]{\ocamlinlinecode{collection}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak -\label{module-Ocamlary-module-FunctorTypeOf-argument-1-Collection-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-FunctorTypeOf-argument-1-Collection-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-FunctorTypeOf-argument-1-Collection-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% +\label{module-Ocamlary-module-FunctorTypeOf-argument-1-Collection-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-FunctorTypeOf-argument-1-Collection-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-FunctorTypeOf-argument-1-Collection-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak \end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{InnerModuleA'}.\end{ocamlindent}% diff --git a/test/generators/latex/Ocamlary.Recollection.tex b/test/generators/latex/Ocamlary.Recollection.tex index f49f99179f..2bed2680d1 100644 --- a/test/generators/latex/Ocamlary.Recollection.tex +++ b/test/generators/latex/Ocamlary.Recollection.tex @@ -7,7 +7,7 @@ \subsection{Parameters\label{parameters}}% \label{module-Ocamlary-module-Recollection-argument-1-C-type-element}\ocamlcodefragment{\ocamltag{keyword}{type} element}\\ \label{module-Ocamlary-module-Recollection-argument-1-C-module-InnerModuleA}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-Recollection-argument-1-C-module-InnerModuleA]{\ocamlinlinecode{InnerModuleA}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-Recollection-argument-1-C-module-InnerModuleA-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = \hyperref[module-Ocamlary-module-Recollection-argument-1-C-type-collection]{\ocamlinlinecode{collection}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak -\label{module-Ocamlary-module-Recollection-argument-1-C-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-Recollection-argument-1-C-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-Recollection-argument-1-C-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% +\label{module-Ocamlary-module-Recollection-argument-1-C-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-Recollection-argument-1-C-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-Recollection-argument-1-C-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak \end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{InnerModuleA'}.\end{ocamlindent}% @@ -32,7 +32,7 @@ \subsection{Signature\label{signature}}% \label{module-Ocamlary-module-Recollection-type-element}\ocamlcodefragment{\ocamltag{keyword}{type} element = \hyperref[module-Ocamlary-module-Recollection-argument-1-C-type-collection]{\ocamlinlinecode{C.\allowbreak{}collection}}}\\ \label{module-Ocamlary-module-Recollection-module-InnerModuleA}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-Recollection-module-InnerModuleA]{\ocamlinlinecode{InnerModuleA}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-Recollection-module-InnerModuleA-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = \hyperref[module-Ocamlary-module-Recollection-type-collection]{\ocamlinlinecode{collection}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak -\label{module-Ocamlary-module-Recollection-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-Recollection-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-Recollection-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% +\label{module-Ocamlary-module-Recollection-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-Recollection-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-Recollection-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak \end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{InnerModuleA'}.\end{ocamlindent}% diff --git a/test/generators/latex/Ocamlary.tex b/test/generators/latex/Ocamlary.tex index 0191945b33..01757c4498 100644 --- a/test/generators/latex/Ocamlary.tex +++ b/test/generators/latex/Ocamlary.tex @@ -143,7 +143,8 @@ \subsubsection{Basic type and value stuff with advanced doc comments\label{basic \item[{returns}]{the \ocamlinlinecode{y} coordinate}\end{description}% \end{ocamlindent}% \medbreak -\label{module-Ocamlary-val-fun+u+fun+u+fun}\ocamlcodefragment{\ocamltag{keyword}{val} fun\_\allowbreak{}fun\_\allowbreak{}fun : ((int,\allowbreak{} int) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}},\allowbreak{} (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\\ +\label{module-Ocamlary-val-fun+u+fun+u+fun}\ocamlcodefragment{\ocamltag{keyword}{val} fun\_\allowbreak{}fun\_\allowbreak{}fun : + ( ( int,\allowbreak{} int ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}},\allowbreak{} ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}} ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\\ \label{module-Ocamlary-val-fun+u+maybe}\ocamlcodefragment{\ocamltag{keyword}{val} fun\_\allowbreak{}maybe : ?yes:unit \ocamltag{arrow}{$\rightarrow$} unit \ocamltag{arrow}{$\rightarrow$} int}\\ \label{module-Ocamlary-val-not+u+found}\ocamlcodefragment{\ocamltag{keyword}{val} not\_\allowbreak{}found : unit \ocamltag{arrow}{$\rightarrow$} unit}\begin{ocamlindent}\begin{description}\kern-\topsep \makeatletter\advance\@topsepadd-\topsep\makeatother% topsep is hardcoded @@ -202,7 +203,7 @@ \subsubsection{Advanced Module Stuff\label{advanced-module-stuff}}% \label{module-Ocamlary-module-CollectionModule-type-element}\ocamlcodefragment{\ocamltag{keyword}{type} element}\\ \label{module-Ocamlary-module-CollectionModule-module-InnerModuleA}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-CollectionModule-module-InnerModuleA]{\ocamlinlinecode{InnerModuleA}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-CollectionModule-module-InnerModuleA-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = \hyperref[module-Ocamlary-module-CollectionModule-type-collection]{\ocamlinlinecode{collection}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak -\label{module-Ocamlary-module-CollectionModule-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-CollectionModule-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-CollectionModule-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% +\label{module-Ocamlary-module-CollectionModule-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-CollectionModule-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-CollectionModule-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak \end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{InnerModuleA'}.\end{ocamlindent}% @@ -227,7 +228,7 @@ \subsubsection{Advanced Module Stuff\label{advanced-module-stuff}}% \label{module-Ocamlary-module-type-COLLECTION-type-element}\ocamlcodefragment{\ocamltag{keyword}{type} element}\\ \label{module-Ocamlary-module-type-COLLECTION-module-InnerModuleA}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-COLLECTION-module-InnerModuleA]{\ocamlinlinecode{InnerModuleA}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-COLLECTION-module-InnerModuleA-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = \hyperref[module-Ocamlary-module-type-COLLECTION-type-collection]{\ocamlinlinecode{collection}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak -\label{module-Ocamlary-module-type-COLLECTION-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-COLLECTION-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-COLLECTION-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% +\label{module-Ocamlary-module-type-COLLECTION-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-COLLECTION-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-COLLECTION-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak \end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{InnerModuleA'}.\end{ocamlindent}% @@ -245,7 +246,11 @@ \subsubsection{Advanced Module Stuff\label{advanced-module-stuff}}% \end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}module type of\end{ocamlindent}% \medbreak -\label{module-Ocamlary-module-Recollection}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-Recollection]{\ocamlinlinecode{Recollection}}}\ocamlcodefragment{ (\hyperref[module-Ocamlary-module-Recollection-argument-1-C]{\ocamlinlinecode{C}} : \hyperref[module-Ocamlary-module-type-COLLECTION]{\ocamlinlinecode{COLLECTION}}) : \hyperref[module-Ocamlary-module-type-COLLECTION]{\ocamlinlinecode{COLLECTION}} \ocamltag{keyword}{with} \ocamltag{keyword}{type} \hyperref[module-Ocamlary-module-type-COLLECTION-type-collection]{\ocamlinlinecode{collection}} = \hyperref[module-Ocamlary-module-Recollection-argument-1-C-type-element]{\ocamlinlinecode{C.\allowbreak{}element}} list \ocamltag{keyword}{and} \ocamltag{keyword}{type} \hyperref[module-Ocamlary-module-type-COLLECTION-type-element]{\ocamlinlinecode{element}} = \hyperref[module-Ocamlary-module-Recollection-argument-1-C-type-collection]{\ocamlinlinecode{C.\allowbreak{}collection}}}\\ +\label{module-Ocamlary-module-Recollection}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-Recollection]{\ocamlinlinecode{Recollection}}}\ocamlcodefragment{ + (\hyperref[module-Ocamlary-module-Recollection-argument-1-C]{\ocamlinlinecode{C}} : \hyperref[module-Ocamlary-module-type-COLLECTION]{\ocamlinlinecode{COLLECTION}}) : + \hyperref[module-Ocamlary-module-type-COLLECTION]{\ocamlinlinecode{COLLECTION}} + \ocamltag{keyword}{with} \ocamltag{keyword}{type} \hyperref[module-Ocamlary-module-type-COLLECTION-type-collection]{\ocamlinlinecode{collection}} = \hyperref[module-Ocamlary-module-Recollection-argument-1-C-type-element]{\ocamlinlinecode{C.\allowbreak{}element}} list + \ocamltag{keyword}{and} \ocamltag{keyword}{type} \hyperref[module-Ocamlary-module-type-COLLECTION-type-element]{\ocamlinlinecode{element}} = \hyperref[module-Ocamlary-module-Recollection-argument-1-C-type-collection]{\ocamlinlinecode{C.\allowbreak{}collection}}}\\ \label{module-Ocamlary-module-type-MMM}\ocamlcodefragment{\ocamltag{keyword}{module} \ocamltag{keyword}{type} \hyperref[module-Ocamlary-module-type-MMM]{\ocamlinlinecode{MMM}}}\ocamlcodefragment{ = \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-MMM-module-C}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-MMM-module-C]{\ocamlinlinecode{C}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}This comment is for \ocamlinlinecode{CollectionModule}. \label{module-Ocamlary-module-type-MMM-module-C-type-collection}\ocamlcodefragment{\ocamltag{keyword}{type} collection}\begin{ocamlindent}This comment is for \ocamlinlinecode{collection}.\end{ocamlindent}% @@ -253,7 +258,7 @@ \subsubsection{Advanced Module Stuff\label{advanced-module-stuff}}% \label{module-Ocamlary-module-type-MMM-module-C-type-element}\ocamlcodefragment{\ocamltag{keyword}{type} element}\\ \label{module-Ocamlary-module-type-MMM-module-C-module-InnerModuleA}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-MMM-module-C-module-InnerModuleA]{\ocamlinlinecode{InnerModuleA}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-MMM-module-C-module-InnerModuleA-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = \hyperref[module-Ocamlary-module-type-MMM-module-C-type-collection]{\ocamlinlinecode{collection}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak -\label{module-Ocamlary-module-type-MMM-module-C-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-MMM-module-C-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-MMM-module-C-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% +\label{module-Ocamlary-module-type-MMM-module-C-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-MMM-module-C-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-MMM-module-C-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak \end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{InnerModuleA'}.\end{ocamlindent}% @@ -279,7 +284,7 @@ \subsubsection{Advanced Module Stuff\label{advanced-module-stuff}}% \label{module-Ocamlary-module-type-RecollectionModule-type-element}\ocamlcodefragment{\ocamltag{keyword}{type} element = \hyperref[module-Ocamlary-module-CollectionModule-type-collection]{\ocamlinlinecode{CollectionModule.\allowbreak{}collection}}}\\ \label{module-Ocamlary-module-type-RecollectionModule-module-InnerModuleA}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-RecollectionModule-module-InnerModuleA]{\ocamlinlinecode{InnerModuleA}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-RecollectionModule-module-InnerModuleA-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = \hyperref[module-Ocamlary-module-type-RecollectionModule-type-collection]{\ocamlinlinecode{collection}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak -\label{module-Ocamlary-module-type-RecollectionModule-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-RecollectionModule-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-RecollectionModule-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% +\label{module-Ocamlary-module-type-RecollectionModule-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-RecollectionModule-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-RecollectionModule-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak \end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{InnerModuleA'}.\end{ocamlindent}% @@ -304,7 +309,7 @@ \subsubsection{Advanced Module Stuff\label{advanced-module-stuff}}% \label{module-Ocamlary-module-type-A-module-Q-type-element}\ocamlcodefragment{\ocamltag{keyword}{type} element}\\ \label{module-Ocamlary-module-type-A-module-Q-module-InnerModuleA}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-A-module-Q-module-InnerModuleA]{\ocamlinlinecode{InnerModuleA}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-A-module-Q-module-InnerModuleA-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = \hyperref[module-Ocamlary-module-type-A-module-Q-type-collection]{\ocamlinlinecode{collection}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak -\label{module-Ocamlary-module-type-A-module-Q-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-A-module-Q-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-A-module-Q-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% +\label{module-Ocamlary-module-type-A-module-Q-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-A-module-Q-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-A-module-Q-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak \end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{InnerModuleA'}.\end{ocamlindent}% @@ -331,7 +336,7 @@ \subsubsection{Advanced Module Stuff\label{advanced-module-stuff}}% \label{module-Ocamlary-module-type-B-module-Q-type-element}\ocamlcodefragment{\ocamltag{keyword}{type} element}\\ \label{module-Ocamlary-module-type-B-module-Q-module-InnerModuleA}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-B-module-Q-module-InnerModuleA]{\ocamlinlinecode{InnerModuleA}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-B-module-Q-module-InnerModuleA-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = \hyperref[module-Ocamlary-module-type-B-module-Q-type-collection]{\ocamlinlinecode{collection}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak -\label{module-Ocamlary-module-type-B-module-Q-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-B-module-Q-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-B-module-Q-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% +\label{module-Ocamlary-module-type-B-module-Q-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-B-module-Q-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-B-module-Q-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak \end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{InnerModuleA'}.\end{ocamlindent}% @@ -358,7 +363,7 @@ \subsubsection{Advanced Module Stuff\label{advanced-module-stuff}}% \label{module-Ocamlary-module-type-C-module-Q-type-element}\ocamlcodefragment{\ocamltag{keyword}{type} element}\\ \label{module-Ocamlary-module-type-C-module-Q-module-InnerModuleA}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-C-module-Q-module-InnerModuleA]{\ocamlinlinecode{InnerModuleA}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-C-module-Q-module-InnerModuleA-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = \hyperref[module-Ocamlary-module-type-C-module-Q-type-collection]{\ocamlinlinecode{collection}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak -\label{module-Ocamlary-module-type-C-module-Q-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-C-module-Q-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-C-module-Q-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% +\label{module-Ocamlary-module-type-C-module-Q-module-InnerModuleA-module-InnerModuleA'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-C-module-Q-module-InnerModuleA-module-InnerModuleA']{\ocamlinlinecode{InnerModuleA'}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Ocamlary-module-type-C-module-Q-module-InnerModuleA-module-InnerModuleA'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-a+u+function]{\ocamlinlinecode{a\_\allowbreak{}function}}}\begin{ocamlindent}This comment is for \ocamlinlinecode{t}.\end{ocamlindent}% \medbreak \end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{InnerModuleA'}.\end{ocamlindent}% @@ -378,7 +383,9 @@ \subsubsection{Advanced Module Stuff\label{advanced-module-stuff}}% \ocamltag{keyword}{include} \hyperref[module-Ocamlary-module-type-B]{\ocamlinlinecode{B}} \ocamltag{keyword}{with} \ocamltag{keyword}{type} \hyperref[module-Ocamlary-module-type-B-type-t]{\ocamlinlinecode{t}} := \hyperref[module-Ocamlary-module-type-C-type-t]{\ocamlinlinecode{t}} \ocamltag{keyword}{and} \ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-type-B-module-Q]{\ocamlinlinecode{Q}} := \hyperref[module-Ocamlary-module-type-C-module-Q]{\ocamlinlinecode{Q}}\end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}This module type includes two signatures.\end{ocamlindent}% \medbreak -\label{module-Ocamlary-module-FunctorTypeOf}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-FunctorTypeOf]{\ocamlinlinecode{FunctorTypeOf}}}\ocamlcodefragment{ (\hyperref[module-Ocamlary-module-FunctorTypeOf-argument-1-Collection]{\ocamlinlinecode{Collection}} : \ocamltag{keyword}{module} \ocamltag{keyword}{type} \ocamltag{keyword}{of} \hyperref[module-Ocamlary-module-CollectionModule]{\ocamlinlinecode{CollectionModule}}) : \ocamltag{keyword}{sig} .\allowbreak{}.\allowbreak{}.\allowbreak{} \ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{FunctorTypeOf}.\end{ocamlindent}% +\label{module-Ocamlary-module-FunctorTypeOf}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Ocamlary-module-FunctorTypeOf]{\ocamlinlinecode{FunctorTypeOf}}}\ocamlcodefragment{ + (\hyperref[module-Ocamlary-module-FunctorTypeOf-argument-1-Collection]{\ocamlinlinecode{Collection}} : \ocamltag{keyword}{module} \ocamltag{keyword}{type} \ocamltag{keyword}{of} \hyperref[module-Ocamlary-module-CollectionModule]{\ocamlinlinecode{CollectionModule}}) : + \ocamltag{keyword}{sig} .\allowbreak{}.\allowbreak{}.\allowbreak{} \ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{FunctorTypeOf}.\end{ocamlindent}% \medbreak \label{module-Ocamlary-module-type-IncludeModuleType}\ocamlcodefragment{\ocamltag{keyword}{module} \ocamltag{keyword}{type} \hyperref[module-Ocamlary-module-type-IncludeModuleType]{\ocamlinlinecode{IncludeModuleType}}}\ocamlcodefragment{ = \ocamltag{keyword}{sig}}\begin{ocamlindent}This comment is for \ocamlinlinecode{include EmptySigAlias}.\ocamltag{keyword}{include} \hyperref[module-Ocamlary-module-type-EmptySig]{\ocamlinlinecode{EmptySigAlias}}\end{ocamlindent}% \ocamlcodefragment{\ocamltag{keyword}{end}}\begin{ocamlindent}This comment is for \ocamlinlinecode{IncludeModuleType}.\end{ocamlindent}% @@ -413,7 +420,7 @@ \subsubsection{Advanced Type Stuff\label{advanced-type-stuff}}% \\ \ocamlcodefragment{\}}\\ \label{module-Ocamlary-type-universe+u+record}\ocamlcodefragment{\ocamltag{keyword}{type} universe\_\allowbreak{}record = \{}\\ -\begin{ocamltabular}{p{1.000\textwidth}}\ocamlinlinecode{nihilate : a.\allowbreak{} \ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} unit;\allowbreak{}}\label{module-Ocamlary-type-universe+u+record.nihilate}\\ +\begin{ocamltabular}{p{1.000\textwidth}}\ocamlinlinecode{nihilate : 'a.\allowbreak{} \ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} unit;\allowbreak{}}\label{module-Ocamlary-type-universe+u+record.nihilate}\\ \end{ocamltabular}% \\ \ocamlcodefragment{\}}\\ @@ -434,10 +441,10 @@ \subsubsection{Advanced Type Stuff\label{advanced-type-stuff}}% \ocamlcodefragment{ ]}\begin{ocamlindent}This comment is for \ocamlinlinecode{poly\_\allowbreak{}variant}.Wow! It was a polymorphic variant!\end{ocamlindent}% \medbreak \label{module-Ocamlary-type-full+u+gadt}\ocamlcodefragment{\ocamltag{keyword}{type} (\_\allowbreak{},\allowbreak{} \_\allowbreak{}) full\_\allowbreak{}gadt = }\\ -\begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{Tag} : (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-full+u+gadt]{\ocamlinlinecode{full\_\allowbreak{}gadt}}}\label{module-Ocamlary-type-full+u+gadt.Tag}\\ -\ocamlcodefragment{| \ocamltag{constructor}{First} : \ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} (\ocamltag{type-var}{'a},\allowbreak{} unit) \hyperref[module-Ocamlary-type-full+u+gadt]{\ocamlinlinecode{full\_\allowbreak{}gadt}}}\label{module-Ocamlary-type-full+u+gadt.First}\\ -\ocamlcodefragment{| \ocamltag{constructor}{Second} : \ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} (unit,\allowbreak{} \ocamltag{type-var}{'a}) \hyperref[module-Ocamlary-type-full+u+gadt]{\ocamlinlinecode{full\_\allowbreak{}gadt}}}\label{module-Ocamlary-type-full+u+gadt.Second}\\ -\ocamlcodefragment{| \ocamltag{constructor}{Exist} : \ocamltag{type-var}{'a} * \ocamltag{type-var}{'b} \ocamltag{arrow}{$\rightarrow$} (\ocamltag{type-var}{'b},\allowbreak{} unit) \hyperref[module-Ocamlary-type-full+u+gadt]{\ocamlinlinecode{full\_\allowbreak{}gadt}}}\label{module-Ocamlary-type-full+u+gadt.Exist}\\ +\begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{Tag} : ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-full+u+gadt]{\ocamlinlinecode{full\_\allowbreak{}gadt}}}\label{module-Ocamlary-type-full+u+gadt.Tag}\\ +\ocamlcodefragment{| \ocamltag{constructor}{First} : \ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} ( \ocamltag{type-var}{'a},\allowbreak{} unit ) \hyperref[module-Ocamlary-type-full+u+gadt]{\ocamlinlinecode{full\_\allowbreak{}gadt}}}\label{module-Ocamlary-type-full+u+gadt.First}\\ +\ocamlcodefragment{| \ocamltag{constructor}{Second} : \ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} ( unit,\allowbreak{} \ocamltag{type-var}{'a} ) \hyperref[module-Ocamlary-type-full+u+gadt]{\ocamlinlinecode{full\_\allowbreak{}gadt}}}\label{module-Ocamlary-type-full+u+gadt.Second}\\ +\ocamlcodefragment{| \ocamltag{constructor}{Exist} : \ocamltag{type-var}{'a} * \ocamltag{type-var}{'b} \ocamltag{arrow}{$\rightarrow$} ( \ocamltag{type-var}{'b},\allowbreak{} unit ) \hyperref[module-Ocamlary-type-full+u+gadt]{\ocamlinlinecode{full\_\allowbreak{}gadt}}}\label{module-Ocamlary-type-full+u+gadt.Exist}\\ \end{ocamltabular}% \\ \begin{ocamlindent}This comment is for \ocamlinlinecode{full\_\allowbreak{}gadt}.Wow! It was a GADT!\end{ocamlindent}% @@ -445,7 +452,7 @@ \subsubsection{Advanced Type Stuff\label{advanced-type-stuff}}% \label{module-Ocamlary-type-partial+u+gadt}\ocamlcodefragment{\ocamltag{keyword}{type} 'a partial\_\allowbreak{}gadt = }\\ \begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{AscribeTag} : \ocamltag{type-var}{'a} \hyperref[module-Ocamlary-type-partial+u+gadt]{\ocamlinlinecode{partial\_\allowbreak{}gadt}}}\label{module-Ocamlary-type-partial+u+gadt.AscribeTag}\\ \ocamlcodefragment{| \ocamltag{constructor}{OfTag} \ocamltag{keyword}{of} \ocamltag{type-var}{'a} \hyperref[module-Ocamlary-type-partial+u+gadt]{\ocamlinlinecode{partial\_\allowbreak{}gadt}}}\label{module-Ocamlary-type-partial+u+gadt.OfTag}\\ -\ocamlcodefragment{| \ocamltag{constructor}{ExistGadtTag} : (\ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} \ocamltag{type-var}{'b}) \ocamltag{arrow}{$\rightarrow$} \ocamltag{type-var}{'a} \hyperref[module-Ocamlary-type-partial+u+gadt]{\ocamlinlinecode{partial\_\allowbreak{}gadt}}}\label{module-Ocamlary-type-partial+u+gadt.ExistGadtTag}\\ +\ocamlcodefragment{| \ocamltag{constructor}{ExistGadtTag} : ( \ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} \ocamltag{type-var}{'b} ) \ocamltag{arrow}{$\rightarrow$} \ocamltag{type-var}{'a} \hyperref[module-Ocamlary-type-partial+u+gadt]{\ocamlinlinecode{partial\_\allowbreak{}gadt}}}\label{module-Ocamlary-type-partial+u+gadt.ExistGadtTag}\\ \end{ocamltabular}% \\ \begin{ocamlindent}This comment is for \ocamlinlinecode{partial\_\allowbreak{}gadt}.Wow! It was a mixed GADT!\end{ocamlindent}% @@ -503,11 +510,11 @@ \subsubsection{Advanced Type Stuff\label{advanced-type-stuff}}% \end{ocamltabular}% \\ \ocamlcodefragment{ ]}\\ -\label{module-Ocamlary-type-full+u+gadt+u+alias}\ocamlcodefragment{\ocamltag{keyword}{type} ('a,\allowbreak{} 'b) full\_\allowbreak{}gadt\_\allowbreak{}alias = (\ocamltag{type-var}{'a},\allowbreak{} \ocamltag{type-var}{'b}) \hyperref[module-Ocamlary-type-full+u+gadt]{\ocamlinlinecode{full\_\allowbreak{}gadt}} = }\\ -\begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{Tag} : (unit,\allowbreak{} unit) \hyperref[module-Ocamlary-type-full+u+gadt+u+alias]{\ocamlinlinecode{full\_\allowbreak{}gadt\_\allowbreak{}alias}}}\label{module-Ocamlary-type-full+u+gadt+u+alias.Tag}\\ -\ocamlcodefragment{| \ocamltag{constructor}{First} : \ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} (\ocamltag{type-var}{'a},\allowbreak{} unit) \hyperref[module-Ocamlary-type-full+u+gadt+u+alias]{\ocamlinlinecode{full\_\allowbreak{}gadt\_\allowbreak{}alias}}}\label{module-Ocamlary-type-full+u+gadt+u+alias.First}\\ -\ocamlcodefragment{| \ocamltag{constructor}{Second} : \ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} (unit,\allowbreak{} \ocamltag{type-var}{'a}) \hyperref[module-Ocamlary-type-full+u+gadt+u+alias]{\ocamlinlinecode{full\_\allowbreak{}gadt\_\allowbreak{}alias}}}\label{module-Ocamlary-type-full+u+gadt+u+alias.Second}\\ -\ocamlcodefragment{| \ocamltag{constructor}{Exist} : \ocamltag{type-var}{'a} * \ocamltag{type-var}{'b} \ocamltag{arrow}{$\rightarrow$} (\ocamltag{type-var}{'b},\allowbreak{} unit) \hyperref[module-Ocamlary-type-full+u+gadt+u+alias]{\ocamlinlinecode{full\_\allowbreak{}gadt\_\allowbreak{}alias}}}\label{module-Ocamlary-type-full+u+gadt+u+alias.Exist}\\ +\label{module-Ocamlary-type-full+u+gadt+u+alias}\ocamlcodefragment{\ocamltag{keyword}{type} ('a,\allowbreak{} 'b) full\_\allowbreak{}gadt\_\allowbreak{}alias = ( \ocamltag{type-var}{'a},\allowbreak{} \ocamltag{type-var}{'b} ) \hyperref[module-Ocamlary-type-full+u+gadt]{\ocamlinlinecode{full\_\allowbreak{}gadt}} = }\\ +\begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{Tag} : ( unit,\allowbreak{} unit ) \hyperref[module-Ocamlary-type-full+u+gadt+u+alias]{\ocamlinlinecode{full\_\allowbreak{}gadt\_\allowbreak{}alias}}}\label{module-Ocamlary-type-full+u+gadt+u+alias.Tag}\\ +\ocamlcodefragment{| \ocamltag{constructor}{First} : \ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} ( \ocamltag{type-var}{'a},\allowbreak{} unit ) \hyperref[module-Ocamlary-type-full+u+gadt+u+alias]{\ocamlinlinecode{full\_\allowbreak{}gadt\_\allowbreak{}alias}}}\label{module-Ocamlary-type-full+u+gadt+u+alias.First}\\ +\ocamlcodefragment{| \ocamltag{constructor}{Second} : \ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} ( unit,\allowbreak{} \ocamltag{type-var}{'a} ) \hyperref[module-Ocamlary-type-full+u+gadt+u+alias]{\ocamlinlinecode{full\_\allowbreak{}gadt\_\allowbreak{}alias}}}\label{module-Ocamlary-type-full+u+gadt+u+alias.Second}\\ +\ocamlcodefragment{| \ocamltag{constructor}{Exist} : \ocamltag{type-var}{'a} * \ocamltag{type-var}{'b} \ocamltag{arrow}{$\rightarrow$} ( \ocamltag{type-var}{'b},\allowbreak{} unit ) \hyperref[module-Ocamlary-type-full+u+gadt+u+alias]{\ocamlinlinecode{full\_\allowbreak{}gadt\_\allowbreak{}alias}}}\label{module-Ocamlary-type-full+u+gadt+u+alias.Exist}\\ \end{ocamltabular}% \\ \begin{ocamlindent}This comment is for \ocamlinlinecode{full\_\allowbreak{}gadt\_\allowbreak{}alias}.\end{ocamlindent}% @@ -515,7 +522,7 @@ \subsubsection{Advanced Type Stuff\label{advanced-type-stuff}}% \label{module-Ocamlary-type-partial+u+gadt+u+alias}\ocamlcodefragment{\ocamltag{keyword}{type} 'a partial\_\allowbreak{}gadt\_\allowbreak{}alias = \ocamltag{type-var}{'a} \hyperref[module-Ocamlary-type-partial+u+gadt]{\ocamlinlinecode{partial\_\allowbreak{}gadt}} = }\\ \begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{AscribeTag} : \ocamltag{type-var}{'a} \hyperref[module-Ocamlary-type-partial+u+gadt+u+alias]{\ocamlinlinecode{partial\_\allowbreak{}gadt\_\allowbreak{}alias}}}\label{module-Ocamlary-type-partial+u+gadt+u+alias.AscribeTag}\\ \ocamlcodefragment{| \ocamltag{constructor}{OfTag} \ocamltag{keyword}{of} \ocamltag{type-var}{'a} \hyperref[module-Ocamlary-type-partial+u+gadt+u+alias]{\ocamlinlinecode{partial\_\allowbreak{}gadt\_\allowbreak{}alias}}}\label{module-Ocamlary-type-partial+u+gadt+u+alias.OfTag}\\ -\ocamlcodefragment{| \ocamltag{constructor}{ExistGadtTag} : (\ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} \ocamltag{type-var}{'b}) \ocamltag{arrow}{$\rightarrow$} \ocamltag{type-var}{'a} \hyperref[module-Ocamlary-type-partial+u+gadt+u+alias]{\ocamlinlinecode{partial\_\allowbreak{}gadt\_\allowbreak{}alias}}}\label{module-Ocamlary-type-partial+u+gadt+u+alias.ExistGadtTag}\\ +\ocamlcodefragment{| \ocamltag{constructor}{ExistGadtTag} : ( \ocamltag{type-var}{'a} \ocamltag{arrow}{$\rightarrow$} \ocamltag{type-var}{'b} ) \ocamltag{arrow}{$\rightarrow$} \ocamltag{type-var}{'a} \hyperref[module-Ocamlary-type-partial+u+gadt+u+alias]{\ocamlinlinecode{partial\_\allowbreak{}gadt\_\allowbreak{}alias}}}\label{module-Ocamlary-type-partial+u+gadt+u+alias.ExistGadtTag}\\ \end{ocamltabular}% \\ \begin{ocamlindent}This comment is for \ocamlinlinecode{partial\_\allowbreak{}gadt\_\allowbreak{}alias}.\end{ocamlindent}% @@ -536,12 +543,12 @@ \subsubsection{Advanced Type Stuff\label{advanced-type-stuff}}% \\ \begin{ocamlindent}This comment is for \hyperref[module-Ocamlary-type-mutual+u+constr+u+b]{\ocamlinlinecode{\ocamlinlinecode{mutual\_\allowbreak{}constr\_\allowbreak{}b}}[p\pageref*{module-Ocamlary-type-mutual+u+constr+u+b}]} then \hyperref[module-Ocamlary-type-mutual+u+constr+u+a]{\ocamlinlinecode{\ocamlinlinecode{mutual\_\allowbreak{}constr\_\allowbreak{}a}}[p\pageref*{module-Ocamlary-type-mutual+u+constr+u+a}]}.\end{ocamlindent}% \medbreak -\label{module-Ocamlary-type-rec+u+obj}\ocamlcodefragment{\ocamltag{keyword}{type} rec\_\allowbreak{}obj = < f : int;\allowbreak{} g : unit \ocamltag{arrow}{$\rightarrow$} unit;\allowbreak{} h : \hyperref[module-Ocamlary-type-rec+u+obj]{\ocamlinlinecode{rec\_\allowbreak{}obj}};\allowbreak{} >}\\ -\label{module-Ocamlary-type-open+u+obj}\ocamlcodefragment{\ocamltag{keyword}{type} 'a open\_\allowbreak{}obj = < f : int;\allowbreak{} g : unit \ocamltag{arrow}{$\rightarrow$} unit;\allowbreak{} .\allowbreak{}.\allowbreak{} > \ocamltag{keyword}{as} 'a}\\ -\label{module-Ocamlary-type-oof}\ocamlcodefragment{\ocamltag{keyword}{type} 'a oof = < a : unit;\allowbreak{} .\allowbreak{}.\allowbreak{} > \ocamltag{keyword}{as} 'a \ocamltag{arrow}{$\rightarrow$} \ocamltag{type-var}{'a}}\\ +\label{module-Ocamlary-type-rec+u+obj}\ocamlcodefragment{\ocamltag{keyword}{type} rec\_\allowbreak{}obj = < f : int ;\allowbreak{} g : unit \ocamltag{arrow}{$\rightarrow$} unit ;\allowbreak{} h : \hyperref[module-Ocamlary-type-rec+u+obj]{\ocamlinlinecode{rec\_\allowbreak{}obj}} >}\\ +\label{module-Ocamlary-type-open+u+obj}\ocamlcodefragment{\ocamltag{keyword}{type} 'a open\_\allowbreak{}obj = < f : int ;\allowbreak{} g : unit \ocamltag{arrow}{$\rightarrow$} unit.\allowbreak{}.\allowbreak{} > \ocamltag{keyword}{as} 'a}\\ +\label{module-Ocamlary-type-oof}\ocamlcodefragment{\ocamltag{keyword}{type} 'a oof = < a : unit.\allowbreak{}.\allowbreak{} > \ocamltag{keyword}{as} 'a \ocamltag{arrow}{$\rightarrow$} \ocamltag{type-var}{'a}}\\ \label{module-Ocamlary-type-any+u+obj}\ocamlcodefragment{\ocamltag{keyword}{type} 'a any\_\allowbreak{}obj = < .\allowbreak{}.\allowbreak{} > \ocamltag{keyword}{as} 'a}\\ -\label{module-Ocamlary-type-empty+u+obj}\ocamlcodefragment{\ocamltag{keyword}{type} empty\_\allowbreak{}obj = < >}\\ -\label{module-Ocamlary-type-one+u+meth}\ocamlcodefragment{\ocamltag{keyword}{type} one\_\allowbreak{}meth = < meth : unit;\allowbreak{} >}\\ +\label{module-Ocamlary-type-empty+u+obj}\ocamlcodefragment{\ocamltag{keyword}{type} empty\_\allowbreak{}obj = < >}\\ +\label{module-Ocamlary-type-one+u+meth}\ocamlcodefragment{\ocamltag{keyword}{type} one\_\allowbreak{}meth = < meth : unit >}\\ \label{module-Ocamlary-type-ext}\ocamlcodefragment{\ocamltag{keyword}{type} ext = .\allowbreak{}.\allowbreak{}}\begin{ocamlindent}A mystery wrapped in an ellipsis\end{ocamlindent}% \medbreak \label{module-Ocamlary-extension-decl-ExtA}\ocamlcodefragment{\ocamltag{keyword}{type} \hyperref[module-Ocamlary-type-ext]{\ocamlinlinecode{ext}} += }\\ diff --git a/test/generators/latex/Type.tex b/test/generators/latex/Type.tex index 23fbc3fb9b..259584c12a 100644 --- a/test/generators/latex/Type.tex +++ b/test/generators/latex/Type.tex @@ -5,16 +5,27 @@ \section{Module \ocamlinlinecode{Type}}\label{module-Type}% \label{module-Type-type-private+u+}\ocamlcodefragment{\ocamltag{keyword}{type} private\_\allowbreak{} = \ocamltag{keyword}{private} int}\\ \label{module-Type-type-constructor}\ocamlcodefragment{\ocamltag{keyword}{type} 'a constructor = \ocamltag{type-var}{'a}}\\ \label{module-Type-type-arrow}\ocamlcodefragment{\ocamltag{keyword}{type} arrow = int \ocamltag{arrow}{$\rightarrow$} int}\\ -\label{module-Type-type-higher+u+order}\ocamlcodefragment{\ocamltag{keyword}{type} higher\_\allowbreak{}order = (int \ocamltag{arrow}{$\rightarrow$} int) \ocamltag{arrow}{$\rightarrow$} int}\\ +\label{module-Type-type-higher+u+order}\ocamlcodefragment{\ocamltag{keyword}{type} higher\_\allowbreak{}order = ( int \ocamltag{arrow}{$\rightarrow$} int ) \ocamltag{arrow}{$\rightarrow$} int}\\ \label{module-Type-type-labeled}\ocamlcodefragment{\ocamltag{keyword}{type} labeled = l:int \ocamltag{arrow}{$\rightarrow$} int}\\ \label{module-Type-type-optional}\ocamlcodefragment{\ocamltag{keyword}{type} optional = ?l:int \ocamltag{arrow}{$\rightarrow$} int}\\ -\label{module-Type-type-labeled+u+higher+u+order}\ocamlcodefragment{\ocamltag{keyword}{type} labeled\_\allowbreak{}higher\_\allowbreak{}order = (l:int \ocamltag{arrow}{$\rightarrow$} int) \ocamltag{arrow}{$\rightarrow$} (?l:int \ocamltag{arrow}{$\rightarrow$} int) \ocamltag{arrow}{$\rightarrow$} int}\\ +\label{module-Type-type-labeled+u+higher+u+order}\ocamlcodefragment{\ocamltag{keyword}{type} labeled\_\allowbreak{}higher\_\allowbreak{}order = ( l:int \ocamltag{arrow}{$\rightarrow$} int ) \ocamltag{arrow}{$\rightarrow$} ( ?l:int \ocamltag{arrow}{$\rightarrow$} int ) \ocamltag{arrow}{$\rightarrow$} int}\\ \label{module-Type-type-pair}\ocamlcodefragment{\ocamltag{keyword}{type} pair = int * int}\\ \label{module-Type-type-parens+u+dropped}\ocamlcodefragment{\ocamltag{keyword}{type} parens\_\allowbreak{}dropped = int * int}\\ \label{module-Type-type-triple}\ocamlcodefragment{\ocamltag{keyword}{type} triple = int * int * int}\\ \label{module-Type-type-nested+u+pair}\ocamlcodefragment{\ocamltag{keyword}{type} nested\_\allowbreak{}pair = (int * int) * int}\\ \label{module-Type-type-instance}\ocamlcodefragment{\ocamltag{keyword}{type} instance = int \hyperref[module-Type-type-constructor]{\ocamlinlinecode{constructor}}}\\ -\label{module-Type-type-long}\ocamlcodefragment{\ocamltag{keyword}{type} long = \hyperref[module-Type-type-labeled+u+higher+u+order]{\ocamlinlinecode{labeled\_\allowbreak{}higher\_\allowbreak{}order}} \ocamltag{arrow}{$\rightarrow$} [ `Bar | `Baz of \hyperref[module-Type-type-triple]{\ocamlinlinecode{triple}} ] \ocamltag{arrow}{$\rightarrow$} \hyperref[module-Type-type-pair]{\ocamlinlinecode{pair}} \ocamltag{arrow}{$\rightarrow$} \hyperref[module-Type-type-labeled]{\ocamlinlinecode{labeled}} \ocamltag{arrow}{$\rightarrow$} \hyperref[module-Type-type-higher+u+order]{\ocamlinlinecode{higher\_\allowbreak{}order}} \ocamltag{arrow}{$\rightarrow$} (string \ocamltag{arrow}{$\rightarrow$} int) \ocamltag{arrow}{$\rightarrow$} (int * float * char * string * char * unit) option \ocamltag{arrow}{$\rightarrow$} \hyperref[module-Type-type-nested+u+pair]{\ocamlinlinecode{nested\_\allowbreak{}pair}} \ocamltag{arrow}{$\rightarrow$} \hyperref[module-Type-type-arrow]{\ocamlinlinecode{arrow}} \ocamltag{arrow}{$\rightarrow$} string \ocamltag{arrow}{$\rightarrow$} \hyperref[module-Type-type-nested+u+pair]{\ocamlinlinecode{nested\_\allowbreak{}pair}} array}\\ +\label{module-Type-type-long}\ocamlcodefragment{\ocamltag{keyword}{type} long = + \hyperref[module-Type-type-labeled+u+higher+u+order]{\ocamlinlinecode{labeled\_\allowbreak{}higher\_\allowbreak{}order}} \ocamltag{arrow}{$\rightarrow$} + [ `Bar | `Baz of \hyperref[module-Type-type-triple]{\ocamlinlinecode{triple}} ] \ocamltag{arrow}{$\rightarrow$} + \hyperref[module-Type-type-pair]{\ocamlinlinecode{pair}} \ocamltag{arrow}{$\rightarrow$} + \hyperref[module-Type-type-labeled]{\ocamlinlinecode{labeled}} \ocamltag{arrow}{$\rightarrow$} + \hyperref[module-Type-type-higher+u+order]{\ocamlinlinecode{higher\_\allowbreak{}order}} \ocamltag{arrow}{$\rightarrow$} + ( string \ocamltag{arrow}{$\rightarrow$} int ) \ocamltag{arrow}{$\rightarrow$} + (int * float * char * string * char * unit) option \ocamltag{arrow}{$\rightarrow$} + \hyperref[module-Type-type-nested+u+pair]{\ocamlinlinecode{nested\_\allowbreak{}pair}} \ocamltag{arrow}{$\rightarrow$} + \hyperref[module-Type-type-arrow]{\ocamlinlinecode{arrow}} \ocamltag{arrow}{$\rightarrow$} + string \ocamltag{arrow}{$\rightarrow$} + \hyperref[module-Type-type-nested+u+pair]{\ocamlinlinecode{nested\_\allowbreak{}pair}} array}\\ \label{module-Type-type-variant+u+e}\ocamlcodefragment{\ocamltag{keyword}{type} variant\_\allowbreak{}e = \{}\\ \begin{ocamltabular}{p{1.000\textwidth}}\ocamlinlinecode{a : int;\allowbreak{}}\label{module-Type-type-variant+u+e.a}\\ \end{ocamltabular}% @@ -52,7 +63,7 @@ \section{Module \ocamlinlinecode{Type}}\label{module-Type}% \ocamlinlinecode{\ocamltag{keyword}{mutable} b : int;\allowbreak{}}\label{module-Type-type-record.b}& \\ \ocamlinlinecode{c : int;\allowbreak{}}\label{module-Type-type-record.c}& foo\\ \ocamlinlinecode{d : int;\allowbreak{}}\label{module-Type-type-record.d}& \emph{bar}\\ -\ocamlinlinecode{e : a.\allowbreak{} \ocamltag{type-var}{'a};\allowbreak{}}\label{module-Type-type-record.e}& \\ +\ocamlinlinecode{e : 'a.\allowbreak{} \ocamltag{type-var}{'a};\allowbreak{}}\label{module-Type-type-record.e}& \\ \end{ocamltabular}% \\ \ocamlcodefragment{\}}\\ @@ -81,7 +92,7 @@ \section{Module \ocamlinlinecode{Type}}\label{module-Type}% \end{ocamltabular}% \\ \ocamlcodefragment{ ]}\\ -\label{module-Type-type-object+u+}\ocamlcodefragment{\ocamltag{keyword}{type} object\_\allowbreak{} = < a : int;\allowbreak{} b : int;\allowbreak{} c : int;\allowbreak{} >}\\ +\label{module-Type-type-object+u+}\ocamlcodefragment{\ocamltag{keyword}{type} object\_\allowbreak{} = < a : int ;\allowbreak{} b : int ;\allowbreak{} c : int >}\\ \label{module-Type-module-type-X}\ocamlcodefragment{\ocamltag{keyword}{module} \ocamltag{keyword}{type} \hyperref[module-Type-module-type-X]{\ocamlinlinecode{X}}}\ocamlcodefragment{ = \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Type-module-type-X-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t}\\ \label{module-Type-module-type-X-type-u}\ocamlcodefragment{\ocamltag{keyword}{type} u}\\ \end{ocamlindent}% @@ -92,7 +103,7 @@ \section{Module \ocamlinlinecode{Type}}\label{module-Type}% \label{module-Type-type-contravariant}\ocamlcodefragment{\ocamltag{keyword}{type} -'a contravariant}\\ \label{module-Type-type-bivariant}\ocamlcodefragment{\ocamltag{keyword}{type} \_\allowbreak{} bivariant = int}\\ \label{module-Type-type-binary}\ocamlcodefragment{\ocamltag{keyword}{type} ('a,\allowbreak{} 'b) binary}\\ -\label{module-Type-type-using+u+binary}\ocamlcodefragment{\ocamltag{keyword}{type} using\_\allowbreak{}binary = (int,\allowbreak{} int) \hyperref[module-Type-type-binary]{\ocamlinlinecode{binary}}}\\ +\label{module-Type-type-using+u+binary}\ocamlcodefragment{\ocamltag{keyword}{type} using\_\allowbreak{}binary = ( int,\allowbreak{} int ) \hyperref[module-Type-type-binary]{\ocamlinlinecode{binary}}}\\ \label{module-Type-type-name}\ocamlcodefragment{\ocamltag{keyword}{type} 'custom name}\\ \label{module-Type-type-constrained}\ocamlcodefragment{\ocamltag{keyword}{type} 'a constrained = \ocamltag{type-var}{'a} \ocamltag{keyword}{constraint} \ocamltag{type-var}{'a} = int}\\ \label{module-Type-type-exact+u+variant}\ocamlcodefragment{\ocamltag{keyword}{type} 'a exact\_\allowbreak{}variant = \ocamltag{type-var}{'a} \ocamltag{keyword}{constraint} \ocamltag{type-var}{'a} = [ `A | `B of int ]}\\ @@ -100,9 +111,9 @@ \section{Module \ocamlinlinecode{Type}}\label{module-Type}% \label{module-Type-type-any+u+variant}\ocamlcodefragment{\ocamltag{keyword}{type} 'a any\_\allowbreak{}variant = \ocamltag{type-var}{'a} \ocamltag{keyword}{constraint} \ocamltag{type-var}{'a} = [> ]}\\ \label{module-Type-type-upper+u+variant}\ocamlcodefragment{\ocamltag{keyword}{type} 'a upper\_\allowbreak{}variant = \ocamltag{type-var}{'a} \ocamltag{keyword}{constraint} \ocamltag{type-var}{'a} = [< `A | `B of int ]}\\ \label{module-Type-type-named+u+variant}\ocamlcodefragment{\ocamltag{keyword}{type} 'a named\_\allowbreak{}variant = \ocamltag{type-var}{'a} \ocamltag{keyword}{constraint} \ocamltag{type-var}{'a} = [< \hyperref[module-Type-type-polymorphic+u+variant]{\ocamlinlinecode{polymorphic\_\allowbreak{}variant}} ]}\\ -\label{module-Type-type-exact+u+object}\ocamlcodefragment{\ocamltag{keyword}{type} 'a exact\_\allowbreak{}object = \ocamltag{type-var}{'a} \ocamltag{keyword}{constraint} \ocamltag{type-var}{'a} = < a : int;\allowbreak{} b : int;\allowbreak{} >}\\ -\label{module-Type-type-lower+u+object}\ocamlcodefragment{\ocamltag{keyword}{type} 'a lower\_\allowbreak{}object = \ocamltag{type-var}{'a} \ocamltag{keyword}{constraint} \ocamltag{type-var}{'a} = < a : int;\allowbreak{} b : int;\allowbreak{} .\allowbreak{}.\allowbreak{} >}\\ -\label{module-Type-type-poly+u+object}\ocamlcodefragment{\ocamltag{keyword}{type} 'a poly\_\allowbreak{}object = \ocamltag{type-var}{'a} \ocamltag{keyword}{constraint} \ocamltag{type-var}{'a} = < a : a.\allowbreak{} \ocamltag{type-var}{'a};\allowbreak{} >}\\ +\label{module-Type-type-exact+u+object}\ocamlcodefragment{\ocamltag{keyword}{type} 'a exact\_\allowbreak{}object = \ocamltag{type-var}{'a} \ocamltag{keyword}{constraint} \ocamltag{type-var}{'a} = < a : int ;\allowbreak{} b : int >}\\ +\label{module-Type-type-lower+u+object}\ocamlcodefragment{\ocamltag{keyword}{type} 'a lower\_\allowbreak{}object = \ocamltag{type-var}{'a} \ocamltag{keyword}{constraint} \ocamltag{type-var}{'a} = < a : int ;\allowbreak{} b : int.\allowbreak{}.\allowbreak{} >}\\ +\label{module-Type-type-poly+u+object}\ocamlcodefragment{\ocamltag{keyword}{type} 'a poly\_\allowbreak{}object = \ocamltag{type-var}{'a} \ocamltag{keyword}{constraint} \ocamltag{type-var}{'a} = < a : 'a.\allowbreak{} \ocamltag{type-var}{'a} >}\\ \label{module-Type-type-double+u+constrained}\ocamlcodefragment{\ocamltag{keyword}{type} ('a,\allowbreak{} 'b) double\_\allowbreak{}constrained = \ocamltag{type-var}{'a} * \ocamltag{type-var}{'b} \ocamltag{keyword}{constraint} \ocamltag{type-var}{'a} = int \ocamltag{keyword}{constraint} \ocamltag{type-var}{'b} = unit}\\ \label{module-Type-type-as+u+}\ocamlcodefragment{\ocamltag{keyword}{type} as\_\allowbreak{} = int \ocamltag{keyword}{as} 'a * \ocamltag{type-var}{'a}}\\ \label{module-Type-type-extensible}\ocamlcodefragment{\ocamltag{keyword}{type} extensible = .\allowbreak{}.\allowbreak{}}\\ diff --git a/test/generators/man/Ocamlary.3o b/test/generators/man/Ocamlary.3o index 7ab3e457bf..6b6791d3af 100644 --- a/test/generators/man/Ocamlary.3o +++ b/test/generators/man/Ocamlary.3o @@ -380,7 +380,8 @@ This is a_function with param and return type\. @returns: the y coordinate .nf .sp -\f[CB]val\fR fun_fun_fun : ((int, int) a_function, (unit, unit) a_function) a_function +\f[CB]val\fR fun_fun_fun : + ( ( int, int ) a_function, ( unit, unit ) a_function ) a_function .sp \f[CB]val\fR fun_maybe : ?yes:unit \f[CB]\->\fR unit \f[CB]\->\fR int .sp @@ -518,7 +519,7 @@ This comment is for t\. \f[CB]module\fR InnerModuleA' : \f[CB]sig\fR .br .ti +6 -\f[CB]type\fR t = (unit, unit) a_function +\f[CB]type\fR t = ( unit, unit ) a_function .fi .br .ti +8 @@ -579,7 +580,11 @@ This comment is for InnerModuleTypeA\. module type of .nf .sp -\f[CB]module\fR Recollection (C : COLLECTION) : COLLECTION \f[CB]with\fR \f[CB]type\fR collection = C\.element list \f[CB]and\fR \f[CB]type\fR element = C\.collection +\f[CB]module\fR Recollection + (C : COLLECTION) : + COLLECTION + \f[CB]with\fR \f[CB]type\fR collection = C\.element list + \f[CB]and\fR \f[CB]type\fR element = C\.collection .sp \f[CB]module\fR \f[CB]type\fR MMM = \f[CB]sig\fR .br @@ -617,7 +622,7 @@ This comment is for t\. \f[CB]module\fR InnerModuleA' : \f[CB]sig\fR .br .ti +8 -\f[CB]type\fR t = (unit, unit) a_function +\f[CB]type\fR t = ( unit, unit ) a_function .fi .br .ti +10 @@ -706,7 +711,7 @@ This comment is for t\. \f[CB]module\fR InnerModuleA' : \f[CB]sig\fR .br .ti +6 -\f[CB]type\fR t = (unit, unit) a_function +\f[CB]type\fR t = ( unit, unit ) a_function .fi .br .ti +8 @@ -801,7 +806,7 @@ This comment is for t\. \f[CB]module\fR InnerModuleA' : \f[CB]sig\fR .br .ti +8 -\f[CB]type\fR t = (unit, unit) a_function +\f[CB]type\fR t = ( unit, unit ) a_function .fi .br .ti +10 @@ -899,7 +904,7 @@ This comment is for t\. \f[CB]module\fR InnerModuleA' : \f[CB]sig\fR .br .ti +8 -\f[CB]type\fR t = (unit, unit) a_function +\f[CB]type\fR t = ( unit, unit ) a_function .fi .br .ti +10 @@ -997,7 +1002,7 @@ This comment is for t\. \f[CB]module\fR InnerModuleA' : \f[CB]sig\fR .br .ti +8 -\f[CB]type\fR t = (unit, unit) a_function +\f[CB]type\fR t = ( unit, unit ) a_function .fi .br .ti +10 @@ -1064,7 +1069,9 @@ This comment is for InnerModuleTypeA\. This module type includes two signatures\. .nf .sp -\f[CB]module\fR FunctorTypeOf (Collection : \f[CB]module\fR \f[CB]type\fR \f[CB]of\fR CollectionModule) : \f[CB]sig\fR \.\.\. \f[CB]end\fR +\f[CB]module\fR FunctorTypeOf + (Collection : \f[CB]module\fR \f[CB]type\fR \f[CB]of\fR CollectionModule) : + \f[CB]sig\fR \.\.\. \f[CB]end\fR .fi .br .ti +2 @@ -1167,7 +1174,7 @@ b : unit; \f[CB]type\fR universe_record = { .br .ti +2 -nihilate : a\. \f[CB]'a\fR \f[CB]\->\fR unit; +nihilate : 'a\. \f[CB]'a\fR \f[CB]\->\fR unit; .br } .sp @@ -1227,16 +1234,16 @@ Wow! It was a polymorphic variant! \f[CB]type\fR (_, _) full_gadt = .br .ti +2 -| \f[CB]Tag\fR : (unit, unit) full_gadt +| \f[CB]Tag\fR : ( unit, unit ) full_gadt .br .ti +2 -| \f[CB]First\fR : \f[CB]'a\fR \f[CB]\->\fR (\f[CB]'a\fR, unit) full_gadt +| \f[CB]First\fR : \f[CB]'a\fR \f[CB]\->\fR ( \f[CB]'a\fR, unit ) full_gadt .br .ti +2 -| \f[CB]Second\fR : \f[CB]'a\fR \f[CB]\->\fR (unit, \f[CB]'a\fR) full_gadt +| \f[CB]Second\fR : \f[CB]'a\fR \f[CB]\->\fR ( unit, \f[CB]'a\fR ) full_gadt .br .ti +2 -| \f[CB]Exist\fR : \f[CB]'a\fR * \f[CB]'b\fR \f[CB]\->\fR (\f[CB]'b\fR, unit) full_gadt +| \f[CB]Exist\fR : \f[CB]'a\fR * \f[CB]'b\fR \f[CB]\->\fR ( \f[CB]'b\fR, unit ) full_gadt .br .fi .br @@ -1256,7 +1263,7 @@ Wow! It was a GADT! | \f[CB]OfTag\fR \f[CB]of\fR \f[CB]'a\fR partial_gadt .br .ti +2 -| \f[CB]ExistGadtTag\fR : (\f[CB]'a\fR \f[CB]\->\fR \f[CB]'b\fR) \f[CB]\->\fR \f[CB]'a\fR partial_gadt +| \f[CB]ExistGadtTag\fR : ( \f[CB]'a\fR \f[CB]\->\fR \f[CB]'b\fR ) \f[CB]\->\fR \f[CB]'a\fR partial_gadt .br .fi .br @@ -1378,19 +1385,19 @@ This comment is for poly_variant_union\. .br ] .sp -\f[CB]type\fR ('a, 'b) full_gadt_alias = (\f[CB]'a\fR, \f[CB]'b\fR) full_gadt = +\f[CB]type\fR ('a, 'b) full_gadt_alias = ( \f[CB]'a\fR, \f[CB]'b\fR ) full_gadt = .br .ti +2 -| \f[CB]Tag\fR : (unit, unit) full_gadt_alias +| \f[CB]Tag\fR : ( unit, unit ) full_gadt_alias .br .ti +2 -| \f[CB]First\fR : \f[CB]'a\fR \f[CB]\->\fR (\f[CB]'a\fR, unit) full_gadt_alias +| \f[CB]First\fR : \f[CB]'a\fR \f[CB]\->\fR ( \f[CB]'a\fR, unit ) full_gadt_alias .br .ti +2 -| \f[CB]Second\fR : \f[CB]'a\fR \f[CB]\->\fR (unit, \f[CB]'a\fR) full_gadt_alias +| \f[CB]Second\fR : \f[CB]'a\fR \f[CB]\->\fR ( unit, \f[CB]'a\fR ) full_gadt_alias .br .ti +2 -| \f[CB]Exist\fR : \f[CB]'a\fR * \f[CB]'b\fR \f[CB]\->\fR (\f[CB]'b\fR, unit) full_gadt_alias +| \f[CB]Exist\fR : \f[CB]'a\fR * \f[CB]'b\fR \f[CB]\->\fR ( \f[CB]'b\fR, unit ) full_gadt_alias .br .fi .br @@ -1407,7 +1414,7 @@ This comment is for full_gadt_alias\. | \f[CB]OfTag\fR \f[CB]of\fR \f[CB]'a\fR partial_gadt_alias .br .ti +2 -| \f[CB]ExistGadtTag\fR : (\f[CB]'a\fR \f[CB]\->\fR \f[CB]'b\fR) \f[CB]\->\fR \f[CB]'a\fR partial_gadt_alias +| \f[CB]ExistGadtTag\fR : ( \f[CB]'a\fR \f[CB]\->\fR \f[CB]'b\fR ) \f[CB]\->\fR \f[CB]'a\fR partial_gadt_alias .br .fi .br @@ -1456,17 +1463,17 @@ This comment is for \f[CI]mutual_constr_a\fR then \f[CI]mutual_constr_b\fR\. This comment is for \f[CI]mutual_constr_b\fR then \f[CI]mutual_constr_a\fR\. .nf .sp -\f[CB]type\fR rec_obj = < f : int; g : unit \f[CB]\->\fR unit; h : rec_obj; > +\f[CB]type\fR rec_obj = < f : int ; g : unit \f[CB]\->\fR unit ; h : rec_obj > .sp -\f[CB]type\fR 'a open_obj = < f : int; g : unit \f[CB]\->\fR unit; \.\. > \f[CB]as\fR 'a +\f[CB]type\fR 'a open_obj = < f : int ; g : unit \f[CB]\->\fR unit\.\. > \f[CB]as\fR 'a .sp -\f[CB]type\fR 'a oof = < a : unit; \.\. > \f[CB]as\fR 'a \f[CB]\->\fR \f[CB]'a\fR +\f[CB]type\fR 'a oof = < a : unit\.\. > \f[CB]as\fR 'a \f[CB]\->\fR \f[CB]'a\fR .sp \f[CB]type\fR 'a any_obj = < \.\. > \f[CB]as\fR 'a .sp -\f[CB]type\fR empty_obj = < > +\f[CB]type\fR empty_obj = < > .sp -\f[CB]type\fR one_meth = < meth : unit; > +\f[CB]type\fR one_meth = < meth : unit > .sp \f[CB]type\fR ext = \.\. .fi diff --git a/test/generators/man/Ocamlary.CollectionModule.InnerModuleA.InnerModuleA'.3o b/test/generators/man/Ocamlary.CollectionModule.InnerModuleA.InnerModuleA'.3o index e6f284b4a8..a27e06a6a1 100644 --- a/test/generators/man/Ocamlary.CollectionModule.InnerModuleA.InnerModuleA'.3o +++ b/test/generators/man/Ocamlary.CollectionModule.InnerModuleA.InnerModuleA'.3o @@ -14,7 +14,7 @@ This comment is for InnerModuleA'\. .SH Documentation .sp .nf -\f[CB]type\fR t = (unit, unit) a_function +\f[CB]type\fR t = ( unit, unit ) a_function .fi .br .ti +2 diff --git a/test/generators/man/Ocamlary.FunctorTypeOf.3o b/test/generators/man/Ocamlary.FunctorTypeOf.3o index d903e89f61..79bd108e34 100644 --- a/test/generators/man/Ocamlary.FunctorTypeOf.3o +++ b/test/generators/man/Ocamlary.FunctorTypeOf.3o @@ -52,7 +52,7 @@ This comment is for t\. \f[CB]module\fR InnerModuleA' : \f[CB]sig\fR .br .ti +6 -\f[CB]type\fR t = (unit, unit) a_function +\f[CB]type\fR t = ( unit, unit ) a_function .fi .br .ti +8 diff --git a/test/generators/man/Ocamlary.Recollection.3o b/test/generators/man/Ocamlary.Recollection.3o index 20931dd19c..c24f209fd5 100644 --- a/test/generators/man/Ocamlary.Recollection.3o +++ b/test/generators/man/Ocamlary.Recollection.3o @@ -49,7 +49,7 @@ This comment is for t\. \f[CB]module\fR InnerModuleA' : \f[CB]sig\fR .br .ti +6 -\f[CB]type\fR t = (unit, unit) a_function +\f[CB]type\fR t = ( unit, unit ) a_function .fi .br .ti +8 diff --git a/test/generators/man/Ocamlary.Recollection.InnerModuleA.InnerModuleA'.3o b/test/generators/man/Ocamlary.Recollection.InnerModuleA.InnerModuleA'.3o index 40b28c210b..b6461f9a62 100644 --- a/test/generators/man/Ocamlary.Recollection.InnerModuleA.InnerModuleA'.3o +++ b/test/generators/man/Ocamlary.Recollection.InnerModuleA.InnerModuleA'.3o @@ -14,7 +14,7 @@ This comment is for InnerModuleA'\. .SH Documentation .sp .nf -\f[CB]type\fR t = (unit, unit) a_function +\f[CB]type\fR t = ( unit, unit ) a_function .fi .br .ti +2 diff --git a/test/generators/man/Type.3o b/test/generators/man/Type.3o index 795ab47651..10c3d6f334 100644 --- a/test/generators/man/Type.3o +++ b/test/generators/man/Type.3o @@ -26,13 +26,13 @@ Some documentation\. .sp \f[CB]type\fR arrow = int \f[CB]\->\fR int .sp -\f[CB]type\fR higher_order = (int \f[CB]\->\fR int) \f[CB]\->\fR int +\f[CB]type\fR higher_order = ( int \f[CB]\->\fR int ) \f[CB]\->\fR int .sp \f[CB]type\fR labeled = l:int \f[CB]\->\fR int .sp \f[CB]type\fR optional = ?l:int \f[CB]\->\fR int .sp -\f[CB]type\fR labeled_higher_order = (l:int \f[CB]\->\fR int) \f[CB]\->\fR (?l:int \f[CB]\->\fR int) \f[CB]\->\fR int +\f[CB]type\fR labeled_higher_order = ( l:int \f[CB]\->\fR int ) \f[CB]\->\fR ( ?l:int \f[CB]\->\fR int ) \f[CB]\->\fR int .sp \f[CB]type\fR pair = int * int .sp @@ -44,7 +44,18 @@ Some documentation\. .sp \f[CB]type\fR instance = int constructor .sp -\f[CB]type\fR long = labeled_higher_order \f[CB]\->\fR [ `Bar | `Baz of triple ] \f[CB]\->\fR pair \f[CB]\->\fR labeled \f[CB]\->\fR higher_order \f[CB]\->\fR (string \f[CB]\->\fR int) \f[CB]\->\fR (int * float * char * string * char * unit) option \f[CB]\->\fR nested_pair \f[CB]\->\fR arrow \f[CB]\->\fR string \f[CB]\->\fR nested_pair array +\f[CB]type\fR long = + labeled_higher_order \f[CB]\->\fR + [ `Bar | `Baz of triple ] \f[CB]\->\fR + pair \f[CB]\->\fR + labeled \f[CB]\->\fR + higher_order \f[CB]\->\fR + ( string \f[CB]\->\fR int ) \f[CB]\->\fR + (int * float * char * string * char * unit) option \f[CB]\->\fR + nested_pair \f[CB]\->\fR + arrow \f[CB]\->\fR + string \f[CB]\->\fR + nested_pair array .sp \f[CB]type\fR variant_e = { .br @@ -129,7 +140,7 @@ d : int; (* bar *) .br .ti +2 -e : a\. \f[CB]'a\fR; +e : 'a\. \f[CB]'a\fR; .br } .sp @@ -175,7 +186,7 @@ e : a\. \f[CB]'a\fR; .br ] .sp -\f[CB]type\fR object_ = < a : int; b : int; c : int; > +\f[CB]type\fR object_ = < a : int ; b : int ; c : int > .sp \f[CB]module\fR \f[CB]type\fR X = \f[CB]sig\fR .br @@ -199,7 +210,7 @@ e : a\. \f[CB]'a\fR; .sp \f[CB]type\fR ('a, 'b) binary .sp -\f[CB]type\fR using_binary = (int, int) binary +\f[CB]type\fR using_binary = ( int, int ) binary .sp \f[CB]type\fR 'custom name .sp @@ -215,11 +226,11 @@ e : a\. \f[CB]'a\fR; .sp \f[CB]type\fR 'a named_variant = \f[CB]'a\fR \f[CB]constraint\fR \f[CB]'a\fR = [< polymorphic_variant ] .sp -\f[CB]type\fR 'a exact_object = \f[CB]'a\fR \f[CB]constraint\fR \f[CB]'a\fR = < a : int; b : int; > +\f[CB]type\fR 'a exact_object = \f[CB]'a\fR \f[CB]constraint\fR \f[CB]'a\fR = < a : int ; b : int > .sp -\f[CB]type\fR 'a lower_object = \f[CB]'a\fR \f[CB]constraint\fR \f[CB]'a\fR = < a : int; b : int; \.\. > +\f[CB]type\fR 'a lower_object = \f[CB]'a\fR \f[CB]constraint\fR \f[CB]'a\fR = < a : int ; b : int\.\. > .sp -\f[CB]type\fR 'a poly_object = \f[CB]'a\fR \f[CB]constraint\fR \f[CB]'a\fR = < a : a\. \f[CB]'a\fR; > +\f[CB]type\fR 'a poly_object = \f[CB]'a\fR \f[CB]constraint\fR \f[CB]'a\fR = < a : 'a\. \f[CB]'a\fR > .sp \f[CB]type\fR ('a, 'b) double_constrained = \f[CB]'a\fR * \f[CB]'b\fR \f[CB]constraint\fR \f[CB]'a\fR = int \f[CB]constraint\fR \f[CB]'b\fR = unit .sp diff --git a/test/xref2/canonical_hidden_module.t/run.t b/test/xref2/canonical_hidden_module.t/run.t index ecc75099ea..343ffd3ce3 100644 --- a/test/xref2/canonical_hidden_module.t/run.t +++ b/test/xref2/canonical_hidden_module.t/run.t @@ -84,8 +84,10 @@ See the comments on the types at the end of test.mli for the expectation.
- module - A_nonhidden + + module + A_nonhidden + : sig ... end @@ -95,7 +97,7 @@ See the comments on the types at the end of test.mli for the expectation.
- module A + module A = A
@@ -104,8 +106,9 @@ See the comments on the types at the end of test.mli for the expectation.
- module - B + + module B + : sig ... end @@ -115,8 +118,9 @@ See the comments on the types at the end of test.mli for the expectation.
- module - C + + module C + : sig ... end @@ -126,8 +130,9 @@ See the comments on the types at the end of test.mli for the expectation.
- module - D + + module D + : sig ... end diff --git a/test/xref2/labels/labels.t/run.t b/test/xref2/labels/labels.t/run.t index 85aab7fc7c..602316f2eb 100644 --- a/test/xref2/labels/labels.t/run.t +++ b/test/xref2/labels/labels.t/run.t @@ -102,8 +102,9 @@ The second occurence of 'B' in the main page should be disambiguated
- module - M + + module M + : sig ... end @@ -113,8 +114,9 @@ The second occurence of 'B' in the main page should be disambiguated
- module - N + + module N + : sig ... end diff --git a/test/xref2/module_preamble.t/run.t b/test/xref2/module_preamble.t/run.t index 0c6dc76ded..ef2247fa54 100644 --- a/test/xref2/module_preamble.t/run.t +++ b/test/xref2/module_preamble.t/run.t @@ -49,8 +49,9 @@ and that "hidden" modules (eg. `A__b`, rendered to `html/A__b`) are not rendered
- module - B + + module B + : sig ... end