+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

+2 -2

sherlodoc/index/type_cache.ml

··· 14 14 15 15 let rec of_odoc ~cache otyp = 16 16 match otyp with 17 17 - | Odoc_model.Lang.TypeExpr.Var _str -> Any 17 17 + | Odoc_model.Lang.TypeExpr.Var (_str, _) -> Any 18 18 | Any -> Any 19 19 - | Arrow (_lbl, left, right) -> cache (Arrow (of_odoc ~cache left, of_odoc ~cache right)) 19 19 + | Arrow (_lbl, left, right, _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))

+4 -4

src/document/generator.ml

··· 441 441 if needs_parentheses then enclose ~l:"(" res ~r:")" else res 442 442 in 443 443 match t with 444 444 - | Var s -> type_var (Syntax.Type.var_prefix ^ s) 444 444 + | Var (s, _jkind) -> type_var (Syntax.Type.var_prefix ^ s) 445 445 | Any -> type_var Syntax.Type.any 446 446 | Alias (te, alias) -> 447 447 enclose_parens_if_needed 448 448 (type_expr ~needs_parentheses:true te 449 449 ++ O.txt " " ++ O.keyword "as" ++ O.txt " '" ++ O.txt alias) 450 450 - | Arrow (None, src, dst) -> 450 450 + | Arrow (None, src, dst, _modes) -> 451 451 let res = 452 452 O.span 453 453 ((O.box_hv @@ type_expr ~needs_parentheses:true src) ··· 456 456 (* ++ O.end_hv *) 457 457 in 458 458 if not needs_parentheses then res else enclose ~l:"(" res ~r:")" 459 459 - | Arrow (Some (RawOptional _ as lbl), _src, dst) -> 459 459 + | Arrow (Some (RawOptional _ as lbl), _src, dst, _modes) -> 460 460 let res = 461 461 O.span 462 462 (O.box_hv ··· 466 466 ++ O.sp ++ type_expr dst 467 467 in 468 468 if not needs_parentheses then res else enclose ~l:"(" res ~r:")" 469 469 - | Arrow (Some lbl, src, dst) -> 469 469 + | Arrow (Some lbl, src, dst, _modes) -> 470 470 let res = 471 471 O.span 472 472 ((O.box_hv

+2 -2

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 58 58 - | Any -> Var (Printf.sprintf "tv_%i" i)) 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) = 61 61 let args = c.args in

+6 -6

src/loader/cmi.ml

··· 495 495 let rec read_type_expr env typ = 496 496 let open TypeExpr in 497 497 let px = proxy typ in 498 498 - if used_alias px then Var (name_of_type typ) 498 498 + if used_alias px then Var (name_of_type typ, None) 499 499 else begin 500 500 let alias = 501 501 if not (is_aliased px && aliasable typ) then None ··· 509 509 | Tvar _ -> 510 510 let name = name_of_type typ in 511 511 if name = "_" then Any 512 512 - else Var name 512 512 + else Var (name, None) 513 513 #if defined OXCAML 514 514 | Tarrow((lbl,_,_), arg, res, _) -> 515 515 #else ··· 535 535 lbl, read_type_expr env arg 536 536 in 537 537 let res = read_type_expr env res in 538 538 - Arrow(lbl, arg, res) 538 538 + Arrow(lbl, arg, res, []) 539 539 | Ttuple typs -> 540 540 #if OCAML_VERSION >= (5,4,0) || defined OXCAML 541 541 let typs = List.map (fun (lbl,x) -> lbl, read_type_expr env x) typs in ··· 562 562 let typ = read_type_expr env typ in 563 563 remove_names tyl; 564 564 Poly(vars, typ) 565 565 - | Tunivar _ -> Var (name_of_type typ) 565 565 + | Tunivar _ -> Var (name_of_type typ, None) 566 566 #if OCAML_VERSION>=(5,4,0) 567 567 | Tpackage {pack_path=p; pack_cstrs } -> 568 568 let eqs = List.filter_map (fun (l,ty) -> Option.map (fun x -> x, ty) (Longident.unflatten l)) pack_cstrs in ··· 669 669 let open TypeExpr in 670 670 let open TypeExpr.Object in 671 671 let px = proxy fi in 672 672 - if used_alias px then Var (name_of_type fi) 672 672 + if used_alias px then Var (name_of_type fi, None) 673 673 else begin 674 674 use_alias px; 675 675 match nm with ··· 984 984 let read_self_type sty = 985 985 let px = proxy sty in 986 986 if not (is_aliased px) then None 987 987 - else Some (TypeExpr.Var (name_of_type_repr px)) 987 987 + else Some (TypeExpr.Var (name_of_type_repr px, None)) 988 988 989 989 let rec read_class_signature env parent params = 990 990 let open ClassType in function

+1 -1

src/loader/cmt.ml

··· 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_

+3 -3

src/loader/cmti.ml

··· 47 47 (* TODO: presumably we want the layout in these first two cases, 48 48 eventually *) 49 49 | Ttyp_var (None, _layout) -> Any 50 50 - | Ttyp_var (Some s, _layout) -> Var s 50 50 + | Ttyp_var (Some s, _layout) -> Var (s, None) 51 51 #else 52 52 | Ttyp_any -> Any 53 53 - | Ttyp_var s -> Var s 53 53 + | Ttyp_var s -> Var (s, None) 54 54 #endif 55 55 | Ttyp_arrow(lbl, arg, res) -> 56 56 let lbl = read_label lbl in ··· 70 70 #endif 71 71 in 72 72 let res = read_core_type env container res in 73 73 - Arrow(lbl, arg, res) 73 73 + Arrow(lbl, arg, res, []) 74 74 | Ttyp_tuple typs -> 75 75 #if OCAML_VERSION >= (5,4,0) || defined OXCAML 76 76 let typs = List.map (fun (lbl,x) -> lbl, read_core_type env container x) typs in

+3 -2

src/model/lang.ml

··· 470 470 type label = Label of string | RawOptional of string | Optional of string 471 471 472 472 type t = 473 473 - | Var of string 473 473 + | Var of string * string option (** name, jkind (e.g. [Some "float64"]) *) 474 474 | Any 475 475 | Alias of t * string 476 476 - | Arrow of label option * t * t 476 476 + | Arrow of label option * t * t * string list 477 477 + (** label, arg, ret, arg_modes (e.g. [["local"; "unique"]]) *) 477 478 | Tuple of (string option * t) list 478 479 | Unboxed_tuple of (string option * t) list 479 480 | Constr of Path.Type.t * t list

+4 -4

src/model_desc/lang_desc.ml

··· 648 648 let open Lang.TypeExpr in 649 649 Variant 650 650 (function 651 651 - | Var x -> C ("Var", x, string) 651 651 + | Var (x, jk) -> C ("Var", (x, jk), Pair (string, Option string)) 652 652 | Any -> C0 "Any" 653 653 | Alias (x1, x2) -> C ("Alias", (x1, x2), Pair (typeexpr_t, string)) 654 654 - | Arrow (x1, x2, x3) -> 654 654 + | Arrow (x1, x2, x3, x4) -> 655 655 C 656 656 ( "Arrow", 657 657 - (x1, x2, x3), 658 658 - Triple (Option typeexpr_label, typeexpr_t, typeexpr_t) ) 657 657 + ((x1, x2), (x3, x4)), 658 658 + Pair (Pair (Option typeexpr_label, typeexpr_t), Pair (typeexpr_t, List string)) ) 659 659 | Tuple x -> C ("Tuple", x, List (Pair (Option string, typeexpr_t))) 660 660 | Unboxed_tuple x -> C ("Unboxed_tuple", x, List (Pair (Option string, typeexpr_t))) 661 661 | Constr (x1, x2) ->

+7 -6

src/xref2/compile.ml

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

+7 -7

src/xref2/component.ml

··· 119 119 type label = Odoc_model.Lang.TypeExpr.label 120 120 121 121 type t = 122 122 - | Var of string 122 122 + | Var of string * string option 123 123 | Any 124 124 | Alias of t * string 125 125 - | Arrow of label option * t * t 125 125 + | Arrow of label option * t * t * 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 ··· 1184 1184 and type_expr c ppf e = 1185 1185 let open TypeExpr in 1186 1186 match e with 1187 1187 - | Var x -> Format.fprintf ppf "%s" x 1187 1187 + | Var (x, _) -> Format.fprintf ppf "%s" x 1188 1188 | Any -> Format.fprintf ppf "_" 1189 1189 | Alias (x, y) -> Format.fprintf ppf "(alias %a %s)" (type_expr c) x y 1190 1190 - | Arrow (l, t1, t2) -> 1190 1190 + | Arrow (l, t1, t2, _) -> 1191 1191 Format.fprintf ppf "%a(%a) -> %a" type_expr_label l (type_expr c) t1 1192 1192 (type_expr c) t2 1193 1193 | Tuple ts -> Format.fprintf ppf "(%a)" (type_labeled_tuple c) ts ··· 2331 2331 and type_expression ident_map expr = 2332 2332 let open Odoc_model.Lang.TypeExpr in 2333 2333 match expr with 2334 2334 - | Var s -> TypeExpr.Var s 2334 2334 + | Var (s, jk) -> TypeExpr.Var (s, jk) 2335 2335 | Any -> Any 2336 2336 | Constr (p, xs) -> 2337 2337 Constr (type_path ident_map p, List.map (type_expression ident_map) xs) 2338 2338 - | Arrow (lbl, t1, t2) -> 2339 2339 - Arrow (lbl, type_expression ident_map t1, type_expression ident_map t2) 2338 2338 + | Arrow (lbl, t1, t2, modes) -> 2339 2339 + Arrow (lbl, type_expression ident_map t1, type_expression ident_map t2, modes) 2340 2340 | Tuple ts -> 2341 2341 Tuple 2342 2342 (List.map (fun (lbl, ty) -> (lbl, type_expression ident_map ty)) ts)

+2 -2

src/xref2/component.mli

··· 114 114 type label = Odoc_model.Lang.TypeExpr.label 115 115 116 116 type t = 117 117 - | Var of string 117 117 + | Var of string * string option 118 118 | Any 119 119 | Alias of t * string 120 120 - | Arrow of label option * t * t 120 120 + | Arrow of label option * t * t * 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

+2 -2

src/xref2/expand_tools.ml

··· 48 48 let rec type_expr map t = 49 49 let open Lang.TypeExpr in 50 50 match t with 51 51 - | Var v -> ( 51 51 + | Var (v, _) -> ( 52 52 try List.assoc v map 53 53 with _ -> 54 54 Format.eprintf "Failed to list assoc %s\n%!" v; ··· 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) -> Arrow (l, type_expr map t1, type_expr map t2) 59 59 + | Arrow (l, t1, t2, modes) -> Arrow (l, type_expr map t1, type_expr map t2, 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)

+3 -3

src/xref2/lang_of.ml

··· 1023 1023 : Odoc_model.Lang.TypeExpr.t = 1024 1024 try 1025 1025 match t with 1026 1026 - | Var s -> Var s 1026 1026 + | Var (s, jk) -> Var (s, jk) 1027 1027 | Any -> Any 1028 1028 | Alias (t, str) -> Alias (type_expr map parent t, str) 1029 1029 - | Arrow (lbl, t1, t2) -> 1030 1030 - Arrow (lbl, type_expr map parent t1, type_expr map parent t2) 1029 1029 + | Arrow (lbl, t1, t2, modes) -> 1030 1030 + Arrow (lbl, type_expr map parent t1, type_expr map parent t2, modes) 1031 1031 | Tuple ts -> 1032 1032 Tuple (List.map (fun (lbl, ty) -> (lbl, type_expr map parent ty)) ts) 1033 1033 | Unboxed_tuple ts ->

+4 -3

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) -> 1142 1142 + | Arrow (lbl, t1, t2, modes) -> 1143 1143 Arrow 1144 1144 ( lbl, 1145 1145 type_expression env parent visited t1, 1146 1146 - type_expression env parent visited t2 ) 1146 1146 + type_expression env parent visited t2, 1147 1147 + modes ) 1147 1148 | Tuple ts -> 1148 1149 Tuple 1149 1150 (List.map

+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 101 101 + | Odoc_model.Lang.TypeDecl.Var x -> TypeExpr.Var (x, None) 102 102 | Any -> Any) 103 103 e.params 104 104 in

+5 -5

src/xref2/subst.ml

··· 118 118 let rec substitute_vars vars t = 119 119 let open TypeExpr in 120 120 match t with 121 121 - | Var s -> ( try List.assoc s vars with Not_found -> t) 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) -> 125 125 - Arrow (lbl, substitute_vars vars t1, substitute_vars vars t2) 124 124 + | Arrow (lbl, t1, t2, modes) -> 125 125 + Arrow (lbl, substitute_vars vars t1, substitute_vars vars t2, modes) 126 126 | Tuple ts -> 127 127 Tuple (List.map (fun (lbl, ty) -> (lbl, substitute_vars vars ty)) ts) 128 128 | Unboxed_tuple ts -> ··· 549 549 and type_expr s t = 550 550 let open Component.TypeExpr in 551 551 match t with 552 552 - | Var s -> Var s 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) -> Arrow (lbl, type_expr s t1, type_expr s t2) 555 555 + | Arrow (lbl, t1, t2, modes) -> Arrow (lbl, type_expr s t1, type_expr s t2, 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) -> (

+3

test/odoc_print/type_desc_to_yojson.ml

··· 10 10 | Record fields -> 11 11 let field_to_yojson (F (name, get, t)) = (name, to_yojson t (get a)) in 12 12 `Assoc (List.map field_to_yojson fields) 13 13 + | Unboxed_record fields -> 14 14 + let field_to_yojson (UF (name, get, t)) = (name, to_yojson t (get a)) in 15 15 + `Assoc (List.map field_to_yojson fields) 13 16 | Variant get -> ( 14 17 match get a with 15 18 | C0 name -> `String name

+1 -1

test/xref2/lib/common.cppo.ml

··· 526 526 and type_expr ppf e = 527 527 let open TypeExpr in 528 528 match e with 529 529 - | Var x -> Format.fprintf ppf "%s" x 529 529 + | Var (x, _) -> Format.fprintf ppf "%s" x 530 530 | Constr (p,_args) -> path ppf (p :> Odoc_model.Paths.Path.t) 531 531 | _ -> Format.fprintf ppf "unhandled type_expr" 532 532