package merlin-lib
Merlin's libraries
Install
Dune Dependency
Authors
Maintainers
Sources
merlin-5.5-503.tbz
sha256=67da3b34f2fea07678267309f61da4a2c6f08298de0dc59655b8d30fd8269af1
sha512=1fb3b5180d36aa82b82a319e15b743b802b6888f0dc67645baafdb4e18dfc23a7b90064ec9bc42f7424061cf8cde7f8839178d8a8537bf4596759f3ff4891873
doc/src/merlin-lib.ocaml_typing/typeopt.ml.html
Source file typeopt.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
(**************************************************************************) (* *) (* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* Auxiliaries for type-based optimizations, e.g. array kinds *) open Types open Asttypes open Typedtree open Lambda let scrape_ty env ty = match get_desc ty with | Tconstr _ -> let ty = Ctype.expand_head_opt env ty in begin match get_desc ty with | Tconstr (p, _, _) -> begin match Env.find_type p env with | {type_kind = ( Type_variant (_, Variant_unboxed) | Type_record (_, Record_unboxed _) ); _} -> begin match Typedecl_unboxed.get_unboxed_type_representation env ty with | None -> ty | Some ty2 -> ty2 end | _ -> ty | exception Not_found -> ty end | _ -> ty end | _ -> ty let scrape env ty = get_desc (scrape_ty env ty) let scrape_poly env ty = let ty = scrape_ty env ty in match get_desc ty with | Tpoly (ty, _) -> get_desc ty | d -> d let is_function_type env ty = match scrape env ty with | Tarrow (_, lhs, rhs, _) -> Some (lhs, rhs) | _ -> None let is_base_type env ty base_ty_path = match scrape env ty with | Tconstr(p, _, _) -> Path.same p base_ty_path | _ -> false let is_immediate = function | Type_immediacy.Unknown -> false | Type_immediacy.Always -> true | Type_immediacy.Always_on_64bits -> (* In bytecode, we don't know at compile time whether we are targeting 32 or 64 bits. *) !Clflags.native_code && Sys.word_size = 64 let maybe_pointer_type env ty = let ty = scrape_ty env ty in if is_immediate (Ctype.immediacy env ty) then Immediate else Pointer let maybe_pointer exp = maybe_pointer_type exp.exp_env exp.exp_type type classification = | Int | Float | Lazy | Addr (* anything except a float or a lazy *) | Any let classify env ty = let ty = scrape_ty env ty in if is_immediate (Ctype.immediacy env ty) then Int else match get_desc ty with | Tvar _ | Tunivar _ -> Any | Tconstr (p, _args, _abbrev) -> if Path.same p Predef.path_float then Float else if Path.same p Predef.path_lazy_t then Lazy else if Path.same p Predef.path_string || Path.same p Predef.path_bytes || Path.same p Predef.path_array || Path.same p Predef.path_nativeint || Path.same p Predef.path_int32 || Path.same p Predef.path_int64 then Addr else begin try match (Env.find_type p env).type_kind with | Type_abstract _ -> Any | Type_record _ | Type_variant _ | Type_open -> Addr with Not_found -> (* This can happen due to e.g. missing -I options, causing some .cmi files to be unavailable. Maybe we should emit a warning. *) Any end | Tarrow _ | Ttuple _ | Tpackage _ | Tobject _ | Tnil | Tvariant _ -> Addr | Tlink _ | Tsubst _ | Tpoly _ | Tfield _ -> assert false let array_type_kind env ty = match scrape_poly env ty with | Tconstr(p, [elt_ty], _) when Path.same p Predef.path_array -> begin match classify env elt_ty with | Any -> if Config.flat_float_array then Pgenarray else Paddrarray | Float -> if Config.flat_float_array then Pfloatarray else Paddrarray | Addr | Lazy -> Paddrarray | Int -> Pintarray end | Tconstr(p, [], _) when Path.same p Predef.path_floatarray -> Pfloatarray | _ -> (* This can happen with e.g. Obj.field *) Pgenarray let array_kind exp = array_type_kind exp.exp_env exp.exp_type (* let array_pattern_kind pat = array_type_kind pat.pat_env pat.pat_type let bigarray_decode_type env ty tbl dfl = match scrape env ty with | Tconstr(Pdot(Pident mod_id, type_name), [], _) when Ident.name mod_id = "Stdlib__Bigarray" -> begin try List.assoc type_name tbl with Not_found -> dfl end | _ -> dfl let kind_table = ["float16_elt", Pbigarray_float16; "float32_elt", Pbigarray_float32; "float64_elt", Pbigarray_float64; "int8_signed_elt", Pbigarray_sint8; "int8_unsigned_elt", Pbigarray_uint8; "int16_signed_elt", Pbigarray_sint16; "int16_unsigned_elt", Pbigarray_uint16; "int32_elt", Pbigarray_int32; "int64_elt", Pbigarray_int64; "int_elt", Pbigarray_caml_int; "nativeint_elt", Pbigarray_native_int; "complex32_elt", Pbigarray_complex32; "complex64_elt", Pbigarray_complex64] let layout_table = ["c_layout", Pbigarray_c_layout; "fortran_layout", Pbigarray_fortran_layout] let bigarray_type_kind_and_layout env typ = match scrape env typ with | Tconstr(_p, [_caml_type; elt_type; layout_type], _abbrev) -> (bigarray_decode_type env elt_type kind_table Pbigarray_unknown, bigarray_decode_type env layout_type layout_table Pbigarray_unknown_layout) | _ -> (Pbigarray_unknown, Pbigarray_unknown_layout) let value_kind env ty = let ty = scrape_ty env ty in if is_immediate (Ctype.immediacy env ty) then Pintval else begin match get_desc ty with | Tconstr(p, _, _) when Path.same p Predef.path_float -> Pfloatval | Tconstr(p, _, _) when Path.same p Predef.path_int32 -> Pboxedintval Pint32 | Tconstr(p, _, _) when Path.same p Predef.path_int64 -> Pboxedintval Pint64 | Tconstr(p, _, _) when Path.same p Predef.path_nativeint -> Pboxedintval Pnativeint | _ -> Pgenval end *) (** Whether a forward block is needed for a lazy thunk on a value, i.e. if the value can be represented as a float/forward/lazy *) let lazy_val_requires_forward env ty = match classify env ty with | Any | Lazy -> true | Float -> false (* TODO: Config.flat_float_array *) | Addr | Int -> false (** The compilation of the expression [lazy e] depends on the form of e: constants, floats and identifiers are optimized. The optimization must be taken into account when determining whether a recursive binding is safe. *) let classify_lazy_argument : Typedtree.expression -> [`Constant_or_function |`Float_that_cannot_be_shortcut |`Identifier of [`Forward_value|`Other] |`Other] = fun e -> match e.exp_desc with | Texp_constant ( Const_int _ | Const_char _ | Const_string _ | Const_int32 _ | Const_int64 _ | Const_nativeint _ ) | Texp_function _ | Texp_construct (_, {cstr_arity = 0}, _) -> `Constant_or_function | Texp_constant(Const_float _) -> (* TODO: handle flat float array, either at configure time or from the .merlin. *) `Constant_or_function | Texp_ident _ when lazy_val_requires_forward e.exp_env e.exp_type -> `Identifier `Forward_value | Texp_ident _ -> `Identifier `Other | _ -> `Other (* let value_kind_union k1 k2 = if k1 = k2 then k1 else Pgenval *)
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>