+4 -4

sherlodoc/index/load_doc.ml

··· 82 82 | TypeDecl.Constructor.Tuple args -> begin 83 83 match args with 84 84 | _ :: _ :: _ -> 85 85 - TypeExpr.(Arrow (None, Tuple (List.map (fun x -> None, x) args), res, [])) 86 86 - | [ arg ] -> TypeExpr.(Arrow (None, arg, res, [])) 85 85 + TypeExpr.(Arrow (None, Tuple (List.map (fun x -> None, x) args), res, [], [])) 86 86 + | [ arg ] -> TypeExpr.(Arrow (None, arg, res, [], [])) 87 87 | _ -> res 88 88 end 89 89 | TypeDecl.Constructor.Record fields -> ··· 91 91 (fun res field -> 92 92 let open TypeDecl.Field in 93 93 let field_name = Odoc_model.Paths.Identifier.name field.id in 94 94 - TypeExpr.Arrow (Some (Label field_name), field.type_, res, [])) 94 94 + TypeExpr.Arrow (Some (Label field_name), field.type_, res, [], [])) 95 95 res 96 96 fields 97 97 98 98 let searchable_type_of_record parent_type type_ = 99 99 - Odoc_model.Lang.TypeExpr.Arrow (None, parent_type, type_, []) 99 99 + Odoc_model.Lang.TypeExpr.Arrow (None, parent_type, type_, [], []) 100 100 101 101 let convert_kind ~db (Odoc_index.Entry.{ kind; _ } as entry) = 102 102 match kind with

+1 -1

sherlodoc/index/type_cache.ml

··· 16 16 match otyp with 17 17 | Odoc_model.Lang.TypeExpr.Var (_str, _) -> Any 18 18 | Any -> Any 19 19 - | Arrow (_lbl, left, right, _modes) -> cache (Arrow (of_odoc ~cache left, of_odoc ~cache right)) 19 19 + | Arrow (_lbl, left, right, _modes, _ret_modes) -> cache (Arrow (of_odoc ~cache left, of_odoc ~cache right)) 20 20 | Constr (name, args) -> 21 21 cache (Constr (Typename.to_string name, List.map (of_odoc ~cache) args)) 22 22 | Tuple li -> cache (Tuple (List.map (fun (_, ty) -> of_odoc ~cache ty) li))

+27 -6

src/document/generator.ml

··· 451 451 enclose_parens_if_needed 452 452 (type_expr ~needs_parentheses:true te 453 453 ++ O.txt " " ++ O.keyword "as" ++ O.txt " '" ++ O.txt alias) 454 454 - | Arrow (None, src, dst, modes) -> 454 454 + | Arrow (None, src, dst, modes, ret_modes) -> 455 455 let mode_suffix = match modes with 456 456 | [] -> O.noop 457 457 | ms -> 458 458 O.txt " " ++ O.keyword "@" ++ O.txt " " 459 459 ++ O.txt (String.concat ~sep:" " ms) 460 460 in 461 461 + let dst_needs_parens = ret_modes <> [] && (match dst with Arrow _ -> true | _ -> false) in 462 462 + let dst_rendered = type_expr ~needs_parentheses:dst_needs_parens dst in 463 463 + let ret_suffix = match ret_modes with 464 464 + | [] -> O.noop 465 465 + | ms -> 466 466 + O.txt " " ++ O.keyword "@" ++ O.txt " " 467 467 + ++ O.txt (String.concat ~sep:" " ms) 468 468 + in 461 469 let res = 462 470 O.span 463 471 ((O.box_hv @@ type_expr ~needs_parentheses:true src ++ mode_suffix) 464 472 ++ O.txt " " ++ Syntax.Type.arrow) 465 465 - ++ O.sp ++ type_expr dst 473 473 + ++ O.sp ++ dst_rendered ++ ret_suffix 466 474 in 467 475 if not needs_parentheses then res else enclose ~l:"(" res ~r:")" 468 468 - | Arrow (Some (RawOptional _ as lbl), _src, dst, _modes) -> 476 476 + | Arrow (Some (RawOptional _ as lbl), _src, dst, _modes, _ret_modes) -> 469 477 let res = 470 478 O.span 471 479 (O.box_hv ··· 475 483 ++ O.sp ++ type_expr dst 476 484 in 477 485 if not needs_parentheses then res else enclose ~l:"(" res ~r:")" 478 478 - | Arrow (Some lbl, src, dst, modes) -> 486 486 + | Arrow (Some lbl, src, dst, modes, ret_modes) -> 479 487 let mode_suffix = match modes with 480 488 | [] -> O.noop 481 489 | ms -> 482 490 O.txt " " ++ O.keyword "@" ++ O.txt " " 483 491 ++ O.txt (String.concat ~sep:" " ms) 484 492 in 493 493 + let dst_needs_parens = ret_modes <> [] && (match dst with Arrow _ -> true | _ -> false) in 494 494 + let dst_rendered = type_expr ~needs_parentheses:dst_needs_parens dst in 495 495 + let ret_suffix = match ret_modes with 496 496 + | [] -> O.noop 497 497 + | ms -> 498 498 + O.txt " " ++ O.keyword "@" ++ O.txt " " 499 499 + ++ O.txt (String.concat ~sep:" " ms) 500 500 + in 485 501 let res = 486 502 O.span 487 503 ((O.box_hv ··· 489 505 ++ (O.box_hv @@ type_expr ~needs_parentheses:true src) 490 506 ++ mode_suffix) 491 507 ++ O.txt " " ++ Syntax.Type.arrow) 492 492 - ++ O.sp ++ type_expr dst 508 508 + ++ O.sp ++ dst_rendered ++ ret_suffix 493 509 in 494 510 if not needs_parentheses then res else enclose ~l:"(" res ~r:")" 495 511 | Tuple lst -> tuple ~needs_parentheses ~boxed:true lst ··· 852 868 let desc = 853 869 match desc with 854 870 | Odoc_model.Lang.TypeDecl.Any -> [ "_" ] 855 855 - | Var s -> [ "'"; s ] 871 871 + | Var (s, None) -> [ "'"; s ] 872 872 + | Var (s, Some jkind) -> [ "("; "'"; s; " : "; jkind; ")" ] 856 873 in 857 874 let var_desc = 858 875 match variance with ··· 1004 1021 ++ O.txt " " ++ O.txt name 1005 1022 ++ O.txt Syntax.Type.annotation_separator 1006 1023 ++ O.cut ++ type_expr t.type_ 1024 1024 + ++ (match t.modalities with 1025 1025 + | [] -> O.noop 1026 1026 + | ms -> O.txt " " ++ O.keyword "@@" ++ O.txt " " 1027 1027 + ++ O.txt (String.concat ~sep:" " ms)) 1007 1028 ++ if semicolon then O.txt ";" else O.noop) 1008 1029 in 1009 1030 let attr = [ "value" ] @ extra_attr in

