|
10 | 10 | module Doc = Res_doc
|
11 | 11 | module Token = Res_token
|
12 | 12 |
|
| 13 | +(* checks if ident contains "arity", like in "arity1", "arity2", "arity3" etc. *) |
| 14 | +let isArityIdent ident = |
| 15 | + if String.length ident >= 6 then |
| 16 | + (String.sub [@doesNotRaise]) ident 0 5 = "arity" |
| 17 | + else |
| 18 | + false |
| 19 | + |
13 | 20 | type identifierStyle =
|
14 | 21 | | ExoticIdent
|
15 | 22 | | NormalIdent
|
@@ -195,6 +202,21 @@ let printIdentLike ~allowUident txt =
|
195 | 202 | Doc.text " as '";
|
196 | 203 | Doc.text aliasTxt
|
197 | 204 | ]
|
| 205 | + | Otyp_constr ( |
| 206 | + Oide_dot (Oide_dot (Oide_ident "Js", "Fn") , "arity0"), (* Js.Fn.arity0 *) |
| 207 | + [Otyp_constr (Oide_ident ident, [])] (* int or unit or string *) |
| 208 | + ) -> |
| 209 | + (* Js.Fn.arity0<int> -> (.) => int*) |
| 210 | + Doc.concat [ |
| 211 | + Doc.text "(.) => "; |
| 212 | + Doc.text ident; |
| 213 | + ] |
| 214 | + | Otyp_constr ( |
| 215 | + Oide_dot (Oide_dot (Oide_ident "Js", "Fn") , ident), (* Js.Fn.arity2 *) |
| 216 | + [(Otyp_arrow _) as arrowType] (* (int, int) => int *) |
| 217 | + ) when isArityIdent ident -> |
| 218 | + (* Js.Fn.arity2<(int, int) => int> -> (. int, int) => int*) |
| 219 | + printOutArrowType ~uncurried:true arrowType |
198 | 220 | | Otyp_constr (outIdent, []) ->
|
199 | 221 | printOutIdentDoc ~allowUident:false outIdent
|
200 | 222 | | Otyp_manifest (typ1, typ2) ->
|
@@ -283,51 +305,56 @@ let printIdentLike ~allowUident txt =
|
283 | 305 | ]
|
284 | 306 | )
|
285 | 307 | | Otyp_arrow _ as typ ->
|
286 |
| - let (typArgs, typ) = collectArrowArgs typ [] in |
287 |
| - let args = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( |
288 |
| - List.map (fun (lbl, typ) -> |
289 |
| - if lbl = "" then |
290 |
| - printOutTypeDoc typ |
291 |
| - else |
292 |
| - Doc.group ( |
293 |
| - Doc.concat [ |
294 |
| - Doc.text ("~" ^ lbl ^ ": "); |
295 |
| - printOutTypeDoc typ |
296 |
| - ] |
297 |
| - ) |
298 |
| - ) typArgs |
299 |
| - ) in |
300 |
| - let argsDoc = |
301 |
| - let needsParens = match typArgs with |
302 |
| - | [_, (Otyp_tuple _ | Otyp_arrow _)] -> true |
303 |
| - (* single argument should not be wrapped *) |
304 |
| - | ["", _] -> false |
305 |
| - | _ -> true |
306 |
| - in |
307 |
| - if needsParens then |
| 308 | + printOutArrowType ~uncurried:false typ |
| 309 | + | Otyp_module (_modName, _stringList, _outTypes) -> |
| 310 | + Doc.nil |
| 311 | + |
| 312 | + and printOutArrowType ~uncurried typ = |
| 313 | + let (typArgs, typ) = collectArrowArgs typ [] in |
| 314 | + let args = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( |
| 315 | + List.map (fun (lbl, typ) -> |
| 316 | + if lbl = "" then |
| 317 | + printOutTypeDoc typ |
| 318 | + else |
308 | 319 | Doc.group (
|
309 | 320 | Doc.concat [
|
310 |
| - Doc.lparen; |
311 |
| - Doc.indent ( |
312 |
| - Doc.concat [ |
313 |
| - Doc.softLine; |
314 |
| - args; |
315 |
| - ] |
316 |
| - ); |
317 |
| - Doc.trailingComma; |
318 |
| - Doc.softLine; |
319 |
| - Doc.rparen; |
| 321 | + Doc.text ("~" ^ lbl ^ ": "); |
| 322 | + printOutTypeDoc typ |
320 | 323 | ]
|
321 | 324 | )
|
322 |
| - else args |
| 325 | + ) typArgs |
| 326 | + ) in |
| 327 | + let argsDoc = |
| 328 | + let needsParens = match typArgs with |
| 329 | + | _ when uncurried -> true |
| 330 | + | [_, (Otyp_tuple _ | Otyp_arrow _)] -> true |
| 331 | + (* single argument should not be wrapped *) |
| 332 | + | ["", _] -> false |
| 333 | + | _ -> true |
323 | 334 | in
|
324 |
| - Doc.concat [ |
325 |
| - argsDoc; |
326 |
| - Doc.text " => "; |
327 |
| - printOutTypeDoc typ; |
328 |
| - ] |
329 |
| - | Otyp_module (_modName, _stringList, _outTypes) -> |
330 |
| - Doc.nil |
| 335 | + if needsParens then |
| 336 | + Doc.group ( |
| 337 | + Doc.concat [ |
| 338 | + if uncurried then Doc.text "(. " else Doc.lparen; |
| 339 | + Doc.indent ( |
| 340 | + Doc.concat [ |
| 341 | + Doc.softLine; |
| 342 | + args; |
| 343 | + ] |
| 344 | + ); |
| 345 | + Doc.trailingComma; |
| 346 | + Doc.softLine; |
| 347 | + Doc.rparen; |
| 348 | + ] |
| 349 | + ) |
| 350 | + else args |
| 351 | + in |
| 352 | + Doc.concat [ |
| 353 | + argsDoc; |
| 354 | + Doc.text " => "; |
| 355 | + printOutTypeDoc typ; |
| 356 | + ] |
| 357 | + |
331 | 358 |
|
332 | 359 | and printOutVariant variant = match variant with
|
333 | 360 | | Ovar_fields fields -> (* (string * bool * out_type list) list *)
|
|
0 commit comments