2020-11-25 18:51:19 +03:00
|
|
|
(* This file is part of the Catala compiler, a specification language for tax
|
|
|
|
and social benefits computation rules. Copyright (C) 2020 Inria, contributor:
|
|
|
|
Denis Merigoux <denis.merigoux@inria.fr>
|
|
|
|
|
|
|
|
Licensed under the Apache License, Version 2.0 (the "License"); you may not
|
|
|
|
use this file except in compliance with the License. You may obtain a copy of
|
|
|
|
the License at
|
|
|
|
|
|
|
|
http://www.apache.org/licenses/LICENSE-2.0
|
|
|
|
|
|
|
|
Unless required by applicable law or agreed to in writing, software
|
|
|
|
distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
|
|
|
|
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
|
|
|
|
License for the specific language governing permissions and limitations under
|
|
|
|
the License. *)
|
|
|
|
|
2021-01-21 23:33:04 +03:00
|
|
|
open Utils
|
2020-11-26 12:38:13 +03:00
|
|
|
open Ast
|
2020-11-25 18:51:19 +03:00
|
|
|
|
2020-11-26 17:48:26 +03:00
|
|
|
let typ_needs_parens (e : typ Pos.marked) : bool =
|
2020-12-28 01:53:02 +03:00
|
|
|
match Pos.unmark e with TArrow _ | TArray _ -> true | _ -> false
|
2020-11-26 17:48:26 +03:00
|
|
|
|
2021-01-29 13:42:19 +03:00
|
|
|
let is_uppercase (x : CamomileLibraryDefault.Camomile.UChar.t) : bool =
|
2021-01-28 20:30:01 +03:00
|
|
|
try
|
2021-01-29 13:42:19 +03:00
|
|
|
match CamomileLibraryDefault.Camomile.UCharInfo.general_category x with
|
2021-01-28 20:30:01 +03:00
|
|
|
| `Ll -> false
|
|
|
|
| `Lu -> true
|
|
|
|
| _ -> false
|
|
|
|
with _ -> true
|
|
|
|
|
2021-01-29 13:42:19 +03:00
|
|
|
let begins_with_uppercase (s : string) : bool =
|
|
|
|
let first_letter = CamomileLibraryDefault.Camomile.UTF8.get s 0 in
|
|
|
|
is_uppercase first_letter
|
|
|
|
|
2021-01-09 23:03:32 +03:00
|
|
|
let format_uid_list
|
|
|
|
(fmt : Format.formatter)
|
|
|
|
(infos : Uid.MarkedString.info list) : unit =
|
|
|
|
Format.fprintf fmt "%a"
|
|
|
|
(Format.pp_print_list
|
|
|
|
~pp_sep:(fun fmt () -> Format.fprintf fmt ".")
|
|
|
|
(fun fmt info ->
|
2022-01-10 17:00:36 +03:00
|
|
|
Format.fprintf fmt "%a"
|
|
|
|
(Utils.Cli.format_with_style
|
|
|
|
(if begins_with_uppercase (Pos.unmark info) then
|
|
|
|
[ANSITerminal.red]
|
|
|
|
else []))
|
|
|
|
(Format.asprintf "%a" Utils.Uid.MarkedString.format_info info)))
|
2021-01-09 23:03:32 +03:00
|
|
|
infos
|
|
|
|
|
2021-03-11 18:27:57 +03:00
|
|
|
let format_keyword (fmt : Format.formatter) (s : string) : unit =
|
2022-01-10 17:00:36 +03:00
|
|
|
Format.fprintf fmt "%a" (Utils.Cli.format_with_style [ANSITerminal.red]) s
|
2021-03-11 18:27:57 +03:00
|
|
|
|
|
|
|
let format_base_type (fmt : Format.formatter) (s : string) : unit =
|
2022-01-10 17:00:36 +03:00
|
|
|
Format.fprintf fmt "%a" (Utils.Cli.format_with_style [ANSITerminal.yellow]) s
|
2021-03-11 18:27:57 +03:00
|
|
|
|
|
|
|
let format_punctuation (fmt : Format.formatter) (s : string) : unit =
|
2022-01-10 17:00:36 +03:00
|
|
|
Format.fprintf fmt "%a" (Utils.Cli.format_with_style [ANSITerminal.cyan]) s
|
2021-03-11 18:27:57 +03:00
|
|
|
|
2021-03-12 21:37:00 +03:00
|
|
|
let format_operator (fmt : Format.formatter) (s : string) : unit =
|
2022-01-10 17:00:36 +03:00
|
|
|
Format.fprintf fmt "%a" (Utils.Cli.format_with_style [ANSITerminal.green]) s
|
2021-03-12 21:37:00 +03:00
|
|
|
|
2022-02-09 17:01:24 +03:00
|
|
|
let format_lit_style (fmt : Format.formatter) (s : string) : unit =
|
|
|
|
Format.fprintf fmt "%a" (Utils.Cli.format_with_style [ANSITerminal.yellow]) s
|
|
|
|
|
2020-12-10 13:35:56 +03:00
|
|
|
let format_tlit (fmt : Format.formatter) (l : typ_lit) : unit =
|
2021-07-08 17:36:53 +03:00
|
|
|
format_base_type fmt
|
|
|
|
(match l with
|
|
|
|
| TUnit -> "unit"
|
|
|
|
| TBool -> "bool"
|
|
|
|
| TInt -> "integer"
|
|
|
|
| TRat -> "decimal"
|
|
|
|
| TMoney -> "money"
|
|
|
|
| TDuration -> "duration"
|
|
|
|
| TDate -> "date")
|
2020-12-10 13:35:56 +03:00
|
|
|
|
2022-02-06 20:25:37 +03:00
|
|
|
let format_enum_constructor (fmt : Format.formatter) (c : EnumConstructor.t) :
|
|
|
|
unit =
|
|
|
|
Format.fprintf fmt "%a"
|
|
|
|
(Utils.Cli.format_with_style [ANSITerminal.magenta])
|
|
|
|
(Format.asprintf "%a" EnumConstructor.format_t c)
|
|
|
|
|
2021-01-14 02:17:24 +03:00
|
|
|
let rec format_typ
|
|
|
|
(ctx : Ast.decl_ctx)
|
|
|
|
(fmt : Format.formatter)
|
|
|
|
(typ : typ Pos.marked) : unit =
|
|
|
|
let format_typ = format_typ ctx in
|
2020-11-26 17:48:26 +03:00
|
|
|
let format_typ_with_parens (fmt : Format.formatter) (t : typ Pos.marked) =
|
|
|
|
if typ_needs_parens t then Format.fprintf fmt "(%a)" format_typ t
|
|
|
|
else Format.fprintf fmt "%a" format_typ t
|
|
|
|
in
|
2020-11-25 18:51:19 +03:00
|
|
|
match Pos.unmark typ with
|
2020-12-10 13:35:56 +03:00
|
|
|
| TLit l -> Format.fprintf fmt "%a" format_tlit l
|
2021-01-14 02:17:24 +03:00
|
|
|
| TTuple (ts, None) ->
|
2021-01-28 02:28:28 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>(%a)@]"
|
2021-01-14 02:17:24 +03:00
|
|
|
(Format.pp_print_list
|
2022-02-06 20:25:37 +03:00
|
|
|
~pp_sep:(fun fmt () -> Format.fprintf fmt "@ %a@ " format_operator "*")
|
2021-01-14 02:17:24 +03:00
|
|
|
(fun fmt t -> Format.fprintf fmt "%a" format_typ t))
|
2020-12-03 22:11:41 +03:00
|
|
|
ts
|
2022-02-04 17:10:47 +03:00
|
|
|
| TTuple (_args, Some s) ->
|
2022-02-06 20:25:37 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a%a%a%a@]" Ast.StructName.format_t s
|
|
|
|
format_punctuation "{"
|
2022-02-04 17:10:47 +03:00
|
|
|
(Format.pp_print_list
|
2022-02-06 20:25:37 +03:00
|
|
|
~pp_sep:(fun fmt () ->
|
|
|
|
Format.fprintf fmt "%a@ " format_punctuation ";")
|
2022-02-04 17:10:47 +03:00
|
|
|
(fun fmt (field, typ) ->
|
2022-02-06 20:25:37 +03:00
|
|
|
Format.fprintf fmt "%a%a%a%a@ %a" format_punctuation "\""
|
|
|
|
StructFieldName.format_t field format_punctuation "\""
|
|
|
|
format_punctuation ":" format_typ typ))
|
2022-02-04 17:10:47 +03:00
|
|
|
(StructMap.find s ctx.ctx_structs)
|
2022-02-06 20:25:37 +03:00
|
|
|
format_punctuation "}"
|
2022-02-04 17:10:47 +03:00
|
|
|
| TEnum (_, e) ->
|
2022-02-06 20:25:37 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a%a%a%a@]" Ast.EnumName.format_t e
|
|
|
|
format_punctuation "["
|
2022-02-04 17:10:47 +03:00
|
|
|
(Format.pp_print_list
|
2022-02-06 20:25:37 +03:00
|
|
|
~pp_sep:(fun fmt () ->
|
|
|
|
Format.fprintf fmt "@ %a@ " format_punctuation "|")
|
2022-02-04 17:10:47 +03:00
|
|
|
(fun fmt (case, typ) ->
|
2022-02-06 20:25:37 +03:00
|
|
|
Format.fprintf fmt "%a%a@ %a" format_enum_constructor case
|
|
|
|
format_punctuation ":" format_typ typ))
|
|
|
|
(EnumMap.find e ctx.ctx_enums)
|
|
|
|
format_punctuation "]"
|
2020-11-27 18:27:10 +03:00
|
|
|
| TArrow (t1, t2) ->
|
2022-02-09 17:01:24 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a %a@ %a@]" format_typ_with_parens t1
|
|
|
|
format_operator "→" format_typ t2
|
2021-03-12 21:37:00 +03:00
|
|
|
| TArray t1 ->
|
|
|
|
Format.fprintf fmt "@[<hov 2>%a@ %a@]" format_base_type "array" format_typ
|
|
|
|
t1
|
2022-02-14 19:01:34 +03:00
|
|
|
| TAny -> format_base_type fmt "any"
|
2020-11-26 12:38:13 +03:00
|
|
|
|
2021-05-26 22:18:18 +03:00
|
|
|
(* (EmileRolley) NOTE: seems to be factorizable with Lcalc.Print.format_lit. *)
|
2020-11-26 12:38:13 +03:00
|
|
|
let format_lit (fmt : Format.formatter) (l : lit Pos.marked) : unit =
|
|
|
|
match Pos.unmark l with
|
2022-02-09 17:01:24 +03:00
|
|
|
| LBool b -> format_lit_style fmt (string_of_bool b)
|
|
|
|
| LInt i -> format_lit_style fmt (Runtime.integer_to_string i)
|
|
|
|
| LEmptyError -> format_lit_style fmt "∅ "
|
|
|
|
| LUnit -> format_lit_style fmt "()"
|
2020-12-09 18:45:23 +03:00
|
|
|
| LRat i ->
|
2022-02-09 17:01:24 +03:00
|
|
|
format_lit_style fmt
|
|
|
|
(Runtime.decimal_to_string ~max_prec_digits:!Utils.Cli.max_prec_digits i)
|
2021-01-09 23:03:32 +03:00
|
|
|
| LMoney e -> (
|
|
|
|
match !Utils.Cli.locale_lang with
|
2022-02-09 17:01:24 +03:00
|
|
|
| En ->
|
|
|
|
format_lit_style fmt (Format.asprintf "$%s" (Runtime.money_to_string e))
|
|
|
|
| Fr ->
|
|
|
|
format_lit_style fmt (Format.asprintf "%s €" (Runtime.money_to_string e))
|
|
|
|
| Pl ->
|
|
|
|
format_lit_style fmt
|
|
|
|
(Format.asprintf "%s PLN" (Runtime.money_to_string e)))
|
|
|
|
| LDate d -> format_lit_style fmt (Runtime.date_to_string d)
|
|
|
|
| LDuration d -> format_lit_style fmt (Runtime.duration_to_string d)
|
2020-11-26 12:38:13 +03:00
|
|
|
|
2020-12-09 20:14:52 +03:00
|
|
|
let format_op_kind (fmt : Format.formatter) (k : op_kind) =
|
2020-12-10 13:35:56 +03:00
|
|
|
Format.fprintf fmt "%s"
|
|
|
|
(match k with
|
|
|
|
| KInt -> ""
|
|
|
|
| KRat -> "."
|
|
|
|
| KMoney -> "$"
|
|
|
|
| KDate -> "@"
|
|
|
|
| KDuration -> "^")
|
2020-12-09 20:14:52 +03:00
|
|
|
|
2020-11-26 12:38:13 +03:00
|
|
|
let format_binop (fmt : Format.formatter) (op : binop Pos.marked) : unit =
|
2021-07-08 17:36:53 +03:00
|
|
|
format_operator fmt
|
|
|
|
(match Pos.unmark op with
|
|
|
|
| Add k -> Format.asprintf "+%a" format_op_kind k
|
|
|
|
| Sub k -> Format.asprintf "-%a" format_op_kind k
|
|
|
|
| Mult k -> Format.asprintf "*%a" format_op_kind k
|
|
|
|
| Div k -> Format.asprintf "/%a" format_op_kind k
|
|
|
|
| And -> "&&"
|
|
|
|
| Or -> "||"
|
|
|
|
| Xor -> "xor"
|
|
|
|
| Eq -> "="
|
|
|
|
| Neq -> "!="
|
|
|
|
| Lt k -> Format.asprintf "%s%a" "<" format_op_kind k
|
|
|
|
| Lte k -> Format.asprintf "%s%a" "<=" format_op_kind k
|
|
|
|
| Gt k -> Format.asprintf "%s%a" ">" format_op_kind k
|
|
|
|
| Gte k -> Format.asprintf "%s%a" ">=" format_op_kind k
|
|
|
|
| Concat -> "++"
|
|
|
|
| Map -> "map"
|
|
|
|
| Filter -> "filter")
|
2020-12-28 01:53:02 +03:00
|
|
|
|
|
|
|
let format_ternop (fmt : Format.formatter) (op : ternop Pos.marked) : unit =
|
2021-03-11 18:27:57 +03:00
|
|
|
match Pos.unmark op with Fold -> format_keyword fmt "fold"
|
2020-11-26 12:38:13 +03:00
|
|
|
|
2020-12-11 12:51:46 +03:00
|
|
|
let format_log_entry (fmt : Format.formatter) (entry : log_entry) : unit =
|
2022-01-10 17:00:36 +03:00
|
|
|
Format.fprintf fmt "@<2>%s"
|
2021-07-08 17:36:53 +03:00
|
|
|
(match entry with
|
2022-03-08 15:04:27 +03:00
|
|
|
| VarDef _ -> Utils.Cli.with_style [ANSITerminal.blue] "≔ "
|
|
|
|
| BeginCall -> Utils.Cli.with_style [ANSITerminal.yellow] "→ "
|
|
|
|
| EndCall -> Utils.Cli.with_style [ANSITerminal.yellow] "← "
|
|
|
|
| PosRecordIfTrueBool -> Utils.Cli.with_style [ANSITerminal.green] "☛ ")
|
2020-12-11 12:51:46 +03:00
|
|
|
|
2020-11-26 12:38:13 +03:00
|
|
|
let format_unop (fmt : Format.formatter) (op : unop Pos.marked) : unit =
|
2020-12-09 13:23:03 +03:00
|
|
|
Format.fprintf fmt "%s"
|
2021-03-16 20:34:59 +03:00
|
|
|
(match Pos.unmark op with
|
2020-12-11 12:51:46 +03:00
|
|
|
| Minus _ -> "-"
|
|
|
|
| Not -> "~"
|
|
|
|
| Log (entry, infos) ->
|
|
|
|
Format.asprintf "log@[<hov 2>[%a|%a]@]" format_log_entry entry
|
|
|
|
(Format.pp_print_list
|
|
|
|
~pp_sep:(fun fmt () -> Format.fprintf fmt ".")
|
|
|
|
(fun fmt info -> Utils.Uid.MarkedString.format_info fmt info))
|
2020-12-28 01:53:02 +03:00
|
|
|
infos
|
2021-01-04 02:13:59 +03:00
|
|
|
| Length -> "length"
|
2021-01-05 18:00:15 +03:00
|
|
|
| IntToRat -> "int_to_rat"
|
|
|
|
| GetDay -> "get_day"
|
|
|
|
| GetMonth -> "get_month"
|
2022-03-17 14:30:14 +03:00
|
|
|
| GetYear -> "get_year"
|
2022-04-29 22:18:15 +03:00
|
|
|
| RoundMoney -> "round_money"
|
|
|
|
| RoundDecimal -> "round_decimal")
|
2020-11-26 12:38:13 +03:00
|
|
|
|
2022-01-10 12:28:14 +03:00
|
|
|
let needs_parens (e : expr Pos.marked) : bool =
|
|
|
|
match Pos.unmark e with EAbs _ | ETuple (_, Some _) -> true | _ -> false
|
2020-11-26 15:38:42 +03:00
|
|
|
|
|
|
|
let format_var (fmt : Format.formatter) (v : Var.t) : unit =
|
2021-10-28 16:24:39 +03:00
|
|
|
Format.fprintf fmt "%s_%d" (Bindlib.name_of v) (Bindlib.uid_of v)
|
2020-11-26 15:38:42 +03:00
|
|
|
|
2022-01-10 16:19:04 +03:00
|
|
|
let rec format_expr
|
|
|
|
?(debug : bool = false)
|
|
|
|
(ctx : Ast.decl_ctx)
|
|
|
|
(fmt : Format.formatter)
|
|
|
|
(e : expr Pos.marked) : unit =
|
|
|
|
let format_expr = format_expr ~debug ctx in
|
2020-11-26 15:38:42 +03:00
|
|
|
let format_with_parens (fmt : Format.formatter) (e : expr Pos.marked) =
|
2021-03-11 18:27:57 +03:00
|
|
|
if needs_parens e then
|
|
|
|
Format.fprintf fmt "%a%a%a" format_punctuation "(" format_expr e
|
|
|
|
format_punctuation ")"
|
2020-11-26 15:38:42 +03:00
|
|
|
else Format.fprintf fmt "%a" format_expr e
|
|
|
|
in
|
2020-11-26 12:38:13 +03:00
|
|
|
match Pos.unmark e with
|
2020-11-27 20:36:38 +03:00
|
|
|
| EVar v -> Format.fprintf fmt "%a" format_var (Pos.unmark v)
|
2021-01-14 02:17:24 +03:00
|
|
|
| ETuple (es, None) ->
|
2021-03-11 18:27:57 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a%a%a@]" format_punctuation "("
|
2020-12-05 20:12:53 +03:00
|
|
|
(Format.pp_print_list
|
2020-12-31 02:28:26 +03:00
|
|
|
~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
|
2021-01-14 02:17:24 +03:00
|
|
|
(fun fmt e -> Format.fprintf fmt "%a" format_expr e))
|
2021-03-11 18:27:57 +03:00
|
|
|
es format_punctuation ")"
|
2021-01-14 02:17:24 +03:00
|
|
|
| ETuple (es, Some s) ->
|
2021-03-11 18:27:57 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a@ @[<hov 2>%a%a%a@]@]"
|
|
|
|
Ast.StructName.format_t s format_punctuation "{"
|
2021-01-14 02:17:24 +03:00
|
|
|
(Format.pp_print_list
|
2022-02-06 20:25:37 +03:00
|
|
|
~pp_sep:(fun fmt () ->
|
|
|
|
Format.fprintf fmt "%a@ " format_punctuation ";")
|
2021-01-14 02:17:24 +03:00
|
|
|
(fun fmt (e, struct_field) ->
|
2022-02-06 20:25:37 +03:00
|
|
|
Format.fprintf fmt "%a%a%a%a@ %a" format_punctuation "\""
|
|
|
|
Ast.StructFieldName.format_t struct_field format_punctuation "\""
|
|
|
|
format_punctuation "=" format_expr e))
|
2021-01-28 02:28:28 +03:00
|
|
|
(List.combine es (List.map fst (Ast.StructMap.find s ctx.ctx_structs)))
|
2021-03-11 18:27:57 +03:00
|
|
|
format_punctuation "}"
|
2020-12-28 01:53:02 +03:00
|
|
|
| EArray es ->
|
2021-03-11 18:27:57 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a%a%a@]" format_punctuation "["
|
2020-12-28 01:53:02 +03:00
|
|
|
(Format.pp_print_list
|
2020-12-30 00:26:10 +03:00
|
|
|
~pp_sep:(fun fmt () -> Format.fprintf fmt ";@ ")
|
2021-01-09 19:44:45 +03:00
|
|
|
(fun fmt e -> Format.fprintf fmt "%a" format_expr e))
|
2021-03-11 18:27:57 +03:00
|
|
|
es format_punctuation "]"
|
2021-01-14 02:17:24 +03:00
|
|
|
| ETupleAccess (e1, n, s, _ts) -> (
|
|
|
|
match s with
|
2021-03-11 18:27:57 +03:00
|
|
|
| None ->
|
|
|
|
Format.fprintf fmt "%a%a%d" format_expr e1 format_punctuation "." n
|
2021-01-14 02:17:24 +03:00
|
|
|
| Some s ->
|
2022-02-09 17:01:24 +03:00
|
|
|
Format.fprintf fmt "%a%a%a%a%a" format_expr e1 format_operator "."
|
|
|
|
format_punctuation "\"" Ast.StructFieldName.format_t
|
2021-03-11 18:27:57 +03:00
|
|
|
(fst (List.nth (Ast.StructMap.find s ctx.ctx_structs) n))
|
2021-03-16 20:34:59 +03:00
|
|
|
format_punctuation "\"")
|
2021-01-14 02:17:24 +03:00
|
|
|
| EInj (e, n, en, _ts) ->
|
2022-02-06 20:25:37 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a@ %a@]" format_enum_constructor
|
2021-01-28 02:28:28 +03:00
|
|
|
(fst (List.nth (Ast.EnumMap.find en ctx.ctx_enums) n))
|
2021-01-14 02:17:24 +03:00
|
|
|
format_expr e
|
|
|
|
| EMatch (e, es, e_name) ->
|
2022-02-14 19:01:34 +03:00
|
|
|
Format.fprintf fmt "@[<hov 0>%a@ @[<hov 2>%a@]@ %a@ %a@]" format_keyword
|
2021-03-11 18:27:57 +03:00
|
|
|
"match" format_expr e format_keyword "with"
|
2020-12-05 20:12:53 +03:00
|
|
|
(Format.pp_print_list
|
2022-02-14 19:01:34 +03:00
|
|
|
~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
|
2020-12-05 20:12:53 +03:00
|
|
|
(fun fmt (e, c) ->
|
2022-02-14 19:01:34 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a %a%a@ %a@]" format_punctuation "|"
|
|
|
|
format_enum_constructor c format_punctuation ":" format_expr e))
|
2021-01-28 02:28:28 +03:00
|
|
|
(List.combine es (List.map fst (Ast.EnumMap.find e_name ctx.ctx_enums)))
|
2022-02-09 17:01:24 +03:00
|
|
|
| ELit l -> format_lit fmt (Pos.same_pos_as l e)
|
2021-04-03 12:49:13 +03:00
|
|
|
| EApp ((EAbs ((binder, _), taus), _), args) ->
|
2020-11-26 15:38:42 +03:00
|
|
|
let xs, body = Bindlib.unmbind binder in
|
|
|
|
let xs_tau = List.map2 (fun x tau -> x, tau) (Array.to_list xs) taus in
|
|
|
|
let xs_tau_arg = List.map2 (fun (x, tau) arg -> x, tau, arg) xs_tau args in
|
2021-03-12 21:37:00 +03:00
|
|
|
Format.fprintf fmt "%a%a"
|
2020-11-26 15:38:42 +03:00
|
|
|
(Format.pp_print_list
|
2021-02-02 01:35:15 +03:00
|
|
|
~pp_sep:(fun fmt () -> Format.fprintf fmt "")
|
2020-11-26 15:38:42 +03:00
|
|
|
(fun fmt (x, tau, arg) ->
|
2022-02-09 17:01:24 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@ %a@ %a@ %a@ %a@]@\n"
|
2022-02-09 13:37:52 +03:00
|
|
|
format_keyword "let" format_var x format_punctuation ":"
|
|
|
|
(format_typ ctx) tau format_punctuation "=" format_expr arg
|
2021-03-11 18:27:57 +03:00
|
|
|
format_keyword "in"))
|
2020-11-26 15:38:42 +03:00
|
|
|
xs_tau_arg format_expr body
|
2021-04-03 12:49:13 +03:00
|
|
|
| EAbs ((binder, _), taus) ->
|
2020-11-26 12:38:13 +03:00
|
|
|
let xs, body = Bindlib.unmbind binder in
|
|
|
|
let xs_tau = List.map2 (fun x tau -> x, tau) (Array.to_list xs) taus in
|
2021-03-12 21:37:00 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a @[<hov 2>%a@] %a@ %a@]" format_punctuation
|
|
|
|
"λ"
|
2020-11-26 12:38:13 +03:00
|
|
|
(Format.pp_print_list
|
2020-12-30 14:02:09 +03:00
|
|
|
~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ")
|
2020-12-30 00:26:10 +03:00
|
|
|
(fun fmt (x, tau) ->
|
2021-03-12 21:37:00 +03:00
|
|
|
Format.fprintf fmt "%a%a%a %a%a" format_punctuation "(" format_var x
|
|
|
|
format_punctuation ":" (format_typ ctx) tau format_punctuation ")"))
|
2021-03-11 18:27:57 +03:00
|
|
|
xs_tau format_punctuation "→" format_expr body
|
2021-01-10 20:11:46 +03:00
|
|
|
| EApp ((EOp (Binop ((Ast.Map | Ast.Filter) as op)), _), [arg1; arg2]) ->
|
|
|
|
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@]" format_binop (op, Pos.no_pos)
|
|
|
|
format_with_parens arg1 format_with_parens arg2
|
2020-11-26 12:38:13 +03:00
|
|
|
| EApp ((EOp (Binop op), _), [arg1; arg2]) ->
|
2020-12-30 00:26:10 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@]" format_with_parens arg1
|
|
|
|
format_binop (op, Pos.no_pos) format_with_parens arg2
|
2022-01-10 16:19:04 +03:00
|
|
|
| EApp ((EOp (Unop (Log _)), _), [arg1]) when not debug ->
|
|
|
|
format_expr fmt arg1
|
2020-11-26 12:38:13 +03:00
|
|
|
| EApp ((EOp (Unop op), _), [arg1]) ->
|
2020-12-30 00:26:10 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a@ %a@]" format_unop (op, Pos.no_pos)
|
|
|
|
format_with_parens arg1
|
2020-11-26 12:38:13 +03:00
|
|
|
| EApp (f, args) ->
|
2020-12-30 00:26:10 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a@ %a@]" format_expr f
|
2020-11-26 15:38:42 +03:00
|
|
|
(Format.pp_print_list
|
|
|
|
~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ")
|
|
|
|
format_with_parens)
|
2020-11-26 12:38:13 +03:00
|
|
|
args
|
|
|
|
| EIfThenElse (e1, e2, e3) ->
|
2021-03-12 21:37:00 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@ %a@ %a@ %a@]" format_keyword "if"
|
|
|
|
format_expr e1 format_keyword "then" format_expr e2 format_keyword "else"
|
|
|
|
format_expr e3
|
2020-12-28 01:53:02 +03:00
|
|
|
| EOp (Ternop op) -> Format.fprintf fmt "%a" format_ternop (op, Pos.no_pos)
|
2020-11-26 12:38:13 +03:00
|
|
|
| EOp (Binop op) -> Format.fprintf fmt "%a" format_binop (op, Pos.no_pos)
|
|
|
|
| EOp (Unop op) -> Format.fprintf fmt "%a" format_unop (op, Pos.no_pos)
|
2020-12-18 17:59:15 +03:00
|
|
|
| EDefault (exceptions, just, cons) ->
|
|
|
|
if List.length exceptions = 0 then
|
2022-02-09 17:34:13 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a%a@ %a@ %a%a@]" format_punctuation "⟨"
|
2021-03-12 21:37:00 +03:00
|
|
|
format_expr just format_punctuation "⊢" format_expr cons
|
|
|
|
format_punctuation "⟩"
|
2020-11-26 15:38:42 +03:00
|
|
|
else
|
2022-02-09 17:34:13 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a%a@ %a@ %a@ %a@ %a%a@]" format_punctuation
|
|
|
|
"⟨"
|
2021-03-12 21:37:00 +03:00
|
|
|
(Format.pp_print_list
|
|
|
|
~pp_sep:(fun fmt () ->
|
|
|
|
Format.fprintf fmt "%a@ " format_punctuation ",")
|
|
|
|
format_expr)
|
2021-03-11 18:27:57 +03:00
|
|
|
exceptions format_punctuation "|" format_expr just format_punctuation
|
|
|
|
"⊢" format_expr cons format_punctuation "⟩"
|
2022-02-09 17:34:13 +03:00
|
|
|
| ErrorOnEmpty e' ->
|
|
|
|
Format.fprintf fmt "%a@ %a" format_operator "error_empty" format_with_parens
|
|
|
|
e'
|
2021-03-11 18:27:57 +03:00
|
|
|
| EAssert e' ->
|
|
|
|
Format.fprintf fmt "@[<hov 2>%a@ %a%a%a@]" format_keyword "assert"
|
|
|
|
format_punctuation "(" format_expr e' format_punctuation ")"
|
2021-12-10 00:59:39 +03:00
|
|
|
|
2022-01-10 16:19:04 +03:00
|
|
|
let format_scope
|
|
|
|
?(debug : bool = false)
|
|
|
|
(ctx : decl_ctx)
|
|
|
|
(fmt : Format.formatter)
|
2022-04-12 11:53:07 +03:00
|
|
|
((n, s) : Ast.ScopeName.t * Ast.expr scope_body) =
|
2022-02-06 20:25:37 +03:00
|
|
|
Format.fprintf fmt "@[<hov 2>%a %a =@ %a@]" format_keyword "let"
|
|
|
|
Ast.ScopeName.format_t n (format_expr ctx ~debug)
|
2021-12-10 18:30:36 +03:00
|
|
|
(Bindlib.unbox
|
2022-04-12 18:54:00 +03:00
|
|
|
(Ast.build_whole_scope_expr ~make_abs:Ast.make_abs
|
|
|
|
~make_let_in:Ast.make_let_in ~box_expr:Ast.box_expr ctx s
|
2021-12-10 18:30:36 +03:00
|
|
|
(Pos.get_position (Ast.ScopeName.get_info n))))
|