+1 -1

src/index/skeleton.ml

··· 54 54 let varify_params = 55 55 List.mapi (fun i param -> 56 56 match param.TypeDecl.desc with 57 57 - | Var name -> TypeExpr.Var (name, None) 57 57 + | Var (name, _) -> TypeExpr.Var (name, None) 58 58 | Any -> Var (Printf.sprintf "tv_%i" i, None)) 59 59 60 60 let of_constructor id_parent params source_loc (c : TypeDecl.Constructor.t) =

+71 -4

src/loader/cmi.ml

··· 543 543 | Sort (Var _) -> None (* sort variable — not determined *) 544 544 | Product _ -> None (* product layout — complex, skip for now *) 545 545 | Any -> None 546 546 + 547 547 + (** Extract non-default modality strings from a value's modalities. 548 548 + Replicates the implied-modality filtering from [Typemode.least_modalities]. *) 549 549 + let extract_modalities modalities = 550 550 + let m = Mode.Modality.zap_to_floor modalities in 551 551 + if Mode.Modality.Const.is_id m then [] 552 552 + else begin 553 553 + let atoms = Mode.Modality.Const.diff Mode.Modality.Const.id m in 554 554 + (* Compute implied atoms from each annotated atom *) 555 555 + let implied_of_atom (Mode.Modality.Atom (ax, v)) = 556 556 + match ax, v with 557 557 + | Comonadic Areality, Meet_with Global -> 558 558 + [ Mode.Modality.Atom (Comonadic Forkable, Meet_with Mode.Forkable.Const.Forkable) 559 559 + ; Mode.Modality.Atom (Comonadic Yielding, Meet_with Mode.Yielding.Const.Unyielding) 560 560 + ; Mode.Modality.Atom (Monadic Uniqueness, Join_with Mode.Uniqueness.Const.Aliased) 561 561 + ] 562 562 + | Comonadic Areality, Meet_with Local -> 563 563 + [ Mode.Modality.Atom (Comonadic Forkable, Meet_with Mode.Forkable.Const.Unforkable) 564 564 + ; Mode.Modality.Atom (Comonadic Yielding, Meet_with Mode.Yielding.Const.Yielding) 565 565 + ] 566 566 + | Monadic Visibility, Join_with Immutable -> 567 567 + [ Mode.Modality.Atom (Monadic Contention, Join_with Mode.Contention.Const.Contended) ] 568 568 + | Monadic Visibility, Join_with Read -> 569 569 + [ Mode.Modality.Atom (Monadic Contention, Join_with Mode.Contention.Const.Shared) ] 570 570 + | Monadic Visibility, Join_with Read_write -> 571 571 + [ Mode.Modality.Atom (Monadic Contention, Join_with Mode.Contention.Const.Uncontended) ] 572 572 + | Comonadic Statefulness, Meet_with Stateless -> 573 573 + [ Mode.Modality.Atom (Comonadic Portability, Meet_with Mode.Portability.Const.Portable) ] 574 574 + | Comonadic Statefulness, Meet_with Observing -> 575 575 + [ Mode.Modality.Atom (Comonadic Portability, Meet_with Mode.Portability.Const.Shareable) ] 576 576 + | Comonadic Statefulness, Meet_with Stateful -> 577 577 + [ Mode.Modality.Atom (Comonadic Portability, Meet_with Mode.Portability.Const.Nonportable) ] 578 578 + | _ -> [] 579 579 + in 580 580 + let implied = List.concat_map implied_of_atom atoms in 581 581 + (* Filter out atoms that are exactly implied by other atoms *) 582 582 + let filtered = List.filter (fun a -> not (List.mem a implied)) atoms in 583 583 + (* Add back atoms on implied axes with overridden (non-implied) values *) 584 584 + let overridden = List.filter_map (fun imp_atom -> 585 585 + let (Mode.Modality.Atom (ax, _v_implied)) = imp_atom in 586 586 + let v_actual = Mode.Modality.Const.proj ax m in 587 587 + let actual_atom = Mode.Modality.Atom (ax, v_actual) in 588 588 + if actual_atom <> imp_atom then Some actual_atom 589 589 + else None 590 590 + ) implied in 591 591 + let final_atoms = filtered @ overridden in 592 592 + List.filter_map (fun (Mode.Modality.Atom (ax, v)) -> 593 593 + let s = Format.asprintf "%a" (Printtyp.modality ax) v in 594 594 + if s = "" then None else Some s 595 595 + ) final_atoms 596 596 + end 546 597 #endif 547 598 548 599 let rec read_type_expr env typ = ··· 564 615 let nm = match name with Some n -> n | None -> name_of_type typ in 565 616 if nm = "_" then Any 566 617 else Var (nm, extract_jkind_of_tvar jkind) 567 567 - | Tarrow((lbl, marg, _mret), arg, res, _) -> 618 618 + | Tarrow((lbl, marg, mret), arg, res, _) -> 568 619 let arg_modes = extract_arg_modes marg in 620 620 + let ret_modes = extract_arg_modes mret in 569 621 #else 570 622 | Tvar _ -> 571 623 let name = name_of_type typ in ··· 573 625 else Var (name, None) 574 626 | Tarrow(lbl, arg, res, _) -> 575 627 let arg_modes = [] in 628 628 + let ret_modes = [] in 576 629 #endif 577 630 let lbl = read_label lbl in 578 631 let lbl,arg = ··· 594 647 lbl, read_type_expr env arg 595 648 in 596 649 let res = read_type_expr env res in 597 597 - Arrow(lbl, arg, res, arg_modes) 650 650 + Arrow(lbl, arg, res, arg_modes, ret_modes) 598 651 | Ttuple typs -> 599 652 #if OCAML_VERSION >= (5,4,0) || defined OXCAML 600 653 let typs = List.map (fun (lbl,x) -> lbl, read_type_expr env x) typs in ··· 797 850 in 798 851 (* Source location is not trustworthy since it's a cmi so left as None *) 799 852 let source_loc_jane = None in 800 800 - Value { Value.id; source_loc; doc; type_; value ; source_loc_jane } 853 853 + #if defined OXCAML 854 854 + let modalities = extract_modalities vd.val_modalities in 855 855 + #else 856 856 + let modalities = [] in 857 857 + #endif 858 858 + Value { Value.id; source_loc; doc; type_; value ; source_loc_jane; modalities } 801 859 802 860 #if defined OXCAML 803 861 let is_mutable = Types.is_mutable ··· 899 957 let name = name_of_type param in 900 958 let desc = 901 959 if name = "_" then Any 902 902 - else Var name 960 960 + else 961 961 + #if defined OXCAML 962 962 + let jkind_opt = match Compat.get_desc param with 963 963 + | Tvar { jkind; _ } -> extract_jkind_of_tvar jkind 964 964 + | _ -> None 965 965 + in 966 966 + Var (name, jkind_opt) 967 967 + #else 968 968 + Var (name, None) 969 969 + #endif 903 970 in 904 971 let variance = 905 972 if not (abstr || aliasable param) then None

