From 54952f0ec10d2db5dcf05be123fe5d8183361f4c Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 16 Dec 2024 09:30:20 +0100
Subject: [PATCH] [compiler_data] update pretty printer of type_assignment

- add pretty_raw allowing to print raw types, i.e. types with modes
  and functionality
---
 src/compiler/compiler_data.ml      | 19 +++++++++++++++----
 src/compiler/test_compiler_data.ml | 19 +++++--------------
 2 files changed, 20 insertions(+), 18 deletions(-)

diff --git a/src/compiler/compiler_data.ml b/src/compiler/compiler_data.ml
index 391a0db5..79fda427 100644
--- a/src/compiler/compiler_data.ml
+++ b/src/compiler/compiler_data.ml
@@ -338,7 +338,7 @@ module TypeAssignment = struct
     | x -> x
 
   open Format
-  let pretty f fmt tm =
+  let pretty ?(is_raw=false) f fmt tm =
 
     let arrs = 0 in
     let app = 1 in
@@ -348,14 +348,18 @@ module TypeAssignment = struct
       | App _ -> app
       | _ -> 2 in
 
+    let show_mode fmt m =
+      if is_raw then (Format.fprintf fmt "%a:" Mode.pretty m) else Format.fprintf fmt ""
+    in
+
     let rec pretty fmt = function
       | Prop Relation -> fprintf fmt "prop"
-      | Prop Function -> fprintf fmt "func"
+      | Prop Function -> fprintf fmt "%s" (if is_raw then "func" else "prop")
       | Any -> fprintf fmt "any"
       | Cons c -> F.pp fmt c
       | App(f,x,xs) -> fprintf fmt "@[<hov 2>%a@ %a@]" F.pp f (Util.pplist (pretty_parens ~lvl:app) " ") (x::xs)
-      | Arr(m,NotVariadic,s,t) -> fprintf fmt "@[<hov 2>(*%a:*)%a ->@ %a@]" Mode.pretty m (pretty_parens ~lvl:arrs) s pretty t
-      | Arr(m,Variadic,s,t) -> fprintf fmt "(*%a:*)%a ..-> %a" Mode.pretty m (pretty_parens ~lvl:arrs) s pretty t
+      | Arr(m,NotVariadic,s,t) -> fprintf fmt "@[<hov 2>%a%a ->@ %a@]" show_mode m (pretty_parens ~lvl:arrs) s pretty t
+      | Arr(m,Variadic,s,t) -> fprintf fmt "%a%a ..-> %a" show_mode m (pretty_parens ~lvl:arrs) s pretty t
       | UVar m -> f fmt pretty m
       (* | UVar m -> MutableOnce.pretty fmt m *)
     and pretty_parens ~lvl fmt = function
@@ -366,9 +370,16 @@ module TypeAssignment = struct
   in 
   pretty fmt tm
 
+  let pretty_raw fmt = pretty ~is_raw:true fmt
+  let pretty fmt = pretty ~is_raw:false fmt
+
+
   let pretty_mut_once = 
     pretty (fun fmt f t -> if MutableOnce.is_set t then f fmt (deref t) else MutableOnce.pretty fmt t)
 
+  let pretty_mut_once_raw = 
+    pretty_raw (fun fmt f t -> if MutableOnce.is_set t then f fmt (deref t) else MutableOnce.pretty fmt t)
+
   let pretty_ft =
     pretty (fun fmt _ (t:F.t) -> F.pp fmt t)
 
diff --git a/src/compiler/test_compiler_data.ml b/src/compiler/test_compiler_data.ml
index 8e004ee7..c97b1c79 100644
--- a/src/compiler/test_compiler_data.ml
+++ b/src/compiler/test_compiler_data.ml
@@ -1,9 +1,9 @@
 let pp_ta t s =
   let open Elpi_compiler.Compiler_data in
-  let s' = Format.asprintf "@[%a@]" TypeAssignment.pretty_mut_once t in
+  let s' = Format.asprintf "@[%a@]" TypeAssignment.pretty_mut_once_raw t in
   if s <> s' then begin
     Format.eprintf "Unexpected print: %a\nactual: %a\nreference: %s\n"
-      TypeAssignment.pp (Val t) TypeAssignment.pretty_mut_once t s;
+      TypeAssignment.pp (Val t) TypeAssignment.pretty_mut_once_raw t s;
     exit 1
   end
 ;;
@@ -27,24 +27,15 @@ let list x = (App(F.from_string "list",x,[]))
 let int = Cons (F.from_string "int")
 let arr s t = Arr(Output,NotVariadic,s,t)
 
-(* let () = pp_ta (Prop Relation) "prop";;
-let () = pp_ta (Prop Function) "fprop";;
+let () = pp_ta (Prop Relation) "prop";;
+let () = pp_ta (Prop Function) "func";;
 let () = pp_ta (list int) "list int";;
 let () = pp_ta (list (list int)) "list (list int)";;
 let () = pp_ta (arr (list int) int) "o:list int -> int";;
 let () = pp_ta (arr (arr int int) int) "o:(o:int -> int) -> int";;
 let () = pp_ta (arr int (arr int int)) "o:int -> o:int -> int";;
 let () = pp_ta (arr int (arr (list int) int)) "o:int -> o:list int -> int";;
-let () = pp_ta (list (arr int int)) "list (o:int -> int)";; *)
-let () = pp_ta (Prop Relation) "prop";;
-let () = pp_ta (Prop Function) "prop";;
-let () = pp_ta (list int) "list int";;
-let () = pp_ta (list (list int)) "list (list int)";;
-let () = pp_ta (arr (list int) int) "list int -> int";;
-let () = pp_ta (arr (arr int int) int) "(int -> int) -> int";;
-let () = pp_ta (arr int (arr int int)) "int -> int -> int";;
-let () = pp_ta (arr int (arr (list int) int)) "int -> list int -> int";;
-let () = pp_ta (list (arr int int)) "list (int -> int)";;
+let () = pp_ta (list (arr int int)) "list (o:int -> int)";;
 
 open ScopedTerm