Simplify visitors ppx annotations

the small downside is that we lose a little bit of granularity by making
defining all the types at once (with `type ... and`) ; but one well-placed
annotation seems to be enough.

also discarded the `iter` visitor that was unused.

compiler/surface/ast.ml

@@ -31,49 +31,17 @@ open Catala_utils
 (** {1 Type definitions} *)
 
 type uident = (string[@opaque])
-[@@deriving
-  visitors { variety = "map"; name = "uident_map"; nude = true },
-    visitors { variety = "iter"; name = "uident_iter"; nude = true }]
 (** Constructors are CamelCase *)
 
-type lident = (string[@opaque])
-[@@deriving
-  visitors { variety = "map"; name = "lident_map"; nude = true },
-    visitors { variety = "iter"; name = "lident_iter"; nude = true }]
+and lident = (string[@opaque])
 (** Idents are snake_case *)
 
-type path = uident Mark.pos list
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["Mark.pos_map"; "uident_map"];
-      name = "path_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["Mark.pos_iter"; "uident_iter"];
-        name = "path_iter";
-      }]
+and path = uident Mark.pos list
 
-type scope_var = lident Mark.pos list
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["Mark.pos_map"; "lident_map"];
-      name = "scope_var_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["Mark.pos_iter"; "lident_iter"];
-        name = "scope_var_iter";
-      }]
+and scope_var = lident Mark.pos list
 (** [foo.bar] in binding position: used to specify variables of subscopes *)
 
-type primitive_typ =
+and primitive_typ =
   | Integer
   | Decimal
   | Boolean
@@ -82,191 +50,47 @@ type primitive_typ =
   | Text
   | Date
   | Named of path * uident Mark.pos
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["path_map"; "uident_map"];
-      name = "primitive_typ_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["path_iter"; "uident_iter"];
-        name = "primitive_typ_iter";
-      }]
 
-type base_typ_data =
+and base_typ_data =
   | Primitive of primitive_typ
   | Collection of base_typ_data Mark.pos
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["Mark.pos_map"; "primitive_typ_map"];
-      name = "base_typ_data_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["Mark.pos_iter"; "primitive_typ_iter"];
-        name = "base_typ_data_iter";
-      }]
 
-type base_typ = Condition | Data of base_typ_data
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["base_typ_data_map"];
-      name = "base_typ_map";
-      nude = true;
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["base_typ_data_iter"];
-        name = "base_typ_iter";
-        nude = true;
-      }]
+and base_typ = Condition | Data of base_typ_data
 
-type func_typ = {
+and func_typ = {
   arg_typ : (lident Mark.pos * base_typ Mark.pos) list;
   return_typ : base_typ Mark.pos;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["lident_map"; "base_typ_map"];
-      name = "func_typ_map";
-      nude = true;
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["lident_iter"; "base_typ_iter"];
-        name = "func_typ_iter";
-        nude = true;
-      }]
-
-type typ = naked_typ Mark.pos
 
+and typ = naked_typ Mark.pos
 and naked_typ = Base of base_typ | Func of func_typ
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["func_typ_map"];
-      name = "typ_map";
-      nude = true;
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["func_typ_iter"];
-        name = "typ_iter";
-        nude = true;
-      }]
 
-type struct_decl_field = {
+and struct_decl_field = {
   struct_decl_field_name : lident Mark.pos;
   struct_decl_field_typ : typ;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["typ_map"; "lident_map"];
-      name = "struct_decl_field_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["typ_iter"; "lident_iter"];
-        name = "struct_decl_field_iter";
-      }]
 
-type struct_decl = {
+and struct_decl = {
   struct_decl_name : uident Mark.pos;
   struct_decl_fields : struct_decl_field Mark.pos list;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["struct_decl_field_map"];
-      name = "struct_decl_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["struct_decl_field_iter"];
-        name = "struct_decl_iter";
-      }]
 
-type enum_decl_case = {
+and enum_decl_case = {
   enum_decl_case_name : uident Mark.pos;
   enum_decl_case_typ : typ option;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["typ_map"];
-      name = "enum_decl_case_map";
-      nude = true;
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["typ_iter"];
-        name = "enum_decl_case_iter";
-        nude = true;
-      }]
 