+1

src/loader/cmi.mli

··· 90 90 91 91 #if defined OXCAML 92 92 val extract_arg_modes : Mode.Alloc.lr -> string list 93 93 + val extract_modalities : Mode.Modality.t -> string list 93 94 #endif 94 95 95 96 val read_extension_constructor : env ->

+3 -3

src/loader/cmt.ml

··· 54 54 let type_ = Cmi.read_type_expr env pat.pat_type in 55 55 let value = Abstract in 56 56 let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmt_builddir pat.pat_loc) in 57 57 - [Value {id; source_loc; doc; type_; value ; source_loc_jane }] 57 57 + [Value {id; source_loc; doc; type_; value ; source_loc_jane; modalities = [] }] 58 58 #if OCAML_VERSION < (5,2, 0) 59 59 | Tpat_alias(pat, id, _) -> 60 60 #elif defined OXCAML ··· 70 70 let type_ = Cmi.read_type_expr env pat.pat_type in 71 71 let value = Abstract in 72 72 let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmt_builddir pat.pat_loc) in 73 73 - Value {id; source_loc; doc; type_; value ; source_loc_jane } :: read_pattern env parent doc pat 73 73 + Value {id; source_loc; doc; type_; value ; source_loc_jane; modalities = [] } :: read_pattern env parent doc pat 74 74 | Tpat_constant _ -> [] 75 75 | Tpat_tuple pats -> 76 76 #if OCAML_VERSION >= (5, 4, 0) || defined OXCAML ··· 286 286 must keep only the type after the first arrow. *) 287 287 let type_ = 288 288 match Cmi.read_type_expr env expr.exp_type with 289 289 - | Arrow (_, _, t, _) -> t 289 289 + | Arrow (_, _, t, _, _) -> t 290 290 | t -> t 291 291 in 292 292 false, type_

