diff --git a/CHANGES.md b/CHANGES.md index 7f92716f53..2731a0af97 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -14,6 +14,10 @@ Tags: ### Added - Display 'private' keyword for private type extensions (@gpetiot, #1019) - Add support for search (@panglesd, @EmileTrotignon, #972) +- Allow to omit parent type in constructor reference (@panglesd, + @EmileTrotignon, #933) +- Add jumps to documentation in rendered source code, and a `count-occurrences` + flag and command to count occurrences of every identifiers (@panglesd, #976) ### Fixed diff --git a/doc/driver.mld b/doc/driver.mld index 014a05fefb..563a44a138 100644 --- a/doc/driver.mld +++ b/doc/driver.mld @@ -135,7 +135,8 @@ Compiling a file with [odoc] requires a few arguments: the file to compile, an optional parent, a list of include paths, a list of children for [.mld] files, optional parent and name for source implementation, and an output path. Include paths can be just ['.'], and we can calculate the output file from the input -because all of the files are going into the same directory. +because all of the files are going into the same directory. If we wish to count +occurrences of each identifier, we need to pass the [--count-occurrences] flag. Linking a file with [odoc] requires the input file and a list of include paths. As for compile, we will hard-code the include path. @@ -148,6 +149,9 @@ Using the [--source] argument with an [.odocl] file that was not compiled with [--source-parent-file] and [--source-name] will result in an error, as will omitting [--source] when generating HTML of an [odocl] that was compiled with [--source-parent-file] and [--source-name]. +To get the number of uses of each identifier, we can use the [count-occurrences] +command. + In all of these, we'll capture [stdout] and [stderr] so we can check it later. {[ @@ -209,8 +213,9 @@ let add_prefixed_output cmd list prefix lines = !list @ Bos.Cmd.to_string cmd :: List.map (fun l -> prefix ^ ": " ^ l) lines -let compile file ?parent ?(output_dir = Fpath.v "./") +let compile file ?(count_occurrences = false) ?parent ?(output_dir = Fpath.v "./") ?(ignore_output = false) ?source_args children = + let count_occurrences = count_occurrences || (Option.is_some source_args) in let output_basename = let ext = Fpath.get_ext file in let basename = Fpath.basename (Fpath.rem_ext file) in @@ -237,8 +242,9 @@ let compile file ?parent ?(output_dir = Fpath.v "./") | _ -> Cmd.empty else Cmd.empty in + let occ = if count_occurrences then Cmd.v "--count-occurrences" else Cmd.empty in let cmd = - odoc % "compile" % Fpath.to_string file %% source_args %% cmt_arg + odoc % "compile" % Fpath.to_string file %% source_args %% occ %% cmt_arg % "-I" % "." % "-o" % p output_file |> List.fold_right (fun child cmd -> cmd % "--child" % child) children in @@ -289,6 +295,11 @@ let support_files () = let open Cmd in let cmd = odoc % "support-files" % "-o" % "html/odoc" in run cmd + +let count_occurrences output = + let open Cmd in + let cmd = odoc % "count-occurrences" % "-I" % "." % "-o" % p output in + run cmd ]} @@ -750,6 +761,7 @@ let compiled = compile_all () in let linked = link_all compiled in let () = index_generate () in let _ = js_index () in +let _ = count_occurrences (Fpath.v "occurrences.txt") in generate_all linked ]} diff --git a/src/document/generator.ml b/src/document/generator.ml index d5babb232f..cdba1ffae0 100644 --- a/src/document/generator.ml +++ b/src/document/generator.ml @@ -252,18 +252,41 @@ module Make (Syntax : SYNTAX) = struct let path id = Url.Path.from_identifier id let url id = Url.from_path (path id) + let to_link { Lang.Source_info.documentation; implementation } = + let documentation = + let open Paths.Path.Resolved in + match documentation with + | Some (`Resolved p) when not (is_hidden (p :> t)) -> ( + let id = identifier (p :> t) in + match Url.from_identifier ~stop_before:false id with + | Ok link -> Some link + | _ -> None) + | _ -> None + in + let implementation = + match implementation with + | Some (Odoc_model.Lang.Source_info.Resolved id) -> ( + match Url.Anchor.from_identifier (id :> Paths.Identifier.t) with + | Ok url -> Some url + | Error _ -> None) + | _ -> None + in + Some (Source_page.Link { implementation; documentation }) + let info_of_info : Lang.Source_info.annotation -> Source_page.info option = function - | Value id -> ( - match Url.Anchor.from_identifier (id :> Paths.Identifier.t) with - | Ok url -> Some (Link url) - | Error _ -> None) | Definition id -> ( match id.iv with | `SourceLocation (_, def) -> Some (Anchor (DefName.to_string def)) | `SourceLocationInternal (_, local) -> Some (Anchor (LocalName.to_string local)) | _ -> None) + | Module v -> to_link v + | ModuleType v -> to_link v + | Type v -> to_link v + | ClassType v -> to_link v + | Value v -> to_link v + | Constructor v -> to_link v let source id syntax_info infos source_code = let url = path id in @@ -1784,8 +1807,8 @@ module Make (Syntax : SYNTAX) = struct in let source_anchor = match t.source_info with - | Some src -> Some (Source_page.url src.id) - | None -> None + | Some { id = Some id; _ } -> Some (Source_page.url id) + | _ -> None in let page = make_expansion_page ~source_anchor url [ unit_doc ] items in Document.Page page diff --git a/src/document/types.ml b/src/document/types.ml index 2053ce902e..34e9b502d9 100644 --- a/src/document/types.ml +++ b/src/document/types.ml @@ -183,7 +183,11 @@ end = Page and Source_page : sig - type info = Syntax of string | Anchor of string | Link of Url.Anchor.t + type target = { + documentation : Url.Anchor.t option; + implementation : Url.Anchor.t option; + } + type info = Syntax of string | Anchor of string | Link of target type code = span list and span = Tagged_code of info * code | Plain_code of string diff --git a/src/html/html_source.ml b/src/html/html_source.ml index ab08665780..4a859369d4 100644 --- a/src/html/html_source.ml +++ b/src/html/html_source.ml @@ -24,7 +24,9 @@ let html_of_doc ~config ~resolve docs = let children = List.concat @@ List.map (doc_to_html ~is_in_a) docs in match info with | Syntax tok -> [ span ~a:[ a_class [ tok ] ] children ] - | Link anchor -> + (* Currently, we do not render links to documentation *) + | Link { documentation = _; implementation = None } -> children + | Link { documentation = _; implementation = Some anchor } -> let href = Link.href ~config ~resolve anchor in [ a ~a:[ a_href href ] children ] | Anchor lbl -> [ span ~a:[ a_id lbl ] children ]) diff --git a/src/html_support_files/odoc.css b/src/html_support_files/odoc.css index 92d4125d82..32efd6a713 100644 --- a/src/html_support_files/odoc.css +++ b/src/html_support_files/odoc.css @@ -1387,4 +1387,4 @@ td.def-doc *:first-child { WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - ---------------------------------------------------------------------------*/ \ No newline at end of file + ---------------------------------------------------------------------------*/ diff --git a/src/html_support_files/odoc_html_support_files.ml b/src/html_support_files/odoc_html_support_files.ml index cbc9498a1e..9315575264 100644 --- a/src/html_support_files/odoc_html_support_files.ml +++ b/src/html_support_files/odoc_html_support_files.ml @@ -228,8 +228,6 @@ module Internal = struct let d_86df3bac1a1e0286b91bf5a166ab459f = "wOF2\000\001\000\000\000\000a\132\000\017\000\000\000\001\005\164\000\000a!\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\026t\027\129\159T\028\146J\006`\000\133,\b\1300\t\154\022\017\b\n\130\143\b\129\240l\011\133\n\000\0016\002$\003\138\016\004 \005\131P\007\142O\012\129U\027\213\242\023dn\243\188\164\212]U\180\253s\199\177\158\138\177k@\221\213\181>\219\020\162]0\221\220\137@wp\137\170\166\227\020\255\255\159\150\\\140a\0286P\181\172\150\181\254!&\136\218\142\130\149sQFQ\205\173\247\218T\209\243ZB\193&CU\177\ra?L\246\211FC\141\142\138R\248\162\200\184\216$7\201)\199\182\029x~\168\153\238\213TJ\147 \177\161\228\026J7\026\026\170r\248\190T\149i\205\204\207`.T7\245\206\166\218\012\243\251\135\190\220\157>\168\031\250\127\025\199\179\182y\182\228\220\233X\172\1908d\165\025\130\026\204\189\252\141K=\ngs,\222\237(\024#\150\224\011o\234\155\248\019\166\194\245\"?q\240\194\159O\218\248+*}\2002\192v\221\016\"eX\228\240#\207\247\239\223\255\255\247Q5\215\185\226y\000> \181\156N\025\164T\234P\206v\029\209\156\255\179\187\151K\028\b\030Br\137\163\t\226i\192k@\249\144\026}\2400M\251!\0215J\169\136\017J\251\168\184Q\017\007\162j\200\234\153\005\137\178\020\018\163)\132KY\201\172<.\027\195'\165\190\184\159_+}\127\144w\022\128f\t\143\152\146\244\160\136\202\179\143*\025S#+o\000\230V`LA]Q1\022\1450\215\193\138m\172\169\216F\142h\021\1490\0260\224\202\230\024V\252\029z\017m\221\255_\135\194\230X\003\143d\b!\249]\224\177\246\203\228\160\168\1443Y\177y\198e\190/\194\238\149e\171]\003\252>]\1753\002\195\140\244\174r\235\132\1392}\218T4\187+\248\192\242{\n\240\249G\141\182\149\2180\154\000O\007F\n\210\165MsQ\021\223\148i\n,J=\178\030Y\001R\232\198\179\006\218\200$\239\129\238\206{\178\149\228\011\224\223/u\189\183sE\153\176\154\183\217\176\199\014\208\007\135\228\131 HA\233\168\168S\212\234\170'\135\253\207\233\127\250H\178\138u]\228\218\127\245\251\165\238.\192\169\128\132\006gx`\233\136\135\165\243LP\b\217\028\229f3\175\227v+&XMR\017\221d\191\127\180\162\142\216)\020<\t<\225\\\223\155d\154\018,\255,\2091\247\192U\168\184#\167\190\179\007\001\176\180-\212S\208\015Y-\148\195\135\237\017+\128\000\2353\213\175\170\186{f\022\150\132\232\191\177\134J\192\239!C%x8\183\218\133\160\213\138\143g\\\140\132\188\243Y\160Pqp\241?\171\246\203\239\227\185\tu\189Z\177A\144@`\227b#\132\141\144\128 L\242\t\187\001\000\169\b\254\229\246\249\224;p\176\226\248\n|#\170;\1472E\147\020Mw\231\144a\218<[\156St\181\001O\254\1273\245\181\243{3\004\176K\254\128%\029 :\145\138\196\207t\170A\016\192\015\153\250\014)\1483\247\221\153\183\243\222\206\166\193\"-V\004\023\018\140\005\004\018\129\001$\bkgv\177\024, ~&\029\145\018\0292\244s\004\004EB\129\2501\198\162qHE\239\220\169\244\239|\220\185\251M\235\020*\023e\229\202\199Eg\030\254\185w\250oc\001\165\223\026\244\220:\209\006\234t\252cc\129E8E\1905(\012\211\136\226\249\127\1509\155\157K\221\165}\186\229\196\129B\184\161K\140D\198\207\166\191\164\171\161T\137\\a\018\183\194\209=B\"\241{VFz\132\003\158\239\175\031\239\172\173\029\192\005|n\251\237w\169\236\214\031?\244\253\142\231\001&\218,\022H\147J\200Qa\0195Q\b)d}\251\169\221\217\187\t\161\2411\166\214|\012mP\149H\002\128\203\139uQ5\142u\157)<\031W\211f^\031\168[0\192\192^\135\193\137\187[\141\159f\199\137\151eT\212\132\218\004\216xP\155\132e\148\139P8\190\178\248\018$\212w\163\222|\t\253\238\222\150A\130\004\t\018\172\200\244r\221\243\222\019\255\249\191\221\216\238\247\189\0293s\212TEEEDDD\213\030K\201\128;S\015\r\224h\247\175}\173C6s\007\161N\223\007M\240@La2\172\205\134\195\235@1\146C\152\132\180~\207\204\\vKA\149\237\011\000<\190\157\145\021x\170\004\184\011\192Q(R.0P0\200$V\218\017(TT\142\139\024q\014\1414j\215\209\198@Z\227e\166G\142D\022\185\134\148\209\132t\241\173\014\136\225\143%\004\028V\2288\234~\015H\181@\151\131\1935U\016}r_\\\t\190\151{6+HP\128i\215\b6\190\248\1891\026\239{#,\220w\015X8\004/}~\141\021\178\0017\210\173\131\204@e\245z\186\140\001\n\133\021W`\228\205\028\004}\207\2311\171\015l\206\201\012!B\023@p\160tr\031\138\027\001\137\179\142;h\175F[\173\183\210buf\153b\156\017\006\169Q\165D\158l\022\233:I`\018\014\185\221\183\144MS\bi\238K\200\230I\132<\0259\228\254(\151M\165\242(8\165+\182M\011]\018\186;v\185Y\022;\0126MK\191\212\144\190\135\134p]\023ru\139\234\t\193{I(\214\150\164\174\244!L\189\149\149$\003\012$\225\161\195%e\211\213\247\218\181R'Z\209\137>\146A3_\1446i\151N\233\146n\233\145^\017\164_\006dPF\164O\250'\004@\207\139I\195z5\149\133x\152\236\242I\135oZ\128\b\218\205\209\025x\147\153\190.\2447\0207\142xx\144U?Kh\142\236>\001\154\173\019\b\161\162\137.!\137\134\193\222\151\193\222g!\1844G\177\012{\141\219YxO\155\r\221\220\1875\138\173\214[i\177\186G\179\182)\219\184m\1966h\171\217\170\182\1465\204\187X\204\222,[\250\214\t\tL\194\239\0277\223M\189\2016\143M\188\tX4\011V\157\250\229\139w\249/V\235\186\187\174\175\139\235\244:\186\226\254\213\188v\174\205km\186|5\172y\211\025\153I\198\024f@^\191U\177\1386\223\149\187z\209\231G\153+u\165l\131V\220\138^\161+\016zJ\210\199n\203q\241XS\022E\218\250G\127\2347+>\235\135}\187\175\246y'\029\214\162\201\246\199\027{u/\237\250\158\179\199\163)2m\143j\014'\244\168\030\210\182\182\162L\129\127\030\247\232\140\238\210Im\238\200\014n\255\214.\012\t\151\169\168\144q\b&Z\"S\127\234[}\168W\249O\182)u\191n\214\229:[\199Kv\176#k/\211F\216j\253le\183\137\135\139\171\174f\213\148\026g\239\141\168AU\211\254UU%\149W\217e\233Q\149\190t\146\192\2448\188\140\229[\234\146\149G\137K\128\233\149@.\250\149/y\007yY\231\136\247\129\132E\228Y\184(\146X\004;\023j\167\004\148\254d`\177\006\130\134\030\133D_\251J\214r\030\132\199[\142\212\160_\220\tV\175@~\210\213O`l\179e\160q\195W~\245\012\141\243X\206\025\161\174\129R\215\219\024\153\150\150fA\221\209X\153U\\K\001-\133uWJr\229\192$>\180\155\226\211\252n\023 \166\029Z\248\240c\166\153\153!_\155\222U\206\216$\nc\003%Aa+s`c\255Io\226(X\159)r\174H\225\169\130\243\000a\154)\012A(b\219\031Da!g\170\028\015\168\223\130\144p\n,\003i\002\002\012\004T\153x\217\250\"\146k\193\203\240A\n\144\158J\017\020EYU*2\251JA\150\169\185\214\224R@\n `\021\000\132L\184HH[w\143c\148\135\236/'~\247\154\155\\\027\204\166\162\021\143\n\021\177V\197L\244\025';\175\236N\253\223\1369\016D#4\242\161\187\143\246\255\165(;\251C\150\213\193\196\178i\194\136\137\129!\001\129\167\201\0271'\215g\242\156\203\145'GV8 \014\003\169\153oBE\142`\t\199\189<\129W\004\178\2558\248|\019OC\217\197\2470\250\134|\233w\245\235\250O\253\128\215\024\193\250@\127\219E\145\231%\204&\180\024\018.D\024(\1703\027\243y\017\018\149\208x\204D\180z\174\029\142C&A\027\143j8\012\003\244\139\021\192\243\128g\012{\137L\169R\196%\209\025}\152\234\178\007-\012\0077X\029\002\131\177\174\1383\231\014\188\244U+\197\251\016\173JXj\238uiq\237\249\206\191\195\203\226\233\161&\251\199\245\001r\195\145OG\142\030\190\154N\164\016\012\028\132\245B\001\1914\r\023%\237=\223\132\241g\193\180\206\243\217,\210\223\254\015\170\216'BlD\231y\024\199\184\004|\000d\210\185\216\020\211\017\245\182a\219a\023\1853\206Sz\239\011-\202\215\004H\179\137\237\177\023\177\031\226\136\137]r\021r\011\226\190I|\245\r\242\163\141\252\213\214\157\b\219\219\180\205\178\144gP\166BLO\198\234\173\192\182\2106'\164\198\145\245#{\160z\232\168\231\221\167\189\207_m`\206\222\197\255\197\254\146\003\234\007\t\233#\145\018^\018\019N\153\016\242m6\154]\029\152\176\187\205g\236\022#\220B~\007i\225=\004B\212[]\028k\163\189\189E\201Y\023^\228\190J\158\231\007i2\1683r\139\173\205\160.P*\149[\241I\217\130\186{\166\020]\195\170y\135fVd\022&|lq6[\016\162\183\141\211\232\168\012\148a&\242\146\165\012\006\165\162\244\224|\139\024@.o\2297\207\016I\005\169\129\223?|\139V\170\179\255\b2$\1674X\127}{\255X\1858\\x\188\191\210\134-\219v\157:s\238\194\165+\215n\220z\242\237\251\207\127\1535\197L\227X\004\014\135$\016%M3\233\245\186\"\153d>\159,\020\220\197\"\165TK\213\235\180F#\221lzZmF\167\195\234\014yGf\172\217Y\209\220\\n}#\176\183W8\184\176\174\175\173\219[\237\254\222x\248\160\244\248h>=\217\159\159\029/\031\153\031\127\236\252\228\211\157A\203_%\202\215\196\190\193\246-\178\239\144|O\241\007\244\159$\184?\216\021\173\252\014\153?\224\204\160M`\205B\006\011\178_\145\003\224\228\160\169r\200aA\142@\028E\2378:\167\133\191\135H\216\198\163\2165\195\224:r70\184\137\220-\019\185\237\158 \247AZ1z\130\151\167\b\188\021\253&#as\019\188-1\169x4\014 pE\028\188\006d\017\215\b\136s\r\255\184,@\003\177\235\012\205\183\157\133\207H\0268\140?\231O\001\192F\004\156\128\129\150\236C\148f\227\196\020\031}\1799\002\140\224\200E\239\237u\003\223f\029\229\240|??\003k\001\015\018\140g\215\207\218\137\\-\\\1312>\192\177\190\175\254\169g\222\022\182D\140\0209\n4\251\169\202\234\135\138\250\153\202TF\153\212\243i\247\253\159RN\169M'\194\241\216\028$\159@\155Ja5\158H\179\183\135\174\213<\179j\011\"\215\236\144{\015\222\171y\205\210[\176\139\184\219a\0073\003U\011KJ\151\007\172\"t\171\135$\203_\135\181\177\135]\\v\"\028'D\188\241]\n\253f\145\144)\220\153\164\233\002s\251_\006\128A\171\025(5\163\1335~s\168)W\194\240\133\195\1770\004\164\196\249\025\221NI@\166d\151\210\029\000\001*\"!\001\223\130X\"n\144\239Z\140\135\210\023\225\029+\001\178\168\159I\189\239jiM\248\n\159\162\130\179m\178\128\134/L\135S4,E\026\147U\138i\016Ill\016\027\027\012\206\131\192\"Qd:\007\1747\023\243~\251\210\138\177\022C;&\149\157]\187\130\244\180}\139]Gz\199%e\191.\199M\217oK\189\143KS81\220\004\012-\156j\132\151\249\208\"\029Z\1589\b\239\021F\138jS;\151\173K\251\195Z\185\187L\138\234\163\232\021nf\bu\231\149\136%\177|\221'@u\t[\022\163\206\255M%!\001\208*\208\217\nWy\164\157\134[\233\163\200N\133J\192.\007S\003\136\012F\190x}\223\152>\019\253\243\031\0293\237\220\204:~}\154$\023C;\027L,\144\146\187)$h\019t\020\224U\204\"L\166-:\218P\188p9\150\23770\212\150\012\224\025\172,^\241\012\197!M\235\184\149\179~q'\140\146\174\t\232\136\028\023\005a6\189Z:T\024\184\211\137\185Q\020O\131\0196\247L\005\129\167pNB><\130u%\128X\006N\184\185\153\022\210\021f\170\002n\164l>\r\212\020A\026\196\b\168\143\165\004\219\173\239>\135\211e\183\249\022=\182\217\011\212\"E\137\202c\238\164\019\0270\245d\173\209I\255\202\212j\005n \248r\177\132d\1684\002\170\165\233\222\249,3\202\168V\160e\180\140V\199\234\145P\132T\148R `\020\027\239\029g\186{\248\213\203\247gI\127\149\242w\130\132\018\026mQ\031\131\216\182\202\216\173\172\227\148$\166\200\192v\177\023\\\176\151f\214Z\233\183\228$\1418\182\252\246\217\228{\142 1\139enJE\128\192(\155\229p2oA\238\011\t:p/Z/\156w1I\r\159I\241\147\232\242\1390/\220>_;\\,Y|\193\"D\234\128<\143\219uQ\178-\224\199\175\223\127t\182\237h\217\203\175\166\003\162jW*\1492\14038!\230\147\148d[3\161\227@\018\242O'>4\142\240,\146\177r\250\225FbW\181\203\220\227\222+\252\2187\180+\145\252\200\139\207\250\245'\027HA\206I\128{\1687\163\030\028\231G9\157h\134T\225\014\\\224\226(\023\023S\020\005ope\143\162\225l\146\175d\221\135\029\134\b\236\185/\175\145R\179\167[<\159\142Ts\2539\000\175\166\0253H\127%\143[\0311\176\161n\\Q'\023\242\192N\199!\228\145Z\183y\237T5:\182\238\196\132\137\1988G\002\234)\165X[aN\199\129r\022\186\025\214\176\007\213\154%\206l\247\223\024_\171\166\180R\012\129O\212r\148A\127\194\215\216\152>J\199\232\243\242\252\165'\244\207\228\249\000\160\161\201\169w\235\168\226\tQ\167\166\170\021\026C\179\006g\146\020\160\195rv\247\002\130\014\221\147T\220\137v\024\198\164}&\189FV\022\026\030P?\155\142\240\193\170\191\218\200\212\024\025\203\200\018\208\164\005\249H\203\t+Aa\137\217\179\172\189\165\170\0300\219\029\151'/\155\187M|\164\1505\000+\017v@\177\245;;\004J\210{U1)\206\168\031\148\186>\158c\251\229\2388\020\175\252\156b\011B\240m\194.\128C\146\238\159\132]&\130\tu\161,&D\005\r@\025\135\234\166\140jn \019\237&\151=\238l&\243`\196/C)\219\251%Gl/L\133H\147\007\182E\149\1665\195\na\158\171\154{u\215\229\244\159\144?\187#\155\0283\011b\2037\158\r\202\022\156\154*-+,I\135\005w" - let d_89fc6729d4ac5445a0939af01bd9324b = "ljs-keyword,\n.hljs-selector-tag {\n color: #a71d5d;\n}\n\n.hljs-type,\n.hljs-class .hljs-title {\n color: #458;\n font-weight: 500;\n}\n\n.hljs-literal,\n.hljs-symbol,\n.hljs-bullet,\n.hljs-attribute {\n color: #0086b3;\n}\n\n.hljs-section,\n.hljs-name {\n color: #63a35c;\n}\n\n.hljs-tag {\n color: #333333;\n}\n\n.hljs-attr,\n.hljs-selector-id,\n.hljs-selector-class,\n.hljs-selector-attr,\n.hljs-selector-pseudo {\n color: #795da3;\n}\n\n.hljs-addition {\n color: #55a532;\n background-color: #eaffea;\n}\n\n.hljs-deletion {\n color: #bd2c00;\n background-color: #ffecec;\n}\n\n.hljs-link {\n text-decoration: underline;\n}\n\n.VAL,\n.TYPE,\n.LET,\n.REC,\n.IN,\n.OPEN,\n.NONREC,\n.MODULE,\n.METHOD,\n.LETOP,\n.INHERIT,\n.INCLUDE,\n.FUNCTOR,\n.EXTERNAL,\n.CONSTRAINT,\n.ASSERT,\n.AND,\n.END,\n.CLASS,\n.STRUCT,\n.SIG {\n color: #859900;\n ;\n}\n\n.WITH,\n.WHILE,\n.WHEN,\n.VIRTUAL,\n.TRY,\n.TO,\n.THEN,\n.PRIVATE,\n.OF,\n.NEW,\n.MUTABLE,\n.MATCH,\n.LAZY,\n.IF,\n.FUNCTION,\n.FUN,\n.FOR,\n.EXCEPTION,\n.ELSE,\n.TO,\n.DOWNTO,\n.DO,\n.DONE,\n.BEGIN,\n.AS {\n color: #cb4b16;\n}\n\n.TRUE,\n.FALSE {\n color: #b58900;\n}\n\n.failwith,\n.INT,\n.SEMISEMI,\n.LIDENT {\n color: #2aa198;\n}\n\n.STRING,\n.CHAR,\n.UIDENT {\n color: #b58900;\n}\n\n.DOCSTRING {\n color: #268bd2;\n}\n\n.COMMENT {\n color: #93a1a1;\n}\n\n/*---------------------------------------------------------------------------\n Copyright (c) 2016 The odoc contributors\n\n Permission to use, copy, modify, and/or distribute this software for any\n purpose with or without fee is hereby granted, provided that the above\n copyright notice and this permission notice appear in all copies.\n\n THE SOFTWARE IS PROVIDED \"AS IS\" AND THE AUTHOR DISCLAIMS ALL WARRANTIES\n WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF\n MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR\n ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES\n WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN\n ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF\n OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.\n ---------------------------------------------------------------------------*/" - let d_8c0686848665c0616f4fed0880a6fa6b = "wOF2\000\001\000\000\000\000ah\000\017\000\000\000\000\246\248\000\000a\005\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\026t\027\129\162\002\028\144F\006`\000\133,\b\1300\t\154\022\017\b\n\129\240h\129\208<\011\133\016\000\0016\002$\003\138\028\004 \005\131`\007\142u\012\129U\027\017\227\023\2166\237\134a\189YU\t\224\187\253\132\162B\025\183\147\232NPm\251\212\147w\0017\198i\208\029\156\196\020\251\213\228\255\255\179\146\019\025c'*f\020\127\162`\028!\195\218\146-\138g\171[\006\203%\186\245F.\227\154lBK\019\249\254\194w>\236&W\016\171\135\028\179\224`\250\183\217\031b?\168\221\226\219]\173\131\167h\215BV\001v\235\006>\018B\209\157\206\196\203\251\203\248\234H\247\181\219\158\249\004\004!`H\017 E\196\187\214\207\243s\251s\239{{{[3j\212\2466F8\198\154\209#6h\149\018qD\164Q\128_l\240#\191\213\223\001\191\208_\024\213\2327\003\163\192\234M\237\237\238\153yo\023 \193\003\015\196\025o\192\255%@\006\208~cY\140V\011\030\004.Y\144q\177%%\159\005\023^\152*\200\020}\241\207\247\135\228\185\239\239\210\206z\132\002\222\027X\235\134\017-\141K\029\143`@\255\000\191\205^\239N\004T,@\005\137\nA*\031\217\006\216\205\242\188\253\149sko\209\223E\177\200\243\"W\151\181\188\168\250\223\169\t\1931\\\196\014\240\026uC\209\027\168O\157[]\025\186\177\254\243\1502\164\250\190\157Hq~\134\252R\168j\185\225\216\175\026\150\016\130JQb\004F\186>\156{\252\180\1896\151\235%iJI\030\208\128PM( 6\134\141\153\209c\205\198N\242\255\012\001\206Y\174) \0152G\198|\133\019\239\242\127\236\001w*\162[\229\212V}V\000\255>\168\203\175'Y\166A\019\143mI\182\00700\147\143J\178\135K\152\238\168k\238w\021P\187\016\226\212.\177\228\204]\247\215\006d\1792\001\242\246C\2197+J\2404o\024|\005\177\147\197\178_\192\239|\130&\223\138\154\162NW\189,\190\168+\229U^\031\017\156x^\030Z\158\142\136\003\133\251\207in\129f\164\".\159\n\129\235\002\192\252?\223\254J\020V^U`\185\209IW\233\186\136^dg\001@\138\188\132\238\171\138`\165M%\003\193\0254'\195mSy\231\139*U\248q\250D\129um)^\201R\004\241o\144\2330\149\b)\216?\t\bF\213\128\212k\228\015\183\245b\136\166\224!\191z\030~\027p\136\194\243\255\251\181\175o\131\183\185\144\134$\030g\017\018\139H)\1488b\231\029\220\219\197\223\012*)\146(M\236\191\255\147i\019\011Y4\245\031J\007\254\233\151?\237\238\187\138\253\180\227\192\200\245\146R\015\253\209\158\005\137\170\227qHP\014\161\249\030t&\2273>\198\196\218D\216\168L\164\142\021\185\127\155\149wg\234\175\030-\240\152\248\128#\191\011\146\229\200@\161\249\229\142\213U\245U\250\191\186[;\210\200\179\026-\209,\144\204K\250\r\154V\2071G\006\142\b0H(I\000#'\137\147\208\206\238\178\187\212\217e\247\255\251\211\178\189\247=k-\217\179'\254\227\128&\236EO\216E\231\2412T\169S\002\235\191\255\164\015O_\022X\027\129\237\249c-\200\214\144$\207\024wc\193\228\200\246,\000\007\000\004\003\228\000\001\151)\211\214@\021\021e\153*\021\208\195~\162\186\0283q_\012?9Y\225B\172\012\133Q\030\193\127*''+\212\\\132\156\153S\133\254\227\2084\147\157\135\233D!\251\166i\229\1677\1776\222@\154eB\017\011PD\002\030\145\019\188\241\003\240{,\205\003\221Y\142E\148\216_\225\223\149\180}\025\218\028\220\001?1\141\161\134\226\209\131~\027\245\234sr\\\194\134\143\181\198\0122Xc\172\200\178\152\243\146vO\164\190\029\027\220\177wffj\170\162\162\"\162\"\162j\199~\234\247\148\140\217i\012\194\229\152\n\024R\211\183>\223\214\180=\252\185\250\197\133\173]M(B \2333)\004t\253\188\187\247\222J\128\171\002\156\132\"\231\002\003\005\003[1\175=.\144_\150\131\208uk\186-\222\218c\t\228J2\169\136[\"\138(\147\241K\160Q'8\160\143\241\191\132\128#\021\182#\175\127\195\244\028H\1897\183\173\001\"\030\rV\214\131\250ySG\019x\"\0013\193\016\216x\190\214\024\133\219\026a\225\252\025\176\208\248\015{@[\0198\016\189\142Z\130\172\162\250\198fR\183\001\133\196:,\197\136\187\000\004u\237\215\210\239\031\172\205\191i!D\021@\208P\172NB\225\003\159\167\237Fl\244\155\159|\2273\235\189\171\223J=:\205\209\166S\131*%\028rL\145,^\020\011\020\247\238\129\220[\155!O\187\b2\186\222\132\226\220\157P|z\000r\213\027\160\b*\232\220\178\155+3\026\192\004\004\195%\164\129cK\177eN\245Yh\190\149\234\153~\241\158\249/\190w\254\182d\205\239FyL1kk\212t6\165?\146\254B\242\198\026-tcs\001D\000A\185\212\195sb\142\025?\150D\017\196\026\027\023|pp\235\224\166\\\159kre.\203\1859+\167\231\148\2363\011\016~\228I\"\167\241O\128\209$X\012\244S\169\178\195\t,f\2542$7b\\\\H\250\022\001\154\202\227C\208\212L8\132L`\212\tI4\012v\239\005\187\183Cp`\028I0d7\180\245\192\219Z;\255\176mk\b\170(iw\184\228\248M\217\146\183\248-j\179l\250M\189\169\240\2026\233&\217\248Y(\028(^/\2201\242%\255\184\174\175K\235\236:\190\014\174\221k+\252\203\176;\132s\183\155\235\135\237\201\250j\135\201\173\216O\214\218\245\246\019Y\r\203y\131\005\204\210\0222u\171\226\229\139V\222\202\218d+}%n\020\025\187\"\150yiW\224R.\239\229\182\196\139\139C\022\247\184\251\012\190\196\195\190\221W{\180O\247\209\222\223\183\153\221\217\155\251\2394\211\253G\255\002\223\241\005\031\241>\003\210\251\236\172\165\221\221\243v\152\162\137\014\136T\167\201C\212tY\023@.\025\164\250\219\219\218amlM\2517\211\158\237\242B\b\237\224\190z\229\247\212\147\186_7\t\189\220\221u\190N\214\225\243\247\214\246\026i\255\218X\191\213O\217~\211e\245\025\172\231]\250\237\202MR=\188xg\205\169\182j\168\170\237f\149\148\1635\149SS*\185\226+\170,\155lGCQ\219\139K\143zJ\213\155\203\012KK2\177|La\1539\144\129^d,wS\221\031\n\137E\128\252\004$\230&\215\210\243[\140l\011\020WF#kVh\172@\169K]+(n\176b\173-\030\156\021\213^\158\206\178\217\162\019\149\234j\031\168\174\255KZ\245\191\215K`\bP\222\148v\216\152(e]\245\n\1690\145a\005;\191\211\004Lr=\174\233\001\139\209\025>\177;i\245\177\2152\218\025\180\213\237\161\227\159\176\229q\229\196R\148\208\175\019\135\210\r\246W\191\192\163\236Z\165\2285-\184\16624YF\205\003\002\r\1611\021\169\254\157\018F\234\198\005\239\n\020 \213c9\185\133Uo\219BA}8\012\237-\004\218\015|\225\145\194~A\252\007\003\255S\154^\003h\140?\r\219`\163\191:.\255\026a\179-_\179\195N\187\237u\2121\199\157p\210)\167\157q\214\197\206\251o\244\216\139\184\193\178\0178H\\\\,|\002jn\220\168\249\240\225E%\136\154\150\150\154\158\1587\003\003\138\145E\144P\161\216\194\132\209\b\023\206G\132H\180(Q8\162ES\179\178\211K\144@&\201Tz\0252\bd\202\164\231\144O\161T)\131ru\244\0265\210k\214\204Y\139\022\n\173Z\185j3\139\201l\179\185\155c\014\169\185\230\2420\207\002\238\022Z\200S\167NB]\186\232u[\172'\154\217r\225d\005\001V\226f\021b\189\136\244a\180\026\023\253*\181EBZ\136?!\2160\\\027\192\254\146@\029dSC6\131\196\150\177\202V\219\024l\135\176\003?;\t\180O\158F1D\r5\236\164\161s\n\198it\206\1928;F\206\025ep\017\228\nz\215\240v\029\190\155Nj\166XC\0057\236\181=\192\181\250\134\016\001!I\156\228\185:iss\n\206\189\006\127\2000\027\212\250(\011\143l\n8\194\163\192G\019\176\017\018\001\0054\b\182\1958\027\189\133y\246\003\224\004\254\028A\189\202\175f\247\229\019\154\150q4\015\230\0231w\139\134\178\220\234\154\249j\194z\141\154\192/\185\220)\149>\248\235n\184Y1\t/Nn\222\252\244*\173\142C\217\177\168\168P\162hH4\240_\137\212\150H\193>!A\145\023\026\230\017\147\167\205)\024\207\031S\144\154\233\160\231*\178\235\248\000\196\140\205's\215|MU\0314\\\234\162\171y\222\153\235\148\198D\207\026\128P\031\171\157W\215F\162L\247\212\202\b\194\136\185$lW\129\"\151}\207a7\191\245\176~\190\134\236\229\163\133s?W\146\137\014\237\242h\204\172\167\245\000\173\190\212Q\145\200\234\204\197\170\210U\014\027d\230\195\176v\000\000\229\136\142\128n\006,\245\175\012?\145n\208\b5,7\174\212O[|l\233pu\249\147rV\243\253\1741\179\128\134\240\166\194\002F\128G\177\185s0\172^/\209\235\1652#@\201\021*\189\160\021\208\012\014\235\218;\226\152\206\137\186^\242\236\156s\158\239(S\186h\249\1902\131[\012\239\206\b\238\014\239\222\168\221\031\206\131\006=F\132\1344\212(\133\168\139\196\178\159\020\237\164\\\0113\245\159H\011\158\201\139\250\219I\213\157\163VeJcm*\186\b\215\229'C\b\230\254\000\201E\209.\156\017j\n\198E#\202C\178\181\003\200\170P-u\173\166\239;7\179\168\228\1281\248\221\190P/\131B\127\181zdv\019\147\210$#\142\233\187\128&\141\135\183d\177wP8\207\2212=j\182\150\214\173\138\221E\186\220e\183\031\144\129\170\167\175\022\241\006\136\178\167g\131\196Q[6Z\193\1362\001\243\210I_I\184N\217\169i\137\225\141pg\165\214\139jm\208\156)\216lUH\024\217\016\030\023\028w8\232C\136\158Y\\Z\196F\169p\185G&\030\195\015V\151g\"\025\213\171\198\167\249,B\189\175v\205Yk\155\000\230\000I\180*\253\248\023\222x\235\157:\2315\254\172\202\241^\164O\147Vj\171\172J\164\226s\020\r5\031\173(\234e\198@\174Sq\"R 2\018W\003\138\154\1813j\"\177\006J\003d\128\012\012\213\216\136fXZ\128\136\228\149J\164\223\241\203i\244\153x\177F\238\205(\188\029\210\187(\224\180.g\166\245\222F\230\227\000\159+\003\164\224\161\218\244%\230K\158_\149\015\231=\020\005O\220~6\238\127dO\132\180\205\202\2346+7B\211\153\152H\007\186\132n\144&\248\161\2114\245\200\145i\015\255\179dQ\023\177\205\164\127X\131?p\156\223\153=g\006\020\t\161\1484V\254\182\\\191\128_\254\240\167\191\252o\000H\253\151\175\208/\242\194:\b\002_\202/\025P\201\021\002Gr\240p\220\217Y\147\227\203\225\140\238\206\145jv`Z\139u\020\007\183\137\251\236\243\206[\127F{2\165_\186\006\127\248\011\248\255\200\r\203nR6\179e\255\208\128\019\242\181\251_\026\187:\015io1\159\222-q\161t\239\138X\236\194\151\170Se\160\171\180\209\201i\153\129\248\031\221\175\182\150O\170+\145\197AB\205!|:\210u\217\174\194-\130\238>s\224\002\227oxp#'\202A\030\248=C\163\161~i\179C\014\134\249\191w\220Lef6v$\158Ia!\002\219\133\tS\181~\243\031\152\171U\002tT\023\004\159\1660]R\178U\232p\251\237\029\215\030\220\237\016`\237;\175x\163\157oi\241\031B\217W\209^\185\181O\213A\174\169M\003$\187`\213\r:)\142ZC\0116Y\005\165\255\138}\206\162\026\211\238o\025\139\228=\164YZb\195\180\005R\001\148\132\141o\141\163\004\188\029\250\229&\209\011GF\200\190\180N\254f=\007\215\248*\145\1833\r\191\129\229.|d0r\200\bU\029T\151\139\243v4<\149\003\205d\132\014\1416\200'\019j\146\167\130\234~S\140\193\0207'\127\199\237dd\159\230\0263s\018\1524" let d_8f38ae17980f4039d715823515fd56d0 = "group\",\"\\\\rgroup\",\"\\u27ee\",\"\\u27ef\",\"\\\\lmoustache\",\"\\\\rmoustache\",\"\\u23b0\",\"\\u23b1\",\"/\",\"\\\\backslash\",\"|\",\"\\\\vert\",\"\\\\|\",\"\\\\Vert\",\"\\\\uparrow\",\"\\\\Uparrow\",\"\\\\downarrow\",\"\\\\Downarrow\",\"\\\\updownarrow\",\"\\\\Updownarrow\",\".\"];function Cr(e,t){var r=Xt(e);if(r&&l.contains(Br,r.text))return r;throw new n(r?\"Invalid delimiter '\"+r.text+\"' after '\"+t.funcName+\"'\":\"Invalid delimiter type '\"+e.type+\"'\",e)}function qr(e){if(!e.body)throw new Error(\"Bug: The leftright ParseNode wasn't fully parsed.\")}ot({type:\"delimsizing\",names:[\"\\\\bigl\",\"\\\\Bigl\",\"\\\\biggl\",\"\\\\Biggl\",\"\\\\bigr\",\"\\\\Bigr\",\"\\\\biggr\",\"\\\\Biggr\",\"\\\\bigm\",\"\\\\Bigm\",\"\\\\biggm\",\"\\\\Biggm\",\"\\\\big\",\"\\\\Big\",\"\\\\bigg\",\"\\\\Bigg\"],props:{numArgs:1,argTypes:[\"primitive\"]},handler:function(e,t){var r=Cr(t[0],e);return{type:\"delimsizing\",mode:e.parser.mode,size:Tr[e.funcName].size,mclass:Tr[e.funcName].mclass,delim:r.text}},htmlBuilder:function(e,t){return\".\"===e.delim?Ke.makeSpan([e.mclass]):Ar.sizedDelim(e.delim,e.size,t,e.mode,[e.mclass])},mathmlBuilder:function(e){var t=[];\".\"!==e.delim&&t.push(Bt(e.delim,e.mode));var r=new Tt.MathNode(\"mo\",t);\"mopen\"===e.mclass||\"mclose\"===e.mclass?r.setAttribute(\"fence\",\"true\"):r.setAttribute(\"fence\",\"false\"),r.setAttribute(\"stretchy\",\"true\");var n=V(Ar.sizeToMaxHeight[e.size]);return r.setAttribute(\"minsize\",n),r.setAttribute(\"maxsize\",n),r}}),ot({type:\"leftright-right\",names:[\"\\\\right\"],props:{numArgs:1,primitive:!0},handler:function(e,t){var r=e.parser.gullet.macros.get(\"\\\\current@color\");if(r&&\"string\"!=typeof r)throw new n(\"\\\\current@color set to non-string in \\\\right\");return{type:\"leftright-right\",mode:e.parser.mode,delim:Cr(t[0],e).text,color:r}}}),ot({type:\"leftright\",names:[\"\\\\left\"],props:{numArgs:1,primitive:!0},handler:function(e,t){var r=Cr(t[0],e),n=e.parser;++n.leftrightDepth;var a=n.parseExpression(!1);--n.leftrightDepth,n.expect(\"\\\\right\",!1);var i=Ut(n.parseFunction(),\"leftright-right\");return{type:\"leftright\",mode:n.mode,body:a,left:r.text,right:i.delim,rightColor:i.color}},htmlBuilder:function(e,t){qr(e);for(var r,n,a=ft(e.body,t,!0,[\"mopen\",\"mclose\"]),i=0,o=0,s=!1,l=0;l0&&(a=F(e.totalheight,t)-n,r.setAttribute(\"valign\",V(-a))),r.setAttribute(\"height\",V(n+a)),e.width.number>0){var i=F(e.width,t);r.setAttribute(\"width\",V(i))}return r.setAttribute(\"src\",e.src),r}}),ot({type:\"kern\",names:[\"\\\\kern\",\"\\\\mkern\",\"\\\\hskip\",\"\\\\mskip\"],props:{numArgs:1,argTypes:[\"size\"],primitive:!0,allowedInText:!0},handler:function(e,t){var r=e.parser,n=e.funcName,a=Ut(t[0],\"size\");if(r.settings.strict){var i=\"m\"===n[1],o=\"mu\"===a.value.unit;i?(o||r.settings.reportNonstrict(\"mathVsTextUnits\",\"LaTeX's \"+n+\" supports only mu units, not \"+a.value.unit+\" units\"),\"math\"!==r.mode&&r.settings.reportNonstrict(\"mathVsTextUnits\",\"LaTeX's \"+n+\" works only in math mode\")):o&&r.settings.reportNonstrict(\"mathVsTextUnits\",\"LaTeX's \"+n+\" doesn't support mu units\")}return{type:\"kern\",mode:r.mode,dimension:a.value}},htmlBuilder:function(e,t){return Ke.makeGlue(e.dimension,t)},mathmlBuilder:function(e,t){var r=F(e.dimension,t);return new Tt.SpaceNode(r)}}),ot({type:\"lap\",names:[\"\\\\mathllap\",\"\\\\mathrlap\",\"\\\\mathclap\"],props:{numArgs:1,allowedInText:!0},handler:function(e,t){var r=e.parser,n=e.funcName,a=t[0];return{type:\"lap\",mode:r.mode,alignment:n.slice(5),body:a}},htmlBuilder:function(e,t){var r;\"clap\"===e.alignment?(r=Ke.makeSpan([],[wt(e.body,t)]),r=Ke.makeSpan([\"inner\"],[r],t)):r=Ke.makeSpan([\"inner\"],[wt(e.body,t)]);var n=Ke.makeSpan([\"fix\"],[]),a=Ke.makeSpan([e.alignment],[r,n],t),i=Ke.makeSpan([\"strut\"]);return i.style.height=V(a.height+a.depth),a.depth&&(i.style.verticalAlign=V(-a.depth)),a.children.unshift(i),a=Ke.makeSpan([\"thinbox\"],[a],t),Ke.makeSpan([\"mord\",\"vbox\"],[a],t)},mathmlBuilder:function(e,t){var r=new Tt.MathNode(\"mpadded\",[Rt(e.body,t)]);if(\"rlap\"!==e.alignment){var n=\"llap\"===e.alignment?\"-1\":\"-0.5\";r.setAttribute(\"lspace\",n+\"width\")}return r.setAttribute(\"width\",\"0px\"),r}}),ot({type:\"styling\",names:[\"\\\\(\",\"$\"],props:{numArgs:0,allowedInText:!0,allowedInMath:!1},handler:function(e,t){var r=e.funcName,n=e.parser,a=n.mode;n.switchMode(\"math\");var i=\"\\\\(\"===r?\"\\\\)\":\"$\",o=n.parseExpression(!1,i);return n.expect(i),n.switchMode(a),{type:\"styling\",mode:n.mode,style:\"text\",body:o}}}),ot({type:\"text\",names:[\"\\\\)\",\"\\\\]\"],props:{numArgs:0,allowedInText:!0,allowedInMath:!1},handler:function(e,t){throw new n(\"Mismatched \"+e.funcName)}});var mn=function(e,t){switch(t.style.size){case x.DISPLAY.size:return e.display;case x.TEXT.size:return e.text;case x.SCRIPT.size:return e.script;case x.SCRIPTSCRIPT.size:return e.scriptscript;default:return e.text}};ot({type:\"mathchoice\",names:[\"\\\\mathchoice\"],props:{numArgs:4,primitive:!0},handler:function(e,t){return{type:\"mathchoice\",mode:e.parser.mode,display:ht(t[0]),text:ht(t[1]),script:ht(t[2]),scriptscript:ht(t[3])}},htmlBuilder:function(e,t){var r=mn(e,t),n=ft(r,t,!1);return Ke.makeFragment(n)},mathmlBuilder:function(e,t){var r=mn(e,t);return It(r,t)}});var cn=function(e,t,r,n,a,i,o){e=Ke.makeSpan([],[e]);var s,h,m,c=r&&l.isCharacterBox(r);if(t){var u=wt(t,n.havingStyle(a.sup()),n);h={elem:u,kern:Math.max(n.fontMetrics().bigOpSpacing1,n.fontMetrics().bigOpSpacing3-u.depth)}}if(r){var p=wt(r,n.havingStyle(a.sub()),n);s={elem:p,kern:Math.max(n.fontMetrics().bigOpSpacing2,n.fontMetrics().bigOpSpacing4-p.height)}}if(h&&s){var d=n.fontMetrics().bigOpSpacing5+s.elem.height+s.elem.depth+s.kern+e.depth+o;m=Ke.makeVList({positionType:\"bottom\",positionData:d,children:[{type:\"kern\",size:n.fontMetrics().bigOpSpacing5},{type:\"elem\",elem:s.elem,marginLeft:V(-i)},{type:\"kern\",size:s.kern},{type:\"elem\",elem:e},{type:\"kern\",size:h.kern},{type:\"elem\",elem:h.elem,marginLeft:V(i)},{type:\"kern\",size:n.fontMetrics().bigOpSpacing5}]},n)}else if(s){var f=e.height-o;m=Ke.makeVList({positionType:\"top\",positionData:f,children:[{type:\"kern\",size:n.fontMetrics().bigOpSpacing5},{type:\"elem\",elem:s.elem,marginLeft:V(-i)},{type:\"kern\",size:s.kern},{type:\"elem\",elem:e}]},n)}else{if(!h)return e;var g=e.depth+o;m=Ke.makeVList({positionType:\"bottom\"," + let d_acb2c4605ac55515799c591d47af558a = "ljs-keyword,\n.hljs-selector-tag {\n color: #a71d5d;\n}\n\n.hljs-type,\n.hljs-class .hljs-title {\n color: #458;\n font-weight: 500;\n}\n\n.hljs-literal,\n.hljs-symbol,\n.hljs-bullet,\n.hljs-attribute {\n color: #0086b3;\n}\n\n.hljs-section,\n.hljs-name {\n color: #63a35c;\n}\n\n.hljs-tag {\n color: #333333;\n}\n\n.hljs-attr,\n.hljs-selector-id,\n.hljs-selector-class,\n.hljs-selector-attr,\n.hljs-selector-pseudo {\n color: #795da3;\n}\n\n.hljs-addition {\n color: #55a532;\n background-color: #eaffea;\n}\n\n.hljs-deletion {\n color: #bd2c00;\n background-color: #ffecec;\n}\n\n.hljs-link {\n text-decoration: underline;\n}\n\n.VAL,\n.TYPE,\n.LET,\n.REC,\n.IN,\n.OPEN,\n.NONREC,\n.MODULE,\n.METHOD,\n.LETOP,\n.INHERIT,\n.INCLUDE,\n.FUNCTOR,\n.EXTERNAL,\n.CONSTRAINT,\n.ASSERT,\n.AND,\n.END,\n.CLASS,\n.STRUCT,\n.SIG {\n color: #859900;\n ;\n}\n\n.WITH,\n.WHILE,\n.WHEN,\n.VIRTUAL,\n.TRY,\n.TO,\n.THEN,\n.PRIVATE,\n.OF,\n.NEW,\n.MUTABLE,\n.MATCH,\n.LAZY,\n.IF,\n.FUNCTION,\n.FUN,\n.FOR,\n.EXCEPTION,\n.ELSE,\n.TO,\n.DOWNTO,\n.DO,\n.DONE,\n.BEGIN,\n.AS {\n color: #cb4b16;\n}\n\n.TRUE,\n.FALSE {\n color: #b58900;\n}\n\n.failwith,\n.INT,\n.SEMISEMI,\n.LIDENT {\n color: #2aa198;\n}\n\n.STRING,\n.CHAR,\n.UIDENT {\n color: #b58900;\n}\n\n.DOCSTRING {\n color: #268bd2;\n}\n\n.COMMENT {\n color: #93a1a1;\n}\n\n/*---------------------------------------------------------------------------\n Copyright (c) 2016 The odoc contributors\n\n Permission to use, copy, modify, and/or distribute this software for any\n purpose with or without fee is hereby granted, provided that the above\n copyright notice and this permission notice appear in all copies.\n\n THE SOFTWARE IS PROVIDED \"AS IS\" AND THE AUTHOR DISCLAIMS ALL WARRANTIES\n WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF\n MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR\n ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES\n WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN\n ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF\n OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.\n ---------------------------------------------------------------------------*/\n" + let d_ad152fcf832897f8629ca758460f3d22 = "ize10.size11{font-size:1.19961427em}.katex .fontsize-ensurer.reset-size11.size1,.katex .sizing.reset-size11.size1{font-size:.20096463em}.katex .fontsize-ensurer.reset-size11.size2,.katex .sizing.reset-size11.size2{font-size:.24115756em}.katex .fontsize-ensurer.reset-size11.size3,.katex .sizing.reset-size11.size3{font-size:.28135048em}.katex .fontsize-ensurer.reset-size11.size4,.katex .sizing.reset-size11.size4{font-size:.32154341em}.katex .fontsize-ensurer.reset-size11.size5,.katex .sizing.reset-size11.size5{font-size:.36173633em}.katex .fontsize-ensurer.reset-size11.size6,.katex .sizing.reset-size11.size6{font-size:.40192926em}.katex .fontsize-ensurer.reset-size11.size7,.katex .sizing.reset-size11.size7{font-size:.48231511em}.katex .fontsize-ensurer.reset-size11.size8,.katex .sizing.reset-size11.size8{font-size:.57877814em}.katex .fontsize-ensurer.reset-size11.size9,.katex .sizing.reset-size11.size9{font-size:.69453376em}.katex .fontsize-ensurer.reset-size11.size10,.katex .sizing.reset-size11.size10{font-size:.83360129em}.katex .fontsize-ensurer.reset-size11.size11,.katex .sizing.reset-size11.size11{font-size:1em}.katex .delimsizing.size1{font-family:KaTeX_Size1}.katex .delimsizing.size2{font-family:KaTeX_Size2}.katex .delimsizing.size3{font-family:KaTeX_Size3}.katex .delimsizing.size4{font-family:KaTeX_Size4}.katex .delimsizing.mult .delim-size1>span{font-family:KaTeX_Size1}.katex .delimsizing.mult .delim-size4>span{font-family:KaTeX_Size4}.katex .nulldelimiter{display:inline-block;width:.12em}.katex .delimcenter,.katex .op-symbol{position:relative}.katex .op-symbol.small-op{font-family:KaTeX_Size1}.katex .op-symbol.large-op{font-family:KaTeX_Size2}.katex .accent>.vlist-t,.katex .op-limits>.vlist-t{text-align:center}.katex .accent .accent-body{position:relative}.katex .accent .accent-body:not(.accent-full){width:0}.katex .overlay{display:block}.katex .mtable .vertical-separator{display:inline-block;min-width:1px}.katex .mtable .arraycolsep{display:inline-block}.katex .mtable .col-align-c>.vlist-t{text-align:center}.katex .mtable .col-align-l>.vlist-t{text-align:left}.katex .mtable .col-align-r>.vlist-t{text-align:right}.katex .svg-align{text-align:left}.katex svg{fill:currentColor;stroke:currentColor;fill-rule:nonzero;fill-opacity:1;stroke-width:1;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;display:block;height:inherit;position:absolute;width:100%}.katex svg path{stroke:none}.katex img{border-style:none;max-height:none;max-width:none;min-height:0;min-width:0}.katex .stretchy{display:block;overflow:hidden;position:relative;width:100%}.katex .stretchy:after,.katex .stretchy:before{content:\"\"}.katex .hide-tail{overflow:hidden;position:relative;width:100%}.katex .halfarrow-left{left:0;overflow:hidden;position:absolute;width:50.2%}.katex .halfarrow-right{overflow:hidden;position:absolute;right:0;width:50.2%}.katex .brace-left{left:0;overflow:hidden;position:absolute;width:25.1%}.katex .brace-center{left:25%;overflow:hidden;position:absolute;width:50%}.katex .brace-right{overflow:hidden;position:absolute;right:0;width:25.1%}.katex .x-arrow-pad{padding:0 .5em}.katex .cd-arrow-pad{padding:0 .55556em 0 .27778em}.katex .mover,.katex .munder,.katex .x-arrow{text-align:center}.katex .boxpad{padding:0 .3em}.katex .fbox,.katex .fcolorbox{border:.04em solid;box-sizing:border-box}.katex .cancel-pad{padding:0 .2em}.katex .cancel-lap{margin-left:-.2em;margin-right:-.2em}.katex .sout{border-bottom-style:solid;border-bottom-width:.08em}.katex .angl{border-right:.049em solid;border-top:.049em solid;box-sizing:border-box;margin-right:.03889em}.katex .anglpad{padding:0 .03889em}.katex .eqn-num:before{content:\"(\" counter(katexEqnNo) \")\";counter-increment:katexEqnNo}.katex .mml-eqn-num:before{content:\"(\" counter(mmlEqnNo) \")\";counter-increment:mmlEqnNo}.katex .mtr-glue{width:50%}.katex .cd-vert-arrow{display:inline-block;position:relative}.katex .cd-label-left{display:inline-block;position:absolute;right:calc(50% + .3em);text-align:left}.katex .cd-label-right{display:" let d_ad48849637d7c8349cb3e6952d5c8699 = "0.7 8.3 195.3 44 280 108 55.3 42 101.7 93 139 153l9 14c2.7-4 5.7-8.7 9-14\\n 53.3-86.7 123.7-153 211-199 66.7-36 137.3-56.3 212-62h199568v120H200432c-178.3\\n 11.7-311.7 78.3-403 201-6 8-9.7 12-11 12-.7.7-6.7 1-18 1s-17.3-.3-18-1c-1.3 0\\n-5-4-11-12-44.7-59.3-101.3-106.3-170-141s-145.3-54.3-229-60H0V214z\",oiintSize1:\"M512.6 71.6c272.6 0 320.3 106.8 320.3 178.2 0 70.8-47.7 177.6\\n-320.3 177.6S193.1 320.6 193.1 249.8c0-71.4 46.9-178.2 319.5-178.2z\\nm368.1 178.2c0-86.4-60.9-215.4-368.1-215.4-306.4 0-367.3 129-367.3 215.4 0 85.8\\n60.9 214.8 367.3 214.8 307.2 0 368.1-129 368.1-214.8z\",oiintSize2:\"M757.8 100.1c384.7 0 451.1 137.6 451.1 230 0 91.3-66.4 228.8\\n-451.1 228.8-386.3 0-452.7-137.5-452.7-228.8 0-92.4 66.4-230 452.7-230z\\nm502.4 230c0-111.2-82.4-277.2-502.4-277.2s-504 166-504 277.2\\nc0 110 84 276 504 276s502.4-166 502.4-276z\",oiiintSize1:\"M681.4 71.6c408.9 0 480.5 106.8 480.5 178.2 0 70.8-71.6 177.6\\n-480.5 177.6S202.1 320.6 202.1 249.8c0-71.4 70.5-178.2 479.3-178.2z\\nm525.8 178.2c0-86.4-86.8-215.4-525.7-215.4-437.9 0-524.7 129-524.7 215.4 0\\n85.8 86.8 214.8 524.7 214.8 438.9 0 525.7-129 525.7-214.8z\",oiiintSize2:\"M1021.2 53c603.6 0 707.8 165.8 707.8 277.2 0 110-104.2 275.8\\n-707.8 275.8-606 0-710.2-165.8-710.2-275.8C311 218.8 415.2 53 1021.2 53z\\nm770.4 277.1c0-131.2-126.4-327.6-770.5-327.6S248.4 198.9 248.4 330.1\\nc0 130 128.8 326.4 772.7 326.4s770.5-196.4 770.5-326.4z\",rightarrow:\"M0 241v40h399891c-47.3 35.3-84 78-110 128\\n-16.7 32-27.7 63.7-33 95 0 1.3-.2 2.7-.5 4-.3 1.3-.5 2.3-.5 3 0 7.3 6.7 11 20\\n 11 8 0 13.2-.8 15.5-2.5 2.3-1.7 4.2-5.5 5.5-11.5 2-13.3 5.7-27 11-41 14.7-44.7\\n 39-84.5 73-119.5s73.7-60.2 119-75.5c6-2 9-5.7 9-11s-3-9-9-11c-45.3-15.3-85\\n-40.5-119-75.5s-58.3-74.8-73-119.5c-4.7-14-8.3-27.3-11-40-1.3-6.7-3.2-10.8-5.5\\n-12.5-2.3-1.7-7.5-2.5-15.5-2.5-14 0-21 3.7-21 11 0 2 2 10.3 6 25 20.7 83.3 67\\n 151.7 139 205zm0 0v40h399900v-40z\",rightbrace:\"M400000 542l\\n-6 6h-17c-12.7 0-19.3-.3-20-1-4-4-7.3-8.3-10-13-35.3-51.3-80.8-93.8-136.5-127.5\\ns-117.2-55.8-184.5-66.5c-.7 0-2-.3-4-1-18.7-2.7-76-4.3-172-5H0V214h399571l6 1\\nc124.7 8 235 61.7 331 161 31.3 33.3 59.7 72.7 85 118l7 13v35z\",rightbraceunder:\"M399994 0l6 6v35l-6 11c-56 104-135.3 181.3-238 232-57.3\\n 28.7-117 45-179 50H-300V214h399897c43.3-7 81-15 113-26 100.7-33 179.7-91 237\\n-174 2.7-5 6-9 10-13 .7-1 7.3-1 20-1h17z\",rightgroup:\"M0 80h399565c371 0 266.7 149.4 414 180 5.9 1.2 18 0 18 0 2 0\\n 3-1 3-3v-38c-76-158-257-219-435-219H0z\",rightgroupunder:\"M0 262h399565c371 0 266.7-149.4 414-180 5.9-1.2 18 0 18\\n 0 2 0 3 1 3 3v38c-76 158-257 219-435 219H0z\",rightharpoon:\"M0 241v40h399993c4.7-4.7 7-9.3 7-14 0-9.3\\n-3.7-15.3-11-18-92.7-56.7-159-133.7-199-231-3.3-9.3-6-14.7-8-16-2-1.3-7-2-15-2\\n-10.7 0-16.7 2-18 6-2 2.7-1 9.7 3 21 15.3 42 36.7 81.8 64 119.5 27.3 37.7 58\\n 69.2 92 94.5zm0 0v40h399900v-40z\",rightharpoonplus:\"M0 241v40h399993c4.7-4.7 7-9.3 7-14 0-9.3-3.7-15.3-11\\n-18-92.7-56.7-159-133.7-199-231-3.3-9.3-6-14.7-8-16-2-1.3-7-2-15-2-10.7 0-16.7\\n 2-18 6-2 2.7-1 9.7 3 21 15.3 42 36.7 81.8 64 119.5 27.3 37.7 58 69.2 92 94.5z\\nm0 0v40h399900v-40z m100 194v40h399900v-40zm0 0v40h399900v-40z\",rightharpoondown:\"M399747 511c0 7.3 6.7 11 20 11 8 0 13-.8 15-2.5s4.7-6.8\\n 8-15.5c40-94 99.3-166.3 178-217 13.3-8 20.3-12.3 21-13 5.3-3.3 8.5-5.8 9.5\\n-7.5 1-1.7 1.5-5.2 1.5-10.5s-2.3-10.3-7-15H0v40h399908c-34 25.3-64.7 57-92 95\\n-27.3 38-48.7 77.7-64 119-3.3 8.7-5 14-5 16zM0 241v40h399900v-40z\",rightharpoondownplus:\"M399747 705c0 7.3 6.7 11 20 11 8 0 13-.8\\n 15-2.5s4.7-6.8 8-15.5c40-94 99.3-166.3 178-217 13.3-8 20.3-12.3 21-13 5.3-3.3\\n 8.5-5.8 9.5-7.5 1-1.7 1.5-5.2 1.5-10.5s-2.3-10.3-7-15H0v40h399908c-34 25.3\\n-64.7 57-92 95-27.3 38-48.7 77.7-64 119-3.3 8.7-5 14-5 16zM0 435v40h399900v-40z\\nm0-194v40h400000v-40zm0 0v40h400000v-40z\",righthook:\"M399859 241c-764 0 0 0 0 0 40-3.3 68.7-15.7 86-37 10-12 15-25.3\\n 15-40 0-22.7-9.8-40.7-29.5-54-19.7-13.3-43.5-21-71.5-23-17.3-1.3-26-8-26-20 0\\n-13.3 8.7-20 26-20 38 0 71 11.2 99 33.5 0 0 7 5.6 21 16.7 14 11.2 21 33.5 21\\n 66.8s-14 61.2-42 83.5c-28 22.3-61 33.5-99 33.5L0 241z M0 281v-40h399859v40z\",rightlinesegment:\"M399960 241 V94 h" @@ -505,7 +505,7 @@ module Internal = struct | "highlight.pack.js" | "/highlight.pack.js" -> Some [ d_6b9eea5bd2cdd91f629293ab3b8808d1; d_30baf6fb746860926fdd280eefc46735; d_7df05ceea77c14d78f1f1df8f98def4f; d_106b469c9254e3a72af1bc5085256cca; d_5fcd7eba230acf47d54c1897a9a9c394; d_df9507781455088adf4ca1bd7fc0a321; d_b223e3337242ba6cf0905995918760a5; d_d6a1be8caf2478248edb48ee82070d9e; d_98850966979dd224456f716b44220d69; d_9873a9ace25bcd721b8eeb6b8dad71cf; d_b23657c0bc089d459bc6099791f97c23; d_f9c0b1a6ea9c119cb0f7ead5c3dac542; d_80a0027403c5ad56c7da4589713b2348; d_fe8f6a1f53d067d447bae579dc60d6f0; ] | "katex.min.css" | "/katex.min.css" -> Some [ d_2d798108ddda42cb699f6ad4421e720e; d_b128d6f091a42be5d7a929703f09ac36; d_1476b6e94be68e530a90bd0723d69c88; d_e357f75b8a7d9a6031bbdc38adcf1422; d_ad152fcf832897f8629ca758460f3d22; d_7c9075f31df2a532c3135ae327c84a92; ] | "katex.min.js" | "/katex.min.js" -> Some [ d_0c2c3443b618aef3ac4519dd2b159bbe; d_a2070486fb8e9102cd1537ebd1216a96; d_48a6338945c47ceb84d335248c3d6873; d_ad48849637d7c8349cb3e6952d5c8699; d_32baa17e8a53bbd439c58b0d89bc0503; d_c7561e7d22eb89e10083cfba7680012c; d_d04b09d89ef0b9af8a297a3592a2e4b1; d_c0cf7351fa27f73a72840e453c4b15f3; d_fadfd470a088dde5c3755136ac4b6188; d_326148c9e075f26f4dd5ee3862f61cf6; d_a55141bd5690b03d71c9675038f73b3f; d_225bdd9918928e02697ef5570454bf56; d_bf8e1c09c2162b9bb4b6578a59cc8069; d_bb5a8ed07dc95fa6f9f51938da398a35; d_b93e718b1ddefad06d18d9736584ad78; d_e12a510e69c6b3e0210294eedc2c3be3; d_bf043adf1d8ba761903c6f3447bae9d3; d_80ae3e22d162129b593049c0dc7f2407; d_d7b447b6bfc36721f581470728505547; d_92e0c0a734f49413d685531ad3f0a03e; d_cabefc6c9607b95a33af32a8c8832767; d_a03f60fbbac88837b2763d52df2c0820; d_5795c26325c462426548bd12ff6ef7a1; d_c0939c104021af2b0d9b24c7102061f2; d_3a7455b94742964a6cc5e84e314a6cfb; d_dc2a908015f68e5bff245fff4e602604; d_96c4d8e2622ac6552ccf67643b20f09c; d_37935d98135b118d937e895f4bb55add; d_efe21915ced6043dcaa8ff576e7948c7; d_fe0aa5b4043d6894e289163dd38508b7; d_dc29762de1ae6c28b3b3cc202f52ac6f; d_2c5af911fa1596ad2eef3a7e342be949; d_01738333fc004372ab1ae8bc7d370677; d_0d6ec6387686b4173900d29c91f338ee; d_5f9942b4d85184e45b9addfc25ca6fd4; d_105a9e030400f28a404c6badd930fe01; d_79c029f6f746a52f4a8bc8b6280c5c88; d_3a50124eae7017a15bb92024b9f6c8ad; d_d1d8d575696cbb5a4994efc9e2862948; d_a6e92521674c97f4d1bd649490d8a987; d_8f38ae17980f4039d715823515fd56d0; d_a841840589a3efb0465e49e0d8f985b5; d_e33d592534625de6438003412e1d8813; d_5b12b53efc1e6da3a434634e81c2251b; d_c7270ab94b84005c36e6e864e6ea5b10; d_5e57240b8ff6745d663ebd2060201199; d_02c9bc01125e92ce389d2ac93e62d14b; d_0d4c13a0e6487657499a2f37795ab83b; d_8ff622534e1e1348711c11358657050b; d_a8b5fa32242a1d360076af4bdc9dafbe; d_725c52bce5d22dff34816d0cea74cf51; d_a6db9cb29ea27586d2138cf4f8710b12; d_31ee9944b6c75c4351486bc790988371; d_1005d4f63119125aeb03e8a2fa265969; d_9ff5a6ec97f55e01b81f13d9d3f0ff67; d_f361846717ba3e91093152df70d5aab3; d_e462cdcfecbc18ac1f1e447bf1ed3697; d_0d5bde992f9fa1c53103cd024ff5833b; d_1b66f4e8c1fbc1c74875f8da050cc1d0; d_bad0217136fdcd657898ee631bd512d1; d_428c2b0f069b4ffaef294dc85aef1e4b; d_cb988ca0480d611a7c52551adcc9ed48; d_cdc6e947cdb2e0bb7fae7f338ffa12a0; d_f56cd226d59f4d3190a095998f97ac56; d_f5d214c6b91ee7f61f5a433fcdd70682; d_f4caf2cb8610b6735641c064e6453b79; d_da739bd79e1901a19d34fbf2d1a16298; ] - | "odoc.css" | "/odoc.css" -> Some [ d_fa1c053d8b56d1e18253a2cf90453dfb; d_e17d79834bf5120a96c58d54a0ebfd29; d_3c0fd09a46dafedd922d3c7247ae8164; d_dd310317f27add09a8e020a67a028cb7; d_1748a7036eb134e2f5e68d79313a1372; d_65627a2f7cd45ea24715b66452954999; d_89fc6729d4ac5445a0939af01bd9324b; ] + | "odoc.css" | "/odoc.css" -> Some [ d_fa1c053d8b56d1e18253a2cf90453dfb; d_e17d79834bf5120a96c58d54a0ebfd29; d_3c0fd09a46dafedd922d3c7247ae8164; d_dd310317f27add09a8e020a67a028cb7; d_1748a7036eb134e2f5e68d79313a1372; d_65627a2f7cd45ea24715b66452954999; d_acb2c4605ac55515799c591d47af558a; ] | "odoc_search.js" | "/odoc_search.js" -> Some [ d_baa9e7597ed780d04fe80009b6d2457e; ] | _ -> None @@ -554,7 +554,7 @@ let hash = function | "highlight.pack.js" | "/highlight.pack.js" -> Some "f7f17015c0de1023c93929e3725a9248" | "katex.min.css" | "/katex.min.css" -> Some "1a262c83aa48d3ba34dd01c2ec6087d8" | "katex.min.js" | "/katex.min.js" -> Some "0376fd70eef224e946e13788118db3d1" - | "odoc.css" | "/odoc.css" -> Some "e0969de2e227384142d98b2aea09d7ed" + | "odoc.css" | "/odoc.css" -> Some "0dd873f4f54223ac467142340429aa6c" | "odoc_search.js" | "/odoc_search.js" -> Some "baa9e7597ed780d04fe80009b6d2457e" | _ -> None @@ -593,6 +593,6 @@ let size = function | "highlight.pack.js" | "/highlight.pack.js" -> Some 54535 | "katex.min.css" | "/katex.min.css" -> Some 20978 | "katex.min.js" | "/katex.min.js" -> Some 270376 - | "odoc.css" | "/odoc.css" -> Some 26708 + | "odoc.css" | "/odoc.css" -> Some 26709 | "odoc_search.js" | "/odoc_search.js" -> Some 2158 | _ -> None diff --git a/src/loader/cmi.ml b/src/loader/cmi.ml index 8429d3bd15..8365e5b22a 100644 --- a/src/loader/cmi.ml +++ b/src/loader/cmi.ml @@ -628,11 +628,11 @@ let read_constructor_declaration_arguments env parent arg = let read_constructor_declaration env parent cd = let open TypeDecl.Constructor in let id = Ident_env.find_constructor_identifier env cd.cd_id in - let container = (parent : Identifier.DataType.t :> Identifier.LabelParent.t) in + let container = (parent :> Identifier.LabelParent.t) in let doc = Doc_attr.attached_no_tag container cd.cd_attributes in let args = read_constructor_declaration_arguments env - (parent :> Identifier.Parent.t) cd.cd_args + (parent :> Identifier.FieldParent.t) cd.cd_args in let res = opt_map (read_type_expr env) cd.cd_res in {id; doc; args; res} @@ -652,7 +652,7 @@ let read_type_kind env parent = | Type_record(lbls, _) -> let lbls = List.map - (read_label_declaration env (parent :> Identifier.Parent.t)) + (read_label_declaration env (parent :> Identifier.FieldParent.t)) lbls in Some (Record lbls) @@ -713,7 +713,7 @@ let read_type_declaration env parent id decl = let params = mark_type_declaration decl in let manifest = opt_map (read_type_expr env) decl.type_manifest in let constraints = read_type_constraints env params in - let representation = read_type_kind env id decl.type_kind in + let representation = read_type_kind env (id :> Identifier.DataType.t) decl.type_kind in let abstr = match decl.type_kind with Type_abstract -> @@ -745,7 +745,7 @@ let read_extension_constructor env parent id ext = let doc = Doc_attr.attached_no_tag container ext.ext_attributes in let args = read_constructor_declaration_arguments env - (parent : Identifier.Signature.t :> Identifier.Parent.t) ext.ext_args + (parent : Identifier.Signature.t :> Identifier.FieldParent.t) ext.ext_args in let res = opt_map (read_type_expr env) ext.ext_ret_type in {id; locs; doc; args; res} @@ -779,7 +779,7 @@ let read_exception env parent id ext = mark_exception ext; let args = read_constructor_declaration_arguments env - (parent : Identifier.Signature.t :> Identifier.Parent.t) ext.ext_args + (parent : Identifier.Signature.t :> Identifier.FieldParent.t) ext.ext_args in let res = opt_map (read_type_expr env) ext.ext_ret_type in {id; locs; doc; args; res} @@ -924,17 +924,18 @@ let rec read_module_type env parent (mty : Odoc_model.Compat.module_type) = | Mty_ident p -> Path {p_path = Env.Path.read_module_type env p; p_expansion=None } | Mty_signature sg -> Signature (read_signature env parent sg) | Mty_functor(parameter, res) -> - let f_parameter, env = + let f_parameter = match parameter with - | Unit -> Odoc_model.Lang.FunctorParameter.Unit, env + | Unit -> Odoc_model.Lang.FunctorParameter.Unit | Named (id_opt, arg) -> - let id, env = match id_opt with - | None -> Identifier.Mk.parameter(parent, Odoc_model.Names.ModuleName.make_std "_"), env - | Some id -> let env = Env.add_parameter parent id (ModuleName.of_ident id) env in - Ident_env.find_parameter_identifier env id, env + let id = match id_opt with + | None -> Identifier.Mk.parameter(parent, Odoc_model.Names.ModuleName.make_std "_") + | Some id -> + let () = Env.add_parameter parent id (ModuleName.of_ident id) env in + Ident_env.find_parameter_identifier env id in let arg = read_module_type env (id :> Identifier.Signature.t) arg in - Odoc_model.Lang.FunctorParameter.Named ({ FunctorParameter. id; expr = arg }), env + Odoc_model.Lang.FunctorParameter.Named ({ FunctorParameter. id; expr = arg }) in let res = read_module_type env (Identifier.Mk.result parent) res in Functor( f_parameter, res) @@ -1082,7 +1083,7 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) = loop ([],{s_modules=[]; s_module_types=[]; s_values=[];s_types=[]; s_classes=[]; s_class_types=[]}) items and read_signature env parent (items : Odoc_model.Compat.signature) = - let env = Env.handle_signature_type_items parent items env in + let () = Env.handle_signature_type_items parent items env in fst @@ read_signature_noenv env parent items diff --git a/src/loader/cmt.ml b/src/loader/cmt.ml index 34d8a5d7da..9b06dbaa87 100644 --- a/src/loader/cmt.ml +++ b/src/loader/cmt.ml @@ -363,34 +363,35 @@ let rec read_module_expr env parent label_parent mexpr = Signature sg #if OCAML_VERSION >= (4,10,0) | Tmod_functor(parameter, res) -> - let f_parameter, env = + let f_parameter = match parameter with - | Unit -> FunctorParameter.Unit, env + | Unit -> FunctorParameter.Unit | Named (id_opt, _, arg) -> - let id, env = + let id = match id_opt with - | None -> Identifier.Mk.parameter (parent, Odoc_model.Names.ModuleName.make_std "_"), env - | Some id -> let env = Env.add_parameter parent id (ModuleName.of_ident id) env in - Env.find_parameter_identifier env id, env + | None -> Identifier.Mk.parameter (parent, Odoc_model.Names.ModuleName.make_std "_") + | Some id -> + let () = Env.add_parameter parent id (ModuleName.of_ident id) env in + Env.find_parameter_identifier env id in let arg = Cmti.read_module_type env (id :> Identifier.Signature.t) label_parent arg in - Named { id; expr=arg }, env + Named { id; expr=arg } in let res = read_module_expr env (Identifier.Mk.result parent) label_parent res in Functor (f_parameter, res) #else | Tmod_functor(id, _, arg, res) -> - let new_env = Env.add_parameter parent id (ModuleName.of_ident id) env in + let () = Env.add_parameter parent id (ModuleName.of_ident id) env in let f_parameter = match arg with | None -> FunctorParameter.Unit | Some arg -> - let id = Env.find_parameter_identifier new_env id in + let id = Env.find_parameter_identifier env id in let arg = Cmti.read_module_type env (id :> Identifier.Signature.t) label_parent arg in Named { FunctorParameter. id; expr = arg; } in - let res = read_module_expr new_env (Identifier.Mk.result parent) label_parent res in + let res = read_module_expr env (Identifier.Mk.result parent) label_parent res in Functor(f_parameter, res) #endif | Tmod_apply _ -> @@ -576,7 +577,7 @@ and read_structure : 'tags. 'tags Odoc_model.Semantics.handle_internal_tags -> _ -> _ -> _ -> _ * 'tags = fun internal_tags env parent str -> - let env = Env.add_structure_tree_items parent str env in + let () = Env.add_structure_tree_items parent str env in let items, (doc, doc_post), tags = let classify item = match item.str_desc with diff --git a/src/loader/cmti.ml b/src/loader/cmti.ml index 53297e98dd..436f6a6fdc 100644 --- a/src/loader/cmti.ml +++ b/src/loader/cmti.ml @@ -214,7 +214,7 @@ let read_constructor_declaration_arguments env parent label_parent arg = let read_constructor_declaration env parent cd = let open TypeDecl.Constructor in let id = Ident_env.find_constructor_identifier env cd.cd_id in - let container = (parent : Identifier.DataType.t :> Identifier.Parent.t) in + let container = (parent :> Identifier.FieldParent.t) in let label_container = (container :> Identifier.LabelParent.t) in let doc = Doc_attr.attached_no_tag label_container cd.cd_attributes in let args = @@ -231,7 +231,7 @@ let read_type_kind env parent = let cstrs = List.map (read_constructor_declaration env parent) cstrs in Some (Variant cstrs) | Ttype_record lbls -> - let parent = (parent : Identifier.DataType.t :> Identifier.Parent.t) in + let parent = (parent :> Identifier.FieldParent.t) in let label_parent = (parent :> Identifier.LabelParent.t) in let lbls = List.map (read_label_declaration env parent label_parent) lbls in @@ -260,7 +260,7 @@ let read_type_declaration env parent decl = let doc, canonical = Doc_attr.attached Odoc_model.Semantics.Expect_canonical container decl.typ_attributes in let canonical = (canonical :> Path.Type.t option) in let equation = read_type_equation env container decl in - let representation = read_type_kind env (id :> Identifier.DataType.t) decl.typ_kind in + let representation = read_type_kind env id decl.typ_kind in {id; locs; doc; canonical; equation; representation} let read_type_declarations env parent rec_flag decls = @@ -292,7 +292,7 @@ let read_extension_constructor env parent ext = let open Extension.Constructor in let id = Env.find_extension_identifier env ext.ext_id in let locs = None in - let container = (parent : Identifier.Signature.t :> Identifier.Parent.t) in + let container = (parent : Identifier.Signature.t :> Identifier.FieldParent.t) in let label_container = (container :> Identifier.LabelParent.t) in let doc = Doc_attr.attached_no_tag label_container ext.ext_attributes in match ext.ext_kind with @@ -325,7 +325,7 @@ let read_exception env parent (ext : extension_constructor) = let open Exception in let id = Env.find_exception_identifier env ext.ext_id in let locs = None in - let container = (parent : Identifier.Signature.t :> Identifier.Parent.t) in + let container = (parent : Identifier.Signature.t :> Identifier.FieldParent.t) in let label_container = (container :> Identifier.LabelParent.t) in let doc = Doc_attr.attached_no_tag label_container ext.ext_attributes in match ext.ext_kind with @@ -517,12 +517,12 @@ and read_module_type env parent label_parent mty = match parameter with | Unit -> FunctorParameter.Unit, env | Named (id_opt, _, arg) -> - let id, env = + let id = match id_opt with - | None -> Identifier.Mk.parameter (parent, ModuleName.make_std "_"), env + | None -> Identifier.Mk.parameter (parent, ModuleName.make_std "_") | Some id -> - let env = Env.add_parameter parent id (ModuleName.of_ident id) env in - Env.find_parameter_identifier env id, env + let () = Env.add_parameter parent id (ModuleName.of_ident id) env in + Env.find_parameter_identifier env id in let arg = read_module_type env (id :> Identifier.Signature.t) label_parent arg in Named { id; expr = arg; }, env @@ -531,16 +531,16 @@ and read_module_type env parent label_parent mty = Functor (f_parameter, res) #else | Tmty_functor(id, _, arg, res) -> - let new_env = Env.add_parameter parent id (ModuleName.of_ident id) env in + let () = Env.add_parameter parent id (ModuleName.of_ident id) env in let f_parameter = match arg with | None -> Odoc_model.Lang.FunctorParameter.Unit | Some arg -> - let id = Ident_env.find_parameter_identifier new_env id in + let id = Ident_env.find_parameter_identifier env id in let arg = read_module_type env (id :> Identifier.Signature.t) label_parent arg in Named { FunctorParameter. id; expr = arg } in - let res = read_module_type new_env (Identifier.Mk.result parent) label_parent res in + let res = read_module_type () (Identifier.Mk.result parent) label_parent res in Functor( f_parameter, res) #endif | Tmty_with(body, subs) -> ( @@ -772,7 +772,7 @@ and read_signature : 'tags. 'tags Odoc_model.Semantics.handle_internal_tags -> _ -> _ -> _ -> _ * 'tags = fun internal_tags env parent sg -> - let env = Env.add_signature_tree_items parent sg env in + let () = Env.add_signature_tree_items parent sg env in let items, (doc, doc_post), tags = let classify item = match item.sig_desc with diff --git a/src/loader/ident_env.cppo.ml b/src/loader/ident_env.cppo.ml index 0d2dea858f..6e5094306b 100644 --- a/src/loader/ident_env.cppo.ml +++ b/src/loader/ident_env.cppo.ml @@ -29,36 +29,42 @@ module LocHashtbl = Hashtbl.Make(struct let hash = Hashtbl.hash end) +module IdentHashtbl = Hashtbl.Make(struct + type t = Ident.t + let equal l1 l2 = l1 = l2 + let hash = Hashtbl.hash + end) + type t = - { modules : Id.Module.t Ident.tbl; - parameters : Id.FunctorParameter.t Ident.tbl; - module_paths : P.Module.t Ident.tbl; - module_types : Id.ModuleType.t Ident.tbl; - types : Id.DataType.t Ident.tbl; - exceptions: Id.Exception.t Ident.tbl; - extensions: Id.Extension.t Ident.tbl; - constructors: Id.Constructor.t Ident.tbl; - values: Id.Value.t Ident.tbl; - classes : Id.Class.t Ident.tbl; - class_types : Id.ClassType.t Ident.tbl; + { modules : Id.Module.t IdentHashtbl.t; + parameters : Id.FunctorParameter.t IdentHashtbl.t; + module_paths : P.Module.t IdentHashtbl.t; + module_types : Id.ModuleType.t IdentHashtbl.t; + types : Id.DataType.t IdentHashtbl.t; + exceptions: Id.Exception.t IdentHashtbl.t; + extensions: Id.Extension.t IdentHashtbl.t; + constructors: Id.Constructor.t IdentHashtbl.t; + values: Id.Value.t IdentHashtbl.t; + classes : Id.Class.t IdentHashtbl.t; + class_types : Id.ClassType.t IdentHashtbl.t; loc_to_ident : Id.t LocHashtbl.t; - hidden : Ident.t list; (* we use term hidden to mean shadowed and idents_in_doc_off_mode items*) + hidden : unit IdentHashtbl.t; (* we use term hidden to mean shadowed and idents_in_doc_off_mode items*) } let empty () = - { modules = Ident.empty; - parameters = Ident.empty; - module_paths = Ident.empty; - module_types = Ident.empty; - types = Ident.empty; - exceptions = Ident.empty; - constructors = Ident.empty; - extensions = Ident.empty; - values = Ident.empty; - classes = Ident.empty; - class_types = Ident.empty; + { modules = IdentHashtbl.create 10; + parameters = IdentHashtbl.create 10; + module_paths = IdentHashtbl.create 10; + module_types = IdentHashtbl.create 10; + types = IdentHashtbl.create 10; + exceptions = IdentHashtbl.create 10; + constructors = IdentHashtbl.create 10; + extensions = IdentHashtbl.create 10; + values = IdentHashtbl.create 10; + classes = IdentHashtbl.create 10; + class_types = IdentHashtbl.create 10; loc_to_ident = LocHashtbl.create 100; - hidden = []; + hidden = IdentHashtbl.create 100; } (* The boolean is an override for whether it should be hidden - true only for @@ -481,84 +487,84 @@ let class_name_exists name items = let class_type_name_exists name items = List.exists (function | `ClassType (id',_,_,_,_) when Ident.name id' = name -> true | _ -> false) items -let add_items : Id.Signature.t -> item list -> t -> t = fun parent items env -> +let add_items : Id.Signature.t -> item list -> t -> unit = fun parent items env -> let open Odoc_model.Paths.Identifier in let rec inner items env = match items with | `Type (t, is_hidden_item, loc) :: rest -> let name = Ident.name t in let is_hidden = is_hidden_item || type_name_exists name rest in - let identifier, hidden = + let identifier = if is_hidden - then Mk.type_(parent, TypeName.internal_of_string name), t :: env.hidden - else Mk.type_(parent, TypeName.make_std name), env.hidden + then (IdentHashtbl.add env.hidden t (); Mk.type_(parent, TypeName.internal_of_string name)) + else Mk.type_(parent, TypeName.make_std name) in - let types = Ident.add t identifier env.types in + let () = IdentHashtbl.add env.types t identifier in (match loc with | Some l -> LocHashtbl.add env.loc_to_ident l (identifier :> Id.any) | _ -> ()); - inner rest { env with types; hidden } + inner rest env | `Constructor (t, t_parent, loc) :: rest -> let name = Ident.name t in let identifier = - let parent = Ident.find_same t_parent env.types in + let parent = IdentHashtbl.find env.types t_parent in Mk.constructor(parent, ConstructorName.make_std name) in - let constructors = Ident.add t identifier env.constructors in + let () = IdentHashtbl.add env.constructors t identifier in (match loc with | Some l -> LocHashtbl.add env.loc_to_ident l (identifier :> Id.any) | _ -> ()); - inner rest { env with constructors } + inner rest env | `Exception (t, loc) :: rest -> let name = Ident.name t in let identifier = Mk.exception_(parent, ExceptionName.make_std name) in (match loc with | Some l -> LocHashtbl.add env.loc_to_ident l (identifier :> Id.any) | _ -> ()); - let exceptions = Ident.add t identifier env.exceptions in - inner rest {env with exceptions } + let () = IdentHashtbl.add env.exceptions t identifier in + inner rest env | `Extension (t, loc) :: rest -> let name = Ident.name t in let identifier = Mk.extension(parent, ExtensionName.make_std name) in (match loc with | Some l -> LocHashtbl.add env.loc_to_ident l (identifier :> Id.any) | _ -> ()); - let extensions = Ident.add t identifier env.extensions in - inner rest {env with extensions } + let () = IdentHashtbl.add env.extensions t identifier in + inner rest env | `Value (t, is_hidden_item, loc) :: rest -> let name = Ident.name t in let is_hidden = is_hidden_item || value_name_exists name rest in - let identifier, hidden = + let identifier = if is_hidden - then Mk.value(parent, ValueName.internal_of_string name), t :: env.hidden - else Mk.value(parent, ValueName.make_std name), env.hidden + then (IdentHashtbl.add env.hidden t (); Mk.value(parent, ValueName.internal_of_string name)) + else Mk.value(parent, ValueName.make_std name) in - let values = Ident.add t identifier env.values in + let () = IdentHashtbl.add env.values t identifier in (match loc with | Some l -> LocHashtbl.add env.loc_to_ident l (identifier :> Id.any) | _ -> ()); - inner rest { env with values; hidden } + inner rest env | `ModuleType (t, is_hidden_item, loc) :: rest -> let name = Ident.name t in let is_hidden = is_hidden_item || module_type_name_exists name rest in - let identifier, hidden = + let identifier = if is_hidden - then Mk.module_type(parent, ModuleTypeName.internal_of_string name), t :: env.hidden - else Mk.module_type(parent, ModuleTypeName.make_std name), env.hidden + then (IdentHashtbl.add env.hidden t (); Mk.module_type(parent, ModuleTypeName.internal_of_string name)) + else Mk.module_type(parent, ModuleTypeName.make_std name) in - let module_types = Ident.add t identifier env.module_types in + let () = IdentHashtbl.add env.module_types t identifier in (match loc with | Some l -> LocHashtbl.add env.loc_to_ident l (identifier :> Id.any) | _ -> ()); - inner rest { env with module_types; hidden } + inner rest env | `Module (t, is_hidden_item, loc) :: rest -> let name = Ident.name t in let double_underscore = Odoc_model.Root.contains_double_underscore name in let is_hidden = is_hidden_item || module_name_exists name rest || double_underscore in - let identifier, hidden = - if is_hidden - then Mk.module_(parent, ModuleName.internal_of_string name), t :: env.hidden - else Mk.module_(parent, ModuleName.make_std name), env.hidden + let identifier = + if is_hidden + then (IdentHashtbl.add env.hidden t (); Mk.module_(parent, ModuleName.internal_of_string name)) + else Mk.module_(parent, ModuleName.make_std name) in let path = `Identifier(identifier, is_hidden) in - let modules = Ident.add t identifier env.modules in - let module_paths = Ident.add t path env.module_paths in + let () = IdentHashtbl.add env.modules t identifier in + let () = IdentHashtbl.add env.module_paths t path in (match loc with | Some l -> LocHashtbl.add env.loc_to_ident l (identifier :> Id.any) | _ -> ()); - inner rest { env with modules; module_paths; hidden } + inner rest env | `Class (t,t2,t3,t4, is_hidden_item, loc) :: rest -> let name = Ident.name t in @@ -567,19 +573,21 @@ let add_items : Id.Signature.t -> item list -> t -> t = fun parent items env -> | None -> [t;t2;t3] | Some t4 -> [t;t2;t3;t4] in - let identifier, hidden = + let identifier = if is_hidden - then Mk.class_(parent, ClassName.internal_of_string name), class_types @ env.hidden - else Mk.class_(parent, ClassName.make_std name), env.hidden + then ( + List.iter (fun t -> IdentHashtbl.add env.hidden t ()) class_types; + Mk.class_(parent, ClassName.internal_of_string name)) + else Mk.class_(parent, ClassName.make_std name) in - let classes = - List.fold_right (fun id classes -> Ident.add id identifier classes) - class_types env.classes in + let () = + List.fold_right (fun id () -> IdentHashtbl.add env.classes id identifier) + class_types () in (match loc with | Some l -> LocHashtbl.add env.loc_to_ident l (identifier :> Id.any) | _ -> ()); - inner rest { env with classes; hidden } + inner rest env | `ClassType (t,t2,t3, is_hidden_item, loc) :: rest -> let name = Ident.name t in @@ -588,18 +596,20 @@ let add_items : Id.Signature.t -> item list -> t -> t = fun parent items env -> | None -> [t;t2] | Some t3 -> [t;t2;t3] in - let identifier, hidden = + let identifier = if is_hidden - then Mk.class_type(parent, ClassTypeName.internal_of_string name), class_types @ env.hidden - else Mk.class_type(parent, ClassTypeName.make_std name), env.hidden + then ( + List.iter (fun t -> IdentHashtbl.add env.hidden t ()) class_types; + Mk.class_type(parent, ClassTypeName.internal_of_string name)) + else Mk.class_type(parent, ClassTypeName.make_std name) in - let class_types = - List.fold_right (fun id class_types -> Ident.add id identifier class_types) - class_types env.class_types in + let () = + List.fold_right (fun id () -> IdentHashtbl.add env.class_types id identifier) + class_types () in (match loc with | Some l -> LocHashtbl.add env.loc_to_ident l (identifier :> Id.any) | _ -> ()); - inner rest { env with class_types; hidden } + inner rest env - | [] -> env + | [] -> () in inner items env let identifier_of_loc : t -> Location.t -> Odoc_model.Paths.Identifier.t option = fun env loc -> @@ -608,17 +618,17 @@ let identifier_of_loc : t -> Location.t -> Odoc_model.Paths.Identifier.t option let iter_located_identifier : t -> (Location.t -> Odoc_model.Paths.Identifier.t -> unit) -> unit = fun env f -> LocHashtbl.iter f env.loc_to_ident -let add_signature_tree_items : Paths.Identifier.Signature.t -> Typedtree.signature -> t -> t = +let add_signature_tree_items : Paths.Identifier.Signature.t -> Typedtree.signature -> t -> unit = fun parent sg env -> let items = extract_signature_tree_items false sg.sig_items |> flatten_includes in add_items parent items env -let add_structure_tree_items : Paths.Identifier.Signature.t -> Typedtree.structure -> t -> t = +let add_structure_tree_items : Paths.Identifier.Signature.t -> Typedtree.structure -> t -> unit = fun parent sg env -> let items = extract_structure_tree_items false sg.str_items |> flatten_includes in add_items parent items env -let handle_signature_type_items : Paths.Identifier.Signature.t -> Compat.signature -> t -> t = +let handle_signature_type_items : Paths.Identifier.Signature.t -> Compat.signature -> t -> unit = fun parent sg env -> let items = extract_signature_type_items sg in add_items parent items env @@ -627,47 +637,47 @@ let add_parameter parent id name env = let hidden = ModuleName.is_hidden name in let oid = Odoc_model.Paths.Identifier.Mk.parameter(parent, name) in let path = `Identifier (oid, hidden) in - let module_paths = Ident.add id path env.module_paths in - let modules = Ident.add id oid env.modules in - let parameters = Ident.add id oid env.parameters in - { env with module_paths; modules; parameters } + let () = IdentHashtbl.add env.module_paths id path in + let () = IdentHashtbl.add env.modules id oid in + let () = IdentHashtbl.add env.parameters id oid in + () let find_module env id = - Ident.find_same id env.module_paths + IdentHashtbl.find env.module_paths id let find_module_identifier env id = - Ident.find_same id env.modules + IdentHashtbl.find env.modules id let find_parameter_identifier env id = - Ident.find_same id env.parameters + IdentHashtbl.find env.parameters id let find_module_type env id = - Ident.find_same id env.module_types + IdentHashtbl.find env.module_types id let find_type_identifier env id = - Ident.find_same id env.types + IdentHashtbl.find env.types id let find_constructor_identifier env id = - Ident.find_same id env.constructors + IdentHashtbl.find env.constructors id let find_exception_identifier env id = - Ident.find_same id env.exceptions + IdentHashtbl.find env.exceptions id let find_extension_identifier env id = - Ident.find_same id env.extensions + IdentHashtbl.find env.extensions id let find_value_identifier env id = - Ident.find_same id env.values + IdentHashtbl.find env.values id let find_type env id = try - (Ident.find_same id env.types :> Id.Path.Type.t) + (IdentHashtbl.find env.types id :> Id.Path.Type.t) with Not_found -> try - (Ident.find_same id env.classes :> Id.Path.Type.t) + (IdentHashtbl.find env.classes id :> Id.Path.Type.t) with Not_found -> try - (Ident.find_same id env.class_types :> Id.Path.Type.t) + (IdentHashtbl.find env.class_types id :> Id.Path.Type.t) with Not_found -> if List.mem id builtin_idents then match core_type_identifier (Ident.name id) with @@ -677,19 +687,19 @@ let find_type env id = let find_class_type env id = try - (Ident.find_same id env.classes :> Id.Path.ClassType.t) + (IdentHashtbl.find env.classes id :> Id.Path.ClassType.t) with Not_found -> - (Ident.find_same id env.class_types :> Id.Path.ClassType.t) + (IdentHashtbl.find env.class_types id :> Id.Path.ClassType.t) let find_class_identifier env id = - Ident.find_same id env.classes + IdentHashtbl.find env.classes id let find_class_type_identifier env id = - Ident.find_same id env.class_types + IdentHashtbl.find env.class_types id let is_shadowed env id = - List.mem id env.hidden + IdentHashtbl.mem env.hidden id module Path = struct let read_module_ident env id = @@ -708,6 +718,9 @@ module Path = struct `Identifier (find_type env id, false) with Not_found -> assert false + let read_value_ident env id : Paths.Path.Value.t = + `Identifier (find_value_identifier env id, false) + let read_class_type_ident env id : Paths.Path.ClassType.t = try `Identifier (find_class_type env id, false) @@ -786,6 +799,18 @@ module Path = struct | Path.Pextra_ty (p,_) -> read_type env p #endif + let read_value env = function + | Path.Pident id -> read_value_ident env id +#if OCAML_VERSION >= (4,8,0) + | Path.Pdot(p, s) -> `Dot(read_module env p, s) +#else + | Path.Pdot(p, s, _) -> `Dot(read_module env p, s) +#endif + | Path.Papply(_, _) -> assert false +#if OCAML_VERSION >= (5,1,0) + | Path.Pextra_ty _ -> assert false +#endif + end module Fragment = struct diff --git a/src/loader/ident_env.cppo.mli b/src/loader/ident_env.cppo.mli index 2be505ca18..c17f827bf3 100644 --- a/src/loader/ident_env.cppo.mli +++ b/src/loader/ident_env.cppo.mli @@ -21,16 +21,16 @@ type t val empty : unit -> t val add_parameter : - Paths.Identifier.Signature.t -> Ident.t -> Names.ModuleName.t -> t -> t + Paths.Identifier.Signature.t -> Ident.t -> Names.ModuleName.t -> t -> unit val handle_signature_type_items : - Paths.Identifier.Signature.t -> Compat.signature -> t -> t + Paths.Identifier.Signature.t -> Compat.signature -> t -> unit val add_signature_tree_items : - Paths.Identifier.Signature.t -> Typedtree.signature -> t -> t + Paths.Identifier.Signature.t -> Typedtree.signature -> t -> unit val add_structure_tree_items : - Paths.Identifier.Signature.t -> Typedtree.structure -> t -> t + Paths.Identifier.Signature.t -> Typedtree.structure -> t -> unit module Path : sig val read_module : t -> Path.t -> Paths.Path.Module.t @@ -40,6 +40,8 @@ module Path : sig val read_type : t -> Path.t -> Paths.Path.Type.t val read_class_type : t -> Path.t -> Paths.Path.ClassType.t + + val read_value : t -> Path.t -> Paths.Path.Value.t end val find_module : t -> Ident.t -> Paths.Path.Module.t diff --git a/src/loader/implementation.ml b/src/loader/implementation.ml index 6b8bc6c9f6..55c011adea 100644 --- a/src/loader/implementation.ml +++ b/src/loader/implementation.ml @@ -1,6 +1,12 @@ #if OCAML_VERSION >= (4, 14, 0) -(* open Odoc_model.Lang.Source_info *) +let rec is_persistent : Path.t -> bool = function + | Path.Pident id -> Ident.persistent id + | Path.Pdot(p, _) -> is_persistent p + | Path.Papply(p, _) -> is_persistent p +#if OCAML_VERSION >= (5,1,0) + | Path.Pextra_ty _ -> assert false +#endif let pos_of_loc loc = (loc.Location.loc_start.pos_cnum, loc.loc_end.pos_cnum) @@ -15,12 +21,12 @@ module Env = struct open Odoc_model.Paths let rec structure env parent str = - let env' = Ident_env.add_structure_tree_items parent str env in - List.iter (structure_item env' parent) str.str_items + let () = Ident_env.add_structure_tree_items parent str env in + List.iter (structure_item env parent) str.str_items and signature env parent sg = - let env' = Ident_env.add_signature_tree_items parent sg env in - List.iter (signature_item env' parent) sg.sig_items + let () = Ident_env.add_signature_tree_items parent sg env in + List.iter (signature_item env parent) sg.sig_items and signature_item env parent item = match item.sig_desc with @@ -53,18 +59,12 @@ module Env = struct match item.str_desc with | Tstr_module mb -> module_binding env parent mb | Tstr_recmodule mbs -> module_bindings env parent mbs - | Tstr_modtype mtd -> module_type_decl env parent mtd + | Tstr_modtype mtd -> module_type_declaration env parent mtd | Tstr_open _ | Tstr_value _ | Tstr_class _ | Tstr_eval _ | Tstr_class_type _ | Tstr_include _ | Tstr_attribute _ | Tstr_primitive _ | Tstr_type _ | Tstr_typext _ | Tstr_exception _ -> () - and module_type_decl env _parent mtd = - let id = Ident_env.find_module_type env mtd.mtd_id in - match mtd.mtd_type with - | None -> () - | Some mty -> module_type env (id :> Identifier.Signature.t) mty - and module_type env (parent : Identifier.Signature.t) mty = match mty.mty_desc with | Tmty_signature sg -> signature env (parent : Identifier.Signature.t) sg @@ -95,20 +95,19 @@ module Env = struct | Tmod_structure str -> structure env parent str | Tmod_functor (parameter, res) -> let open Odoc_model.Names in - let env = + let () = match parameter with - | Unit -> env + | Unit -> () | Named (id_opt, _, arg) -> ( match id_opt with | Some id -> - let env = + let () = Ident_env.add_parameter parent id (ModuleName.of_ident id) env in let id = Ident_env.find_module_identifier env id in - module_type env (id :> Identifier.Signature.t) arg; - env - | None -> env) + module_type env (id :> Identifier.Signature.t) arg + | None -> ()) in module_expr env (Odoc_model.Paths.Identifier.Mk.result parent) res | Tmod_constraint (me, _, constr, _) -> @@ -144,23 +143,34 @@ module IdentHashtbl = Hashtbl.Make (struct let hash = Hashtbl.hash end) +module AnnotHashtbl = Hashtbl.Make (struct + type t = + Odoc_model.Lang.Source_info.annotation Odoc_model.Lang.Source_info.with_pos + let equal l1 l2 = l1 = l2 + let hash = Hashtbl.hash +end) + module UidHashtbl = Shape.Uid.Tbl (* Adds the local definitions found in traverse infos to the [loc_to_id] and [ident_to_id] tables. *) -let populate_local_defs source_id poses loc_to_id ident_to_id = +let populate_local_defs source_id poses loc_to_id local_ident_to_loc = List.iter (function - | Typedtree_traverse.Analysis.Definition id, loc -> + | Typedtree_traverse.Analysis.LocalDefinition id, loc -> let name = Odoc_model.Names.LocalName.make_std (Printf.sprintf "local_%s_%d" (Ident.name id) (counter ())) in - let identifier = - Odoc_model.Paths.Identifier.Mk.source_location_int (source_id, name) - in - IdentHashtbl.add ident_to_id id identifier; - LocHashtbl.add loc_to_id loc identifier + (match source_id with + | Some source_id -> + let identifier = + Odoc_model.Paths.Identifier.Mk.source_location_int + (source_id, name) + in + LocHashtbl.add loc_to_id loc identifier + | None -> ()); + IdentHashtbl.add local_ident_to_loc id loc | _ -> ()) poses @@ -246,55 +256,100 @@ let anchor_of_identifier id = (* Adds the global definitions, found in the [uid_to_loc], to the [loc_to_id] and [uid_to_id] tables. *) let populate_global_defs env source_id loc_to_id uid_to_loc uid_to_id = - let mk_src_id id = - let name = Odoc_model.Names.DefName.make_std (anchor_of_identifier id) in - (Odoc_model.Paths.Identifier.Mk.source_location (source_id, name) - :> Odoc_model.Paths.Identifier.SourceLocation.t) - in - let () = - Ident_env.iter_located_identifier env @@ fun loc id -> - LocHashtbl.add loc_to_id loc (mk_src_id id) - in - let mk_src_id () = - let name = - Odoc_model.Names.DefName.make_std (Printf.sprintf "def_%d" (counter ())) - in - (Odoc_model.Paths.Identifier.Mk.source_location (source_id, name) - :> Odoc_model.Paths.Identifier.SourceLocation.t) - in - Shape.Uid.Tbl.iter - (fun uid loc -> - if loc.Location.loc_ghost then () - else - match LocHashtbl.find_opt loc_to_id loc with - | Some id -> UidHashtbl.add uid_to_id uid id - | None -> ( - (* In case there is no entry for the location of the uid, we add one. *) - match uid with - | Item _ -> - let id = mk_src_id () in - LocHashtbl.add loc_to_id loc id; - UidHashtbl.add uid_to_id uid id - | Compilation_unit _ -> () - | _ -> ())) - uid_to_loc + match source_id with + | None -> () + | Some source_id -> + let mk_src_id id = + let name = + Odoc_model.Names.DefName.make_std (anchor_of_identifier id) + in + (Odoc_model.Paths.Identifier.Mk.source_location (source_id, name) + :> Odoc_model.Paths.Identifier.SourceLocation.t) + in + let () = + Ident_env.iter_located_identifier env @@ fun loc id -> + LocHashtbl.add loc_to_id loc (mk_src_id id) + in + let mk_src_id () = + let name = + Odoc_model.Names.DefName.make_std + (Printf.sprintf "def_%d" (counter ())) + in + (Odoc_model.Paths.Identifier.Mk.source_location (source_id, name) + :> Odoc_model.Paths.Identifier.SourceLocation.t) + in + Shape.Uid.Tbl.iter + (fun uid loc -> + if loc.Location.loc_ghost then () + else + match LocHashtbl.find_opt loc_to_id loc with + | Some id -> UidHashtbl.add uid_to_id uid id + | None -> ( + (* In case there is no entry for the location of the uid, we add one. *) + match uid with + | Item _ -> + let id = mk_src_id () in + LocHashtbl.add loc_to_id loc id; + UidHashtbl.add uid_to_id uid id + | Compilation_unit _ -> () + | _ -> ())) + uid_to_loc (* Extract [Typedtree_traverse] occurrence information and turn them into proper source infos *) -let process_occurrences poses uid_to_id ident_to_id = - List.filter_map +let process_occurrences env poses loc_to_id local_ident_to_loc = + let open Odoc_model.Lang.Source_info in + (* Ensure source infos are not repeated by putting them in a Set (a unit hashtbl) *) + let occ_tbl = AnnotHashtbl.create 100 in + let process p find_in_env = + match p with + | Path.Pident id when IdentHashtbl.mem local_ident_to_loc id -> ( + match + LocHashtbl.find_opt loc_to_id + (IdentHashtbl.find local_ident_to_loc id) + with + | None -> None + | Some id -> + let documentation = None and implementation = Some (Resolved id) in + Some { documentation; implementation }) + | p -> ( + match find_in_env env p with + | path -> + let documentation = if is_persistent p then Some path else None + and implementation = Some (Unresolved path) in + Some { documentation; implementation } + | exception _ -> None) + in + List.iter (function - | Typedtree_traverse.Analysis.Value (LocalValue uniq), loc -> ( - match IdentHashtbl.find_opt ident_to_id uniq with - | Some anchor -> - Some (Odoc_model.Lang.Source_info.Value anchor, pos_of_loc loc) - | None -> None) - | Value (DefJmp x), loc -> ( - match UidHashtbl.find_opt uid_to_id x with - | Some id -> Some (Value id, pos_of_loc loc) - | None -> None) - | Definition _, _ -> None) - poses + | Typedtree_traverse.Analysis.Value p, loc -> + process p Ident_env.Path.read_value + |> Option.iter @@ fun l -> + AnnotHashtbl.replace occ_tbl (Value l, pos_of_loc loc) () + | Module p, loc -> + process p Ident_env.Path.read_module + |> Option.iter @@ fun l -> + AnnotHashtbl.replace occ_tbl (Module l, pos_of_loc loc) () + | ClassType p, loc -> + process p Ident_env.Path.read_class_type + |> Option.iter @@ fun l -> + AnnotHashtbl.replace occ_tbl (ClassType l, pos_of_loc loc) () + | ModuleType p, loc -> + process p Ident_env.Path.read_module_type + |> Option.iter @@ fun l -> + AnnotHashtbl.replace occ_tbl (ModuleType l, pos_of_loc loc) () + | Type p, loc -> + process p Ident_env.Path.read_type + |> Option.iter @@ fun l -> + AnnotHashtbl.replace occ_tbl (Type l, pos_of_loc loc) () + | Constructor _p, loc -> + (* process p Ident_env.Path.read_constructor *) + None + |> Option.iter @@ fun l -> + AnnotHashtbl.replace occ_tbl (Constructor l, pos_of_loc loc) () + | LocalDefinition _, _ -> ()) + poses; + AnnotHashtbl.fold (fun k () acc -> k :: acc) occ_tbl [] (* Add definition source info from the [loc_to_id] table *) let add_definitions loc_to_id occurrences = @@ -303,30 +358,32 @@ let add_definitions loc_to_id occurrences = (Odoc_model.Lang.Source_info.Definition id, pos_of_loc loc) :: acc) loc_to_id occurrences -let read_cmt_infos source_id_opt id cmt_info = +let read_cmt_infos source_id_opt id cmt_info ~count_occurrences = match Odoc_model.Compat.shape_of_cmt_infos cmt_info with | Some shape -> ( let uid_to_loc = cmt_info.cmt_uid_to_loc in - match (source_id_opt, cmt_info.cmt_annots) with - | Some source_id, Implementation impl -> + match (source_id_opt, count_occurrences, cmt_info.cmt_annots) with + | (Some _ as source_id), _, Implementation impl + | source_id, true, Implementation impl -> let env = Env.of_structure id impl in let traverse_infos = - Typedtree_traverse.of_cmt env uid_to_loc impl |> List.rev + Typedtree_traverse.of_cmt env impl |> List.rev (* Information are accumulated in a list. We need to have the first info first in the list, to assign anchors with increasing numbers, so that adding some content at the end of a file does not modify the anchors for existing anchors. *) in let loc_to_id = LocHashtbl.create 10 - and ident_to_id = IdentHashtbl.create 10 + and local_ident_to_loc = IdentHashtbl.create 10 and uid_to_id = UidHashtbl.create 10 in let () = (* populate [loc_to_id], [ident_to_id] and [uid_to_id] *) - populate_local_defs source_id traverse_infos loc_to_id ident_to_id; + populate_local_defs source_id traverse_infos loc_to_id + local_ident_to_loc; populate_global_defs env source_id loc_to_id uid_to_loc uid_to_id in let source_infos = - process_occurrences traverse_infos uid_to_id ident_to_id + process_occurrences env traverse_infos loc_to_id local_ident_to_loc |> add_definitions loc_to_id in ( Some (shape, Shape.Uid.Tbl.to_map uid_to_id), @@ -335,12 +392,12 @@ let read_cmt_infos source_id_opt id cmt_info = Odoc_model.Lang.Source_info.id = source_id; infos = source_infos; } ) - | _, _ -> (Some (shape, Odoc_model.Compat.empty_map), None)) + | _, _, _ -> (Some (shape, Odoc_model.Compat.empty_map), None)) | None -> (None, None) #else -let read_cmt_infos _source_id_opt _id _cmt_info = +let read_cmt_infos _source_id_opt _id _cmt_info ~count_occurrences:_ = (None, None) #endif diff --git a/src/loader/implementation.mli b/src/loader/implementation.mli index 49701e6dcc..88acd2030d 100644 --- a/src/loader/implementation.mli +++ b/src/loader/implementation.mli @@ -2,6 +2,7 @@ val read_cmt_infos : Odoc_model.Paths.Identifier.Id.source_page option -> Odoc_model.Paths.Identifier.Id.root_module -> Cmt_format.cmt_infos -> + count_occurrences:bool -> (Odoc_model.Compat.shape * Odoc_model.Paths.Identifier.Id.source_location Odoc_model.Compat.shape_uid_map) diff --git a/src/loader/odoc_loader.ml b/src/loader/odoc_loader.ml index a3f0cb8799..bdb3c177d0 100644 --- a/src/loader/odoc_loader.ml +++ b/src/loader/odoc_loader.ml @@ -42,12 +42,12 @@ exception Not_an_interface exception Make_root_error of string -let read_cmt_infos source_id_opt id ~filename () = +let read_cmt_infos source_id_opt id ~filename ~count_occurrences () = match Cmt_format.read_cmt filename with | exception Cmi_format.Error _ -> raise Corrupted | cmt_info -> ( match cmt_info.cmt_annots with - | Implementation _ -> Implementation.read_cmt_infos source_id_opt id cmt_info + | Implementation _ -> Implementation.read_cmt_infos source_id_opt id cmt_info ~count_occurrences | _ -> raise Not_an_implementation) @@ -99,7 +99,7 @@ let compilation_unit_of_sig ~make_root ~imports ~interface ?sourcefile ~name ~id make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id ?canonical ?shape_info content -let read_cmti ~make_root ~parent ~filename ~cmt_filename_opt ~source_id_opt () = +let read_cmti ~make_root ~parent ~filename ~cmt_filename_opt ~source_id_opt ~count_occurrences () = let cmt_info = Cmt_format.read_cmt filename in match cmt_info.cmt_annots with | Interface intf -> ( @@ -116,15 +116,16 @@ let read_cmti ~make_root ~parent ~filename ~cmt_filename_opt ~source_id_opt () = let shape_info, source_info = match cmt_filename_opt with | Some cmt_filename -> - read_cmt_infos source_id_opt id ~filename:cmt_filename () - | None -> (None, None) + read_cmt_infos source_id_opt id ~filename:cmt_filename ~count_occurrences () + | None -> + (None, None) in compilation_unit_of_sig ~make_root ~imports:cmt_info.cmt_imports ~interface ~sourcefile ~name ~id ?shape_info ~source_info ?canonical sg) | _ -> raise Not_an_interface -let read_cmt ~make_root ~parent ~filename ~source_id_opt () = +let read_cmt ~make_root ~parent ~filename ~source_id_opt ~count_occurrences () = match Cmt_format.read_cmt filename with | exception Cmi_format.Error (Not_an_interface _) -> raise Not_an_implementation @@ -168,7 +169,7 @@ let read_cmt ~make_root ~parent ~filename ~source_id_opt () = | Implementation impl -> let id, sg, canonical = Cmt.read_implementation parent name impl in let shape_info, source_info = - read_cmt_infos source_id_opt id ~filename () + read_cmt_infos source_id_opt id ~filename ~count_occurrences () in compilation_unit_of_sig ~make_root ~imports ~interface ~sourcefile ~name ~id ?canonical ?shape_info ~source_info sg @@ -199,12 +200,12 @@ let wrap_errors ~filename f = | Not_an_interface -> not_an_interface filename | Make_root_error m -> error_msg filename m) -let read_cmti ~make_root ~parent ~filename ~source_id_opt ~cmt_filename_opt = +let read_cmti ~make_root ~parent ~filename ~source_id_opt ~cmt_filename_opt ~count_occurrences = wrap_errors ~filename - (read_cmti ~make_root ~parent ~filename ~source_id_opt ~cmt_filename_opt) + (read_cmti ~make_root ~parent ~filename ~source_id_opt ~cmt_filename_opt ~count_occurrences) -let read_cmt ~make_root ~parent ~filename ~source_id_opt = - wrap_errors ~filename (read_cmt ~make_root ~parent ~filename ~source_id_opt) +let read_cmt ~make_root ~parent ~filename ~source_id_opt ~count_occurrences = + wrap_errors ~filename (read_cmt ~make_root ~parent ~filename ~source_id_opt ~count_occurrences) let read_cmi ~make_root ~parent ~filename = wrap_errors ~filename (read_cmi ~make_root ~parent ~filename) diff --git a/src/loader/odoc_loader.mli b/src/loader/odoc_loader.mli index d60014f300..db0adc302d 100644 --- a/src/loader/odoc_loader.mli +++ b/src/loader/odoc_loader.mli @@ -19,6 +19,7 @@ val read_cmti : filename:string -> source_id_opt:Identifier.SourcePage.t option -> cmt_filename_opt:string option -> + count_occurrences:bool -> (Lang.Compilation_unit.t, Error.t) result Error.with_warnings val read_cmt : @@ -26,6 +27,7 @@ val read_cmt : parent:Identifier.ContainerPage.t option -> filename:string -> source_id_opt:Identifier.SourcePage.t option -> + count_occurrences:bool -> (Lang.Compilation_unit.t, Error.t) result Error.with_warnings val read_cmi : diff --git a/src/loader/typedtree_traverse.ml b/src/loader/typedtree_traverse.ml index 164035bb3b..8b5a96a97f 100644 --- a/src/loader/typedtree_traverse.ml +++ b/src/loader/typedtree_traverse.ml @@ -1,34 +1,44 @@ #if OCAML_VERSION >= (4, 14, 0) module Analysis = struct - type value_implementation = LocalValue of Ident.t | DefJmp of Shape.Uid.t + type annotation = + | LocalDefinition of Ident.t + | Value of Path.t + | Module of Path.t + | ClassType of Path.t + | ModuleType of Path.t + | Type of Path.t + | Constructor of Path.t - type annotation = Definition of Ident.t | Value of value_implementation - - let expr uid_to_loc poses expr = + let expr poses expr = let exp_loc = expr.Typedtree.exp_loc in if exp_loc.loc_ghost then () else match expr.exp_desc with - | Texp_ident (p, _, value_description) -> ( - let implementation = - match - Shape.Uid.Tbl.find_opt uid_to_loc value_description.val_uid - with - | Some _ -> Some (DefJmp value_description.val_uid) - | None -> ( - match p with Pident id -> Some (LocalValue id) | _ -> None) - in - match implementation with - | None -> () - | Some impl -> poses := (Value impl, exp_loc) :: !poses) + | Texp_ident (p, _, _) -> poses := (Value p, exp_loc) :: !poses + | Texp_construct (_, { cstr_res; _ }, _) -> ( + let desc = Types.get_desc cstr_res in + match desc with + | Types.Tconstr (p, _, _) -> + poses := (Constructor p, exp_loc) :: !poses + | _ -> ()) | _ -> () let pat env (type a) poses : a Typedtree.general_pattern -> unit = function | { Typedtree.pat_desc; pat_loc; _ } when not pat_loc.loc_ghost -> + let () = + match pat_desc with + | Typedtree.Tpat_construct (_, { cstr_res; _ }, _, _) -> ( + let desc = Types.get_desc cstr_res in + match desc with + | Types.Tconstr (p, _, _) -> + poses := (Constructor p, pat_loc) :: !poses + | _ -> ()) + | _ -> () + in let maybe_localvalue id loc = match Ident_env.identifier_of_loc env loc with - | None -> Some (Definition id, loc) + | None -> Some (LocalDefinition id, loc) | Some _ -> None in let () = @@ -45,19 +55,85 @@ module Analysis = struct in () | _ -> () + + let module_binding env poses = function + | { Typedtree.mb_id = Some id; mb_loc; _ } when not mb_loc.loc_ghost -> ( + match Ident_env.identifier_of_loc env mb_loc with + | None -> poses := (LocalDefinition id, mb_loc) :: !poses + | Some _ -> ()) + | _ -> () + + let module_expr poses mod_expr = + match mod_expr with + | { Typedtree.mod_desc = Tmod_ident (p, _); mod_loc; _ } + when not mod_loc.loc_ghost -> + poses := (Module p, mod_loc) :: !poses + | _ -> () + + let class_type poses cltyp = + match cltyp with + | { Typedtree.cltyp_desc = Tcty_constr (p, _, _); cltyp_loc; _ } + when not cltyp_loc.loc_ghost -> + poses := (ClassType p, cltyp_loc) :: !poses + | _ -> () + + let module_type poses mty_expr = + match mty_expr with + | { Typedtree.mty_desc = Tmty_ident (p, _); mty_loc; _ } + when not mty_loc.loc_ghost -> + poses := (ModuleType p, mty_loc) :: !poses + | _ -> () + + let core_type poses ctyp_expr = + match ctyp_expr with + | { Typedtree.ctyp_desc = Ttyp_constr (p, _, _); ctyp_loc; _ } + when not ctyp_loc.loc_ghost -> + poses := (Type p, ctyp_loc) :: !poses + | _ -> () end -let of_cmt env uid_to_loc structure = +let of_cmt env structure = let poses = ref [] in + let module_expr iterator mod_expr = + Analysis.module_expr poses mod_expr; + Tast_iterator.default_iterator.module_expr iterator mod_expr + in let expr iterator e = - Analysis.expr uid_to_loc poses e; + Analysis.expr poses e; Tast_iterator.default_iterator.expr iterator e in let pat iterator e = Analysis.pat env poses e; Tast_iterator.default_iterator.pat iterator e in - let iterator = { Tast_iterator.default_iterator with expr; pat } in + let typ iterator ctyp_expr = + Analysis.core_type poses ctyp_expr; + Tast_iterator.default_iterator.typ iterator ctyp_expr + in + let module_type iterator mty = + Analysis.module_type poses mty; + Tast_iterator.default_iterator.module_type iterator mty + in + let class_type iterator cl_type = + Analysis.class_type poses cl_type; + Tast_iterator.default_iterator.class_type iterator cl_type + in + let module_binding iterator mb = + Analysis.module_binding env poses mb; + Tast_iterator.default_iterator.module_binding iterator mb + in + let iterator = + { + Tast_iterator.default_iterator with + expr; + pat; + module_expr; + typ; + module_type; + class_type; + module_binding; + } + in iterator.structure iterator structure; !poses diff --git a/src/model/lang.ml b/src/model/lang.ml index 74c5b66023..dd4abf6a68 100644 --- a/src/model/lang.ml +++ b/src/model/lang.ml @@ -18,15 +18,31 @@ open Paths (** {3 Modules} *) module Source_info = struct + type 'a jump_to_impl = + | Unresolved of 'a + | Resolved of Identifier.SourceLocation.t + + type ('doc, 'impl) jump_to = { + documentation : 'doc option; + implementation : 'impl jump_to_impl option; + } + + type 'path jump_1 = ('path, 'path) jump_to + type annotation = | Definition of Paths.Identifier.SourceLocation.t - | Value of Paths.Identifier.SourceLocation.t + | Value of Path.Value.t jump_1 + | Module of Path.Module.t jump_1 + | ClassType of Path.ClassType.t jump_1 + | ModuleType of Path.ModuleType.t jump_1 + | Type of Path.Type.t jump_1 + | Constructor of Path.Constructor.t jump_1 type 'a with_pos = 'a * (int * int) type infos = annotation with_pos list - type t = { id : Identifier.SourcePage.t; infos : infos } + type t = { id : Identifier.SourcePage.t option; infos : infos } end module rec Module : sig diff --git a/src/model/paths.ml b/src/model/paths.ml index 31e8f2e2df..47225b09fa 100644 --- a/src/model/paths.ml +++ b/src/model/paths.ml @@ -19,6 +19,15 @@ module Ocaml_env = Env open Names +let contains_double_underscore s = + let len = String.length s in + let rec aux i = + if i > len - 2 then false + else if s.[i] = '_' && s.[i + 1] = '_' then true + else aux (i + 1) + in + aux 0 + module Identifier = struct type 'a id = 'a Paths_types.id = { iv : 'a; ihash : int; ikey : string } @@ -66,7 +75,9 @@ module Identifier = struct let rec is_internal : t -> bool = fun x -> match x.iv with - | `Root (_, name) -> ModuleName.is_internal name + | `Root (_, name) -> + ModuleName.is_internal name + || contains_double_underscore (ModuleName.to_string name) | `Page (_, _) -> false | `LeafPage (_, _) -> false | `Module (_, name) -> ModuleName.is_internal name @@ -91,6 +102,36 @@ module Identifier = struct | `SourceLocationInternal _ | `AssetFile _ -> false + let rec is_internal_rec : t -> bool = + fun x -> + is_internal x + || + match x.iv with + | `Root (_, name) -> ModuleName.is_internal name + | `Page (_, _) -> false + | `LeafPage (_, _) -> false + | `Module (parent, _) -> is_internal_rec (parent :> t) + | `Parameter (parent, _) -> is_internal_rec (parent :> t) + | `Result x -> is_internal_rec (x :> t) + | `ModuleType (parent, _) -> is_internal_rec (parent :> t) + | `Type (parent, _) -> is_internal_rec (parent :> t) + | `CoreType name -> TypeName.is_internal name + | `Constructor (parent, _) -> is_internal (parent :> t) + | `Field (parent, _) -> is_internal (parent :> t) + | `Extension (parent, _) -> is_internal (parent :> t) + | `ExtensionDecl (parent, _, _) -> is_internal (parent :> t) + | `Exception (parent, _) -> is_internal (parent :> t) + | `CoreException _ -> false + | `Value (parent, _) -> is_internal_rec (parent :> t) + | `Class (parent, _) -> is_internal_rec (parent :> t) + | `ClassType (parent, _) -> is_internal_rec (parent :> t) + | `Method (parent, _) -> is_internal (parent :> t) + | `InstanceVariable (parent, _) -> is_internal (parent :> t) + | `Label (parent, _) -> is_internal (parent :> t) + | `SourceDir _ | `SourceLocationMod _ | `SourceLocation _ | `SourcePage _ + | `SourceLocationInternal _ | `AssetFile _ -> + false + let name : [< t_pv ] id -> string = fun n -> name_aux (n :> t) let rec full_name_aux : t -> string list = @@ -132,16 +173,19 @@ module Identifier = struct InstanceVariableName.to_string name :: full_name_aux (parent :> t) | `Label (parent, name) -> LabelName.to_string name :: full_name_aux (parent :> t) + | `SourceDir (parent, name) -> name :: full_name_aux (parent :> t) + | `SourceLocation (parent, name) -> + DefName.to_string name :: full_name_aux (parent :> t) + | `SourceLocationInternal (parent, name) -> + LocalName.to_string name :: full_name_aux (parent :> t) + | `SourceLocationMod name -> full_name_aux (name :> t) + | `SourcePage (parent, name) -> name :: full_name_aux (parent :> t) | `AssetFile (parent, name) -> name :: full_name_aux (parent :> t) - | `SourceDir _ | `SourceLocationMod _ | `SourceLocation _ | `SourcePage _ - | `SourceLocationInternal _ -> - [] let fullname : [< t_pv ] id -> string list = fun n -> List.rev @@ full_name_aux (n :> t) let is_internal : [< t_pv ] id -> bool = fun n -> is_internal (n :> t) - let rec label_parent_aux = let open Id in fun (n : non_src) -> @@ -166,7 +210,7 @@ module Identifier = struct | { iv = `Method (p, _); _ } | { iv = `InstanceVariable (p, _); _ } -> (p : class_signature :> label_parent) | { iv = `Constructor (p, _); _ } -> (p : datatype :> label_parent) - | { iv = `Field (p, _); _ } -> (p : parent :> label_parent) + | { iv = `Field (p, _); _ } -> (p : field_parent :> label_parent) let label_parent n = label_parent_aux (n :> Id.non_src) @@ -217,9 +261,9 @@ module Identifier = struct type t_pv = Id.datatype_pv end - module Parent = struct - type t = Id.parent - type t_pv = Id.parent_pv + module FieldParent = struct + type t = Paths_types.Identifier.field_parent + type t_pv = Paths_types.Identifier.field_parent_pv end module LabelParent = struct @@ -572,13 +616,14 @@ module Identifier = struct mk_fresh (fun s -> s) "coret" (fun s -> `CoreType (TypeName.make_std s)) let constructor : - Type.t * ConstructorName.t -> - [> `Constructor of Type.t * ConstructorName.t ] id = + DataType.t * ConstructorName.t -> + [> `Constructor of DataType.t * ConstructorName.t ] id = mk_parent ConstructorName.to_string "ctor" (fun (p, n) -> `Constructor (p, n)) let field : - Parent.t * FieldName.t -> [> `Field of Parent.t * FieldName.t ] id = + FieldParent.t * FieldName.t -> + [> `Field of FieldParent.t * FieldName.t ] id = mk_parent FieldName.to_string "fld" (fun (p, n) -> `Field (p, n)) let extension : @@ -667,7 +712,7 @@ module Path = struct | `Identifier { iv = `Module (_, m); _ } when Names.ModuleName.is_internal m -> true - | `Identifier _ -> false + | `Identifier i -> Identifier.is_internal_rec i | `Canonical (_, `Resolved _) -> false | `Canonical (x, _) -> (not weak_canonical_test) && inner (x : module_ :> any) @@ -704,15 +749,6 @@ module Path = struct in inner x - and contains_double_underscore s = - let len = String.length s in - let rec aux i = - if i > len - 2 then false - else if s.[i] = '_' && s.[i + 1] = '_' then true - else aux (i + 1) - in - aux 0 - and is_path_hidden : Paths_types.Path.any -> bool = let open Paths_types.Path in function @@ -991,30 +1027,32 @@ module Reference = struct | `ClassType (sg, s) -> Identifier.Mk.class_type (parent_signature_identifier sg, s) - and parent_identifier : parent -> Identifier.Parent.t = function + and field_parent_identifier : field_parent -> Identifier.FieldParent.t = + function | `Identifier id -> id | (`Hidden _ | `Alias _ | `AliasModuleType _ | `Module _ | `ModuleType _) as sg -> - (parent_signature_identifier sg :> Identifier.Parent.t) - | `Type _ as t -> (parent_type_identifier t :> Identifier.Parent.t) - | (`Class _ | `ClassType _) as c -> - (parent_class_signature_identifier c :> Identifier.Parent.t) + (parent_signature_identifier sg :> Identifier.FieldParent.t) + | `Type _ as t -> (parent_type_identifier t :> Identifier.FieldParent.t) and label_parent_identifier : label_parent -> Identifier.LabelParent.t = function | `Identifier id -> id + | (`Class _ | `ClassType _) as c -> + (parent_class_signature_identifier c :> Identifier.LabelParent.t) | ( `Hidden _ | `Alias _ | `AliasModuleType _ | `Module _ | `ModuleType _ - | `Type _ | `Class _ | `ClassType _ ) as r -> - (parent_identifier r :> Identifier.LabelParent.t) + | `Type _ ) as r -> + (field_parent_identifier r :> Identifier.LabelParent.t) and identifier : t -> Identifier.t = function | `Identifier id -> id | ( `Alias _ | `AliasModuleType _ | `Module _ | `Hidden _ | `Type _ | `Class _ | `ClassType _ | `ModuleType _ ) as r -> (label_parent_identifier r :> Identifier.t) - | `Field (p, n) -> Identifier.Mk.field (parent_identifier p, n) + | `Field (p, n) -> Identifier.Mk.field (field_parent_identifier p, n) | `Constructor (s, n) -> - Identifier.Mk.constructor (parent_type_identifier s, n) + Identifier.Mk.constructor + ((parent_type_identifier s :> Identifier.DataType.t), n) | `Extension (p, q) -> Identifier.Mk.extension (parent_signature_identifier p, q) | `ExtensionDecl (p, q, r) -> @@ -1041,8 +1079,8 @@ module Reference = struct type t = Paths_types.Resolved_reference.datatype end - module Parent = struct - type t = Paths_types.Resolved_reference.parent + module FieldParent = struct + type t = Paths_types.Resolved_reference.field_parent end module LabelParent = struct @@ -1126,8 +1164,8 @@ module Reference = struct type t = Paths_types.Reference.datatype end - module Parent = struct - type t = Paths_types.Reference.parent + module FragmentTypeParent = struct + type t = Paths_types.Reference.fragment_type_parent end module LabelParent = struct diff --git a/src/model/paths.mli b/src/model/paths.mli index 901a0c8df7..f52538ba73 100644 --- a/src/model/paths.mli +++ b/src/model/paths.mli @@ -79,9 +79,9 @@ module Identifier : sig type t = Id.datatype type t_pv = Id.datatype_pv end - module Parent : sig - type t = Id.parent - type t_pv = Id.parent_pv + module FieldParent : sig + type t = Id.field_parent + type t_pv = Id.field_parent_pv end module FunctorResult : sig @@ -206,8 +206,6 @@ module Identifier : sig val name : [< t_pv ] id -> string - (* val root : [< t_pv ] id -> RootModule.t_pv id option *) - val fullname : [< t_pv ] id -> string list (** The fullname of value [x] in module [M] is [M.x], whereas the regular name is [x]. *) @@ -290,11 +288,12 @@ module Identifier : sig val core_type : string -> [> `CoreType of TypeName.t ] id val constructor : - Type.t * ConstructorName.t -> - [> `Constructor of Type.t * ConstructorName.t ] id + DataType.t * ConstructorName.t -> + [> `Constructor of DataType.t * ConstructorName.t ] id val field : - Parent.t * FieldName.t -> [> `Field of Parent.t * FieldName.t ] id + FieldParent.t * FieldName.t -> + [> `Field of FieldParent.t * FieldName.t ] id val extension : Signature.t * ExtensionName.t -> @@ -383,12 +382,6 @@ module rec Path : sig module Value : sig type t = Paths_types.Resolved_path.value - - (* val of_ident : Identifier.Path.Value.t -> t *) - - (* val is_hidden : t -> bool *) - - (* val identifier : t -> Identifier.Path.Type.t *) end module ClassType : sig @@ -507,8 +500,8 @@ module rec Reference : sig type t = Paths_types.Resolved_reference.datatype end - module Parent : sig - type t = Paths_types.Resolved_reference.parent + module FieldParent : sig + type t = Paths_types.Resolved_reference.field_parent end module LabelParent : sig @@ -592,8 +585,8 @@ module rec Reference : sig type t = Paths_types.Reference.datatype end - module Parent : sig - type t = Paths_types.Reference.parent + module FragmentTypeParent : sig + type t = Paths_types.Reference.fragment_type_parent end module LabelParent : sig diff --git a/src/model/paths_types.ml b/src/model/paths_types.ml index 1fd7fb2cc7..8c61ca316c 100644 --- a/src/model/paths_types.ml +++ b/src/model/paths_types.ml @@ -81,13 +81,16 @@ module Identifier = struct and datatype = datatype_pv id (** @canonical Odoc_model.Paths.Identifier.DataType.t *) - type parent_pv = [ signature_pv | datatype_pv | class_signature_pv ] - (** @canonical Odoc_model.Paths.Identifier.Parent.t_pv *) + type field_parent_pv = [ signature_pv | datatype_pv ] + (** @canonical Odoc_model.Paths.Identifier.FieldParent.t_pv *) - and parent = parent_pv id - (** @canonical Odoc_model.Paths.Identifier.Parent.t *) + (* fragment_type_parent in identifiers is for record fields parent. It’s type + (for usual record fields) or [signature] for fields of inline records of + extension constructor. *) + and field_parent = field_parent_pv id + (** @canonical Odoc_model.Paths.Identifier.FieldParent.t *) - type label_parent_pv = [ parent_pv | page_pv ] + type label_parent_pv = [ field_parent_pv | page_pv | class_signature_pv ] (** @canonical Odoc_model.Paths.Identifier.LabelParent.t_pv *) and label_parent = label_parent_pv id @@ -132,13 +135,13 @@ module Identifier = struct and type_ = type_pv id (** @canonical Odoc_model.Paths.Identifier.Type.t *) - type constructor_pv = [ `Constructor of type_ * ConstructorName.t ] + type constructor_pv = [ `Constructor of datatype * ConstructorName.t ] (** @canonical Odoc_model.Paths.Identifier.Constructor.t_pv *) and constructor = constructor_pv id (** @canonical Odoc_model.Paths.Identifier.Constructor.t *) - type field_pv = [ `Field of parent * FieldName.t ] + type field_pv = [ `Field of field_parent * FieldName.t ] (** @canonical Odoc_model.Paths.Identifier.Field.t_pv *) and field = field_pv id @@ -206,7 +209,7 @@ module Identifier = struct [ signature_pv | class_signature_pv | datatype_pv - | parent_pv + | field_parent_pv | label_parent_pv | module_pv | functor_parameter_pv @@ -349,7 +352,10 @@ module rec Path : sig [ `Resolved of Resolved_path.constructor | `Dot of datatype * string ] (** @canonical Odoc_model.Paths.Path.Constructor.t *) - type value = [ `Resolved of Resolved_path.value | `Dot of module_ * string ] + type value = + [ `Resolved of Resolved_path.value + | `Identifier of Identifier.path_value * bool + | `Dot of module_ * string ] (** @canonical Odoc_model.Paths.Path.Value.t *) type class_type = @@ -407,7 +413,8 @@ and Resolved_path : sig type constructor = [ `Constructor of datatype * ConstructorName.t ] (** @canonical Odoc_model.Paths.Path.Resolved.Constructor.t *) - type value = [ `Value of module_ * ValueName.t ] + type value = + [ `Identifier of Identifier.path_value | `Value of module_ * ValueName.t ] (** @canonical Odoc_model.Paths.Path.Resolved.Value.t *) type class_type = @@ -580,8 +587,7 @@ module rec Reference : sig type tag_datatype = [ `TUnknown | `TType ] - type tag_parent = - [ `TUnknown | `TModule | `TModuleType | `TClass | `TClassType | `TType ] + type tag_parent = [ `TUnknown | `TModule | `TModuleType | `TType ] type tag_label_parent = [ `TUnknown @@ -617,16 +623,15 @@ module rec Reference : sig | `Type of signature * TypeName.t ] (** @canonical Odoc_model.Paths.Reference.DataType.t *) - and parent = - [ `Resolved of Resolved_reference.parent + (* Parent of fields and constructor. Can be either a type or [signature] *) + and fragment_type_parent = + [ `Resolved of Resolved_reference.field_parent | `Root of string * tag_parent | `Dot of label_parent * string | `Module of signature * ModuleName.t | `ModuleType of signature * ModuleTypeName.t - | `Class of signature * ClassName.t - | `ClassType of signature * ClassTypeName.t | `Type of signature * TypeName.t ] - (** @canonical Odoc_model.Paths.Reference.Parent.t *) + (** @canonical Odoc_model.Paths.Reference.FragmentTypeParent.t *) and label_parent = [ `Resolved of Resolved_reference.label_parent @@ -666,7 +671,7 @@ module rec Reference : sig [ `Resolved of Resolved_reference.constructor | `Root of string * [ `TConstructor | `TExtension | `TException | `TUnknown ] | `Dot of label_parent * string - | `Constructor of datatype * ConstructorName.t + | `Constructor of fragment_type_parent * ConstructorName.t | `Extension of signature * ExtensionName.t | `Exception of signature * ExceptionName.t ] (** @canonical Odoc_model.Paths.Reference.Constructor.t *) @@ -675,7 +680,7 @@ module rec Reference : sig [ `Resolved of Resolved_reference.field | `Root of string * [ `TField | `TUnknown ] | `Dot of label_parent * string - | `Field of parent * FieldName.t ] + | `Field of fragment_type_parent * FieldName.t ] (** @canonical Odoc_model.Paths.Reference.Field.t *) type extension = @@ -756,8 +761,8 @@ module rec Reference : sig | `Module of signature * ModuleName.t | `ModuleType of signature * ModuleTypeName.t | `Type of signature * TypeName.t - | `Constructor of datatype * ConstructorName.t - | `Field of parent * FieldName.t + | `Constructor of fragment_type_parent * ConstructorName.t + | `Field of fragment_type_parent * FieldName.t | `Extension of signature * ExtensionName.t | `ExtensionDecl of signature * ExtensionName.t | `Exception of signature * ExceptionName.t @@ -805,18 +810,18 @@ and Resolved_reference : sig | `ClassType of signature * ClassTypeName.t ] (** @canonical Odoc_model.Paths.Reference.Resolved.ClassSignature.t *) - (* parent is [ signature | class_signature ] *) - and parent = - [ `Identifier of Identifier.parent + (* fragment_type_parent in resolved references is for record fields parent. + It’s type (for usual record fields) or [signature] for fields of inline + records of extension constructor. *) + and field_parent = + [ `Identifier of Identifier.field_parent | `Alias of Resolved_path.module_ * module_ | `AliasModuleType of Resolved_path.module_type * module_type | `Module of signature * ModuleName.t | `Hidden of module_ | `ModuleType of signature * ModuleTypeName.t - | `Class of signature * ClassName.t - | `ClassType of signature * ClassTypeName.t | `Type of signature * TypeName.t ] - (** @canonical Odoc_model.Paths.Reference.Resolved.Parent.t *) + (** @canonical Odoc_model.Paths.Reference.Resolved.FragmentTypeParent.t *) (* The only difference between parent and label_parent is that the Identifier allows more types *) @@ -854,7 +859,7 @@ and Resolved_reference : sig type field = [ `Identifier of Identifier.reference_field - | `Field of parent * FieldName.t ] + | `Field of field_parent * FieldName.t ] (** @canonical Odoc_model.Paths.Reference.Resolved.Field.t *) type extension = @@ -921,7 +926,7 @@ and Resolved_reference : sig | `ModuleType of signature * ModuleTypeName.t | `Type of signature * TypeName.t | `Constructor of datatype * ConstructorName.t - | `Field of parent * FieldName.t + | `Field of field_parent * FieldName.t | `Extension of signature * ExtensionName.t | `ExtensionDecl of signature * ExtensionName.t * ExtensionName.t | `Exception of signature * ExceptionName.t diff --git a/src/model/reference.ml b/src/model/reference.ml index 57e690ad1c..1f9b98c5a6 100644 --- a/src/model/reference.ml +++ b/src/model/reference.ml @@ -214,18 +214,15 @@ let parse whole_reference_location s : | _ -> expected [ "module"; "module-type" ] location |> Error.raise_exception) - and parent (kind, identifier, location) tokens : Parent.t = + and parent (kind, identifier, location) tokens : FragmentTypeParent.t = let kind = match_reference_kind location kind in match tokens with | [] -> ( match kind with - | (`TUnknown | `TModule | `TModuleType | `TType | `TClass | `TClassType) - as kind -> + | (`TUnknown | `TModule | `TModuleType | `TType) as kind -> `Root (identifier, kind) | _ -> - expected - [ "module"; "module-type"; "type"; "class"; "class-type" ] - location + expected [ "module"; "module-type"; "type" ] location |> Error.raise_exception) | next_token :: tokens -> ( match kind with @@ -238,15 +235,8 @@ let parse whole_reference_location s : (signature next_token tokens, ModuleTypeName.make_std identifier) | `TType -> `Type (signature next_token tokens, TypeName.make_std identifier) - | `TClass -> - `Class (signature next_token tokens, ClassName.make_std identifier) - | `TClassType -> - `ClassType - (signature next_token tokens, ClassTypeName.make_std identifier) | _ -> - expected - [ "module"; "module-type"; "type"; "class"; "class-type" ] - location + expected [ "module"; "module-type"; "type" ] location |> Error.raise_exception) in @@ -273,22 +263,6 @@ let parse whole_reference_location s : ) in - let datatype (kind, identifier, location) tokens : DataType.t = - let kind = match_reference_kind location kind in - match tokens with - | [] -> ( - match kind with - | (`TUnknown | `TType) as kind -> `Root (identifier, kind) - | _ -> expected [ "type" ] location |> Error.raise_exception) - | next_token :: tokens -> ( - match kind with - | `TUnknown -> - `Dot ((parent next_token tokens :> LabelParent.t), identifier) - | `TType -> - `Type (signature next_token tokens, TypeName.make_std identifier) - | _ -> expected [ "type" ] location |> Error.raise_exception) - in - let rec label_parent (kind, identifier, location) tokens : LabelParent.t = let kind = match_reference_kind location kind in match tokens with @@ -360,7 +334,7 @@ let parse whole_reference_location s : `Type (signature next_token tokens, TypeName.make_std identifier) | `TConstructor -> `Constructor - (datatype next_token tokens, ConstructorName.make_std identifier) + (parent next_token tokens, ConstructorName.make_std identifier) | `TField -> `Field (parent next_token tokens, FieldName.make_std identifier) | `TExtension -> diff --git a/src/model_desc/lang_desc.ml b/src/model_desc/lang_desc.ml index 56c96bc008..491fee961c 100644 --- a/src/model_desc/lang_desc.ml +++ b/src/model_desc/lang_desc.ml @@ -18,7 +18,7 @@ let inline_status = let source_info = let open Lang.Source_info in - Record [ F ("id", (fun t -> t.id), identifier) ] + Record [ F ("id", (fun t -> t.id), Option identifier) ] (** {3 Module} *) diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index 0251f7a5af..70d9cc6b8c 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -184,7 +184,7 @@ end = struct let compile hidden directories resolve_fwd_refs dst package_opt parent_name_opt open_modules children input warnings_options - source_parent_file source_name cmt_filename_opt = + source_parent_file source_name cmt_filename_opt count_occurrences = let open Or_error in let resolver = Resolver.create ~important_digests:(not resolve_fwd_refs) ~directories @@ -220,7 +220,7 @@ end = struct source >>= fun source -> Fs.Directory.mkdir_p (Fs.File.dirname output); Compile.compile ~resolver ~parent_cli_spec ~hidden ~children ~output - ~warnings_options ~source ~cmt_filename_opt input + ~warnings_options ~source ~cmt_filename_opt ~count_occurrences input let input = let doc = "Input $(i,.cmti), $(i,.cmt), $(i,.cmi) or $(i,.mld) file." in @@ -293,11 +293,18 @@ end = struct let doc = "Try resolving forward references." in Arg.(value & flag & info ~doc [ "r"; "resolve-fwd-refs" ]) in + let count_occurrences = + let doc = + "Count occurrences in implementation. Useful in search ranking." + in + Arg.(value & flag & info ~doc [ "count-occurrences" ]) + in Term.( const handle_error $ (const compile $ hidden $ odoc_file_directories $ resolve_fwd_refs $ dst $ package_opt $ parent_opt $ open_modules $ children $ input - $ warnings_options $ source_parent_file $ source_name $ source_cmt)) + $ warnings_options $ source_parent_file $ source_name $ source_cmt + $ count_occurrences)) let info ~docs = let man = @@ -1104,6 +1111,80 @@ module Targets = struct end end +module Occurrences = struct + module Count = struct + let count directories dst warnings_options include_hidden = + let dst = Fpath.v dst in + Occurrences.count ~dst ~warnings_options directories include_hidden + + let cmd = + let dst = + let doc = "Output file path." in + Arg.( + required + & opt (some string) None + & info ~docs ~docv:"PATH" ~doc [ "o" ]) + in + let include_hidden = + let doc = "Include hidden identifiers in the table" in + Arg.(value & flag & info ~docs ~doc [ "include-hidden" ]) + in + Term.( + const handle_error + $ (const count $ odoc_file_directories $ dst $ warnings_options + $ include_hidden)) + + let info ~docs = + let doc = + "Generate a hashtable mapping identifiers to number of occurrences, as \ + computed from the implementations of .odocl files found in the given \ + directories." + in + Term.info "count-occurrences" ~docs ~doc + end + module Aggregate = struct + let index dst files file_list warnings_options = + match (files, file_list) with + | [], [] -> + Error + (`Msg + "At least one of --file-list or a path to a file must be passed \ + to odoc aggregate-occurrences") + | _ -> + let dst = Fpath.v dst in + Occurrences.aggregate ~dst ~warnings_options files file_list + + let cmd = + let dst = + let doc = "Output file path." in + Arg.( + required + & opt (some string) None + & info ~docs ~docv:"PATH" ~doc [ "o" ]) + in + let inputs_in_file = + let doc = + "Input text file containing a line-separated list of paths to files \ + created with count-occurrences." + in + Arg.( + value & opt_all convert_fpath [] + & info ~doc ~docv:"FILE" [ "file-list" ]) + in + let inputs = + let doc = "file created with count-occurrences" in + Arg.(value & pos_all convert_fpath [] & info ~doc ~docv:"FILE" []) + in + Term.( + const handle_error + $ (const index $ dst $ inputs $ inputs_in_file $ warnings_options)) + + let info ~docs = + let doc = "Aggregate hashtables created with odoc count-occurrences." in + Term.info "aggregate-occurrences" ~docs ~doc + end +end + module Odoc_error = struct let errors input = let open Odoc_odoc in @@ -1144,6 +1225,8 @@ let () = Printexc.record_backtrace true; let subcommands = [ + Occurrences.Count.(cmd, info ~docs:section_pipeline); + Occurrences.Aggregate.(cmd, info ~docs:section_pipeline); Compile.(cmd, info ~docs:section_pipeline); Odoc_link.(cmd, info ~docs:section_pipeline); Odoc_html.generate ~docs:section_pipeline; diff --git a/src/odoc/compile.ml b/src/odoc/compile.ml index 5429c353bf..51244fdf0a 100644 --- a/src/odoc/compile.ml +++ b/src/odoc/compile.ml @@ -99,16 +99,17 @@ let resolve_imports resolver imports = (** Raises warnings and errors. *) let resolve_and_substitute ~resolver ~make_root ~source_id_opt ~cmt_filename_opt ~hidden (parent : Paths.Identifier.ContainerPage.t option) input_file - input_type = + input_type ~count_occurrences = let filename = Fs.File.to_string input_file in let unit = match input_type with | `Cmti -> Odoc_loader.read_cmti ~make_root ~parent ~filename ~source_id_opt - ~cmt_filename_opt + ~cmt_filename_opt ~count_occurrences |> Error.raise_errors_and_warnings | `Cmt -> Odoc_loader.read_cmt ~make_root ~parent ~filename ~source_id_opt + ~count_occurrences |> Error.raise_errors_and_warnings | `Cmi -> Odoc_loader.read_cmi ~make_root ~parent ~filename @@ -250,7 +251,7 @@ let handle_file_ext ext = Error (`Msg "Unknown extension, expected one of: cmti, cmt, cmi or mld.") let compile ~resolver ~parent_cli_spec ~hidden ~children ~output - ~warnings_options ~source ~cmt_filename_opt input = + ~warnings_options ~source ~cmt_filename_opt ~count_occurrences input = parent resolver parent_cli_spec >>= fun parent_spec -> let ext = Fs.File.get_ext input in if ext = ".mld" then @@ -296,7 +297,7 @@ let compile ~resolver ~parent_cli_spec ~hidden ~children ~output let result = Error.catch_errors_and_warnings (fun () -> resolve_and_substitute ~resolver ~make_root ~hidden ~source_id_opt - ~cmt_filename_opt parent input input_type) + ~cmt_filename_opt ~count_occurrences parent input input_type) in (* Extract warnings to write them into the output file *) let _, warnings = Error.unpack_warnings result in diff --git a/src/odoc/compile.mli b/src/odoc/compile.mli index 602d9d5724..7d2755cbf6 100644 --- a/src/odoc/compile.mli +++ b/src/odoc/compile.mli @@ -43,6 +43,7 @@ val compile : warnings_options:Odoc_model.Error.warnings_options -> source:(Fpath.t * string list) option -> cmt_filename_opt:string option -> + count_occurrences:bool -> Fs.File.t -> (unit, [> msg ]) result (** Produces .odoc files out of [.cm{i,t,ti}] or .mld files. *) diff --git a/src/odoc/html_page.ml b/src/odoc/html_page.ml index b0c790416a..c316899694 100644 --- a/src/odoc/html_page.ml +++ b/src/odoc/html_page.ml @@ -39,7 +39,7 @@ let render { html_config; source = _; assets = _ } page = let source_documents source_info source ~syntax = match (source_info, source) with - | Some { Lang.Source_info.id; infos }, Some src -> ( + | Some { Lang.Source_info.id = Some id; infos }, Some src -> ( let file = match src with | Source.File f -> f @@ -68,7 +68,7 @@ let source_documents source_info source ~syntax = Odoc_document.Renderer.document_of_source ~syntax id syntax_info infos source_code; ]) - | Some { id; _ }, None -> + | Some { id = Some id; _ }, None -> let filename = Paths.Identifier.name id in Error.raise_warning (Error.filename_only @@ -77,14 +77,14 @@ let source_documents source_info source ~syntax = --source-name" filename); [] - | None, Some src -> + | _, Some src -> Error.raise_warning (Error.filename_only "--source argument is invalid on compilation unit that were not \ compiled with --source-parent and --source-name" (Source.to_string src)); [] - | None, None -> [] + | _, None -> [] let list_filter_map f lst = List.rev diff --git a/src/odoc/occurrences.ml b/src/odoc/occurrences.ml new file mode 100644 index 0000000000..9922257112 --- /dev/null +++ b/src/odoc/occurrences.ml @@ -0,0 +1,203 @@ +open Or_error + +let handle_file file ~f = + Odoc_file.load file + |> Result.map @@ fun unit' -> + match unit' with + | { Odoc_file.content = Unit_content unit; _ } -> Some (f unit) + | _ -> None + +let fold_dirs ~dirs ~f ~init = + dirs + |> List.fold_left + (fun acc dir -> + acc >>= fun acc -> + Fs.Directory.fold_files_rec_result ~ext:"odocl" + (fun acc file -> + file |> handle_file ~f:(f acc) >>= function + | None -> Ok acc + | Some acc -> Ok acc) + acc dir) + (Ok init) + +module H = Hashtbl.Make (Odoc_model.Paths.Identifier) + +module Occtbl : sig + type item = { direct : int; indirect : int; sub : item H.t } + type t = item H.t + type key = Odoc_model.Paths.Identifier.t + val v : unit -> t + + val add : t -> key -> unit + + val iter : (key -> item -> unit) -> t -> unit + + val get : t -> key -> item option +end = struct + type item = { direct : int; indirect : int; sub : item H.t } + type t = item H.t + type key = Odoc_model.Paths.Identifier.t + + let v_item () = { direct = 0; indirect = 0; sub = H.create 0 } + + let v () = H.create 0 + + let add tbl id = + let rec add ?(kind = `Indirect) id = + let incr htbl id = + let { direct; indirect; sub } = + match H.find_opt htbl id with Some n -> n | None -> v_item () + in + let direct, indirect = + match kind with + | `Direct -> (direct + 1, indirect) + | `Indirect -> (direct, indirect + 1) + in + H.replace htbl id { direct; indirect; sub }; + sub + in + let do_ parent = + let htbl = add (parent :> key) in + incr htbl id + in + match id.iv with + | `InstanceVariable (parent, _) -> do_ parent + | `Parameter (parent, _) -> do_ parent + | `Module (parent, _) -> do_ parent + | `ModuleType (parent, _) -> do_ parent + | `Method (parent, _) -> do_ parent + | `Field (parent, _) -> do_ parent + | `Extension (parent, _) -> do_ parent + | `Type (parent, _) -> do_ parent + | `CoreType _ -> incr tbl id + | `Constructor (parent, _) -> do_ parent + | `Exception (parent, _) -> do_ parent + | `ExtensionDecl (parent, _, _) -> do_ parent + | `Class (parent, _) -> do_ parent + | `Value (parent, _) -> do_ parent + | `ClassType (parent, _) -> do_ parent + | `Root _ -> incr tbl id + | `SourcePage _ | `Page _ | `LeafPage _ | `SourceLocation _ + | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _ + | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ -> + assert false + in + let _htbl = add ~kind:`Direct id in + () + + let rec get t id = + let ( >>= ) = Option.bind in + let do_ parent = + get t (parent :> key) >>= fun { sub; _ } -> H.find_opt sub id + in + match id.iv with + | `InstanceVariable (parent, _) -> do_ parent + | `Parameter (parent, _) -> do_ parent + | `Module (parent, _) -> do_ parent + | `ModuleType (parent, _) -> do_ parent + | `Method (parent, _) -> do_ parent + | `Field (parent, _) -> do_ parent + | `Extension (parent, _) -> do_ parent + | `ExtensionDecl (parent, _, _) -> do_ parent + | `Type (parent, _) -> do_ parent + | `Constructor (parent, _) -> do_ parent + | `Exception (parent, _) -> do_ parent + | `Class (parent, _) -> do_ parent + | `Value (parent, _) -> do_ parent + | `ClassType (parent, _) -> do_ parent + | `Root _ -> H.find_opt t id + | `SourcePage _ | `Page _ | `LeafPage _ | `CoreType _ | `SourceLocation _ + | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _ + | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ -> + assert false + + let rec iter f tbl = + H.iter + (fun id v -> + iter f v.sub; + f id v) + tbl +end + +let count ~dst ~warnings_options:_ directories include_hidden = + let htbl = H.create 100 in + let f () (unit : Odoc_model.Lang.Compilation_unit.t) = + let incr tbl p = + let p = (p :> Odoc_model.Paths.Path.Resolved.t) in + let id = Odoc_model.Paths.Path.Resolved.identifier p in + if (not (Odoc_model.Paths.Path.Resolved.is_hidden p)) || include_hidden + then Occtbl.add tbl id + in + let () = + List.iter + (function + | ( Odoc_model.Lang.Source_info.Module + { documentation = Some (`Resolved p); _ }, + _ ) -> + incr htbl p + | Value { documentation = Some (`Resolved p); _ }, _ -> incr htbl p + | ClassType { documentation = Some (`Resolved p); _ }, _ -> + incr htbl p + | ModuleType { documentation = Some (`Resolved p); _ }, _ -> + incr htbl p + | Type { documentation = Some (`Resolved p); _ }, _ -> incr htbl p + | _ -> ()) + (match unit.source_info with None -> [] | Some i -> i.infos) + in + () + in + fold_dirs ~dirs:directories ~f ~init:() >>= fun () -> + Fs.Directory.mkdir_p (Fs.File.dirname dst); + let oc = open_out_bin (Fs.File.to_string dst) in + Marshal.to_channel oc htbl []; + Ok () + +open Astring +open Or_error + +let parse_input_file input = + let is_sep = function '\n' | '\r' -> true | _ -> false in + Fs.File.read input >>= fun content -> + let files = + String.fields ~empty:false ~is_sep content |> List.rev_map Fs.File.of_string + in + Ok files + +let parse_input_files input = + List.fold_left + (fun acc file -> + acc >>= fun acc -> + parse_input_file file >>= fun files -> Ok (files :: acc)) + (Ok []) input + >>= fun files -> Ok (List.concat files) + +let aggregate files file_list ~warnings_options:_ ~dst = + parse_input_files file_list >>= fun new_files -> + let files = files @ new_files in + let from_file file : Occtbl.t = + let ic = open_in_bin (Fs.File.to_string file) in + Marshal.from_channel ic + in + let rec loop n f = + if n > 0 then ( + f (); + loop (n - 1) f) + else () + in + let occtbl = + match files with + | [] -> H.create 0 + | file1 :: files -> + let acc = from_file file1 in + List.iter + (fun file -> + Occtbl.iter + (fun id { direct; _ } -> + loop direct (fun () -> Occtbl.add acc id)) + (from_file file)) + files; + acc + in + let oc = open_out_bin (Fs.File.to_string dst) in + Marshal.to_channel oc occtbl []; + Ok () diff --git a/src/odoc/odoc_link.ml b/src/odoc/odoc_link.ml index 5762db39f3..5eed7dea36 100644 --- a/src/odoc/odoc_link.ml +++ b/src/odoc/odoc_link.ml @@ -8,13 +8,7 @@ let link_unit ~resolver ~filename m = let open Odoc_model in let open Lang.Compilation_unit in let m = - if Root.Odoc_file.hidden m.root.file then - { - m with - content = Module { items = []; compiled = false; doc = [] }; - expansion = None; - } - else m + if Root.Odoc_file.hidden m.root.file then { m with expansion = None } else m in let env = Resolver.build_link_env_for_unit resolver m in Odoc_xref2.Link.link ~filename env m diff --git a/src/xref2/compile.ml b/src/xref2/compile.ml index 716222eb63..4aeebe29b3 100644 --- a/src/xref2/compile.ml +++ b/src/xref2/compile.ml @@ -90,7 +90,28 @@ let rec unit env t = and source_info env si = { si with infos = source_info_infos env si.infos } -and source_info_infos _env infos = infos +and source_info_infos env infos = + let open Source_info in + let map_doc f v = + let documentation = + match v.documentation with Some p -> Some (f p) | None -> None + in + { v with documentation } + in + List.map + (function + | v, pos -> + let v = + match v with + | Value v -> Value (map_doc (value_path env) v) + | Module v -> Module (map_doc (module_path env) v) + | ModuleType v -> ModuleType (map_doc (module_type_path env) v) + | Type v -> Type (map_doc (type_path env) v) + | Constructor v -> Constructor (map_doc (constructor_path env) v) + | i -> i + in + (v, pos)) + infos and content env id = let open Compilation_unit in @@ -103,7 +124,7 @@ and content env id = and value_ env parent t = let open Value in - let container = (parent :> Id.Parent.t) in + let container = (parent :> Id.LabelParent.t) in try { t with type_ = type_expression env container t.type_ } with _ -> Errors.report ~what:(`Value t.id) `Compile; @@ -111,14 +132,14 @@ and value_ env parent t = and exception_ env parent e = let open Exception in - let container = (parent :> Id.Parent.t) in + let container = (parent :> Id.LabelParent.t) in let res = Opt.map (type_expression env container) e.res in let args = type_decl_constructor_argument env container e.args in { e with res; args } and extension env parent t = let open Extension in - let container = (parent :> Id.Parent.t) in + let container = (parent :> Id.LabelParent.t) in let constructor c = let open Constructor in { @@ -133,7 +154,7 @@ and extension env parent t = and class_type_expr env parent = let open ClassType in - let container = (parent :> Id.Parent.t) in + let container = (parent :> Id.LabelParent.t) in function | Constr (path, texps) -> Constr @@ -169,7 +190,7 @@ and class_type env c = and class_signature env parent c = let open ClassSignature in - let container = (parent : Id.ClassSignature.t :> Id.Parent.t) in + let container = (parent : Id.ClassSignature.t :> Id.LabelParent.t) in let env = Env.open_class_signature c env in let map_item = function | Method m -> Method (method_ env parent m) @@ -186,12 +207,12 @@ and class_signature env parent c = and method_ env parent m = let open Method in - let container = (parent :> Id.Parent.t) in + let container = (parent :> Id.LabelParent.t) in { m with type_ = type_expression env container m.type_ } and instance_variable env parent i = let open InstanceVariable in - let container = (parent :> Id.Parent.t) in + let container = (parent :> Id.LabelParent.t) in { i with type_ = type_expression env container i.type_ } and class_constraint env parent cst = @@ -208,7 +229,7 @@ and inherit_ env parent ih = and class_ env parent c = let open Class in - let container = (parent :> Id.Parent.t) in + let container = (parent :> Id.LabelParent.t) in let expansion = match let open Utils.OptionMonad in @@ -513,7 +534,7 @@ and module_type_expr_sub id ~fragment_root (sg_res, env, subs) lsub = Errors.report ~what:(`With_type cfrag) `Compile; (cfrag, frag) in - let eqn' = type_decl_equation env (id :> Id.Parent.t) eqn in + let eqn' = type_decl_equation env (id :> Id.LabelParent.t) eqn in let ceqn' = Component.Of_Lang.(type_equation (empty ()) eqn') in Tools.fragmap ~mark_substituted:true env (Component.ModuleType.TypeEq (cfrag', ceqn')) @@ -556,7 +577,7 @@ and module_type_expr_sub id ~fragment_root (sg_res, env, subs) lsub = Errors.report ~what:(`With_type cfrag) `Compile; (cfrag, frag) in - let eqn' = type_decl_equation env (id :> Id.Parent.t) eqn in + let eqn' = type_decl_equation env (id :> Id.LabelParent.t) eqn in let ceqn' = Component.Of_Lang.(type_equation (empty ()) eqn') in Tools.fragmap ~mark_substituted:true env (Component.ModuleType.TypeSubst (cfrag', ceqn')) @@ -739,7 +760,7 @@ and type_decl : Env.t -> TypeDecl.t -> TypeDecl.t = let open TypeDecl in let container = match t.id.iv with - | `Type (parent, _) -> (parent :> Id.Parent.t) + | `Type (parent, _) -> (parent :> Id.LabelParent.t) | `CoreType _ -> assert false in let equation = type_decl_equation env container t.equation in @@ -749,7 +770,7 @@ and type_decl : Env.t -> TypeDecl.t -> TypeDecl.t = { t with equation; representation } and type_decl_equation : - Env.t -> Id.Parent.t -> TypeDecl.Equation.t -> TypeDecl.Equation.t = + Env.t -> Id.LabelParent.t -> TypeDecl.Equation.t -> TypeDecl.Equation.t = fun env parent t -> let open TypeDecl.Equation in let manifest = Opt.map (type_expression env parent) t.manifest in @@ -763,7 +784,7 @@ and type_decl_equation : and type_decl_representation : Env.t -> - Id.Parent.t -> + Id.LabelParent.t -> TypeDecl.Representation.t -> TypeDecl.Representation.t = fun env parent r -> @@ -784,7 +805,10 @@ and type_decl_constructor_argument env parent c = | Record fs -> Record (List.map (type_decl_field env parent) fs) and type_decl_constructor : - Env.t -> Id.Parent.t -> TypeDecl.Constructor.t -> TypeDecl.Constructor.t = + Env.t -> + Id.LabelParent.t -> + TypeDecl.Constructor.t -> + TypeDecl.Constructor.t = fun env parent c -> let open TypeDecl.Constructor in let args = type_decl_constructor_argument env parent c.args in @@ -853,7 +877,7 @@ and type_expression_package env parent p = })) | Error _ -> { p with path = Lang_of.(Path.module_type (empty ()) cp) } -and type_expression : Env.t -> Id.Parent.t -> _ -> _ = +and type_expression : Env.t -> Id.LabelParent.t -> _ -> _ = fun env parent texpr -> let open TypeExpr in match texpr with diff --git a/src/xref2/component.ml b/src/xref2/component.ml index bdca92cf18..f0fab6a9d5 100644 --- a/src/xref2/component.ml +++ b/src/xref2/component.ml @@ -496,7 +496,7 @@ module Element = struct type module_type = [ `ModuleType of Identifier.ModuleType.t * ModuleType.t ] - type type_ = [ `Type of Identifier.Type.t * TypeDecl.t ] + type datatype = [ `Type of Identifier.Type.t * TypeDecl.t ] type value = [ `Value of Identifier.Value.t * Value.t ] @@ -506,7 +506,7 @@ module Element = struct type class_type = [ `ClassType of Identifier.ClassType.t * ClassType.t ] - type datatype = [ type_ | class_ | class_type ] + type type_ = [ datatype | class_ | class_type ] type signature = [ module_ | module_type ] @@ -527,12 +527,14 @@ module Element = struct (* No component for pages yet *) type page = [ `Page of Identifier.Page.t * Odoc_model.Lang.Page.t ] - type label_parent = [ signature | datatype | page ] + type label_parent = [ signature | type_ | page ] + + type fragment_type_parent = [ signature | datatype ] type any = [ signature | value - | type_ + | datatype | label | class_ | class_type @@ -1058,6 +1060,9 @@ module Fmt = struct | `Value (p, t) -> Format.fprintf ppf "%a.%s" resolved_parent_path p (Odoc_model.Names.ValueName.to_string t) + | `Gpath p -> + Format.fprintf ppf "%a" model_resolved_path + (p :> Odoc_model.Paths.Path.Resolved.t) and resolved_constructor_path : Format.formatter -> Cpath.Resolved.constructor -> unit = @@ -1118,6 +1123,10 @@ module Fmt = struct | `Value (p, t) -> Format.fprintf ppf "%a.%s" resolved_parent_path p (Odoc_model.Names.ValueName.to_string t) + | `Identifier (id, b) -> + Format.fprintf ppf "identifier(%a, %b)" model_identifier + (id :> Odoc_model.Paths.Identifier.t) + b and constructor_path : Format.formatter -> Cpath.constructor -> unit = fun ppf p -> @@ -1870,8 +1879,11 @@ module Of_Lang = struct and resolved_value_path : _ -> Odoc_model.Paths.Path.Resolved.Value.t -> Cpath.Resolved.value = - fun ident_map (`Value (p, name)) -> - `Value (`Module (resolved_module_path ident_map p), name) + fun ident_map p -> + match p with + | `Value (p, name) -> + `Value (`Module (resolved_module_path ident_map p), name) + | `Identifier _ -> `Gpath p and resolved_constructor_path : _ -> @@ -1932,12 +1944,6 @@ module Of_Lang = struct | `Local i -> `Local (i, b)) | `Dot (path', x) -> `Dot (module_path ident_map path', x) - and value_path : _ -> Odoc_model.Paths.Path.Value.t -> Cpath.value = - fun ident_map p -> - match p with - | `Resolved r -> `Resolved (resolved_value_path ident_map r) - | `Dot (path', x) -> `Dot (module_path ident_map path', x) - and datatype : _ -> Odoc_model.Paths.Path.DataType.t -> Cpath.datatype = fun ident_map p -> match p with @@ -1948,6 +1954,13 @@ module Of_Lang = struct | `Local i -> `Local (i, b)) | `Dot (path', x) -> `Dot (module_path ident_map path', x) + and value_path : _ -> Odoc_model.Paths.Path.Value.t -> Cpath.value = + fun ident_map p -> + match p with + | `Resolved r -> `Resolved (resolved_value_path ident_map r) + | `Dot (path', x) -> `Dot (module_path ident_map path', x) + | `Identifier (i, b) -> `Identifier (i, b) + and constructor_path : _ -> Odoc_model.Paths.Path.Constructor.t -> Cpath.constructor = fun ident_map p -> diff --git a/src/xref2/component.mli b/src/xref2/component.mli index 34261d1430..ca945cb8f3 100644 --- a/src/xref2/component.mli +++ b/src/xref2/component.mli @@ -460,7 +460,7 @@ module Element : sig type module_type = [ `ModuleType of Identifier.ModuleType.t * ModuleType.t ] - type type_ = [ `Type of Identifier.Type.t * TypeDecl.t ] + type datatype = [ `Type of Identifier.Type.t * TypeDecl.t ] type value = [ `Value of Identifier.Value.t * Value.t ] @@ -470,7 +470,7 @@ module Element : sig type class_type = [ `ClassType of Identifier.ClassType.t * ClassType.t ] - type datatype = [ type_ | class_ | class_type ] + type type_ = [ datatype | class_ | class_type ] type signature = [ module_ | module_type ] @@ -491,12 +491,14 @@ module Element : sig (* No component for pages yet *) type page = [ `Page of Identifier.Page.t * Odoc_model.Lang.Page.t ] - type label_parent = [ signature | datatype | page ] + type label_parent = [ signature | type_ | page ] + + type fragment_type_parent = [ signature | datatype ] type any = [ signature | value - | type_ + | datatype | label | class_ | class_type diff --git a/src/xref2/cpath.ml b/src/xref2/cpath.ml index 05891c7111..cd9f5f6ac3 100644 --- a/src/xref2/cpath.ml +++ b/src/xref2/cpath.ml @@ -36,7 +36,8 @@ module rec Resolved : sig | `Class of parent * ClassName.t | `ClassType of parent * ClassTypeName.t ] - and value = [ `Value of parent * ValueName.t ] + and value = + [ `Value of parent * ValueName.t | `Gpath of Path.Resolved.Value.t ] and datatype = [ `Local of Ident.path_datatype @@ -89,7 +90,8 @@ and Cpath : sig and value = [ `Resolved of Resolved.value | `Dot of module_ * string - | `Value of Resolved.parent * ValueName.t ] + | `Value of Resolved.parent * ValueName.t + | `Identifier of Identifier.Value.t * bool ] and datatype = [ `Resolved of Resolved.datatype diff --git a/src/xref2/env.ml b/src/xref2/env.ml index 23d5df1150..ad3dd52c69 100644 --- a/src/xref2/env.ml +++ b/src/xref2/env.ml @@ -288,19 +288,20 @@ let add_module identifier m docs env = let env' = add_to_elts Kind_Module identifier (`Module (identifier, m)) env in if env.linking then add_cdocs identifier docs env' else env' -let add_type identifier t env = +let add_type (identifier : Identifier.Type.t) t env = let open Component in let open_typedecl cs = let add_cons env (cons : TypeDecl.Constructor.t) = let ident = Paths.Identifier.Mk.constructor - (identifier, ConstructorName.make_std cons.name) + ( (identifier :> Identifier.DataType.t), + ConstructorName.make_std cons.name ) in add_to_elts Kind_Constructor ident (`Constructor (ident, cons)) env and add_field env (field : TypeDecl.Field.t) = let ident = Paths.Identifier.Mk.field - ( (identifier :> Paths.Identifier.Parent.t), + ( (identifier :> Paths.Identifier.FieldParent.t), FieldName.make_std field.name ) in add_to_elts Kind_Field ident (`Field (ident, field)) env @@ -360,8 +361,8 @@ let module_of_unit : Lang.Compilation_unit.t -> Component.Module.t = let id = (unit.id :> Paths.Identifier.Module.t) in let locs = match unit.source_info with - | Some src -> Some (Identifier.Mk.source_location_mod src.id) - | None -> None + | Some { id = Some id; _ } -> Some (Identifier.Mk.source_location_mod id) + | _ -> None in match unit.content with | Module s -> @@ -542,12 +543,12 @@ let s_module_type : Component.Element.module_type scope = | #Component.Element.module_type as r -> Some r | _ -> None) -let s_datatype : Component.Element.datatype scope = - make_scope (function #Component.Element.datatype as r -> Some r | _ -> None) - let s_type : Component.Element.type_ scope = make_scope (function #Component.Element.type_ as r -> Some r | _ -> None) +let s_datatype : Component.Element.datatype scope = + make_scope (function #Component.Element.datatype as r -> Some r | _ -> None) + let s_class : Component.Element.class_ scope = make_scope (function #Component.Element.class_ as r -> Some r | _ -> None) @@ -591,6 +592,11 @@ let s_label_parent : Component.Element.label_parent scope = | #Component.Element.label_parent as r -> Some r | _ -> None) +let s_fragment_type_parent : Component.Element.fragment_type_parent scope = + make_scope ~root:lookup_root_module_fallback (function + | #Component.Element.fragment_type_parent as r -> Some r + | _ -> None) + let len = ref 0 let n = ref 0 diff --git a/src/xref2/env.mli b/src/xref2/env.mli index 72aa01ae48..8be6e82135 100644 --- a/src/xref2/env.mli +++ b/src/xref2/env.mli @@ -122,10 +122,10 @@ val s_module : Component.Element.module_ scope val s_module_type : Component.Element.module_type scope -val s_datatype : Component.Element.datatype scope - val s_type : Component.Element.type_ scope +val s_datatype : Component.Element.datatype scope + val s_class : Component.Element.class_ scope val s_class_type : Component.Element.class_type scope @@ -144,6 +144,8 @@ val s_field : Component.Element.field scope val s_label_parent : Component.Element.label_parent scope +val s_fragment_type_parent : Component.Element.fragment_type_parent scope + (* val open_component_signature : Paths_types.Identifier.signature -> Component.Signature.t -> t -> t *) diff --git a/src/xref2/errors.ml b/src/xref2/errors.ml index 4ca923a9b7..56b953d785 100644 --- a/src/xref2/errors.ml +++ b/src/xref2/errors.ml @@ -197,7 +197,7 @@ module Tools_error = struct Component.Fmt.model_identifier (m :> Odoc_model.Paths.Identifier.t) | `Lookup_failureC m -> - Format.fprintf fmt "Lookup failure (value): %a" + Format.fprintf fmt "Lookup failure (constructor): %a" Component.Fmt.model_identifier (m :> Odoc_model.Paths.Identifier.t) | `ApplyNotFunctor -> Format.fprintf fmt "Apply module is not a functor" diff --git a/src/xref2/find.ml b/src/xref2/find.ml index 0287f603f3..ba5ec4108e 100644 --- a/src/xref2/find.ml +++ b/src/xref2/find.ml @@ -281,7 +281,10 @@ let module_type_in_sig sg name = let value_in_sig sg name = filter_in_sig sg (function - | Signature.Value (id, m) when N.value id = name -> + | Signature.Value (id, m) + when N.value id = name || N.value id = "(" ^ name ^ ")" -> + (* For operator, the value will have name [()]. We match that even + with name []. *) Some (`FValue (N.typed_value id, Delayed.get m)) | _ -> None) diff --git a/src/xref2/ident.ml b/src/xref2/ident.ml index 5b1de490fe..65adeb2bf3 100644 --- a/src/xref2/ident.ml +++ b/src/xref2/ident.ml @@ -16,10 +16,13 @@ type class_signature = type datatype = [ `LType of TypeName.t * int ] -type parent = [ signature | datatype | class_signature ] +type parent = [ signature | datatype ] type label_parent = - [ parent | `LPage of PageName.t * int | `LLeafPage of PageName.t * int ] + [ parent + | `LPage of PageName.t * int + | `LLeafPage of PageName.t * int + | class_signature ] type module_ = [ `LRoot of ModuleName.t * int @@ -138,17 +141,18 @@ module Of_Identifier = struct | `Type (_, n) -> `LType (n, i) | `CoreType _n -> failwith "Bad" - let parent : Parent.t -> parent = + let field_parent : FieldParent.t -> parent = fun p -> match p with | { iv = #Signature.t_pv; _ } as s -> (signature s :> parent) | { iv = #DataType.t_pv; _ } as s -> (datatype s :> parent) - | { iv = #ClassSignature.t_pv; _ } as s -> (class_signature s :> parent) let label_parent : LabelParent.t -> label_parent = fun p -> match p with - | { iv = #Parent.t_pv; _ } as s -> (parent s :> label_parent) + | { iv = #ClassSignature.t_pv; _ } as s -> + (class_signature s :> label_parent) + | { iv = #FieldParent.t_pv; _ } as s -> (field_parent s :> label_parent) | { iv = `Page (_, n); _ } -> `LPage (n, fresh_int ()) | { iv = `LeafPage (_, n); _ } -> `LLeafPage (n, fresh_int ()) diff --git a/src/xref2/lang_of.ml b/src/xref2/lang_of.ml index f780747dba..bbe07f8ac5 100644 --- a/src/xref2/lang_of.ml +++ b/src/xref2/lang_of.ml @@ -198,9 +198,11 @@ module Path = struct | `ClassType (p, name) -> `ClassType (resolved_parent map p, name) | `Substituted s -> resolved_type map s - and resolved_value map (`Value (p, name) : Cpath.Resolved.value) : + and resolved_value map (p : Cpath.Resolved.value) : Odoc_model.Paths.Path.Resolved.Value.t = - `Value (resolved_parent map p, name) + match p with + | `Value (p, name) -> `Value (resolved_parent map p, name) + | `Gpath y -> y and resolved_datatype map (p : Cpath.Resolved.datatype) : Odoc_model.Paths.Path.Resolved.DataType.t = @@ -513,7 +515,7 @@ and class_decl map parent c = | Arrow (lbl, t, d) -> Arrow ( lbl, - type_expr map (parent :> Identifier.Parent.t) t, + type_expr map (parent :> Identifier.LabelParent.t) t, class_decl map parent d ) and class_type_expr map parent c = @@ -521,7 +523,7 @@ and class_type_expr map parent c = | Component.ClassType.Constr (p, ts) -> Constr ( Path.class_type map p, - List.rev_map (type_expr map (parent :> Identifier.Parent.t)) ts + List.rev_map (type_expr map (parent :> Identifier.LabelParent.t)) ts |> List.rev ) | Signature s -> Signature (class_signature map parent s) @@ -548,7 +550,7 @@ and class_type map parent id c = and class_signature map parent sg = let open Component.ClassSignature in - let pparent = (parent :> Identifier.Parent.t) in + let pparent = (parent :> Identifier.LabelParent.t) in let items = List.rev_map (function @@ -573,7 +575,7 @@ and method_ map parent id m = doc = docs (parent :> Identifier.LabelParent.t) m.doc; private_ = m.private_; virtual_ = m.virtual_; - type_ = type_expr map (parent :> Identifier.Parent.t) m.type_; + type_ = type_expr map (parent :> Identifier.LabelParent.t) m.type_; } and instance_variable map parent id i = @@ -587,7 +589,7 @@ and instance_variable map parent id i = doc = docs (parent :> Identifier.LabelParent.t) i.doc; mutable_ = i.mutable_; virtual_ = i.virtual_; - type_ = type_expr map (parent :> Identifier.Parent.t) i.type_; + type_ = type_expr map (parent :> Identifier.LabelParent.t) i.type_; } and class_constraint map parent cst = @@ -686,7 +688,7 @@ and value_ map parent id v = id = identifier; locs = v.locs; doc = docs (parent :> Identifier.LabelParent.t) v.doc; - type_ = type_expr map (parent :> Identifier.Parent.t) v.type_; + type_ = type_expr map (parent :> Identifier.LabelParent.t) v.type_; value = v.value; } @@ -711,8 +713,10 @@ and extension_constructor map parent c = locs = c.locs; doc = docs (parent :> Identifier.LabelParent.t) c.doc; args = - type_decl_constructor_argument map (parent :> Identifier.Parent.t) c.args; - res = Opt.map (type_expr map (parent :> Identifier.Parent.t)) c.res; + type_decl_constructor_argument map + (parent :> Identifier.FieldParent.t) + c.args; + res = Opt.map (type_expr map (parent :> Identifier.LabelParent.t)) c.res; } and module_ map parent id m = @@ -767,11 +771,11 @@ and mty_substitution map identifier = function | TypeEq (frag, eqn) -> TypeEq ( Path.type_fragment map frag, - type_decl_equation map (identifier :> Identifier.Parent.t) eqn ) + type_decl_equation map (identifier :> Identifier.FieldParent.t) eqn ) | TypeSubst (frag, eqn) -> TypeSubst ( Path.type_fragment map frag, - type_decl_equation map (identifier :> Identifier.Parent.t) eqn ) + type_decl_equation map (identifier :> Identifier.FieldParent.t) eqn ) | ModuleTypeEq (frag, eqn) -> ModuleTypeEq (Path.module_type_fragment map frag, module_type_expr map identifier eqn) @@ -888,17 +892,20 @@ and module_type_substitution : and type_decl_constructor_argument : maps -> - Paths.Identifier.Parent.t -> + Paths.Identifier.FieldParent.t -> Component.TypeDecl.Constructor.argument -> Odoc_model.Lang.TypeDecl.Constructor.argument = fun map parent a -> match a with - | Tuple ls -> Tuple (List.map (type_expr map parent) ls) - | Record fs -> Record (List.map (type_decl_field map parent) fs) + | Tuple ls -> + Tuple (List.map (type_expr map (parent :> Identifier.LabelParent.t)) ls) + | Record fs -> + Record + (List.map (type_decl_field map (parent :> Identifier.FieldParent.t)) fs) and type_decl_field : maps -> - Identifier.Parent.t -> + Identifier.FieldParent.t -> Component.TypeDecl.Field.t -> Odoc_model.Lang.TypeDecl.Field.t = fun map parent f -> @@ -907,12 +914,13 @@ and type_decl_field : id = identifier; doc = docs (parent :> Identifier.LabelParent.t) f.doc; mutable_ = f.mutable_; - type_ = type_expr map parent f.type_; + type_ = type_expr map (parent :> Identifier.LabelParent.t) f.type_; } -and type_decl_equation map (parent : Identifier.Parent.t) +and type_decl_equation map (parent : Identifier.FieldParent.t) (eqn : Component.TypeDecl.Equation.t) : Odoc_model.Lang.TypeDecl.Equation.t = + let parent = (parent :> Identifier.LabelParent.t) in { params = eqn.params; private_ = eqn.private_; @@ -929,7 +937,8 @@ and type_decl map parent id (t : Component.TypeDecl.t) : { id = identifier; locs = t.locs; - equation = type_decl_equation map (parent :> Identifier.Parent.t) t.equation; + equation = + type_decl_equation map (parent :> Identifier.FieldParent.t) t.equation; doc = docs (parent :> Identifier.LabelParent.t) t.doc; canonical = t.canonical; representation = @@ -944,29 +953,29 @@ and type_decl_representation map id (t : Component.TypeDecl.Representation.t) : | Record fs -> Record (List.map - (type_decl_field map (id :> Odoc_model.Paths.Identifier.Parent.t)) + (type_decl_field map + (id :> Odoc_model.Paths.Identifier.FieldParent.t)) fs) and type_decl_constructor : maps -> - Odoc_model.Paths.Identifier.Type.t -> + Odoc_model.Paths.Identifier.DataType.t -> Component.TypeDecl.Constructor.t -> Odoc_model.Lang.TypeDecl.Constructor.t = fun map id t -> let identifier = Identifier.Mk.constructor (id, ConstructorName.make_std t.name) in + let parent = (id :> Identifier.LabelParent.t) in { id = identifier; - doc = docs (id :> Identifier.LabelParent.t) t.doc; + doc = docs parent t.doc; args = - type_decl_constructor_argument map - (id :> Odoc_model.Paths.Identifier.Parent.t) - t.args; - res = Opt.map (type_expr map (id :> Identifier.Parent.t)) t.res; + type_decl_constructor_argument map (id :> Identifier.FieldParent.t) t.args; + res = Opt.map (type_expr map parent) t.res; } -and type_expr_package map parent t = +and type_expr_package map (parent : Identifier.LabelParent.t) t = { Lang.TypeExpr.Package.path = Path.module_type map t.Component.TypeExpr.Package.path; @@ -977,8 +986,8 @@ and type_expr_package map parent t = t.substitutions; } -and type_expr map (parent : Identifier.Parent.t) (t : Component.TypeExpr.t) : - Odoc_model.Lang.TypeExpr.t = +and type_expr map (parent : Identifier.LabelParent.t) (t : Component.TypeExpr.t) + : Odoc_model.Lang.TypeExpr.t = try match t with | Var s -> Var s @@ -1010,7 +1019,7 @@ and type_expr_polyvar map parent v = c.Component.TypeExpr.Polymorphic_variant.Constructor.name; constant = c.constant; arguments = List.map (type_expr map parent) c.arguments; - doc = docs (parent :> Identifier.LabelParent.t) c.doc; + doc = docs parent c.doc; } in let element = function @@ -1054,8 +1063,10 @@ and exception_ map parent id (e : Component.Exception.t) : locs = e.locs; doc = docs (parent :> Identifier.LabelParent.t) e.doc; args = - type_decl_constructor_argument map (parent :> Identifier.Parent.t) e.args; - res = Opt.map (type_expr map (parent :> Identifier.Parent.t)) e.res; + type_decl_constructor_argument map + (parent :> Identifier.FieldParent.t) + e.args; + res = Opt.map (type_expr map (parent :> Identifier.LabelParent.t)) e.res; } and block_element parent diff --git a/src/xref2/lang_of.mli b/src/xref2/lang_of.mli index 24ccf08a2c..136eeba668 100644 --- a/src/xref2/lang_of.mli +++ b/src/xref2/lang_of.mli @@ -186,19 +186,19 @@ val simple_expansion : val type_decl_constructor_argument : maps -> - Identifier.Parent.t -> + Identifier.FieldParent.t -> Component.TypeDecl.Constructor.argument -> Odoc_model.Lang.TypeDecl.Constructor.argument val type_decl_field : maps -> - Identifier.Parent.t -> + Identifier.FieldParent.t -> Component.TypeDecl.Field.t -> Odoc_model.Lang.TypeDecl.Field.t val type_decl_equation : maps -> - Identifier.Parent.t -> + Identifier.FieldParent.t -> Component.TypeDecl.Equation.t -> Odoc_model.Lang.TypeDecl.Equation.t @@ -217,31 +217,31 @@ val type_decl_representation : val type_decl_constructor : maps -> - Identifier.Type.t -> + Identifier.DataType.t -> Component.TypeDecl.Constructor.t -> Odoc_model.Lang.TypeDecl.Constructor.t val type_expr_package : maps -> - Identifier.Parent.t -> + Identifier.LabelParent.t -> Component.TypeExpr.Package.t -> Odoc_model.Lang.TypeExpr.Package.t val type_expr : maps -> - Identifier.Parent.t -> + Identifier.LabelParent.t -> Component.TypeExpr.t -> Odoc_model.Lang.TypeExpr.t val type_expr_polyvar : maps -> - Identifier.Parent.t -> + Identifier.LabelParent.t -> Component.TypeExpr.Polymorphic_variant.t -> Odoc_model.Lang.TypeExpr.Polymorphic_variant.t val type_expr_object : maps -> - Identifier.Parent.t -> + Identifier.LabelParent.t -> Component.TypeExpr.Object.t -> Odoc_model.Lang.TypeExpr.Object.t diff --git a/src/xref2/link.ml b/src/xref2/link.ml index 04f088c2c7..0c1488b20c 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -135,8 +135,9 @@ and should_resolve_constructor : Paths.Path.Constructor.t -> bool = | `Resolved p -> should_reresolve (p :> Paths.Path.Resolved.t) | _ -> true -let type_path : Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t = - fun env p -> +let type_path : + ?report_errors:bool -> Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t = + fun ?(report_errors = true) env p -> if not (should_resolve (p :> Paths.Path.t)) then p else let cp = Component.Of_Lang.(type_path (empty ()) p) in @@ -150,11 +151,13 @@ let type_path : Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t = let result = Tools.reresolve_type env p' in `Resolved Lang_of.(Path.resolved_type (empty ()) result) | Error e -> - Errors.report ~what:(`Type_path cp) ~tools_error:e `Lookup; + if report_errors then + Errors.report ~what:(`Type_path cp) ~tools_error:e `Lookup; p) -let value_path : Env.t -> Paths.Path.Value.t -> Paths.Path.Value.t = - fun env p -> +let value_path : + ?report_errors:bool -> Env.t -> Paths.Path.Value.t -> Paths.Path.Value.t = + fun ?(report_errors = true) env p -> if not (should_resolve (p :> Paths.Path.t)) then p else let cp = Component.Of_Lang.(value_path (empty ()) p) in @@ -168,12 +171,18 @@ let value_path : Env.t -> Paths.Path.Value.t -> Paths.Path.Value.t = let result = Tools.reresolve_value env p' in `Resolved Lang_of.(Path.resolved_value (empty ()) result) | Error e -> - Errors.report ~what:(`Value_path cp) ~tools_error:e `Lookup; + if report_errors then + Errors.report ~what:(`Value_path cp) ~tools_error:e `Lookup; p) let constructor_path : - Env.t -> Paths.Path.Constructor.t -> Paths.Path.Constructor.t = - fun env p -> + ?report_errors:bool -> + Env.t -> + Paths.Path.Constructor.t -> + Paths.Path.Constructor.t = + fun ?(report_errors = true) env p -> + (* if not (should_resolve (p : Paths.Path.Constructor.t :> Paths.Path.t)) then p *) + (* else *) if not (should_resolve_constructor p) then p else let cp = Component.Of_Lang.(constructor_path (empty ()) p) in @@ -187,17 +196,16 @@ let constructor_path : let result = Tools.reresolve_constructor env p' in `Resolved Lang_of.(Path.resolved_constructor (empty ()) result) | Error e -> - Errors.report ~what:(`Constructor_path cp) ~tools_error:e `Lookup; + if report_errors then + Errors.report ~what:(`Constructor_path cp) ~tools_error:e `Lookup; p) -let () = - (* Until those are used *) - ignore value_path; - ignore constructor_path - -let class_type_path : Env.t -> Paths.Path.ClassType.t -> Paths.Path.ClassType.t - = - fun env p -> +let class_type_path : + ?report_errors:bool -> + Env.t -> + Paths.Path.ClassType.t -> + Paths.Path.ClassType.t = + fun ?(report_errors = true) env p -> if not (should_resolve (p :> Paths.Path.t)) then p else let cp = Component.Of_Lang.(class_type_path (empty ()) p) in @@ -211,12 +219,16 @@ let class_type_path : Env.t -> Paths.Path.ClassType.t -> Paths.Path.ClassType.t let result = Tools.reresolve_class_type env p' in `Resolved Lang_of.(Path.resolved_class_type (empty ()) result) | Error e -> - Errors.report ~what:(`Class_type_path cp) ~tools_error:e `Lookup; + if report_errors then + Errors.report ~what:(`Class_type_path cp) ~tools_error:e `Lookup; p) and module_type_path : - Env.t -> Paths.Path.ModuleType.t -> Paths.Path.ModuleType.t = - fun env p -> + ?report_errors:bool -> + Env.t -> + Paths.Path.ModuleType.t -> + Paths.Path.ModuleType.t = + fun ?(report_errors = true) env p -> if not (should_resolve (p :> Paths.Path.t)) then p else let cp = Component.Of_Lang.(module_type_path (empty ()) p) in @@ -230,11 +242,13 @@ and module_type_path : let result = Tools.reresolve_module_type env p' in `Resolved Lang_of.(Path.resolved_module_type (empty ()) result) | Error e -> - Errors.report ~what:(`Module_type_path cp) ~tools_error:e `Resolve; + if report_errors then + Errors.report ~what:(`Module_type_path cp) ~tools_error:e `Resolve; p) -and module_path : Env.t -> Paths.Path.Module.t -> Paths.Path.Module.t = - fun env p -> +and module_path : + ?report_errors:bool -> Env.t -> Paths.Path.Module.t -> Paths.Path.Module.t = + fun ?(report_errors = true) env p -> if not (should_resolve (p :> Paths.Path.t)) then p else let cp = Component.Of_Lang.(module_path (empty ()) p) in @@ -249,7 +263,8 @@ and module_path : Env.t -> Paths.Path.Module.t -> Paths.Path.Module.t = `Resolved Lang_of.(Path.resolved_module (empty ()) result) | Error _ when is_forward p -> p | Error e -> - Errors.report ~what:(`Module_path cp) ~tools_error:e `Resolve; + if report_errors then + Errors.report ~what:(`Module_path cp) ~tools_error:e `Resolve; p) let rec comment_inline_element : @@ -400,16 +415,180 @@ and open_ env parent = function | { Odoc_model__Lang.Open.doc; _ } as open_ -> { open_ with doc = comment_docs env parent doc } +module Build_env = struct + let rec unit env t = + let open Compilation_unit in + match t.content with + | Module sg -> + let env = signature env sg in + env + | Pack _ -> env + + and signature env s = + let env = Env.open_signature s env in + signature_items env s.items + + and simple_expansion : Env.t -> ModuleType.simple_expansion -> Env.t = + fun env m -> + match m with + | Signature sg -> signature env sg + | Functor (arg, sg) -> + let env = Env.add_functor_parameter arg env in + let env = functor_argument env arg in + simple_expansion env sg + + and functor_argument env a = + match a with + | FunctorParameter.Unit -> env + | Named arg -> functor_parameter_parameter env arg + + and functor_parameter_parameter : Env.t -> FunctorParameter.parameter -> Env.t + = + fun env a -> module_type_expr env a.expr + + and module_type_expr : Env.t -> ModuleType.expr -> Env.t = + fun env expr -> + let open ModuleType in + match expr with + | Signature s -> signature env s + | Path { p_path = _; p_expansion = Some p_expansion } -> + simple_expansion env p_expansion + | Path { p_path = _; p_expansion = None } -> env + | With _ -> env + | Functor (arg, res) -> + let env = functor_argument env arg in + let env = Env.add_functor_parameter arg env in + let env = module_type_expr env res in + env + | TypeOf { t_expansion = None; _ } -> env + | TypeOf { t_expansion = Some exp; _ } -> simple_expansion env exp + + and signature_items : Env.t -> Signature.item list -> Env.t = + fun env s -> + let open Signature in + List.fold_left + (fun env item -> + match item with + | Module (_, m) -> module_ env m + | ModuleSubstitution m -> Env.open_module_substitution m env + | Type _ -> env + | TypeSubstitution t -> Env.open_type_substitution t env + | ModuleType mt -> module_type env mt + | ModuleTypeSubstitution mts -> + let env = Env.open_module_type_substitution mts env in + module_type_substitution env mts + | Value _ -> env + | Comment _ -> env + | TypExt _ -> env + | Exception _ -> env + | Class _ -> env (* TODO *) + | ClassType _ -> env + | Include i -> include_ env i + | Open _ -> env) + env s + + and module_type_substitution : Env.t -> ModuleTypeSubstitution.t -> Env.t = + fun env m -> module_type_expr env m.manifest + + and include_ : Env.t -> Include.t -> Env.t = + fun env i -> + let open Include in + signature_items env i.expansion.content.items + + and module_type : Env.t -> ModuleType.t -> Env.t = + fun env m -> + match m.expr with None -> env | Some expr -> module_type_expr env expr + + and module_ : Env.t -> Module.t -> Env.t = + fun env m -> + let open Module in + let env = module_decl env m.type_ in + match m.type_ with + | Alias (`Resolved _, Some exp) -> simple_expansion env exp + | Alias _ | ModuleType _ -> env + + and module_decl : Env.t -> Module.decl -> Env.t = + fun env decl -> + let open Module in + match decl with + | ModuleType expr -> module_type_expr env expr + | Alias (_, None) -> env + | Alias (_, Some e) -> simple_expansion env e +end let rec unit env t = let open Compilation_unit in let content = - match t.content with - | Module sg -> - let sg = signature env (t.id :> Id.Signature.t) sg in - Module sg - | Pack _ as p -> p + if t.Lang.Compilation_unit.linked || t.hidden then t.content + else + match t.content with + | Module sg -> + let sg = signature env (t.id :> Id.Signature.t) sg in + Module sg + | Pack _ as p -> p + in + let source_info = + let env = Build_env.unit env t in + let open Source_info in + match t.source_info with + | Some inf -> + let jump_to v f_impl f_doc = + let documentation = + match v.documentation with Some p -> Some (f_doc p) | None -> None + in + let implementation = + match v.implementation with + | Some (Unresolved p) -> ( + match f_impl p with + | Some x -> Some (Resolved x) + | None -> v.implementation) + | x -> x + in + { documentation; implementation } + in + let infos = + List.map + (fun (i, pos) -> + let info = + match i with + | Value v -> + Value + (jump_to v + (Shape_tools.lookup_value_path env) + (value_path ~report_errors:false env)) + | Module v -> + Module + (jump_to v + (Shape_tools.lookup_module_path env) + (module_path ~report_errors:false env)) + | ModuleType v -> + ModuleType + (jump_to v + (Shape_tools.lookup_module_type_path env) + (module_type_path ~report_errors:false env)) + | Type v -> + Type + (jump_to v + (Shape_tools.lookup_type_path env) + (type_path ~report_errors:false env)) + | Constructor v -> + Constructor + (jump_to v + (fun _ -> None) + (constructor_path ~report_errors:false env)) + | ClassType v -> + ClassType + (jump_to v + (Shape_tools.lookup_class_type_path env) + (class_type_path ~report_errors:false env)) + | i -> i + in + (info, pos)) + inf.infos + in + Some { inf with infos } + | None -> None in - { t with content; linked = true } + { t with content; linked = true; source_info } and value_ env parent t = let open Value in @@ -921,7 +1100,7 @@ and type_decl : Env.t -> Id.Signature.t -> TypeDecl.t -> TypeDecl.t = try Expand_tools.collapse_eqns default.equation (Lang_of.type_decl_equation (Lang_of.empty ()) - (parent :> Id.Parent.t) + (parent :> Id.FieldParent.t) t'.equation) params with _ -> default.equation @@ -1047,7 +1226,7 @@ and type_expression : Env.t -> Id.Signature.t -> _ -> _ = let t' = Expand_tools.type_expr map Lang_of.( - type_expr (empty ()) (parent :> Id.Parent.t) expr) + type_expr (empty ()) (parent :> Id.LabelParent.t) expr) in type_expression env parent (p :: visited) t' with @@ -1066,7 +1245,7 @@ and type_expression : Env.t -> Id.Signature.t -> _ -> _ = Constr (`Resolved p, ts) | Ok (_cp, `FType_removed (_, x, _eq)) -> (* Type variables ? *) - Lang_of.(type_expr (empty ()) (parent :> Id.Parent.t) x) + Lang_of.(type_expr (empty ()) (parent :> Id.LabelParent.t) x) | Error _ -> Constr (path', ts)) | Polymorphic_variant v -> Polymorphic_variant (type_expression_polyvar env parent visited v) @@ -1087,8 +1266,7 @@ and type_expression : Env.t -> Id.Signature.t -> _ -> _ = | Package p -> Package (type_expression_package env parent visited p) let link ~filename x y = - Lookup_failures.catch_failures ~filename (fun () -> - if y.Lang.Compilation_unit.linked || y.hidden then y else unit x y) + Lookup_failures.catch_failures ~filename (fun () -> unit x y) let page env page = let () = diff --git a/src/xref2/ref_tools.ml b/src/xref2/ref_tools.ml index f3ac027c94..e838726abb 100644 --- a/src/xref2/ref_tools.ml +++ b/src/xref2/ref_tools.ml @@ -30,6 +30,9 @@ type label_parent_lookup_result = | type_lookup_result | `P of page_lookup_result ] +type fragment_type_parent_lookup_result = + [ `S of signature_lookup_result | `T of datatype_lookup_result ] + type 'a ref_result = ('a, Errors.Tools_error.reference_lookup_error) Result.result (** The result type for every functions in this module. *) @@ -281,13 +284,14 @@ module DT = struct let of_element _env (`Type (id, t)) : t = (`Identifier id, t) let in_env env name = - env_lookup_by_name Env.s_type name env >>= fun e -> Ok (of_element env e) + env_lookup_by_name Env.s_datatype name env >>= fun e -> + Ok (of_element env e) let in_signature _env ((parent', parent_cp, sg) : signature_lookup_result) name = let sg = Tools.prefix_signature (parent_cp, sg) in - find Find.datatype_in_sig sg name >>= fun (`FType (name, t)) -> - Ok (`Type (parent', name), t) + find Find.datatype_in_sig sg name >>= function + | `FType (name, t) -> Ok (`T (`Type (parent', name), t)) end module T = struct @@ -301,8 +305,7 @@ module T = struct | `ClassType _ as e -> `CT (CT.of_element env e) let in_env env name = - env_lookup_by_name Env.s_datatype name env >>= fun e -> - Ok (of_element env e) + env_lookup_by_name Env.s_type name env >>= fun e -> Ok (of_element env e) (* Don't handle name collisions between class, class types and type decls *) let in_signature _env ((parent', parent_cp, sg) : signature_lookup_result) @@ -439,6 +442,24 @@ module EX = struct Ok (`Exception (parent', name)) end +module FTP = struct + (** Fragment type parent *) + + type t = fragment_type_parent_lookup_result + + let of_element env : _ -> t ref_result = function + | `Module _ as e -> + M.of_element env e |> module_lookup_to_signature_lookup env >>= fun r -> + Ok (`S r) + | `ModuleType _ as e -> + MT.of_element env e |> module_type_lookup_to_signature_lookup env + >>= fun r -> Ok (`S r) + | `Type _ as e -> Ok (`T (DT.of_element env e)) + + let in_env env name = + env_lookup_by_name Env.s_fragment_type_parent name env >>= of_element env +end + module CS = struct (** Constructor *) @@ -448,14 +469,29 @@ module CS = struct env_lookup_by_name Env.s_constructor name env >>= fun (`Constructor (id, _)) -> Ok (`Identifier id :> t) - let in_datatype _env ((parent', t) : datatype_lookup_result) name = + let got_a_field name = + (* Let's pretend we didn't see the field and say we didn't find anything. *) + Error (`Find_by_name (`Cons, name)) + + let in_parent _env (parent : fragment_type_parent_lookup_result) name = let name_s = ConstructorName.to_string name in - find Find.any_in_type t name_s >>= function - | `FConstructor _ -> Ok (`Constructor (parent', name)) - | `FField _ -> Error (`Find_by_name (`Cons, name_s)) + match parent with + | `S (parent', parent_cp, sg) -> ( + let sg = Tools.prefix_signature (parent_cp, sg) in + find_ambiguous Find.any_in_type_in_sig sg name_s >>= function + | `In_type (_, _, `FField _) -> got_a_field name_s + | `In_type (typ_name, _, `FConstructor _) -> + Ok (`Constructor (`Type (parent', typ_name), name))) + | `T (parent', t) -> ( + find Find.any_in_type t name_s >>= function + | `FField _ -> got_a_field name_s + | `FConstructor _ -> + Ok (`Constructor ((parent' : Resolved.DataType.t), name))) let of_component _env parent name = - Ok (`Constructor (parent, ConstructorName.make_std name)) + Ok + (`Constructor + ((parent : Resolved.DataType.t), ConstructorName.make_std name)) end module F = struct @@ -471,7 +507,7 @@ module F = struct (* Let's pretend we didn't see the constructor and say we didn't find anything. *) Error (`Find_by_name (`Field, name)) - let in_parent _env (parent : label_parent_lookup_result) name = + let in_parent _env (parent : fragment_type_parent_lookup_result) name = let name_s = FieldName.to_string name in match parent with | `S (parent', parent_cp, sg) -> ( @@ -479,17 +515,18 @@ module F = struct find_ambiguous Find.any_in_type_in_sig sg name_s >>= function | `In_type (_, _, `FConstructor _) -> got_a_constructor name_s | `In_type (typ_name, _, `FField _) -> - Ok (`Field (`Type (parent', typ_name), name))) + Ok + (`Field + ((`Type (parent', typ_name) :> Resolved.FieldParent.t), name))) | `T (parent', t) -> ( find Find.any_in_type t name_s >>= function | `FConstructor _ -> got_a_constructor name_s - | `FField _ -> Ok (`Field ((parent' :> Resolved.Parent.t), name))) - | (`C _ | `CT _ | `P _) as r -> wrong_kind_error [ `S; `T ] r + | `FField _ -> Ok (`Field ((parent' :> Resolved.FieldParent.t), name))) let of_component _env parent name = Ok (`Field - ( (parent : Resolved.DataType.t :> Resolved.Parent.t), + ( (parent : Resolved.DataType.t :> Resolved.FieldParent.t), FieldName.make_std name )) end @@ -616,6 +653,27 @@ let rec resolve_label_parent_reference env r = resolve_signature_reference env (`Root (name, `TModule)) >>= fun s -> Ok (`S s) +and resolve_fragment_type_parent_reference (env : Env.t) + (r : FragmentTypeParent.t) : (fragment_type_parent_lookup_result, _) result + = + let fragment_type_parent_res_of_type_res : datatype_lookup_result -> _ = + fun r -> Ok (`T r) + in + match r with + | `Resolved _ -> failwith "unimplemented" + | `Root (name, `TUnknown) -> FTP.in_env env name + | (`Module _ | `ModuleType _ | `Root (_, (`TModule | `TModuleType))) as sr -> + resolve_signature_reference env sr >>= fun s -> Ok (`S s) + | `Root (name, `TType) -> + DT.in_env env name >>= fragment_type_parent_res_of_type_res + | `Type (parent, name) -> + resolve_signature_reference env parent >>= fun p -> + DT.in_signature env p (TypeName.to_string name) + | `Dot (parent, name) -> + resolve_label_parent_reference env parent + >>= signature_lookup_result_of_label_parent + >>= fun p -> DT.in_signature env p name + and resolve_signature_reference : Env.t -> Signature.t -> signature_lookup_result ref_result = fun env' r -> @@ -662,20 +720,6 @@ and resolve_signature_reference : in resolve env' -and resolve_datatype_reference : - Env.t -> DataType.t -> datatype_lookup_result ref_result = - fun env r -> - match r with - | `Resolved _ -> failwith "TODO" - | `Root (name, (`TType | `TUnknown)) -> DT.in_env env name - | `Type (parent, name) -> - resolve_signature_reference env parent >>= fun p -> - DT.in_signature env p (TypeName.to_string name) - | `Dot (parent, name) -> - resolve_label_parent_reference env parent - >>= signature_lookup_result_of_label_parent - >>= fun p -> DT.in_signature env p name - and resolve_module_reference env (r : Module.t) : M.t ref_result = match r with | `Resolved _r -> failwith "What's going on!?" @@ -818,8 +862,8 @@ let resolve_reference = | `Dot (parent, name) -> resolve_reference_dot env parent name | `Root (name, `TConstructor) -> CS.in_env env name >>= resolved1 | `Constructor (parent, name) -> - resolve_datatype_reference env parent >>= fun p -> - CS.in_datatype env p name >>= resolved1 + resolve_fragment_type_parent_reference env parent >>= fun p -> + CS.in_parent env p name >>= resolved1 | `Root (name, `TException) -> EX.in_env env name >>= resolved1 | `Exception (parent, name) -> resolve_signature_reference env parent >>= fun p -> @@ -834,8 +878,8 @@ let resolve_reference = ED.in_signature env p name >>= resolved1 | `Root (name, `TField) -> F.in_env env name >>= resolved1 | `Field (parent, name) -> - resolve_label_parent_reference env (parent : Parent.t :> LabelParent.t) - >>= fun p -> F.in_parent env p name >>= resolved1 + resolve_fragment_type_parent_reference env parent >>= fun p -> + F.in_parent env p name >>= resolved1 | `Root (name, `TMethod) -> MM.in_env env name >>= resolved1 | `Method (parent, name) -> resolve_class_signature_reference env parent >>= fun p -> diff --git a/src/xref2/shape_tools.cppo.ml b/src/xref2/shape_tools.cppo.ml index c702e17b56..7d2a351c32 100644 --- a/src/xref2/shape_tools.cppo.ml +++ b/src/xref2/shape_tools.cppo.ml @@ -53,6 +53,48 @@ let rec shape_of_id env : (* Not represented in shapes. *) None +let rec shape_of_module_path env : _ -> Shape.t option = + let proj parent kind name = + let item = Shape.Item.make name kind in + match shape_of_module_path env (parent :> Odoc_model.Paths.Path.Module.t) with + | Some shape -> Some (Shape.proj shape item) + | None -> None + in + fun (path : Odoc_model.Paths.Path.Module.t) -> + match path with + | `Resolved _ -> None + | `Root name -> ( + match Env.lookup_unit name env with + | Some (Env.Found unit) -> ( + match unit.shape_info with + | Some (shape, _) -> Some shape + | None -> None) + | _ -> None) + | `Forward _ -> None + | `Dot (parent, name) -> + proj (parent :> Odoc_model.Paths.Path.Module.t) Kind.Module name + | `Apply (parent, arg) -> + shape_of_module_path env (parent :> Odoc_model.Paths.Path.Module.t) + >>= fun parent -> + shape_of_module_path env (arg :> Odoc_model.Paths.Path.Module.t) >>= fun arg -> + Some (Shape.app parent ~arg) + | `Identifier (id, _) -> + shape_of_id env (id :> Odoc_model.Paths.Identifier.NonSrc.t) + +let shape_of_kind_path env kind : + _ -> Shape.t option = + let proj parent kind name = + let item = Shape.Item.make name kind in + match shape_of_module_path env parent with + | Some shape -> Some (Shape.proj shape item) + | None -> None + in + fun path -> + match path with + | `Resolved _ -> None + | `Dot (parent, name) -> proj parent kind name + | `Identifier (id, _) -> shape_of_id env (id :> Odoc_model.Paths.Identifier.NonSrc.t) + module MkId = Identifier.Mk let unit_of_uid uid = @@ -95,8 +137,8 @@ let lookup_shape : | Some x -> Some x | None -> ( match unit.source_info with - | Some si -> Some (MkId.source_location_mod si.id) - | None -> None) + | Some {id = Some id ; _} -> Some (MkId.source_location_mod id) + | _ -> None) let lookup_def : @@ -108,10 +150,38 @@ let lookup_def : | None -> None | Some query -> lookup_shape env query +let lookup_module_path = fun env path -> + match shape_of_module_path env path with + | None -> None + | Some query -> lookup_shape env query + +let lookup_kind_path = fun kind env path -> + match shape_of_kind_path env kind path with + | None -> None + | Some query -> lookup_shape env query + +let lookup_value_path = lookup_kind_path Kind.Value + +let lookup_type_path = lookup_kind_path Kind.Type + +let lookup_module_type_path = lookup_kind_path Kind.Module_type + +let lookup_class_type_path = lookup_kind_path Kind.Class_type + #else type t = unit let lookup_def _ _id = None +let lookup_value_path _ _id = None + +let lookup_module_path _ _id = None + +let lookup_type_path _ _id = None + +let lookup_module_type_path _ _id = None + +let lookup_class_type_path _ _id = None + #endif diff --git a/src/xref2/shape_tools.cppo.mli b/src/xref2/shape_tools.cppo.mli index d9082e06ba..adfddc5d2c 100644 --- a/src/xref2/shape_tools.cppo.mli +++ b/src/xref2/shape_tools.cppo.mli @@ -13,3 +13,29 @@ val lookup_def : Env.t -> Identifier.NonSrc.t -> Identifier.SourceLocation.t option + +val lookup_value_path : + Env.t -> + Path.Value.t -> + Identifier.SourceLocation.t option + +val lookup_type_path : + Env.t -> + Path.Type.t -> + Identifier.SourceLocation.t option + +val lookup_module_path : + Env.t -> + Path.Module.t -> + Identifier.SourceLocation.t option + +val lookup_module_type_path : + Env.t -> + Path.ModuleType.t -> + Identifier.SourceLocation.t option + +val lookup_class_type_path : + Env.t -> + Path.ClassType.t -> + Identifier.SourceLocation.t option + diff --git a/src/xref2/tools.ml b/src/xref2/tools.ml index bbf35ecede..a59437874c 100644 --- a/src/xref2/tools.ml +++ b/src/xref2/tools.ml @@ -52,7 +52,7 @@ let c_ty_poss env p = match p with | `Dot (p, n) -> ( let rest = List.map (fun p -> `Dot (p, n)) (c_mod_poss env p) in - match Env.lookup_by_name Env.s_type n env with + match Env.lookup_by_name Env.s_datatype n env with | Ok (`Type (id, _)) -> `Identifier ((id :> Odoc_model.Paths.Identifier.Path.Type.t), false) :: rest @@ -64,7 +64,7 @@ let c_daty_poss env p = match p with | `Dot (p, n) -> ( let rest = List.map (fun p -> `Dot (p, n)) (c_mod_poss env p) in - match Env.lookup_by_name Env.s_type n env with + match Env.lookup_by_name Env.s_datatype n env with | Ok (`Type (id, _)) -> `Identifier ((id :> Odoc_model.Paths.Identifier.Path.DataType.t), false) @@ -436,7 +436,7 @@ let simplify_type : Env.t -> Cpath.Resolved.type_ -> Cpath.Resolved.type_ = match m with | `Type (`Module (`Gpath (`Identifier p)), name) -> ( let ident = (Mk.type_ ((p :> Signature.t), name) : Path.Type.t) in - match Env.(lookup_by_id s_type (ident :> Path.Type.t) env) with + match Env.(lookup_by_id s_datatype (ident :> Path.Type.t) env) with | Some _ -> `Gpath (`Identifier ident) | None -> m) | _ -> m @@ -858,7 +858,8 @@ and lookup_type_gpath : next clause. We just look them up here in the list of core types *) Ok (`FType (name, List.assoc (TypeName.to_string name) core_types)) | `Identifier ({ iv = `Type _; _ } as i) -> - of_option ~error:(`Lookup_failureT i) (Env.(lookup_by_id s_type) i env) + of_option ~error:(`Lookup_failureT i) + (Env.(lookup_by_id s_datatype) i env) >>= fun (`Type ({ iv = `CoreType name | `Type (_, name); _ }, t)) -> Ok (`FType (name, t)) | `Identifier ({ iv = `Class _; _ } as i) -> @@ -877,6 +878,29 @@ and lookup_type_gpath : in res +and lookup_value_gpath : + Env.t -> + Odoc_model.Paths.Path.Resolved.Value.t -> + (Find.value, simple_value_lookup_error) Result.result = + fun env p -> + let do_value p name = + lookup_parent_gpath ~mark_substituted:true env p + |> map_error (fun e -> (e :> simple_value_lookup_error)) + >>= fun (sg, sub) -> + match Find.value_in_sig sg name with + | `FValue (name, t) :: _ -> Ok (`FValue (name, Subst.value sub t)) + | [] -> Error `Find_failure + in + let res = + match p with + | `Identifier ({ iv = `Value _; _ } as i) -> + of_option ~error:(`Lookup_failureV i) (Env.(lookup_by_id s_value) i env) + >>= fun (`Value ({ iv = `Value (_, name); _ }, t)) -> + Ok (`FValue (name, t)) + | `Value (p, id) -> do_value p (ValueName.to_string id) + in + res + and lookup_datatype_gpath : Env.t -> Odoc_model.Paths.Path.Resolved.DataType.t -> @@ -899,7 +923,8 @@ and lookup_datatype_gpath : next clause. We just look them up here in the list of core types *) Ok (`FType (name, List.assoc (TypeName.to_string name) core_types)) | `Identifier ({ iv = `Type _; _ } as i) -> - of_option ~error:(`Lookup_failureT i) (Env.(lookup_by_id s_type) i env) + of_option ~error:(`Lookup_failureT i) + (Env.(lookup_by_id s_datatype) i env) >>= fun (`Type ({ iv = `CoreType name | `Type (_, name); _ }, t)) -> Ok (`FType (name, t)) | `CanonicalDataType (t1, _) -> lookup_datatype_gpath env t1 @@ -1003,13 +1028,16 @@ and lookup_datatype : and lookup_value : Env.t -> Cpath.Resolved.value -> - (Find.value, simple_value_lookup_error) Result.result = - fun env (`Value (p, id)) -> - lookup_parent ~mark_substituted:true env p - |> map_error (fun e -> (e :> simple_value_lookup_error)) - >>= fun (sg, sub) -> - handle_value_lookup env (ValueName.to_string id) p sg - >>= fun (_, `FValue (name, c)) -> Ok (`FValue (name, Subst.value sub c)) + (_, simple_value_lookup_error) Result.result = + fun env p -> + match p with + | `Value (p, id) -> + lookup_parent ~mark_substituted:true env p + |> map_error (fun e -> (e :> simple_value_lookup_error)) + >>= fun (sg, sub) -> + handle_value_lookup env (ValueName.to_string id) p sg + >>= fun (_, `FValue (name, c)) -> Ok (`FValue (name, Subst.value sub c)) + | `Gpath p -> lookup_value_gpath env p and lookup_constructor : Env.t -> @@ -1355,6 +1383,9 @@ and resolve_value : Env.t -> Cpath.value -> resolve_value_result = in of_option ~error:`Find_failure result | `Resolved r -> lookup_value env r >>= fun t -> Ok (r, t) + | `Identifier (i, _) -> + let i' = `Identifier i in + lookup_value env (`Gpath i') >>= fun t -> Ok (`Gpath i', t) in result @@ -1806,7 +1837,10 @@ and reresolve_datatype : result and reresolve_value : Env.t -> Cpath.Resolved.value -> Cpath.Resolved.value = - fun env (`Value (p, n)) -> `Value (reresolve_parent env p, n) + fun env p -> + match p with + | `Value (p, n) -> `Value (reresolve_parent env p, n) + | `Gpath _ -> p and reresolve_constructor : Env.t -> Cpath.Resolved.constructor -> Cpath.Resolved.constructor = diff --git a/test/model/semantics/test.ml b/test/model/semantics/test.ml index f6ceffc4bd..5460e18824 100644 --- a/test/model/semantics/test.ml +++ b/test/model/semantics/test.ml @@ -1645,79 +1645,79 @@ let%expect_test _ = test "{!class-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_class_type = test "{!class-type-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-type-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-16:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-type-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-16:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_constructor = test "{!constructor-Foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_exception = test "{!exception-Foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_extension = test "{!extension-Foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_field = test "{!field-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"field-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"field-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_section = test "{!section-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"section-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"section-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_instance_variable = test "{!instance-variable-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_method = test "{!method-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"method-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"method-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_module = test "{!module-Foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"module-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Root":["Foo","`TModule"]},"Bar"]},[]]}]}],"warnings":[]} |}] let constructor_in_module_type = test "{!module-type-Foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"module-type-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Root":["Foo","`TModuleType"]},"Bar"]},[]]}]}],"warnings":[]} |}] let constructor_in_page = test "{!page-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_val = test "{!val-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_something_nested = test "{!foo.bar.constructor-Baz}"; @@ -1735,79 +1735,79 @@ let%expect_test _ = test "{!Foo.class-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_class_type_nested = test "{!Foo.class-type-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-type-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-20:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-type-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-20:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_constructor_nested = test "{!Foo.constructor-Bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_exception_nested = test "{!Foo.exception-Bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_extension_nested = test "{!Foo.extension-Bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_field_nested = test "{!foo.field-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_section_nested = test "{!foo.section-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_instance_variable_nested = test "{!foo.instance-variable-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_method_nested = test "{!foo.method-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_module_nested = test "{!Foo.module-Bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.module-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Module":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"Baz"]},[]]}]}],"warnings":[]} |}] let constructor_in_module_type_nested = test "{!Foo.module-type-Bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.module-type-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`ModuleType":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"Baz"]},[]]}]}],"warnings":[]} |}] let constructor_in_page_nested = test "{!foo.page-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_val_nested = test "{!Foo.val-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'type-' or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_empty = test "{!.field-foo}"; @@ -1843,67 +1843,67 @@ let%expect_test _ = test "{!class-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Root":["foo","`TClass"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_class_type = test "{!class-type-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Root":["foo","`TClassType"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-type-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-16:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_constructor = test "{!constructor-Foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_exception = test "{!exception-Foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_extension = test "{!extension-Foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_field = test "{!field-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"field-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"field-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_section = test "{!section-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"section-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"section-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_instance_variable = test "{!instance-variable-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_method = test "{!method-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"method-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"method-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_page = test "{!page-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_val = test "{!val-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_something_nested = test "{!foo.bar.field-baz}"; @@ -1933,67 +1933,67 @@ let%expect_test _ = test "{!Foo.class-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Class":[{"`Root":["Foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_class_type_nested = test "{!Foo.class-type-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`ClassType":[{"`Root":["Foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-type-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-20:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_constructor_nested = test "{!Foo.constructor-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_exception_nested = test "{!Foo.exception-Bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_extension_nested = test "{!Foo.extension-Bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_field_nested = test "{!Foo.field-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.field-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.field-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_section_nested = test "{!foo.section-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_instance_variable_nested = test "{!foo.instance-variable-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_method_nested = test "{!foo.method-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_page_nested = test "{!foo.page-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_val_nested = test "{!Foo.val-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let exception_in_something = test "{!Foo.exception-Bar}"; @@ -2371,13 +2371,13 @@ let%expect_test _ = test "{!class-foo.bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Dot":[{"`Root":["foo","`TClass"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_parent_something_in_page = test "{!page-foo.bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_parent_module_in_module = test "{!module-Foo.module-Bar.field-baz}"; @@ -2419,25 +2419,25 @@ let%expect_test _ = test "{!module-Foo.class-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Class":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"module-Foo.class-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 13-22:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_parent_class_in_class = test "{!class-foo.class-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 12-21:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_parent_class_type_in_module = test "{!module-Foo.class-type-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`ClassType":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"module-Foo.class-type-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 13-27:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_parent_class_type_in_class = test "{!class-foo.class-type-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-type-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-type-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 12-26:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_label_parent_something_in_something = test "{!foo.bar.baz}"; @@ -2527,7 +2527,7 @@ let%expect_test _ = test "{!page-foo.bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_class_signature_class_in_module = test "{!module-Foo.class-bar.method-baz}"; @@ -2563,7 +2563,7 @@ let%expect_test _ = test "{!page-foo.bar.type-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.type-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.type-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_signature_module_in_module = test "{!module-Foo.module-Bar.type-baz}"; @@ -2599,7 +2599,7 @@ let%expect_test _ = test "{!page-foo.bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_datatype_type_in_module = test "{!module-Foo.type-bar.constructor-Baz}"; diff --git a/test/occurrences/double_wrapped.t/a.ml b/test/occurrences/double_wrapped.t/a.ml new file mode 100644 index 0000000000..aa8464151f --- /dev/null +++ b/test/occurrences/double_wrapped.t/a.ml @@ -0,0 +1,9 @@ +let x = 1 + +type t = string + +module type M = sig end + +let (||>) x y = x + y + +let _ = x + x diff --git a/test/occurrences/double_wrapped.t/b.ml b/test/occurrences/double_wrapped.t/b.ml new file mode 100644 index 0000000000..6a01b082fe --- /dev/null +++ b/test/occurrences/double_wrapped.t/b.ml @@ -0,0 +1,15 @@ +module Y = A + +module Z = C + +let y = Y.x + A.x + Z.y + C.y + +let (_ : A.t) = "string" + +module M : A.M = struct end + +module type Y = A.M + +let _ = + let open A in + 1 ||> 2 diff --git a/test/occurrences/double_wrapped.t/c.ml b/test/occurrences/double_wrapped.t/c.ml new file mode 100644 index 0000000000..b0ae315a86 --- /dev/null +++ b/test/occurrences/double_wrapped.t/c.ml @@ -0,0 +1,3 @@ +module Y = A + +let y = Y.x + A.x diff --git a/test/occurrences/double_wrapped.t/main.ml b/test/occurrences/double_wrapped.t/main.ml new file mode 100644 index 0000000000..25a40aaa6e --- /dev/null +++ b/test/occurrences/double_wrapped.t/main.ml @@ -0,0 +1,5 @@ +(** Handwritten top-level module *) + +module A = A + +module B = B diff --git a/test/occurrences/double_wrapped.t/main__.ml b/test/occurrences/double_wrapped.t/main__.ml new file mode 100644 index 0000000000..59f553e2ae --- /dev/null +++ b/test/occurrences/double_wrapped.t/main__.ml @@ -0,0 +1,10 @@ +(** Would be generated by dune *) + +module A = Main__A +(** @canonical Main.A *) + +module B = Main__B +(** @canonical Main.B *) + +module C = Main__C +(** @canonical Main.C *) diff --git a/test/occurrences/double_wrapped.t/root.mld b/test/occurrences/double_wrapped.t/root.mld new file mode 100644 index 0000000000..54f377d3e8 --- /dev/null +++ b/test/occurrences/double_wrapped.t/root.mld @@ -0,0 +1 @@ +{0 Root} diff --git a/test/occurrences/double_wrapped.t/run.t b/test/occurrences/double_wrapped.t/run.t new file mode 100644 index 0000000000..5361b9d035 --- /dev/null +++ b/test/occurrences/double_wrapped.t/run.t @@ -0,0 +1,128 @@ +This test simulates the conditions when a dune user write a toplevel module. + +The module C is not exposed in the handwritten toplevel module. +The module A and B are exposed. +The module B depends on both B and C, the module C only depends on A. + + $ ocamlc -c -o main__.cmo main__.ml -bin-annot -w -49 -no-alias-deps -I . + $ ocamlc -c -open Main__ -o main__A.cmo a.ml -bin-annot -I . + $ ocamlc -c -open Main__ -o main__C.cmo c.ml -bin-annot -I . + $ ocamlc -c -open Main__ -o main__B.cmo b.ml -bin-annot -I . + $ ocamlc -c -open Main__ main.ml -bin-annot -I . + +Passing the count-occurrences flag to odoc compile makes it collect the +occurrences information. + + $ odoc compile --count-occurrences -I . main__A.cmt + $ odoc compile --count-occurrences -I . main__C.cmt + $ odoc compile --count-occurrences -I . main__B.cmt + $ odoc compile --count-occurrences -I . main__.cmt + $ odoc compile --count-occurrences -I . main.cmt + + $ odoc link -I . main.odoc + $ odoc link -I . main__A.odoc + $ odoc link -I . main__B.odoc + $ odoc link -I . main__C.odoc + $ odoc link -I . main__.odoc + +The count occurrences command outputs a marshalled hashtable, whose keys are +odoc identifiers, and whose values are integers corresponding to the number of +uses. We can later aggregate those hashtables, so we create the full hashtable, +and a hashtable for each compilation unit. + + $ mkdir main + $ mkdir main__ + $ mkdir main__A + $ mkdir main__B + $ mkdir main__C + + $ mv main.odocl main + $ mv main__.odocl main__ + $ mv main__A.odocl main__A + $ mv main__B.odocl main__B + $ mv main__C.odocl main__C + $ odoc count-occurrences -I main -o main.occ + $ odoc count-occurrences -I main__ -o main__.occ + $ odoc count-occurrences -I main__A -o main__A.occ + $ odoc count-occurrences -I main__B -o main__B.occ + $ odoc count-occurrences -I main__C -o main__C.occ + +The occurrences_print executable, available only for testing, unmarshal the file +and prints the number of occurrences in a readable format. + +Uses of A are: 2 times in b.ml, 1 time in c.ml, 1 time in main.ml +Uses of B are: 1 time in main.ml +Uses of C are not counted, since the canonical destination (Main.C, generated by dune) does not exist. +Uses of B.Z are not counted since they go to a hidden module. +Uses of values Y.x and Z.y (in b.ml) are not counted since they come from a "local" module. + + $ occurrences_print main.occ | sort + Main was used directly 0 times and indirectly 2 times + Main.A was used directly 1 times and indirectly 0 times + Main.B was used directly 1 times and indirectly 0 times + + $ occurrences_print main__.occ | sort + +A only uses "persistent" values: one it defines itself. + $ occurrences_print main__A.occ | sort + +"Aliased" values are not counted since they become persistent + $ occurrences_print main__B.occ | sort + Main was used directly 0 times and indirectly 7 times + Main.A was used directly 2 times and indirectly 5 times + Main.A.(||>) was used directly 1 times and indirectly 0 times + Main.A.M was used directly 2 times and indirectly 0 times + Main.A.t was used directly 1 times and indirectly 0 times + Main.A.x was used directly 1 times and indirectly 0 times + +"Aliased" values are not counted since they become persistent + $ occurrences_print main__C.occ | sort + Main was used directly 0 times and indirectly 2 times + Main.A was used directly 1 times and indirectly 1 times + Main.A.x was used directly 1 times and indirectly 0 times + +Now we can merge all tables + + $ cat > files.map << EOF + > main__A.occ + > main__B.occ + > main__C.occ + > EOF + $ odoc aggregate-occurrences main.occ main__.occ --file-list files.map -o aggregated.txt + + $ occurrences_print aggregated.txt | sort > all_merged + $ cat all_merged + Main was used directly 0 times and indirectly 11 times + Main.A was used directly 4 times and indirectly 6 times + Main.A.(||>) was used directly 1 times and indirectly 0 times + Main.A.M was used directly 2 times and indirectly 0 times + Main.A.t was used directly 1 times and indirectly 0 times + Main.A.x was used directly 2 times and indirectly 0 times + Main.B was used directly 1 times and indirectly 0 times + +Compare with the one created directly with all occurrences: + + $ odoc count-occurrences -I . -o occurrences.txt + $ occurrences_print occurrences.txt | sort > directly_all + $ diff all_merged directly_all + +We can also include hidden ids: + + $ odoc count-occurrences -I main__A -o occurrences.txt --include-hidden + $ occurrences_print occurrences.txt | sort + + $ odoc count-occurrences -I . -o occurrences.txt --include-hidden + $ occurrences_print occurrences.txt | sort + Main was used directly 0 times and indirectly 11 times + Main.A was used directly 4 times and indirectly 6 times + Main.A.(||>) was used directly 1 times and indirectly 0 times + Main.A.M was used directly 2 times and indirectly 0 times + Main.A.t was used directly 1 times and indirectly 0 times + Main.A.x was used directly 2 times and indirectly 0 times + Main.B was used directly 1 times and indirectly 0 times + Main__ was used directly 0 times and indirectly 2 times + Main__.C was used directly 1 times and indirectly 1 times + Main__.C.y was used directly 1 times and indirectly 0 times + Main__A was used directly 1 times and indirectly 0 times + Main__B was used directly 1 times and indirectly 0 times + Main__C was used directly 1 times and indirectly 0 times diff --git a/test/occurrences/dune b/test/occurrences/dune new file mode 100644 index 0000000000..7ce8e1acbc --- /dev/null +++ b/test/occurrences/dune @@ -0,0 +1,11 @@ +; Tests related to linking to source code + +(env + (_ + (binaries + (../odoc_print/occurrences_print.exe as occurrences_print)))) + +(cram + (enabled_if + (>= %{ocaml_version} 4.14.1)) + (deps %{bin:odoc} %{bin:occurrences_print})) diff --git a/test/odoc_print/dune b/test/odoc_print/dune index 2ff497d279..af9fe88cde 100644 --- a/test/odoc_print/dune +++ b/test/odoc_print/dune @@ -6,9 +6,9 @@ (executable (name odoc_print) (modules odoc_print) - (libraries - odoc_odoc - cmdliner - type_desc_to_yojson - odoc_model_desc - compatcmdliner)) + (libraries odoc_odoc type_desc_to_yojson odoc_model_desc compatcmdliner)) + +(executable + (name occurrences_print) + (modules occurrences_print) + (libraries odoc_model_desc compatcmdliner odoc_odoc)) diff --git a/test/odoc_print/occurrences_print.ml b/test/odoc_print/occurrences_print.ml new file mode 100644 index 0000000000..eb2f8c4284 --- /dev/null +++ b/test/odoc_print/occurrences_print.ml @@ -0,0 +1,28 @@ +module H = Hashtbl.Make (Odoc_model.Paths.Identifier) + +let run inp = + let ic = open_in_bin inp in + let htbl : Odoc_odoc.Occurrences.Occtbl.t = Marshal.from_channel ic in + Odoc_odoc.Occurrences.Occtbl.iter + (fun id { Odoc_odoc.Occurrences.Occtbl.direct; indirect; _ } -> + let id = String.concat "." (Odoc_model.Paths.Identifier.fullname id) in + Format.printf "%s was used directly %d times and indirectly %d times\n" id + direct indirect) + htbl + +open Compatcmdliner + +let a_inp = + let doc = "Input file." in + Arg.(required & pos 0 (some file) None & info ~doc ~docv:"PATH" []) + +let term = + let doc = + "Print the content of occurrences files into a text format. For tests" + in + Term.(const run $ a_inp, info "occurrences_print" ~doc) + +let () = + match Term.eval term with + | `Ok () -> () + | (`Version | `Help | `Error _) as x -> Term.exit x diff --git a/test/sources/source.t/run.t b/test/sources/source.t/run.t index f350b1b810..9adb34e60c 100644 --- a/test/sources/source.t/run.t +++ b/test/sources/source.t/run.t @@ -307,9 +307,8 @@ Ids generated in the source code: id="module-F.argument-1-M.module-A" id="module-F.module-B" id="module-FM" - id="def_3" + id="local_A_3" id="module-FF" id="module-FF2" id="module-FF2.argument-1-A.module-E" id="module-FF2.argument-2-A.module-F" - diff --git a/test/xref2/github_issue_447.t/a.mli b/test/xref2/github_issue_447.t/a.mli new file mode 100644 index 0000000000..6122752420 --- /dev/null +++ b/test/xref2/github_issue_447.t/a.mli @@ -0,0 +1,15 @@ +type u = Foo + +(** {!constructor-Foo} {!u.constructor-Foo} {!Foo} *) + +module M : sig + type t = Foo +end + +(** {!M.constructor-Foo} and {!M.Foo} + + {!M.t.constructor-Foo} and {!M.t.Foo} *) + +class t : object end + +(** {!t.constructor-A} *) diff --git a/test/xref2/github_issue_447.t/run.t b/test/xref2/github_issue_447.t/run.t new file mode 100644 index 0000000000..b8c7efad73 --- /dev/null +++ b/test/xref2/github_issue_447.t/run.t @@ -0,0 +1,26 @@ +This test tests the ability to reference constructors, omitting the type they +are coming from. + + $ ocamlc -c -bin-annot a.mli + $ odoc compile --warn-error -I . a.cmti + +It is possible to omit type parent in constructor reference, and use directly +the parent module. All references in [a.mli] resolve without warning, except the +faulty reference. + + $ odoc link a.odoc + File "a.mli", line 15, characters 4-22: + Warning: Failed to resolve reference unresolvedroot(t).A Couldn't find "t" + +Let's now check that the reference point to the right page/anchor: + + $ odoc html-generate --output-dir html --indent a.odocl + + $ cat html/A/index.html | grep \# | grep Foo | grep -v anchor +

