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

Simplify visitors ppx annotations

Browse Source 
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.
This commit is contained in:
Louis Gesbert 2023-08-04 11:40:23 +02:00
parent b807c34584
commit 300d993733
2 changed files with 49 additions and 616 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

663
compiler/surface/ast.ml
View File

@ -31,49 +31,17 @@ open Catala_utils
(** {1 Type definitions} *) (** {1 Type definitions} *)
type uident = (string[@opaque]) type uident = (string[@opaque])
[@@deriving
visitors { variety = "map"; name = "uident_map"; nude = true },
visitors { variety = "iter"; name = "uident_iter"; nude = true }]
(** Constructors are CamelCase *) (** Constructors are CamelCase *)
type lident = (string[@opaque]) and lident = (string[@opaque])
[@@deriving
visitors { variety = "map"; name = "lident_map"; nude = true },
visitors { variety = "iter"; name = "lident_iter"; nude = true }]
(** Idents are snake_case *) (** Idents are snake_case *)
type path = uident Mark.pos list and 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";
}]
type scope_var = lident Mark.pos list and 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";
}]
(** [foo.bar] in binding position: used to specify variables of subscopes *) (** [foo.bar] in binding position: used to specify variables of subscopes *)
type primitive_typ = and primitive_typ =
| Integer | Integer
| Decimal | Decimal
| Boolean | Boolean
@ -82,191 +50,47 @@ type primitive_typ =
| Text | Text
| Date | Date
| Named of path * uident Mark.pos | 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 | Primitive of primitive_typ
| Collection of base_typ_data Mark.pos | 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 and 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;
}]
type func_typ = { and func_typ = {
arg_typ : (lident Mark.pos * base_typ Mark.pos) list; arg_typ : (lident Mark.pos * base_typ Mark.pos) list;
return_typ : base_typ Mark.pos; 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 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_name : lident Mark.pos;
struct_decl_field_typ : typ; 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_name : uident Mark.pos;
struct_decl_fields : struct_decl_field Mark.pos list; 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_name : uident Mark.pos;
enum_decl_case_typ : typ option; 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_name : uident Mark.pos;
enum_decl_cases : enum_decl_case Mark.pos list; 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 (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 and 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 }]
type binop = and binop =
| And | And
| Or | Or
| Xor | Xor
@ -281,40 +105,10 @@ type binop =
| Eq | Eq
| Neq | Neq
| Concat | 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 and 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;
}]
type builtin_expression = and builtin_expression =
| Cardinal | Cardinal
| ToDecimal | ToDecimal
| ToMoney | ToMoney
@ -324,83 +118,37 @@ type builtin_expression =
| LastDayOfMonth | LastDayOfMonth
| FirstDayOfMonth | FirstDayOfMonth
| Round | 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_day : (int[@opaque]);
literal_date_month : (int[@opaque]); literal_date_month : (int[@opaque]);
literal_date_year : (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]) | Int of (string[@opaque])
| Dec of (string[@opaque]) * (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 and 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 }]
type money_amount = { and money_amount = {
money_amount_units : (string[@opaque]); money_amount_units : (string[@opaque]);
money_amount_cents : (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 | LNumber of literal_number Mark.pos * literal_unit Mark.pos option
| LBool of bool | LBool of bool
| LMoneyAmount of money_amount | LMoneyAmount of money_amount
| LDate of literal_date | 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 } | Exists of { predicate : lident Mark.pos * expression }
| Forall of { predicate : lident Mark.pos * expression } | Forall of { predicate : lident Mark.pos * expression }
| Map of { f : lident Mark.pos * expression } | Map of { f : lident Mark.pos * expression }
| Filter of { f : lident Mark.pos * expression } | Filter of { f : lident Mark.pos * expression }
| AggregateSum of { typ : primitive_typ } | 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 extremums, but we need an additionl overload for "neutral element for
addition across types" *) addition across types" *)
| AggregateExtremum of { max : bool; default : expression } | AggregateExtremum of { max : bool; default : expression }
@ -441,55 +189,13 @@ and naked_expression =
| Ident of path * lident Mark.pos | Ident of path * lident Mark.pos
| Dotted of expression * (path * lident Mark.pos) Mark.pos | Dotted of expression * (path * lident Mark.pos) Mark.pos
(** Dotted is for both struct field projection and sub-scope variables *) (** 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 | NotAnException
| UnlabeledException | UnlabeledException
| ExceptionToLabel of lident Mark.pos | 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_label : lident Mark.pos option;
rule_exception_to : exception_to; rule_exception_to : exception_to;
rule_parameter : lident Mark.pos list Mark.pos option; rule_parameter : lident Mark.pos list Mark.pos option;
@ -499,21 +205,8 @@ type rule = {
rule_consequence : (bool[@opaque]) Mark.pos; rule_consequence : (bool[@opaque]) Mark.pos;
rule_state : lident Mark.pos option; 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_label : lident Mark.pos option;
definition_exception_to : exception_to; definition_exception_to : exception_to;
definition_name : scope_var Mark.pos; definition_name : scope_var Mark.pos;
@ -523,155 +216,46 @@ type definition = {
definition_expr : expression; definition_expr : expression;
definition_state : lident Mark.pos option; 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 and variation_typ = Increasing | Decreasing
[@@deriving
visitors { variety = "map"; name = "variation_typ_map" },
visitors { variety = "iter"; name = "variation_typ_iter" }]
type meta_assertion = and meta_assertion =
| FixedBy of scope_var Mark.pos * lident Mark.pos | FixedBy of scope_var Mark.pos * lident Mark.pos
| VariesWith of | VariesWith of
scope_var Mark.pos * expression * variation_typ Mark.pos option 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_condition : expression option;
assertion_content : expression; 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 | Rule of rule
| Definition of definition | Definition of definition
| Assertion of assertion | Assertion of assertion
| MetaAssertion of meta_assertion | MetaAssertion of meta_assertion
| DateRounding of variation_typ Mark.pos | 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_condition : expression option;
scope_use_name : uident Mark.pos; scope_use_name : uident Mark.pos;
scope_use_items : scope_use_item Mark.pos list; 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 and io_input = Input | Context | Internal
[@@deriving
visitors { variety = "map"; name = "io_input_map" },
visitors { variety = "iter"; name = "io_input_iter" }]
type scope_decl_context_io = { and scope_decl_context_io = {
scope_decl_context_io_input : io_input Mark.pos; scope_decl_context_io_input : io_input Mark.pos;
scope_decl_context_io_output : bool 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_name : lident Mark.pos;
scope_decl_context_scope_sub_scope : uident Mark.pos; scope_decl_context_scope_sub_scope : uident Mark.pos;
scope_decl_context_scope_attribute : scope_decl_context_io; 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_name : lident Mark.pos;
scope_decl_context_item_typ : typ; scope_decl_context_item_typ : typ;
scope_decl_context_item_parameters : 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_attribute : scope_decl_context_io;
scope_decl_context_item_states : lident Mark.pos list; 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 | ContextData of scope_decl_context_data
| ContextScope of scope_decl_context_scope | 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_name : uident Mark.pos;
scope_decl_context : scope_decl_context_item Mark.pos list; 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_name : lident Mark.pos;
topdef_args : (lident Mark.pos * base_typ Mark.pos) list Mark.pos option; topdef_args : (lident Mark.pos * base_typ Mark.pos) list Mark.pos option;
(** Empty list if this is not a function *) (** Empty list if this is not a function *)
topdef_type : typ; topdef_type : typ;
topdef_expr : expression option; 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 | ScopeUse of scope_use
| ScopeDecl of scope_decl | ScopeDecl of scope_decl
| StructDecl of struct_decl | StructDecl of struct_decl
| EnumDecl of enum_decl | EnumDecl of enum_decl
| Topdef of top_def | 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 and code_block = code_item Mark.pos list
[@@deriving and source_repr = (string[@opaque]) Mark.pos
visitors
{ variety = "map"; ancestors = ["code_item_map"]; name = "code_block_map" },
visitors
{
variety = "iter";
ancestors = ["code_item_iter"];
name = "code_block_iter";
}]
type source_repr = (string[@opaque]) Mark.pos and law_heading = {
[@@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 = {
law_heading_name : (string[@opaque]) Mark.pos; law_heading_name : (string[@opaque]) Mark.pos;
law_heading_id : (string[@opaque]) option; law_heading_id : (string[@opaque]) option;
law_heading_is_archive : bool; [@opaque] law_heading_is_archive : bool; [@opaque]
law_heading_precedence : (int[@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 | PdfFile of (string[@opaque]) Mark.pos * (int[@opaque]) option
| CatalaFile of (string[@opaque]) Mark.pos | CatalaFile of (string[@opaque]) Mark.pos
| LegislativeText 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 | LawInclude of law_include
| LawHeading of law_heading * law_structure list | LawHeading of law_heading * law_structure list
| LawText of (string[@opaque]) | LawText of (string[@opaque])
| CodeBlock of code_block * source_repr * bool (* Metadata if true *) | 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 : program_interfaces :
((Shared_ast.Qident.path[@opaque]) * code_item Mark.pos) list; ((Shared_ast.Qident.path[@opaque]) * code_item Mark.pos) list;
program_items : law_structure list; program_items : law_structure list;
program_source_files : (string[@opaque]) 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}*) (** {1 Helpers}*)

2
compiler/surface/fill_positions.ml
View File

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