+20 -10

src/loader/cmti.ml

··· 75 75 in 76 76 let res = read_core_type env container res in 77 77 #if defined OXCAML 78 78 - let arg_modes = match Types.get_desc ctyp.ctyp_type with 79 79 - | Tarrow((_lbl, marg, _mret), _arg, _res, _) -> 80 80 - Cmi.extract_arg_modes marg 81 81 - | _ -> [] 78 78 + let arg_modes, ret_modes = match Types.get_desc ctyp.ctyp_type with 79 79 + | Tarrow((_lbl, marg, mret), _arg, _res, _) -> 80 80 + (Cmi.extract_arg_modes marg, Cmi.extract_arg_modes mret) 81 81 + | _ -> ([], []) 82 82 in 83 83 - Arrow(lbl, arg, res, arg_modes) 83 83 + Arrow(lbl, arg, res, arg_modes, ret_modes) 84 84 #else 85 85 - Arrow(lbl, arg, res, []) 85 85 + Arrow(lbl, arg, res, [], []) 86 86 #endif 87 87 | Ttyp_tuple typs -> 88 88 #if OCAML_VERSION >= (5,4,0) || defined OXCAML ··· 229 229 | primitives -> External primitives 230 230 in 231 231 let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmti_builddir vd.val_loc) in 232 232 - Value { Value.id; source_loc; doc; type_; value ; source_loc_jane } 232 232 + #if defined OXCAML 233 233 + let modalities = Cmi.extract_modalities vd.val_val.val_modalities in 234 234 + #else 235 235 + let modalities = [] in 236 236 + #endif 237 237 + Value { Value.id; source_loc; doc; type_; value ; source_loc_jane; modalities } 233 238 234 239 let read_type_parameter (ctyp, var_and_injectivity) = 235 240 let open TypeDecl in 236 241 let desc = 237 242 match ctyp.ctyp_desc with 238 243 #if defined OXCAML 239 239 - (* TODO: presumably we want the layouts below, eventually *) 240 244 | Ttyp_var (None, _layout) -> Any 241 241 - | Ttyp_var (Some s, _layout) -> Var s 245 245 + | Ttyp_var (Some s, layout) -> 246 246 + let jkind = match layout with 247 247 + | Some { Parsetree.pjkind_desc = Pjk_abbreviation name; _ } -> 248 248 + if name = "value" then None else Some name 249 249 + | _ -> None 250 250 + in 251 251 + Var (s, jkind) 242 252 #else 243 253 | Ttyp_any -> Any 244 244 - | Ttyp_var s -> Var s 254 254 + | Ttyp_var s -> Var (s, None) 245 255 #endif 246 256 | _ -> assert false 247 257 in

+5 -3

src/model/lang.ml

··· 263 263 264 264 type variance = Pos | Neg | Bivariant 265 265 266 266 - type param_desc = Any | Var of string 266 266 + type param_desc = Any | Var of string * string option 267 267 + (** name, jkind (e.g. [Some "float64"]) *) 267 268 268 269 type param = { 269 270 desc : param_desc; ··· 341 342 value : value; 342 343 doc : Comment.docs; 343 344 type_ : TypeExpr.t; 345 345 + modalities : string list; 344 346 } 345 347 end = 346 348 Value ··· 473 475 | Var of string * string option (** name, jkind (e.g. [Some "float64"]) *) 474 476 | Any 475 477 | Alias of t * string 476 476 - | Arrow of label option * t * t * string list 477 477 - (** label, arg, ret, arg_modes (e.g. [["local"; "unique"]]) *) 478 478 + | Arrow of label option * t * t * string list * string list 479 479 + (** label, arg, ret, arg_modes, ret_modes *) 478 480 | Tuple of (string option * t) list 479 481 | Unboxed_tuple of (string option * t) list 480 482 | Constr of Path.Type.t * t list

