CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-11-08 07:51:43 +03:00
Code Issues Projects Releases Wiki Activity

Explain plugin: more layout improvements

Browse Source
This commit is contained in:
Louis Gesbert 2024-10-15 11:46:38 +02:00
parent 5afe4ca340
commit b67758ec6a
3 changed files with 26 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
compiler/plugins/explain.ml
View File

@ -40,7 +40,7 @@ module Style = struct
let dark =
{
page_background = 0x0;
arrows = 0xff7700;
arrows = 0x606060;
input =
{ fill = 0x252526; border = 0xBC3FBC; stroke = 2; text = 0xFFFFFF };
middle =
@ -1227,7 +1227,7 @@ let expr_to_dot_label0 :
match o with
| Eq_boo_boo | Eq_int_int | Eq_rat_rat | Eq_mon_mon | Eq_dur_dur
| Eq_dat_dat | Eq ->
"="
"＝"
| Minus_int | Minus_rat | Minus_mon | Minus_dur | Minus -> "-"
| ToRat_int | ToRat_mon | ToRat -> ""
| ToMoney_rat | ToMoney -> ""
@ -1241,19 +1241,19 @@ let expr_to_dot_label0 :
"×"
| Div_int_int | Div_rat_rat | Div_mon_mon | Div_mon_rat | Div_dur_dur
| Div ->
"/"
"÷"
| Lt_int_int | Lt_rat_rat | Lt_mon_mon | Lt_dur_dur | Lt_dat_dat | Lt
->
"<"
| Lte_int_int | Lte_rat_rat | Lte_mon_mon | Lte_dur_dur | Lte_dat_dat
| Lte ->
"<="
"≤"
| Gt_int_int | Gt_rat_rat | Gt_mon_mon | Gt_dur_dur | Gt_dat_dat | Gt
->
">"
| Gte_int_int | Gte_rat_rat | Gte_mon_mon | Gte_dur_dur | Gte_dat_dat
| Gte ->
">="
"≥"
| Concat -> "++"
| Not -> xlang () ~en:"not" ~fr:"non"
| Length -> xlang () ~en:"length" ~fr:"nombre"
@ -1349,11 +1349,6 @@ let htmlencode =
| "@" -> "&commat;"
| _ -> assert false)
let scale_svg_width s =
let open Re in
let re = Pcre.re "<svg width=\"[^\"]*pt\"" in
replace_string (compile re) ~by:"<svg width=\"100%\"" s
let expr_to_dot_label0 lang ctx env ppf e =
Format.fprintf ppf "%s"
(htmlencode (Format.asprintf "%a" (expr_to_dot_label0 lang ctx env) e))
@ -1448,7 +1443,7 @@ let to_dot lang ppf ctx env base_vars g ~base_src_url ~line_format ~theme =
(* `Ratio (`Float 0.8); *)
(* `Concentrate true; *)
`Ratio `Compress;
(* `Size (8.3, 11.7); (\* A4 in inches..... *\) *)
(* `Size (8.3, 11.7); (* A4 in inches..... *) *)
(* `Rankdir `LeftToRight *)
]
@ -1594,14 +1589,14 @@ let to_dot lang ppf ctx env base_vars g ~base_src_url ~line_format ~theme =
[
`Style `Dashed;
`Penwidth 2.;
`Color theme.arrows;
`Color 0xff7700;
`Arrowhead `Odot;
`Weight 5;
`Weight 8;
]
| { side = Some (Lhs s | Rhs s); _ } ->
[`Color 0x606060 (* `Label s; `Color 0xbb7700 *); `Weight 10]
[`Color theme.arrows (* `Label s; `Color 0xbb7700 *); `Weight 10]
| { side = None; _ } ->
[`Color 0x606060 (* `Minlen 0; `Weight 10 *); `Weight 10]
[`Color theme.arrows (* `Minlen 0; `Weight 10 *); `Weight 10]
end) in
let g =
(* Add fake edges from everything towards the inputs to force ordering *)
@ -1901,11 +1896,16 @@ let run
output_string oc "<!DOCTYPE html>\n<html>\n<head>\n <title>";
output_string oc (htmlencode ex_scope);
Printf.fprintf oc
"</title>\n</head>\n<body style=\"background-color: #%06x\">\n"
" </title>\n\
\ <style>\n\
\ body { background-color: #%06x }\n\
\ svg { max-width: 80rem; height: fit-content; }\n\
\ </style>\n\
</head>\n\
<body>\n"
explain_options.theme.page_background);
let contents = File.process_out "dot" ["-T" ^ fmt; dotfile] in
output_string oc
(if wrap_html then scale_svg_width contents else contents);
output_string oc contents;
if wrap_html then output_string oc "</body>\n</html>\n")
| `Dot -> ());
match explain_options.show with

2
compiler/scopelang/from_desugared.ml
View File

@ -863,7 +863,7 @@ let translate_program
match states with
| D.WholeVar -> WholeVar (ScopeVar.fresh (var_name, var_pos))
| States states ->
let var_prefix = var_name ^ "_" in
let var_prefix = var_name ^ "#" in
let state_var state =
ScopeVar.fresh
(Mark.map (( ^ ) var_prefix) (StateName.get_info state))

14
tests/variable_state/good/subscope.catala_en
View File

@ -44,14 +44,14 @@ $ catala Typecheck --check-invariants
```catala-test-inline
$ catala Scopelang -s A
let scope A (foo_bar: ⟨integer⟩|context) (foo_baz: integer|internal)
(foo_fizz: integer|internal|output) =
let foo_bar : integer = reentrant or by default
let scope A (foo#bar: ⟨integer⟩|context) (foo#baz: integer|internal)
(foo#fizz: integer|internal|output) =
let foo#bar : integer = reentrant or by default
error_empty ⟨ ⟨true ⊢ ⟨1⟩⟩ | false ⊢ ∅ ⟩;
let foo_baz : integer =
error_empty ⟨ ⟨true ⊢ ⟨foo_bar + 1⟩⟩ | false ⊢ ∅ ⟩;
let foo_fizz : integer =
error_empty ⟨ ⟨true ⊢ ⟨foo_baz + 1⟩⟩ | false ⊢ ∅ ⟩
let foo#baz : integer =
error_empty ⟨ ⟨true ⊢ ⟨foo#bar + 1⟩⟩ | false ⊢ ∅ ⟩;
let foo#fizz : integer =
error_empty ⟨ ⟨true ⊢ ⟨foo#baz + 1⟩⟩ | false ⊢ ∅ ⟩
```
```catala-test-inline