Foo + u.Foo + Foo +

M.t.Foo and + M.t.Foo +

M.t.Foo and + M.t.Foo diff --git a/test/xref2/refs/refs.md b/test/xref2/refs/refs.md index f40426be05..cbc5bb2229 100644 --- a/test/xref2/refs/refs.md +++ b/test/xref2/refs/refs.md @@ -448,8 +448,24 @@ Explicit, in sig: M); ihash = 716453475; ikey = "m_M.r_Root.p_None"}, E2) -# resolve_ref "constructor:M.C2" (* Not allowed by types *) ;; -Exception: Failure "resolve_reference: Couldn't find \"M\"". +# resolve_ref "constructor:M.C2" ;; +- : ref = +`Constructor + (`Type + (`Identifier + {Odoc_model__Paths_types.iv = + `Module + ({Odoc_model__Paths_types.iv = + `Root + (Some + {Odoc_model__Paths_types.iv = `Page (None, None); + ihash = 236059787; ikey = "p_None"}, + Root); + ihash = 818126955; ikey = "r_Root.p_None"}, + M); + ihash = 716453475; ikey = "m_M.r_Root.p_None"}, + t2), + C2) # resolve_ref "val:M.e2" ;; - : ref = `Value @@ -515,7 +531,7 @@ Exception: Failure "resolve_reference: Couldn't find \"M\"". ihash = 716453475; ikey = "m_M.r_Root.p_None"}, x2) # resolve_ref "constructor:M.X2" (* X2 is an extension constructor *) ;; -Exception: Failure "resolve_reference: Couldn't find \"M\"". +Exception: Failure "resolve_reference: Couldn't find \"X2\"". # resolve_ref "extension:M.X2" ;; - : ref = `Extension @@ -2634,7 +2650,7 @@ Exception: Failure "resolve_reference: Couldn't find field \"C\"". Exception: Failure "resolve_reference: is of kind type but expected class". # (* Lookup a constructor but find a field *) resolve_ref "M.constructor-f" ;; -Exception: Failure "resolve_reference: Couldn't find \"M\"". +Exception: Failure "resolve_reference: Couldn't find constructor \"f\"". # resolve_ref "M.u.constructor-f" ;; Exception: Failure "resolve_reference: Couldn't find constructor \"f\"". ``` @@ -2666,11 +2682,10 @@ Failure # resolve_ref "M.t.method-m" ;; Exception: Failure "resolve_reference: is of kind type but expected class or class type". -# resolve_ref "c.constructor-C" (* Type in env but find class (parent of constructor is "datatype") *) ;; +# resolve_ref "c.constructor-C" (* Type in env but find class (parent of constructor is "parent") *) ;; Exception: Failure "resolve_reference: Couldn't find \"c\"". # resolve_ref "c.field-f" (* Field in class (parent of field is "label_parent") *) ;; -Exception: -Failure "resolve_reference: is of kind class but expected signature or type". +Exception: Failure "resolve_reference: Couldn't find \"c\"". ``` ## Ambiguous references @@ -2922,7 +2937,23 @@ Unambiguous: ihash = 895481052; ikey = "m_X.r_Root.p_None"}, u) # resolve_ref "X.constructor-Y" ;; -Exception: Failure "resolve_reference: Couldn't find \"X\"". +- : ref = +`Constructor + (`Type + (`Identifier + {Odoc_model__Paths_types.iv = + `Module + ({Odoc_model__Paths_types.iv = + `Root + (Some + {Odoc_model__Paths_types.iv = `Page (None, None); + ihash = 236059787; ikey = "p_None"}, + Root); + ihash = 818126955; ikey = "r_Root.p_None"}, + X); + ihash = 895481052; ikey = "m_X.r_Root.p_None"}, + u), + Y) # resolve_ref "X.module-Y" ;; - : ref = `Module @@ -3037,7 +3068,23 @@ Unambiguous 2: ihash = 895481052; ikey = "m_X.r_Root.p_None"}, u) # resolve_ref "constructor:X.Y" ;; -Exception: Failure "resolve_reference: Couldn't find \"X\"". +- : ref = +`Constructor + (`Type + (`Identifier + {Odoc_model__Paths_types.iv = + `Module + ({Odoc_model__Paths_types.iv = + `Root + (Some + {Odoc_model__Paths_types.iv = `Page (None, None); + ihash = 236059787; ikey = "p_None"}, + Root); + ihash = 818126955; ikey = "r_Root.p_None"}, + X); + ihash = 895481052; ikey = "m_X.r_Root.p_None"}, + u), + Y) # resolve_ref "module:X.Y" ;; - : ref = `Module