-type enum_decl = {
+and enum_decl = {
   enum_decl_name : uident Mark.pos;
   enum_decl_cases : enum_decl_case Mark.pos list;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["enum_decl_case_map"];
-      name = "enum_decl_map";
-      nude = true;
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["enum_decl_case_iter"];
-        name = "enum_decl_iter";
-        nude = true;
-      }]
 
-type match_case_pattern =
+and match_case_pattern =
   (path * uident Mark.pos) Mark.pos list * lident Mark.pos option
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["path_map"; "lident_map"; "uident_map"; "Mark.pos_map"];
-      name = "match_case_pattern_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["path_iter"; "lident_iter"; "uident_iter"; "Mark.pos_iter"];
-        name = "match_case_pattern_iter";
-      }]
 
-type op_kind = KPoly | KInt | KDec | KMoney | KDate | KDuration
-[@@deriving
-  visitors { variety = "map"; name = "op_kind_map"; nude = true },
-    visitors { variety = "iter"; name = "op_kind_iter"; nude = true }]
+and op_kind = KPoly | KInt | KDec | KMoney | KDate | KDuration
 
-type binop =
+and binop =
   | And
   | Or
   | Xor
@@ -281,40 +105,10 @@ type binop =
   | Eq
   | Neq
   | Concat
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["op_kind_map"];
-      name = "binop_map";
-      nude = true;
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["op_kind_iter"];
-        name = "binop_iter";
-        nude = true;
-      }]
 
-type unop = Not | Minus of op_kind
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["op_kind_map"];
-      name = "unop_map";
-      nude = true;
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["op_kind_iter"];
-        name = "unop_iter";
-        nude = true;
-      }]
+and unop = Not | Minus of op_kind
 
-type builtin_expression =
+and builtin_expression =
   | Cardinal
   | ToDecimal
   | ToMoney
@@ -324,83 +118,37 @@ type builtin_expression =
   | LastDayOfMonth
   | FirstDayOfMonth
   | Round
-[@@deriving
-  visitors { variety = "map"; name = "builtin_expression_map"; nude = true },
-    visitors { variety = "iter"; name = "builtin_expression_iter"; nude = true }]
 
-type literal_date = {
+and literal_date = {
   literal_date_day : (int[@opaque]);
   literal_date_month : (int[@opaque]);
   literal_date_year : (int[@opaque]);
 }
-[@@deriving
-  visitors
-    { variety = "map"; ancestors = ["Mark.pos_map"]; name = "literal_date_map" },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["Mark.pos_iter"];
-        name = "literal_date_iter";
-      }]
 
-type literal_number =
+and literal_number =
   | Int of (string[@opaque])
   | Dec of (string[@opaque]) * (string[@opaque])
-[@@deriving
-  visitors { variety = "map"; name = "literal_number_map"; nude = true },
-    visitors { variety = "iter"; name = "literal_number_iter"; nude = true }]
 
-type literal_unit = Percent | Year | Month | Day
-[@@deriving
-  visitors { variety = "map"; name = "literal_unit_map"; nude = true },
-    visitors { variety = "iter"; name = "literal_unit_iter"; nude = true }]
+and literal_unit = Percent | Year | Month | Day
 
-type money_amount = {
+and money_amount = {
   money_amount_units : (string[@opaque]);
   money_amount_cents : (string[@opaque]);
 }
-[@@deriving
-  visitors { variety = "map"; name = "money_amount_map"; nude = true },
-    visitors { variety = "iter"; name = "money_amount_iter"; nude = true }]
 
-type literal =
+and literal =
   | LNumber of literal_number Mark.pos * literal_unit Mark.pos option
   | LBool of bool
   | LMoneyAmount of money_amount
   | LDate of literal_date
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors =
-        [
-          "literal_number_map";
-          "money_amount_map";
-          "literal_date_map";
-          "literal_unit_map";
-        ];
-      name = "literal_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors =
-          [
-            "literal_number_iter";
-            "money_amount_iter";
-            "literal_date_iter";
-            "literal_unit_iter";
-          ];
-        name = "literal_iter";
-      }]
 
