Skip to content

Commit 297981a

Browse files
cmester0cmester0
committed
fmt
1 parent e6cd79e commit 297981a

File tree

2 files changed

+717
-613
lines changed

2 files changed

+717
-613
lines changed

‎engine/bin/ast_printer.ml

Lines changed: 103 additions & 53 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,10 @@
11
open Hax_engine
22
open Utils
33
open Base
4-
54
open Ast
65

76
module Make
8-
(F : Features.T)
9-
(Default : sig
7+
(F : Features.T) (Default : sig
108
val default : string -> string
119
end) =
1210
struct
@@ -15,7 +13,9 @@ struct
1513
module Base = Generic_printer.Make (F)
1614
open PPrint
1715

18-
let default_string_for s = "/*" ^ "TODO: please implement the method `" ^ s ^ "`" ^ "*/"
16+
let default_string_for s =
17+
"/*" ^ "TODO: please implement the method `" ^ s ^ "`" ^ "*/"
18+
1919
let default_document_for = default_string_for >> string
2020
let any_number_of x = parens x ^^ string "*"
2121
let option_of x = parens x ^^ string "?"
@@ -42,11 +42,9 @@ struct
4242
^^ string "\""
4343

4444
let features l =
45-
string "/*" ^^ space
46-
^^ string "features:" ^^ space
45+
string "/*" ^^ space ^^ string "features:" ^^ space
4746
^^ separate_map (space ^^ comma ^^ space) (fun x -> string x) l
48-
^^ space ^^ string "*/"
49-
^^ space
47+
^^ space ^^ string "*/" ^^ space
5048

5149
(* let code_parens x = string "1;31m" ^ parens ( x ^^ string "\x1b[1;31m" ) ^^ string "\x1b[0m" *)
5250

@@ -88,13 +86,20 @@ struct
8886
method expr ~e ~span:_ ~typ:_ = e#p
8987

9088
method expr'_AddressOf ~super:_ ~mut ~e:_ ~witness:_ =
91-
either_of [
92-
symbol_str "&" ^^ space ^^ string "expr" ^^ space ^^ symbol_str "as" ^^ space ^^ symbol_str "&const _";
93-
features [ "mutable_pointer" ] ^^ symbol_str "&mut" ^^ space ^^ string "expr" ^^ symbol_str "as" ^^ space ^^ symbol_str "&mut _";
94-
]
89+
either_of
90+
[
91+
symbol_str "&" ^^ space ^^ string "expr" ^^ space ^^ symbol_str "as"
92+
^^ space ^^ symbol_str "&const _";
93+
features [ "mutable_pointer" ]
94+
^^ symbol_str "&mut" ^^ space ^^ string "expr" ^^ symbol_str "as"
95+
^^ space ^^ symbol_str "&mut _";
96+
]
9597

96-
method _do_not_override_expr'_App ~super ~f ~args ~generic_args ~bounds_impls ~trait =
97-
string "expr" ^^ space ^^ symbol_parens ( any_number_of (string "expr" ^^ space ^^ symbol_comma) )
98+
method _do_not_override_expr'_App ~super ~f ~args ~generic_args
99+
~bounds_impls ~trait =
100+
string "expr" ^^ space
101+
^^ symbol_parens
102+
(any_number_of (string "expr" ^^ space ^^ symbol_comma))
98103

99104
method expr'_App_application ~super:_ ~f:_ ~args:_ ~generics:_ =
100105
default_document_for "expr'_App_application"
@@ -119,23 +124,39 @@ struct
119124
^^ symbol_braces (string "expr")
120125

121126
method expr'_Borrow ~super:_ ~kind:_ ~e:_ ~witness:_ =
122-
features [ "reference" ] ^^ symbol_str "&" ^^ space ^^ option_of ( symbol_str "mut" ) ^^ space ^^ string "expr"
127+
features [ "reference" ] ^^ symbol_str "&" ^^ space
128+
^^ option_of (symbol_str "mut")
129+
^^ space ^^ string "expr"
123130

124131
method expr'_Break ~super:_ ~e:_ ~acc:_ ~label:_ ~witness:_ =
125-
features [ "break"; "loop" ] ^^ symbol_str "break" ^^ space ^^ string "expr"
132+
features [ "break"; "loop" ]
133+
^^ symbol_str "break" ^^ space ^^ string "expr"
126134

127135
method expr'_Closure ~super:_ ~params:_ ~body:_ ~captures:_ =
128136
symbol_str "|" ^^ space ^^ string "param" ^^ space ^^ symbol_str "|"
129137
^^ space ^^ string "expr"
130138

131139
method expr'_Construct_inductive ~super:_ ~constructor:_ ~is_record:_
132140
~is_struct:_ ~fields:_ ~base:_ =
133-
either_of [
134-
string "ident" ^^ symbol_parens ( any_number_of ( string "expr" ^^ space ^^ symbol_comma ) );
135-
string "ident" ^^ symbol_braces ( any_number_of ( string "ident" ^^ space ^^ symbol_colon ^^ string "expr" ^^ space ^^ symbol_semi ) );
136-
features ["construct_base"] ^^ string "ident" ^^ symbol_braces ( any_number_of ( string "ident" ^^ space ^^ symbol_colon ^^ string "expr" ^^ space ^^ symbol_semi ) ^^ space ^^ symbol_str ".." ^^ space ^^ string "base" );
137-
]
138-
(* string "constructor" ^^ space ^^ any_number_of (string "expr") *)
141+
either_of
142+
[
143+
string "ident"
144+
^^ symbol_parens
145+
(any_number_of (string "expr" ^^ space ^^ symbol_comma));
146+
string "ident"
147+
^^ symbol_braces
148+
(any_number_of
149+
(string "ident" ^^ space ^^ symbol_colon ^^ string "expr"
150+
^^ space ^^ symbol_semi));
151+
features [ "construct_base" ]
152+
^^ string "ident"
153+
^^ symbol_braces
154+
(any_number_of
155+
(string "ident" ^^ space ^^ symbol_colon ^^ string "expr"
156+
^^ space ^^ symbol_semi)
157+
^^ space ^^ symbol_str ".." ^^ space ^^ string "base");
158+
]
159+
(* string "constructor" ^^ space ^^ any_number_of (string "expr") *)
139160

140161
method expr'_Construct_tuple ~super:_ ~components:_ =
141162
default_document_for "expr'_Construct_tuple"
@@ -161,29 +182,52 @@ struct
161182
(symbol_str "else" ^^ space ^^ symbol_braces (string "expr"))
162183

163184
method expr'_Let ~super:_ ~monadic:_ ~lhs:_ ~rhs:_ ~body:_ =
164-
either_of [
165-
symbol_str "let" ^^ space ^^ string "pat" ^^ space
166-
^^ option_of ( symbol_colon ^^ space ^^ string "ty" )
167-
^^ space ^^ symbol_str ":=" ^^ space ^^ string "expr" ^^ space
168-
^^ symbol_semi ^^ space ^^ string "expr";
169-
features ["monadic_binding"] ^^ string "monadic_binding" ^^ space ^^ symbol_str "<" ^^ space ^^ string "monad" ^^ space ^^ symbol_str ">" ^^ space ^^ symbol_parens (
170-
symbol_str "|" ^^ space ^^ string "pat" ^^ space ^^ symbol_str "|" ^^ space ^^ string "expr"
171-
^^ symbol_comma
172-
^^ string "expr";
173-
)
174-
]
185+
either_of
186+
[
187+
symbol_str "let" ^^ space ^^ string "pat" ^^ space
188+
^^ option_of (symbol_colon ^^ space ^^ string "ty")
189+
^^ space ^^ symbol_str ":=" ^^ space ^^ string "expr" ^^ space
190+
^^ symbol_semi ^^ space ^^ string "expr";
191+
features [ "monadic_binding" ]
192+
^^ string "monadic_binding" ^^ space ^^ symbol_str "<" ^^ space
193+
^^ string "monad" ^^ space ^^ symbol_str ">" ^^ space
194+
^^ symbol_parens
195+
(symbol_str "|" ^^ space ^^ string "pat" ^^ space
196+
^^ symbol_str "|" ^^ space ^^ string "expr" ^^ symbol_comma
197+
^^ string "expr");
198+
]
175199

176200
method expr'_Literal ~super:_ _x2 = string "literal"
177201
method expr'_LocalVar ~super:_ _x2 = string "local_var"
178202

179-
method expr'_Loop ~super:_ ~body:_ ~kind:_ ~state:_ ~control_flow:_ ~label:_ ~witness:_ =
203+
method expr'_Loop ~super:_ ~body:_ ~kind:_ ~state:_ ~control_flow:_
204+
~label:_ ~witness:_ =
180205
(* Type of loop *)
181-
either_of [
182-
features [ "loop" ] ^^ symbol_str "loop" ^^ space ^^ symbol_braces( string "expr" );
183-
features [ "loop"; "while_loop" ] ^^ symbol_str "while" ^^ space ^^ symbol_parens( string "expr" ) ^^ space ^^ symbol_braces( string "expr" );
184-
features [ "loop"; "for_loop" ] ^^ symbol_str "for" ^^ space ^^ symbol_parens( string "pat" ^^ space ^^ symbol_str "in" ^^ space ^^ string "expr" ) ^^ space ^^ symbol_braces ( string "expr" );
185-
features [ "loop"; "for_index_loop" ] ^^ symbol_str "for" ^^ space ^^ symbol_parens( symbol_str "let" ^^ space ^^ string "ident" ^^ space ^^ symbol_str "in" ^^ space ^^ string "expr" ^^ space ^^ symbol_str ".." ^^ space ^^ string "expr" ) ^^ space ^^ symbol_braces ( string "expr" );
186-
]
206+
either_of
207+
[
208+
features [ "loop" ] ^^ symbol_str "loop" ^^ space
209+
^^ symbol_braces (string "expr");
210+
features [ "loop"; "while_loop" ]
211+
^^ symbol_str "while" ^^ space
212+
^^ symbol_parens (string "expr")
213+
^^ space
214+
^^ symbol_braces (string "expr");
215+
features [ "loop"; "for_loop" ]
216+
^^ symbol_str "for" ^^ space
217+
^^ symbol_parens
218+
(string "pat" ^^ space ^^ symbol_str "in" ^^ space
219+
^^ string "expr")
220+
^^ space
221+
^^ symbol_braces (string "expr");
222+
features [ "loop"; "for_index_loop" ]
223+
^^ symbol_str "for" ^^ space
224+
^^ symbol_parens
225+
(symbol_str "let" ^^ space ^^ string "ident" ^^ space
226+
^^ symbol_str "in" ^^ space ^^ string "expr" ^^ space
227+
^^ symbol_str ".." ^^ space ^^ string "expr")
228+
^^ space
229+
^^ symbol_braces (string "expr");
230+
]
187231

188232
method expr'_MacroInvokation ~super:_ ~macro:_ ~args:_ ~witness:_ =
189233
string "macro_name" ^^ space ^^ symbol_str "!" ^^ space
@@ -207,7 +251,8 @@ struct
207251
method expr'_Quote ~super:_ _x2 = default_document_for "expr'_Quote"
208252

209253
method expr'_Return ~super:_ ~e:_ ~witness:_ =
210-
features [ "early_exit" ] ^^ symbol_str "return" ^^ space ^^ string "expr"
254+
features [ "early_exit" ] ^^ symbol_str "return" ^^ space
255+
^^ string "expr"
211256

212257
method cf_kind_BreakOrReturn =
213258
default_document_for "cf_kind_BreakOrReturn"
@@ -431,7 +476,7 @@ struct
431476
default_document_for "pat'_PConstruct_tuple"
432477

433478
method pat'_PDeref ~super:_ ~subpat:_ ~witness:_ =
434-
features ["reference"] ^^ symbol_str "&" ^^ space ^^ string "pat"
479+
features [ "reference" ] ^^ symbol_str "&" ^^ space ^^ string "pat"
435480

436481
method pat'_PWild = symbol_str "_"
437482

@@ -469,7 +514,8 @@ struct
469514
method trait_item'_TIType _x1 = default_document_for "trait_item'_TIType"
470515

471516
method ty_TApp_application ~typ:_ ~generics:_ =
472-
any_number_of (string "ty" ^^ space ^^ symbol_comma) (* TODO uses top level implementation ? *)
517+
any_number_of (string "ty" ^^ space ^^ symbol_comma)
518+
(* TODO uses top level implementation ? *)
473519

474520
method ty_TApp_tuple ~types:_ = default_document_for "ty_TApp_tuple"
475521

@@ -486,7 +532,9 @@ struct
486532

487533
method ty_TBool = symbol_str "bool"
488534
method ty_TChar = symbol_str "char"
489-
method ty_TDyn ~witness:_ ~goals:_ = features ["dyn"] ^^ any_number_of (string "goal")
535+
536+
method ty_TDyn ~witness:_ ~goals:_ =
537+
features [ "dyn" ] ^^ any_number_of (string "goal")
490538

491539
method ty_TFloat _x1 =
492540
either_of [ symbol_str "f16"; symbol_str "f32"; symbol_str "f64" ]
@@ -515,9 +563,11 @@ struct
515563
]
516564