+5 -4

src/model_desc/lang_desc.ml

··· 368 368 369 369 and typedecl_param_desc = 370 370 let open Lang.TypeDecl in 371 371 - Variant (function Any -> C0 "Any" | Var x -> C ("Var", x, string)) 371 371 + Variant (function Any -> C0 "Any" | Var (x, jk) -> C ("Var", (x, jk), Pair (string, Option string))) 372 372 373 373 and typedecl_param = 374 374 let open Lang.TypeDecl in ··· 459 459 F ("doc", (fun t -> t.doc), docs); 460 460 F ("type_", (fun t -> t.type_), typeexpr_t); 461 461 F ("value", (fun t -> t.value), value_value_t); 462 462 + F ("modalities", (fun t -> t.modalities), List string); 462 463 ] 463 464 464 465 (** {3 Class} *) ··· 651 652 | Var (x, jk) -> C ("Var", (x, jk), Pair (string, Option string)) 652 653 | Any -> C0 "Any" 653 654 | Alias (x1, x2) -> C ("Alias", (x1, x2), Pair (typeexpr_t, string)) 654 654 - | Arrow (x1, x2, x3, x4) -> 655 655 + | Arrow (x1, x2, x3, x4, x5) -> 655 656 C 656 657 ( "Arrow", 657 657 - ((x1, x2), (x3, x4)), 658 658 - Pair (Pair (Option typeexpr_label, typeexpr_t), Pair (typeexpr_t, List string)) ) 658 658 + ((x1, x2), (x3, (x4, x5))), 659 659 + Pair (Pair (Option typeexpr_label, typeexpr_t), Pair (typeexpr_t, Pair (List string, List string))) ) 659 660 | Tuple x -> C ("Tuple", x, List (Pair (Option string, typeexpr_t))) 660 661 | Unboxed_tuple x -> C ("Unboxed_tuple", x, List (Pair (Option string, typeexpr_t))) 661 662 | Constr (x1, x2) ->

+1 -1

src/search/html.ml