-type collection_op =
+and collection_op =
   | Exists of { predicate : lident Mark.pos * expression }
   | Forall of { predicate : lident Mark.pos * expression }
   | Map of { f : lident Mark.pos * expression }
   | Filter of { f : lident Mark.pos * expression }
   | AggregateSum of { typ : primitive_typ }
-  (* it would be nice to remove the need for specifying the type here like for
+  (* it would be nice to remove the need for specifying the and here like for
      extremums, but we need an additionl overload for "neutral element for
      addition across types" *)
   | AggregateExtremum of { max : bool; default : expression }
@@ -441,55 +189,13 @@ and naked_expression =
   | Ident of path * lident Mark.pos
   | Dotted of expression * (path * lident Mark.pos) Mark.pos
       (** Dotted is for both struct field projection and sub-scope variables *)
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors =
-        [
-          "primitive_typ_map";
-          "match_case_pattern_map";
-          "literal_map";
-          "binop_map";
-          "unop_map";
-          "builtin_expression_map";
-        ];
-      name = "expression_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors =
-          [
-            "primitive_typ_iter";
-            "match_case_pattern_iter";
-            "literal_iter";
-            "binop_iter";
-            "unop_iter";
-            "builtin_expression_iter";
-          ];
-        name = "expression_iter";
-      }]
 
-type exception_to =
+and exception_to =
   | NotAnException
   | UnlabeledException
   | ExceptionToLabel of lident Mark.pos
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["lident_map"; "Mark.pos_map"];
-      name = "exception_to_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["lident_iter"; "Mark.pos_iter"];
-        name = "exception_to_iter";
-      }]
 
-type rule = {
+and rule = {
   rule_label : lident Mark.pos option;
   rule_exception_to : exception_to;
   rule_parameter : lident Mark.pos list Mark.pos option;
@@ -499,21 +205,8 @@ type rule = {
   rule_consequence : (bool[@opaque]) Mark.pos;
   rule_state : lident Mark.pos option;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["expression_map"; "scope_var_map"; "exception_to_map"];
-      name = "rule_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["expression_iter"; "scope_var_iter"; "exception_to_iter"];
-        name = "rule_iter";
-      }]
 
-type definition = {
+and definition = {
   definition_label : lident Mark.pos option;
   definition_exception_to : exception_to;
   definition_name : scope_var Mark.pos;
@@ -523,155 +216,46 @@ type definition = {
   definition_expr : expression;
   definition_state : lident Mark.pos option;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["expression_map"; "scope_var_map"; "exception_to_map"];
-      name = "definition_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["expression_iter"; "scope_var_iter"; "exception_to_iter"];
-        name = "definition_iter";
-      }]
 
-type variation_typ = Increasing | Decreasing
-[@@deriving
-  visitors { variety = "map"; name = "variation_typ_map" },
-    visitors { variety = "iter"; name = "variation_typ_iter" }]
+and variation_typ = Increasing | Decreasing
 
-type meta_assertion =
+and meta_assertion =
   | FixedBy of scope_var Mark.pos * lident Mark.pos
   | VariesWith of
       scope_var Mark.pos * expression * variation_typ Mark.pos option
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["variation_typ_map"; "scope_var_map"; "expression_map"];
-      name = "meta_assertion_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["variation_typ_iter"; "scope_var_iter"; "expression_iter"];
-        name = "meta_assertion_iter";
-      }]
 
-type assertion = {
+and assertion = {
   assertion_condition : expression option;
   assertion_content : expression;
 }
-[@@deriving
-  visitors
-    { variety = "map"; ancestors = ["expression_map"]; name = "assertion_map" },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["expression_iter"];
-        name = "assertion_iter";
-      }]
 
