CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-09-20 00:41:05 +03:00
Code Issues Projects Releases Wiki Activity

Improved log printing

Browse Source
This commit is contained in:
Denis Merigoux 2021-01-09 17:44:45 +01:00
parent 839310d5ba
commit 6aefb03b94
3 changed files with 42 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/catala/default_calculus/dune
View File

@ -1,7 +1,7 @@
(library
(name dcalc)
(public_name catala.dcalc)
(libraries bindlib unionFind utils zarith zarith_stubs_js odate))
(libraries bindlib unionFind utils zarith zarith_stubs_js odate re))
(documentation
(package catala))

34
src/catala/default_calculus/interpreter.ml
View File

@ -43,6 +43,8 @@ let rec type_eq (t1 : A.typ Pos.marked) (t2 : A.typ Pos.marked) : bool =
| A.TArrow (t11, t12), A.TArrow (t21, t22) -> type_eq t11 t12 && type_eq t21 t22
| _, _ -> false
let log_indent = ref 0
(** {1 Evaluation} *)
let rec evaluate_operator (op : A.operator Pos.marked) (args : A.expr Pos.marked list) :
@ -206,22 +208,42 @@ let rec evaluate_operator (op : A.operator Pos.marked) (args : A.expr Pos.marked
(Pos.get_position op)
else e'
| A.Unop (A.Log (entry, infos)), [ e' ] ->
if !Cli.trace_flag then
if !Cli.trace_flag then (
match entry with
| VarDef ->
let aux l = if !Utils.Cli.style_flag then l else [] in
Cli.log_print
(Format.asprintf "@[<hov 2>%a@ %a@ =@ %a@]" Print.format_log_entry entry
(Format.asprintf "%*s%a %a: %s" (!log_indent * 2) "" Print.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))
infos Print.format_expr (e', Pos.no_pos))
| _ ->
infos
( match e' with
| Ast.EAbs _ -> ANSITerminal.sprintf (aux [ ANSITerminal.green ]) "<function>"
| _ ->
let expr_str = Format.asprintf "%a" Print.format_expr (e', Pos.no_pos) in
let expr_str =
Re.Pcre.substitute ~rex:(Re.Pcre.regexp "\n\\s*")
~subst:(fun _ -> " ")
expr_str
in
ANSITerminal.sprintf (aux [ ANSITerminal.green ]) "%s" expr_str ))
| BeginCall ->
Cli.log_print
(Format.asprintf "@[<hov 2>%a@ %a@]" Print.format_log_entry entry
(Format.asprintf "%*s%a %a" (!log_indent * 2) "" Print.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))
infos)
infos);
log_indent := !log_indent + 1
| EndCall ->
log_indent := !log_indent - 1;
Cli.log_print
(Format.asprintf "%*s%a %a" (!log_indent * 2) "" Print.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))
infos) )
else ();
e'
| A.Unop _, [ ELit LEmptyError ] -> A.ELit LEmptyError

25
src/catala/default_calculus/print.ml
View File

@ -119,11 +119,11 @@ let format_ternop (fmt : Format.formatter) (op : ternop Pos.marked) : unit =
match Pos.unmark op with Fold -> Format.fprintf fmt "fold"
let format_log_entry (fmt : Format.formatter) (entry : log_entry) : unit =
Format.fprintf fmt "%s"
( match entry with
| VarDef -> "Defining variable"
| BeginCall -> "Calling subscope"
| EndCall -> "Returned from subscope" )
let aux l = if !Utils.Cli.style_flag then l else [] in
match entry with
| VarDef -> Format.fprintf fmt "%s" (ANSITerminal.sprintf (aux [ ANSITerminal.blue ]) "≔ ")
| BeginCall -> Format.fprintf fmt "%s" (ANSITerminal.sprintf (aux [ ANSITerminal.yellow ]) "→ ")
| EndCall -> Format.fprintf fmt "%s" (ANSITerminal.sprintf (aux [ ANSITerminal.yellow ]) "← ")
let format_unop (fmt : Format.formatter) (op : unop Pos.marked) : unit =
Format.fprintf fmt "%s"
@ -163,21 +163,22 @@ let rec format_expr (fmt : Format.formatter) (e : expr Pos.marked) : unit =
(fun fmt (e, struct_field) ->
match struct_field with
| Some struct_field ->
Format.fprintf fmt "@[<hov 2>\"%a\":@ %a@]" Uid.MarkedString.format_info
struct_field format_expr e
| None -> Format.fprintf fmt "@[%a@]" format_expr e))
Format.fprintf fmt "\"%a\":@ %a" Uid.MarkedString.format_info struct_field
format_expr e
| None -> Format.fprintf fmt "%a" format_expr e))
es
| EArray es ->
Format.fprintf fmt "@[<hov 2>[%a]@]"
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ";@ ")
(fun fmt e -> Format.fprintf fmt "@[%a@]" format_expr e))
(fun fmt e -> Format.fprintf fmt "%a" format_expr e))
es
| ETupleAccess (e1, n, i, _) -> (
match i with
| None -> Format.fprintf fmt "%a.%d" format_expr e1 n
| Some i -> Format.fprintf fmt "%a.\"%a\"" format_expr e1 Uid.MarkedString.format_info i )
| EInj (e, _n, i, _ts) -> Format.fprintf fmt "%a@ %a" Uid.MarkedString.format_info i format_expr e
| EInj (e, _n, i, _ts) ->
Format.fprintf fmt "@[<hov 2>%a@ %a@]" Uid.MarkedString.format_info i format_expr e
| EMatch (e, es) ->
Format.fprintf fmt "@[<hov 2>match@ %a@ with@ %a@]" format_expr e
(Format.pp_print_list
@ -216,8 +217,8 @@ let rec format_expr (fmt : Format.formatter) (e : expr Pos.marked) : unit =
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ") format_with_parens)
args
| EIfThenElse (e1, e2, e3) ->
Format.fprintf fmt "if@ @[<hov 2>%a@]@ then@ @[<hov 2>%a@]@ else@ @[<hov 2>%a@]" format_expr
e1 format_expr e2 format_expr e3
Format.fprintf fmt "@[<hov 2> if@ @[<hov 2>%a@]@ then@ @[<hov 2>%a@]@ else@ @[<hov 2>%a@]@]"
format_expr e1 format_expr e2 format_expr e3
| EOp (Ternop op) -> Format.fprintf fmt "%a" format_ternop (op, Pos.no_pos)
| 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)