··· 57 57 let typedecl_params ?(delim = `parens) params = 58 58 let format_param { TypeDecl.desc; variance; injectivity } = 59 59 let desc = 60 60 - match desc with TypeDecl.Any -> [ "_" ] | Var s -> [ "'"; s ] 60 60 + match desc with TypeDecl.Any -> [ "_" ] | Var (s, _) -> [ "'"; s ] 61 61 in 62 62 let var_desc = 63 63 match variance with

+7 -6

src/xref2/compile.ml

··· 879 879 TypeExpr.t -> 880 880 TypeExpr.t -> 881 881 string list -> 882 882 + string list -> 882 883 TypeExpr.t = 883 883 - fun env parent lbl t1 t2 modes -> 884 884 + fun env parent lbl t1 t2 modes ret_modes -> 884 885 let t2' = type_expression env parent t2 in 885 886 match lbl with 886 887 | Some (Optional _ | Label _) | None -> 887 887 - Arrow (lbl, type_expression env parent t1, t2', modes) 888 888 + Arrow (lbl, type_expression env parent t1, t2', modes, ret_modes) 888 889 | Some (RawOptional s) -> ( 889 890 (* s is definitely an option type, but not _obviously_ so. *) 890 891 match Component.Of_Lang.(type_expression (empty ()) t1) with ··· 906 907 in 907 908 match find_option p with 908 909 | Some t1 -> 909 909 - Arrow (Some (Optional s), type_expression env parent t1, t2', modes) 910 910 + Arrow (Some (Optional s), type_expression env parent t1, t2', modes, ret_modes) 910 911 | None -> 911 911 - Arrow (Some (RawOptional s), type_expression env parent t1, t2', modes)) 912 912 - | _ -> Arrow (Some (RawOptional s), type_expression env parent t1, t2', modes)) 912 912 + Arrow (Some (RawOptional s), type_expression env parent t1, t2', modes, ret_modes)) 913 913 + | _ -> Arrow (Some (RawOptional s), type_expression env parent t1, t2', modes, ret_modes)) 913 914 914 915 and type_expression : Env.t -> Id.LabelParent.t -> _ -> _ = 915 916 fun env parent texpr -> ··· 917 918 match texpr with 918 919 | Var _ | Any -> texpr 919 920 | Alias (t, str) -> Alias (type_expression env parent t, str) 920 920 - | Arrow (lbl, t1, t2, modes) -> handle_arrow env parent lbl t1 t2 modes 921 921 + | Arrow (lbl, t1, t2, modes, ret_modes) -> handle_arrow env parent lbl t1 t2 modes ret_modes 921 922 | Tuple ts -> 922 923 Tuple 923 924 (List.map (fun (lbl, ty) -> (lbl, type_expression env parent ty)) ts)

+8 -6

src/xref2/component.ml

··· 122 122 | Var of string * string option 123 123 | Any 124 124 | Alias of t * string 125 125 - | Arrow of label option * t * t * string list 125 125 + | Arrow of label option * t * t * string list * string list 126 126 | Tuple of (string option * t) list 127 127 | Unboxed_tuple of (string option * t) list 128 128 | Constr of Cpath.type_ * t list ··· 312 312 doc : CComment.docs; 313 313 type_ : TypeExpr.t; 314 314 value : value; 315 315 + modalities : string list; 315 316 } 316 317 end = 317 318 Value ··· 1078 1079 1079 1080 and type_param ppf t = 1080 1081 let desc = 1081 1081 - match t.Odoc_model.Lang.TypeDecl.desc with Any -> "_" | Var n -> n 1082 1082 + match t.Odoc_model.Lang.TypeDecl.desc with Any -> "_" | Var (n, _) -> n 1082 1083 and variance = 1083 1084 match t.variance with 1084 1085 | Some Pos -> "+" ··· 1187 1188 | Var (x, _) -> Format.fprintf ppf "%s" x 1188 1189 | Any -> Format.fprintf ppf "_" 1189 1190 | Alias (x, y) -> Format.fprintf ppf "(alias %a %s)" (type_expr c) x y 1190 1190 - | Arrow (l, t1, t2, _) -> 1191 1191 + | Arrow (l, t1, t2, _, _) -> 1191 1192 Format.fprintf ppf "%a(%a) -> %a" type_expr_label l (type_expr c) t1 1192 1193 (type_expr c) t2 1193 1194 | Tuple ts -> Format.fprintf ppf "(%a)" (type_labeled_tuple c) ts ··· 2335 2336 | Any -> Any 2336 2337 | Constr (p, xs) -> 2337 2338 Constr (type_path ident_map p, List.map (type_expression ident_map) xs) 2338 2338 - | Arrow (lbl, t1, t2, modes) -> 2339 2339 - Arrow (lbl, type_expression ident_map t1, type_expression ident_map t2, modes) 2339 2339 + | Arrow (lbl, t1, t2, modes, ret_modes) -> 2340 2340 + Arrow (lbl, type_expression ident_map t1, type_expression ident_map t2, modes, ret_modes) 2340 2341 | Tuple ts -> 2341 2342 Tuple 2342 2343 (List.map (fun (lbl, ty) -> (lbl, type_expression ident_map ty)) ts) ··· 2585 2586 doc = docs ident_map v.doc; 2586 2587 value = v.value; 2587 2588 source_loc = v.source_loc; 2588 2588 - source_loc_jane = v.source_loc_jane 2589 2589 + source_loc_jane = v.source_loc_jane; 2590 2590 + modalities = v.Lang.Value.modalities; 2589 2591 } 2590 2592 2591 2593 and include_ ident_map i =

+2 -1

src/xref2/component.mli

··· 117 117 | Var of string * string option 118 118 | Any 119 119 | Alias of t * string 120 120 - | Arrow of label option * t * t * string list 120 120 + | Arrow of label option * t * t * string list * string list 121 121 | Tuple of (string option * t) list 122 122 | Unboxed_tuple of (string option * t) list 123 123 | Constr of Cpath.type_ * t list ··· 354 354 doc : CComment.docs; 355 355 type_ : TypeExpr.t; 356 356 value : value; 357 357 + modalities : string list; 357 358 } 358 359 end 359 360

+2 -2

src/xref2/expand_tools.ml

··· 56 56 | Any -> Any 57 57 | Alias (t, s) -> 58 58 if List.mem_assoc s map then raise Clash else Alias (type_expr map t, s) 59 59 - | Arrow (l, t1, t2, modes) -> Arrow (l, type_expr map t1, type_expr map t2, modes) 59 59 + | Arrow (l, t1, t2, modes, ret_modes) -> Arrow (l, type_expr map t1, type_expr map t2, modes, ret_modes) 60 60 | Tuple ts -> Tuple (List.map (fun (l, ty) -> (l, type_expr map ty)) ts) 61 61 | Unboxed_tuple ts -> Unboxed_tuple (List.map (fun (l, t) -> l, type_expr map t) ts) 62 62 | Constr (p, ts) -> Constr (p, List.map (type_expr map) ts) ··· 100 100 let open Lang.TypeDecl in 101 101 let map = 102 102 List.map2 103 103 - (fun v p -> match v.desc with Var x -> Some (x, p) | Any -> None) 103 103 + (fun v p -> match v.desc with Var (x, _) -> Some (x, p) | Any -> None) 104 104 eqn2.Equation.params params 105 105 in 106 106 let map =

+3 -2

src/xref2/lang_of.ml

··· 693 693 doc = docs (parent :> Identifier.LabelParent.t) v.doc; 694 694 type_ = type_expr map (parent :> Identifier.LabelParent.t) v.type_; 695 695 value = v.value; 696 696 + modalities = v.modalities; 696 697 } 697 698 698 699 and typ_ext map parent t = ··· 1026 1027 | Var (s, jk) -> Var (s, jk) 1027 1028 | Any -> Any 1028 1029 | Alias (t, str) -> Alias (type_expr map parent t, str) 1029 1029 - | Arrow (lbl, t1, t2, modes) -> 1030 1030 - Arrow (lbl, type_expr map parent t1, type_expr map parent t2, modes) 1030 1030 + | Arrow (lbl, t1, t2, modes, ret_modes) -> 1031 1031 + Arrow (lbl, type_expr map parent t1, type_expr map parent t2, modes, ret_modes) 1031 1032 | Tuple ts -> 1032 1033 Tuple (List.map (fun (lbl, ty) -> (lbl, type_expr map parent ty)) ts) 1033 1034 | Unboxed_tuple ts ->

+5 -4

src/xref2/link.ml

··· 445 445 is_hidden (p :> Paths.Path.t) 446 446 || List.exists (fun t -> internal_typ_exp t) ts 447 447 | Poly (_, t) | Alias (t, _) -> internal_typ_exp t 448 448 - | Arrow (_, t, t2, _) -> internal_typ_exp t || internal_typ_exp t2 448 448 + | Arrow (_, t, t2, _, _) -> internal_typ_exp t || internal_typ_exp t2 449 449 | Tuple ts -> List.exists (fun (_, t) -> internal_typ_exp t) ts 450 450 | Class (_, ts) -> List.exists (fun t -> internal_typ_exp t) ts 451 451 | _ -> false ··· 1139 1139 match texpr with 1140 1140 | Var _ | Any -> texpr 1141 1141 | Alias (t, str) -> Alias (type_expression env parent visited t, str) 1142 1142 - | Arrow (lbl, t1, t2, modes) -> 1142 1142 + | Arrow (lbl, t1, t2, modes, ret_modes) -> 1143 1143 Arrow 1144 1144 ( lbl, 1145 1145 type_expression env parent visited t1, 1146 1146 type_expression env parent visited t2, 1147 1147 - modes ) 1147 1147 + modes, 1148 1148 + ret_modes ) 1148 1149 | Tuple ts -> 1149 1150 Tuple 1150 1151 (List.map ··· 1171 1172 List.fold_left2 1172 1173 (fun acc param sub -> 1173 1174 match param.Lang.TypeDecl.desc with 1174 1174 - | Lang.TypeDecl.Var x -> (x, sub) :: acc 1175 1175 + | Lang.TypeDecl.Var (x, _) -> (x, sub) :: acc 1175 1176 | Any -> acc) 1176 1177 [] params ts 1177 1178 in

+1 -1

src/xref2/strengthen.ml

··· 98 98 List.map 99 99 (fun { Odoc_model.Lang.TypeDecl.desc; _ } -> 100 100 match desc with 101 101 - | Odoc_model.Lang.TypeDecl.Var x -> TypeExpr.Var (x, None) 101 101 + | Odoc_model.Lang.TypeDecl.Var (x, _jk) -> TypeExpr.Var (x, None) 102 102 | Any -> Any) 103 103 e.params 104 104 in

+4 -4

src/xref2/subst.ml

··· 121 121 | Var (s, _jk) -> ( try List.assoc s vars with Not_found -> t) 122 122 | Any -> Any 123 123 | Alias (t, str) -> Alias (substitute_vars vars t, str) 124 124 - | Arrow (lbl, t1, t2, modes) -> 125 125 - Arrow (lbl, substitute_vars vars t1, substitute_vars vars t2, modes) 124 124 + | Arrow (lbl, t1, t2, modes, ret_modes) -> 125 125 + Arrow (lbl, substitute_vars vars t1, substitute_vars vars t2, modes, ret_modes) 126 126 | Tuple ts -> 127 127 Tuple (List.map (fun (lbl, ty) -> (lbl, substitute_vars vars ty)) ts) 128 128 | Unboxed_tuple ts -> ··· 552 552 | Var _ as v -> v 553 553 | Any -> Any 554 554 | Alias (t, str) -> Alias (type_expr s t, str) 555 555 - | Arrow (lbl, t1, t2, modes) -> Arrow (lbl, type_expr s t1, type_expr s t2, modes) 555 555 + | Arrow (lbl, t1, t2, modes, ret_modes) -> Arrow (lbl, type_expr s t1, type_expr s t2, modes, ret_modes) 556 556 | Tuple ts -> Tuple (List.map (fun (lbl, ty) -> (lbl, type_expr s ty)) ts) 557 557 | Unboxed_tuple ts -> Unboxed_tuple (List.map (fun (l, t) -> l, type_expr s t) ts) 558 558 | Constr (p, ts) -> ( ··· 561 561 let mk_var acc pexpr param = 562 562 match param.Odoc_model.Lang.TypeDecl.desc with 563 563 | Any -> acc 564 564 - | Var n -> (n, type_expr s pexpr) :: acc 564 564 + | Var (n, _) -> (n, type_expr s pexpr) :: acc 565 565 in 566 566 let vars = List.fold_left2 mk_var [] ts eq.params in 567 567 substitute_vars vars t

+5

test/integration/dune

··· 18 18 (applies_to html_support_files) 19 19 (enabled_if 20 20 (> %{ocaml_version} 4.14.0))) 21 21 + 22 22 + (cram 23 23 + (applies_to oxcaml_modes) 24 24 + (deps %{bin:odoc}) 25 25 + (enabled_if %{ocaml-config:ox}))

+47

test/integration/oxcaml_modes.t/run.t

··· 1 1 + OxCaml mode, jkind, and modality rendering tests. 2 2 + 3 3 + Compile the test .mli with OxCaml and run through the odoc pipeline: 4 4 + 5 5 + $ ocamlc -bin-annot -c test_modes.mli 6 6 + $ odoc compile --package test test_modes.cmti 7 7 + $ odoc link test_modes.odoc 8 8 + $ odoc html-generate test_modes.odocl -o html --indent 9 9 + 10 10 + Check arrow argument modes (@ local, @ unique): 11 11 + 12 12 + $ grep 'keyword.*@.*local' html/test/Test_modes/index.html | head -1 | sed 's/ *$//' 13 13 + <span>string <span class="keyword">@</span> local 14 14 + 15 15 + $ grep 'keyword.*@.*unique' html/test/Test_modes/index.html | head -1 | sed 's/ *$//' 16 16 + <span>string <span class="keyword">@</span> unique 17 17 + 18 18 + Multiple argument modes on one arrow: 19 19 + 20 20 + $ grep 'keyword.*@.*local unique' html/test/Test_modes/index.html | head -1 | sed 's/ *$//' 21 21 + <span>string <span class="keyword">@</span> local unique 22 22 + 23 23 + Arrow return modes (@ after arrow): 24 24 + 25 25 + $ grep 'keyword.*@.*local' html/test/Test_modes/index.html | grep -v 'string' | sed 's/ *$//' 26 26 + <span class="keyword">@</span> local 27 27 + </span> int <span class="keyword">@</span> local 28 28 + 29 29 + Value modalities with @@ syntax: 30 30 + 31 31 + $ grep 'keyword.*@@' html/test/Test_modes/index.html | sed 's/ *$//' 32 32 + <span class="keyword">@@</span> portable 33 33 + <span class="keyword">@@</span> global 34 34 + 35 35 + Normal function has no @@ or @ mode annotations: 36 36 + 37 37 + $ grep 'val-normal_fun' html/test/Test_modes/index.html | head -1 38 38 + <div class="spec value anchored" id="val-normal_fun"> 39 39 + $ grep -c 'keyword.*@' html/test/Test_modes/index.html 40 40 + 8 41 41 + 42 42 + Type parameter jkinds: 43 43 + 44 44 + $ grep 'float64' html/test/Test_modes/index.html 45 45 + <span>('a : float64) float_box</span> 46 46 + $ grep 'immediate' html/test/Test_modes/index.html 47 47 + <span>('a : immediate) imm_box</span>

+31

test/integration/oxcaml_modes.t/test_modes.mli

··· 1 1 + (** OxCaml mode, jkind, and modality tests *) 2 2 + 3 3 + (** {1 Arrow argument modes} *) 4 4 + 5 5 + val local_arg : string @ local -> int 6 6 + 7 7 + val unique_arg : string @ unique -> int 8 8 + 9 9 + val local_unique : string @ local unique -> int 10 10 + 11 11 + (** {1 Arrow return modes} *) 12 12 + 13 13 + val ret_mode : string -> int @ local 14 14 + 15 15 + val multi_mode : string @ local unique -> int @ local 16 16 + 17 17 + (** {1 No modes} *) 18 18 + 19 19 + val normal_fun : string -> int 20 20 + 21 21 + (** {1 Value modalities} *) 22 22 + 23 23 + val portable_val : int @@ portable 24 24 + 25 25 + val global_val : string @@ global 26 26 + 27 27 + (** {1 Type parameter jkinds} *) 28 28 + 29 29 + type ('a : float64) float_box 30 30 + 31 31 + type ('a : immediate) imm_box