-type scope_use_item =
+and scope_use_item =
   | Rule of rule
   | Definition of definition
   | Assertion of assertion
   | MetaAssertion of meta_assertion
   | DateRounding of variation_typ Mark.pos
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors =
-        ["meta_assertion_map"; "definition_map"; "assertion_map"; "rule_map"];
-      name = "scope_use_item_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors =
-          [
-            "meta_assertion_iter";
-            "definition_iter";
-            "assertion_iter";
-            "rule_iter";
-          ];
-        name = "scope_use_item_iter";
-      }]
 
-type scope_use = {
+and scope_use = {
   scope_use_condition : expression option;
   scope_use_name : uident Mark.pos;
   scope_use_items : scope_use_item Mark.pos list;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["expression_map"; "scope_use_item_map"];
-      name = "scope_use_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["expression_iter"; "scope_use_item_iter"];
-        name = "scope_use_iter";
-      }]
 
-type io_input = Input | Context | Internal
-[@@deriving
-  visitors { variety = "map"; name = "io_input_map" },
-    visitors { variety = "iter"; name = "io_input_iter" }]
+and io_input = Input | Context | Internal
 
-type scope_decl_context_io = {
+and scope_decl_context_io = {
   scope_decl_context_io_input : io_input Mark.pos;
   scope_decl_context_io_output : bool Mark.pos;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["io_input_map"; "Mark.pos_map"];
-      name = "scope_decl_context_io_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["io_input_iter"; "Mark.pos_iter"];
-        name = "scope_decl_context_io_iter";
-      }]
 
-type scope_decl_context_scope = {
+and scope_decl_context_scope = {
   scope_decl_context_scope_name : lident Mark.pos;
   scope_decl_context_scope_sub_scope : uident Mark.pos;
   scope_decl_context_scope_attribute : scope_decl_context_io;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors =
-        [
-          "lident_map"; "uident_map"; "scope_decl_context_io_map"; "Mark.pos_map";
-        ];
-      name = "scope_decl_context_scope_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors =
-          [
-            "lident_iter";
-            "uident_iter";
-            "scope_decl_context_io_iter";
-            "Mark.pos_iter";
-          ];
-        name = "scope_decl_context_scope_iter";
-      }]
 
-type scope_decl_context_data = {
+and scope_decl_context_data = {
   scope_decl_context_item_name : lident Mark.pos;
   scope_decl_context_item_typ : typ;
   scope_decl_context_item_parameters :
@@ -679,212 +263,61 @@ type scope_decl_context_data = {
   scope_decl_context_item_attribute : scope_decl_context_io;
   scope_decl_context_item_states : lident Mark.pos list;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["typ_map"; "scope_decl_context_io_map"; "lident_map"];
-      name = "scope_decl_context_data_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["typ_iter"; "scope_decl_context_io_iter"; "lident_iter"];
-        name = "scope_decl_context_data_iter";
-      }]
 
-type scope_decl_context_item =
+and scope_decl_context_item =
   | ContextData of scope_decl_context_data
   | ContextScope of scope_decl_context_scope
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors =
-        ["scope_decl_context_data_map"; "scope_decl_context_scope_map"];
-      name = "scope_decl_context_item_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors =
-          ["scope_decl_context_data_iter"; "scope_decl_context_scope_iter"];
-        name = "scope_decl_context_item_iter";
-      }]
 
-type scope_decl = {
+and scope_decl = {
   scope_decl_name : uident Mark.pos;
   scope_decl_context : scope_decl_context_item Mark.pos list;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["scope_decl_context_item_map"];
-      name = "scope_decl_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["scope_decl_context_item_iter"];
-        name = "scope_decl_iter";
-      }]
 
-type top_def = {
+and top_def = {
   topdef_name : lident Mark.pos;
   topdef_args : (lident Mark.pos * base_typ Mark.pos) list Mark.pos option;
       (** Empty list if this is not a function *)
   topdef_type : typ;
   topdef_expr : expression option;
 }
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors = ["lident_map"; "typ_map"; "expression_map"];
-      name = "top_def_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["lident_iter"; "typ_iter"; "expression_iter"];
-        name = "top_def_iter";
-      }]
 
