lib/typesPp.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

(** Copyright 2025, Ksenia Kotelnikova <xeniia.ka@gmail.com>, Sofya Kozyreva <k81sofia@gmail.com>, Vyacheslav Kochergin <vyacheslav.kochergin1@gmail.com> *)

(** SPDX-License-Identifier: LGPL-3.0-or-later *)

open TypedTree
open Format

let rec pp_typ fmt = function
  | Primitive s -> fprintf fmt "%s" s
  | Type_var var -> fprintf fmt "'%d" var
  | Arrow (fst, snd) ->
    (match fst with
     | Arrow _ -> fprintf fmt "(%a) -> %a" pp_typ fst pp_typ snd
     | _ -> fprintf fmt "%a -> %a" pp_typ fst pp_typ snd)
  | Type_list typ -> fprintf fmt "%a list" pp_typ typ
  | Type_tuple (first, second, rest) ->
    Format.pp_print_list
      ~pp_sep:(fun fmt () -> fprintf fmt " * ")
      (fun fmt typ ->
         match typ with
         | Arrow _ -> fprintf fmt "(%a)" pp_typ typ
         | _ -> pp_typ fmt typ)
      fmt
      (first :: second :: rest)
  | TOption t ->
    (match t with
     | Type_tuple _ | Arrow _ -> fprintf fmt "(%a) option" pp_typ t
     | t -> fprintf fmt "%a option" pp_typ t)
  | TActPat (name, t) -> fprintf fmt "%s (%a)" name pp_typ t
  | Choice map ->
    fprintf fmt "Choice<";
    (pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt ", ") pp_typ fmt)
      (choice_to_list map);
    fprintf fmt ">"
;;