517565
method ty_TRef ~witness:_ ~region:_ ~typ:_ ~mut:_ =
518-
either_of [
566+
either_of
567+
[
519568
features [ "reference" ] ^^ symbol_str "*" ^^ space ^^ string "expr";
520-
features [ "reference"; "mutable_reference" ] ^^ symbol_str "*mut" ^^ space ^^ string "expr";
569+
features [ "reference"; "mutable_reference" ]
570+
^^ symbol_str "*mut" ^^ space ^^ string "expr";
521571
]
522572

523573
method ty_TSlice ~witness:_ ~ty:_ =
@@ -537,7 +587,6 @@ struct
537587

538588
(* END GENERATED *)
539589
end
540-
541590
end
542591

543592
module HaxCFG = struct
@@ -549,16 +598,16 @@ module HaxCFG = struct
549598
end)
550599

551600
module MyAstGenerator = Ast_utils.ASTGenerator
552-
553601
module AST = Ast.Make (Features.Full)
554602
open AST
555603

556604
let print_ast (_ : unit) =
557605
let my_printer = new MyPrinter.printer in
558606

559-
(** Can use rendering tools for EBNF e.g. https://rr.red-dove.com/ui **)
560-
561-
let (my_literals, my_tys, my_pats, my_exprs, my_items) : (literal list * ty list * pat list * expr list * item list) = MyAstGenerator.generate_full_ast in
607+
let (my_literals, my_tys, my_pats, my_exprs, my_items)
608+
: literal list * ty list * pat list * expr list * item list =
609+
MyAstGenerator.generate_full_ast
610+
in
562611

563612
let literal_string =
564613
"\n\n```ebnf\nliteral ::=\n"
@@ -619,7 +668,8 @@ module HaxCFG = struct
619668
^ "\n```"
620669
in
621670

622-
"# Hax CFG" ^ literal_string ^ ty_string ^ pat_string ^ expr_string ^ item_string;
671+
"# Hax CFG" ^ literal_string ^ ty_string ^ pat_string ^ expr_string
672+
^ item_string
623673
end
624674

625675
let main =
@@ -633,5 +683,5 @@ let main =
633683
(* Types.parse_engine_options json *)
634684
(* in *)
635685
Concrete_ident.ImplInfoStore.init
636-
(Concrete_ident_generated.impl_infos (* @ options.impl_infos *));
686+
Concrete_ident_generated.impl_infos (* @ options.impl_infos *);
637687
print_endline (HaxCFG.print_ast ())

0 commit comments

Comments
 (0)