-type code_item =
+and code_item =
   | ScopeUse of scope_use
   | ScopeDecl of scope_decl
   | StructDecl of struct_decl
   | EnumDecl of enum_decl
   | Topdef of top_def
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors =
-        [
-          "scope_decl_map";
-          "enum_decl_map";
-          "struct_decl_map";
-          "scope_use_map";
-          "top_def_map";
-        ];
-      name = "code_item_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors =
-          [
-            "scope_decl_iter";
-            "enum_decl_iter";
-            "struct_decl_iter";
-            "scope_use_iter";
-            "top_def_iter";
-          ];
-        name = "code_item_iter";
-      }]
 
-type code_block = code_item Mark.pos list
-[@@deriving
-  visitors
-    { variety = "map"; ancestors = ["code_item_map"]; name = "code_block_map" },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["code_item_iter"];
-        name = "code_block_iter";
-      }]
+and code_block = code_item Mark.pos list
+and source_repr = (string[@opaque]) Mark.pos
 
-type source_repr = (string[@opaque]) Mark.pos
-[@@deriving
-  visitors
-    { variety = "map"; ancestors = ["Mark.pos_map"]; name = "source_repr_map" },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["Mark.pos_iter"];
-        name = "source_repr_iter";
-      }]
-
-type law_heading = {
+and law_heading = {
   law_heading_name : (string[@opaque]) Mark.pos;
   law_heading_id : (string[@opaque]) option;
   law_heading_is_archive : bool; [@opaque]
   law_heading_precedence : (int[@opaque]);
 }
-[@@deriving
-  visitors
-    { variety = "map"; ancestors = ["Mark.pos_map"]; name = "law_heading_map" },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["Mark.pos_iter"];
-        name = "law_heading_iter";
-      }]
 
-type law_include =
+and law_include =
   | PdfFile of (string[@opaque]) Mark.pos * (int[@opaque]) option
   | CatalaFile of (string[@opaque]) Mark.pos
   | LegislativeText of (string[@opaque]) Mark.pos
-[@@deriving
-  visitors
-    { variety = "map"; ancestors = ["Mark.pos_map"]; name = "law_include_map" },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["Mark.pos_iter"];
-        name = "law_include_iter";
-      }]
 
-type law_structure =
+and law_structure =
   | LawInclude of law_include
   | LawHeading of law_heading * law_structure list
   | LawText of (string[@opaque])
   | CodeBlock of code_block * source_repr * bool (* Metadata if true *)
-[@@deriving
-  visitors
-    {
-      variety = "map";
-      ancestors =
-        [
-          "law_include_map";
-          "code_block_map";
-          "source_repr_map";
-          "law_heading_map";
-        ];
-      name = "law_structure_map";
-    },
-    visitors
-      {
-        variety = "iter";
-        ancestors =
-          [
-            "law_include_iter";
-            "code_block_iter";
-            "source_repr_iter";
-            "law_heading_iter";
-          ];
-        name = "law_structure_iter";
-      }]
 
-type program = {
+and program = {
   program_interfaces :
     ((Shared_ast.Qident.path[@opaque]) * code_item Mark.pos) list;
   program_items : law_structure list;
   program_source_files : (string[@opaque]) list;
 }
-[@@deriving
-  visitors
-    { variety = "map"; ancestors = ["law_structure_map"]; name = "program_map" },
-    visitors
-      {
-        variety = "iter";
-        ancestors = ["law_structure_iter"];
-        name = "program_iter";
-      }]
 
-type source_file = law_structure list
+and source_file = law_structure list
+[@@deriving visitors { variety = "map"; ancestors = ["Mark.pos_map"] }]
 
 (** {1 Helpers}*)
 

compiler/surface/fill_positions.ml

@@ -19,7 +19,7 @@ open Catala_utils
 let fill_pos_with_legislative_info (p : Ast.program) : Ast.program =
   let visitor =
     object
-      inherit [_] Ast.program_map as super
+      inherit [_] Ast.map as super
 
       method! visit_pos f env x =
         f env (Mark.remove x), Pos.overwrite_law_info (Mark.get x) env