Hide the intermediate functions from PP_generic's signature
This commit is contained in:
Suzanne Dupéron
parent
92069077df
commit
008f228ed7
@ -3,115 +3,117 @@ open Fold
|
|||||||
open Format
|
open Format
|
||||||
open PP_helpers
|
open PP_helpers
|
||||||
|
|
||||||
let needs_parens = {
|
module M = struct
|
||||||
generic = (fun state info ->
|
let needs_parens = {
|
||||||
match info.node_instance.instance_kind with
|
generic = (fun state info ->
|
||||||
| RecordInstance _ -> false
|
match info.node_instance.instance_kind with
|
||||||
| VariantInstance _ -> true
|
| RecordInstance _ -> false
|
||||||
| PolyInstance { poly =_; arguments=_; poly_continue } ->
|
| VariantInstance _ -> true
|
||||||
(poly_continue state)
|
| PolyInstance { poly =_; arguments=_; poly_continue } ->
|
||||||
);
|
(poly_continue state)
|
||||||
type_variable = (fun _ _ _ -> true) ;
|
);
|
||||||
bool = (fun _ _ _ -> false) ;
|
type_variable = (fun _ _ _ -> true) ;
|
||||||
int = (fun _ _ _ -> false) ;
|
bool = (fun _ _ _ -> false) ;
|
||||||
z = (fun _ _ _ -> false) ;
|
int = (fun _ _ _ -> false) ;
|
||||||
string = (fun _ _ _ -> false) ;
|
z = (fun _ _ _ -> false) ;
|
||||||
ligo_string = (fun _ _ _ -> false) ;
|
string = (fun _ _ _ -> false) ;
|
||||||
bytes = (fun _ _ _ -> false) ;
|
ligo_string = (fun _ _ _ -> false) ;
|
||||||
unit = (fun _ _ _ -> false) ;
|
bytes = (fun _ _ _ -> false) ;
|
||||||
packed_internal_operation = (fun _ _ _ -> false) ;
|
unit = (fun _ _ _ -> false) ;
|
||||||
expression_variable = (fun _ _ _ -> false) ;
|
packed_internal_operation = (fun _ _ _ -> false) ;
|
||||||
constructor' = (fun _ _ _ -> false) ;
|
expression_variable = (fun _ _ _ -> false) ;
|
||||||
location = (fun _ _ _ -> false) ;
|
constructor' = (fun _ _ _ -> false) ;
|
||||||
label = (fun _ _ _ -> false) ;
|
location = (fun _ _ _ -> false) ;
|
||||||
ast_core_type_expression = (fun _ _ _ -> true) ;
|
label = (fun _ _ _ -> false) ;
|
||||||
constructor_map = (fun _ _ _ _ -> false) ;
|
ast_core_type_expression = (fun _ _ _ -> true) ;
|
||||||
label_map = (fun _ _ _ _ -> false) ;
|
constructor_map = (fun _ _ _ _ -> false) ;
|
||||||
list = (fun _ _ _ _ -> false) ;
|
label_map = (fun _ _ _ _ -> false) ;
|
||||||
location_wrap = (fun _ _ _ _ -> false) ;
|
list = (fun _ _ _ _ -> false) ;
|
||||||
option = (fun _visitor _continue _state o ->
|
location_wrap = (fun _ _ _ _ -> false) ;
|
||||||
match o with None -> false | Some _ -> true) ;
|
option = (fun _visitor _continue _state o ->
|
||||||
poly_unionfind = (fun _ _ _ _ -> false) ;
|
match o with None -> false | Some _ -> true) ;
|
||||||
poly_set = (fun _ _ _ _ -> false) ;
|
poly_unionfind = (fun _ _ _ _ -> false) ;
|
||||||
typeVariableMap = (fun _ _ _ _ -> false) ;
|
poly_set = (fun _ _ _ _ -> false) ;
|
||||||
}
|
typeVariableMap = (fun _ _ _ _ -> false) ;
|
||||||
|
}
|
||||||
|
|
||||||
let op ppf = {
|
let op ppf = {
|
||||||
generic = (fun () info ->
|
generic = (fun () info ->
|
||||||
match info.node_instance.instance_kind with
|
match info.node_instance.instance_kind with
|
||||||
| RecordInstance { fields } ->
|
| RecordInstance { fields } ->
|
||||||
let aux ppf (fld : 'x Adt_info.ctor_or_field_instance) =
|
let aux ppf (fld : 'x Adt_info.ctor_or_field_instance) =
|
||||||
fprintf ppf "%s = %a" fld.cf.name (fun _ppf -> fld.cf_continue) () in
|
fprintf ppf "%s = %a" fld.cf.name (fun _ppf -> fld.cf_continue) () in
|
||||||
fprintf ppf "{@,@[<hv 2> %a @]@,}" (list_sep aux (fun ppf () -> fprintf ppf " ;@ ")) fields
|
fprintf ppf "{@,@[<hv 2> %a @]@,}" (list_sep aux (fun ppf () -> fprintf ppf " ;@ ")) fields
|
||||||
| VariantInstance { constructor ; _ } ->
|
| VariantInstance { constructor ; _ } ->
|
||||||
if constructor.cf_new_fold needs_parens false
|
if constructor.cf_new_fold needs_parens false
|
||||||
then fprintf ppf "%s (%a)" constructor.cf.name (fun _ppf -> constructor.cf_continue) ()
|
then fprintf ppf "%s (%a)" constructor.cf.name (fun _ppf -> constructor.cf_continue) ()
|
||||||
else let spc = if String.equal constructor.cf.type_ "" then "" else " " in
|
else let spc = if String.equal constructor.cf.type_ "" then "" else " " in
|
||||||
fprintf ppf "%s%s%a" constructor.cf.name spc (fun _ppf -> constructor.cf_continue) ()
|
fprintf ppf "%s%s%a" constructor.cf.name spc (fun _ppf -> constructor.cf_continue) ()
|
||||||
| PolyInstance { poly=_; arguments=_; poly_continue } ->
|
| PolyInstance { poly=_; arguments=_; poly_continue } ->
|
||||||
(poly_continue ())
|
(poly_continue ())
|
||||||
);
|
);
|
||||||
int = (fun _visitor () i -> fprintf ppf "%i" i );
|
int = (fun _visitor () i -> fprintf ppf "%i" i );
|
||||||
type_variable = (fun _visitor () type_variable -> fprintf ppf "Var %a" Var.pp type_variable) ;
|
type_variable = (fun _visitor () type_variable -> fprintf ppf "Var %a" Var.pp type_variable) ;
|
||||||
bool = (fun _visitor () b -> fprintf ppf "%s" (if b then "true" else "false")) ;
|
bool = (fun _visitor () b -> fprintf ppf "%s" (if b then "true" else "false")) ;
|
||||||
z = (fun _visitor () i -> fprintf ppf "%a" Z.pp_print i) ;
|
z = (fun _visitor () i -> fprintf ppf "%a" Z.pp_print i) ;
|
||||||
string = (fun _visitor () str -> fprintf ppf "\"%s\"" str) ;
|
string = (fun _visitor () str -> fprintf ppf "\"%s\"" str) ;
|
||||||
ligo_string = (fun _visitor () str -> fprintf ppf "%a" Ligo_string.pp str) ;
|
ligo_string = (fun _visitor () str -> fprintf ppf "%a" Ligo_string.pp str) ;
|
||||||
bytes = (fun _visitor () _bytes -> fprintf ppf "bytes...") ;
|
bytes = (fun _visitor () _bytes -> fprintf ppf "bytes...") ;
|
||||||
unit = (fun _visitor () () -> fprintf ppf "()") ;
|
unit = (fun _visitor () () -> fprintf ppf "()") ;
|
||||||
packed_internal_operation = (fun _visitor () _op -> fprintf ppf "Operation(...bytes)") ;
|
packed_internal_operation = (fun _visitor () _op -> fprintf ppf "Operation(...bytes)") ;
|
||||||
expression_variable = (fun _visitor () ev -> fprintf ppf "%a" Var.pp ev) ;
|
expression_variable = (fun _visitor () ev -> fprintf ppf "%a" Var.pp ev) ;
|
||||||
constructor' = (fun _visitor () (Constructor c) -> fprintf ppf "Constructor %s" c) ;
|
constructor' = (fun _visitor () (Constructor c) -> fprintf ppf "Constructor %s" c) ;
|
||||||
location = (fun _visitor () loc -> fprintf ppf "%a" Location.pp loc) ;
|
location = (fun _visitor () loc -> fprintf ppf "%a" Location.pp loc) ;
|
||||||
label = (fun _visitor () (Label lbl) -> fprintf ppf "Label %s" lbl) ;
|
label = (fun _visitor () (Label lbl) -> fprintf ppf "Label %s" lbl) ;
|
||||||
ast_core_type_expression = (fun _visitor () te -> fprintf ppf "%a" Ast_core.PP.type_expression te) ;
|
ast_core_type_expression = (fun _visitor () te -> fprintf ppf "%a" Ast_core.PP.type_expression te) ;
|
||||||
constructor_map = (fun _visitor continue () cmap ->
|
constructor_map = (fun _visitor continue () cmap ->
|
||||||
let lst = List.sort (fun (Constructor a, _) (Constructor b, _) -> String.compare a b) (CMap.bindings cmap) in
|
let lst = List.sort (fun (Constructor a, _) (Constructor b, _) -> String.compare a b) (CMap.bindings cmap) in
|
||||||
let aux ppf (Constructor k, v) =
|
let aux ppf (Constructor k, v) =
|
||||||
fprintf ppf "(Constructor %s, %a)" k (fun _ppf -> continue ()) v in
|
fprintf ppf "(Constructor %s, %a)" k (fun _ppf -> continue ()) v in
|
||||||
fprintf ppf "CMap [@,@[<hv 2> %a @]@,]" (list_sep aux (fun ppf () -> fprintf ppf " ; ")) lst);
|
fprintf ppf "CMap [@,@[<hv 2> %a @]@,]" (list_sep aux (fun ppf () -> fprintf ppf " ; ")) lst);
|
||||||
label_map = (fun _visitor continue () lmap ->
|
label_map = (fun _visitor continue () lmap ->
|
||||||
let lst = List.sort (fun (Label a, _) (Label b, _) -> String.compare a b) (LMap.bindings lmap) in
|
let lst = List.sort (fun (Label a, _) (Label b, _) -> String.compare a b) (LMap.bindings lmap) in
|
||||||
let aux ppf (Label k, v) =
|
let aux ppf (Label k, v) =
|
||||||
fprintf ppf "(Constructor %s, %a)" k (fun _ppf -> continue ()) v in
|
fprintf ppf "(Constructor %s, %a)" k (fun _ppf -> continue ()) v in
|
||||||
fprintf ppf "LMap [@,@[<hv 2> %a @]@,]" (list_sep aux (fun ppf () -> fprintf ppf " ; ")) lst);
|
fprintf ppf "LMap [@,@[<hv 2> %a @]@,]" (list_sep aux (fun ppf () -> fprintf ppf " ; ")) lst);
|
||||||
list = (fun _visitor continue () lst ->
|
list = (fun _visitor continue () lst ->
|
||||||
let aux ppf elt =
|
let aux ppf elt =
|
||||||
fprintf ppf "%a" (fun _ppf -> continue ()) elt in
|
fprintf ppf "%a" (fun _ppf -> continue ()) elt in
|
||||||
fprintf ppf "[@,@[<hv 2> %a @]@,]" (list_sep aux (fun ppf () -> fprintf ppf " ;@ ")) lst);
|
fprintf ppf "[@,@[<hv 2> %a @]@,]" (list_sep aux (fun ppf () -> fprintf ppf " ;@ ")) lst);
|
||||||
location_wrap = (fun _visitor continue () lwrap ->
|
location_wrap = (fun _visitor continue () lwrap ->
|
||||||
let ({ wrap_content; location } : _ Location.wrap) = lwrap in
|
let ({ wrap_content; location } : _ Location.wrap) = lwrap in
|
||||||
fprintf ppf "{ wrap_content = %a ; location = %a }" (fun _ppf -> continue ()) wrap_content Location.pp location);
|
fprintf ppf "{ wrap_content = %a ; location = %a }" (fun _ppf -> continue ()) wrap_content Location.pp location);
|
||||||
(* list_ne = (fun _visitor continue () (first, lst) ->
|
(* list_ne = (fun _visitor continue () (first, lst) ->
|
||||||
let aux ppf elt =
|
let aux ppf elt =
|
||||||
fprintf ppf "%a" (fun _ppf -> continue ()) elt in
|
fprintf ppf "%a" (fun _ppf -> continue ()) elt in
|
||||||
fprintf ppf "[@,@[<hv 2> %a @]@,]" (list_sep aux (fun ppf () -> fprintf ppf " ;@ ")) (first::lst)); *)
|
fprintf ppf "[@,@[<hv 2> %a @]@,]" (list_sep aux (fun ppf () -> fprintf ppf " ;@ ")) (first::lst)); *)
|
||||||
option = (fun _visitor continue () o ->
|
option = (fun _visitor continue () o ->
|
||||||
match o with
|
match o with
|
||||||
| None -> fprintf ppf "None"
|
| None -> fprintf ppf "None"
|
||||||
| Some v -> fprintf ppf "%a" (fun _ppf -> continue ()) v) ;
|
| Some v -> fprintf ppf "%a" (fun _ppf -> continue ()) v) ;
|
||||||
poly_unionfind = (fun _visitor continue () p ->
|
poly_unionfind = (fun _visitor continue () p ->
|
||||||
let lst = (UnionFind.Poly2.partitions p) in
|
let lst = (UnionFind.Poly2.partitions p) in
|
||||||
let aux1 l = fprintf ppf "[@,@[<hv 2> (*%a*) %a @]@,]"
|
let aux1 l = fprintf ppf "[@,@[<hv 2> (*%a*) %a @]@,]"
|
||||||
(fun _ppf -> continue ()) (UnionFind.Poly2.repr (List.hd l) p)
|
(fun _ppf -> continue ()) (UnionFind.Poly2.repr (List.hd l) p)
|
||||||
(list_sep (fun _ppf -> continue ()) (fun ppf () -> fprintf ppf " ;@ ")) l in
|
(list_sep (fun _ppf -> continue ()) (fun ppf () -> fprintf ppf " ;@ ")) l in
|
||||||
let aux2 = list_sep (fun _ppf -> aux1) (fun ppf () -> fprintf ppf " ;@ ") in
|
let aux2 = list_sep (fun _ppf -> aux1) (fun ppf () -> fprintf ppf " ;@ ") in
|
||||||
fprintf ppf "UnionFind [@,@[<hv 2> %a @]@,]" aux2 lst);
|
fprintf ppf "UnionFind [@,@[<hv 2> %a @]@,]" aux2 lst);
|
||||||
poly_set = (fun _visitor continue () set ->
|
poly_set = (fun _visitor continue () set ->
|
||||||
let lst = (RedBlackTrees.PolySet.elements set) in
|
let lst = (RedBlackTrees.PolySet.elements set) in
|
||||||
fprintf ppf "Set [@,@[<hv 2> %a @]@,]" (list_sep (fun _ppf -> continue ()) (fun ppf () -> fprintf ppf " ;@ ")) lst);
|
fprintf ppf "Set [@,@[<hv 2> %a @]@,]" (list_sep (fun _ppf -> continue ()) (fun ppf () -> fprintf ppf " ;@ ")) lst);
|
||||||
typeVariableMap = (fun _visitor continue () tvmap ->
|
typeVariableMap = (fun _visitor continue () tvmap ->
|
||||||
let lst = List.sort (fun (a, _) (b, _) -> Var.compare a b) (RedBlackTrees.PolyMap.bindings tvmap) in
|
let lst = List.sort (fun (a, _) (b, _) -> Var.compare a b) (RedBlackTrees.PolyMap.bindings tvmap) in
|
||||||
let aux ppf (k, v) =
|
let aux ppf (k, v) =
|
||||||
fprintf ppf "(Var %a, %a)" Var.pp k (fun _ppf -> continue ()) v in
|
fprintf ppf "(Var %a, %a)" Var.pp k (fun _ppf -> continue ()) v in
|
||||||
fprintf ppf "typeVariableMap [@,@[<hv 2> %a @]@,]" (list_sep aux (fun ppf () -> fprintf ppf " ;@ ")) lst);
|
fprintf ppf "typeVariableMap [@,@[<hv 2> %a @]@,]" (list_sep aux (fun ppf () -> fprintf ppf " ;@ ")) lst);
|
||||||
}
|
}
|
||||||
|
|
||||||
let print : (unit fold_config -> unit -> 'a -> unit) -> formatter -> 'a -> unit = fun fold ppf v ->
|
let print : (unit fold_config -> unit -> 'a -> unit) -> formatter -> 'a -> unit = fun fold ppf v ->
|
||||||
fold (op ppf) () v
|
fold (op ppf) () v
|
||||||
|
end
|
||||||
|
|
||||||
include Fold.Folds(struct
|
include Fold.Folds(struct
|
||||||
type state = unit ;;
|
type state = unit ;;
|
||||||
type 'a t = formatter -> 'a -> unit ;;
|
type 'a t = formatter -> 'a -> unit ;;
|
||||||
let f = print ;;
|
let f = M.print ;;
|
||||||
end)
|
end)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user