Ast (catala.Surface.Ast)

Visitor classes for programs

To allow for quick traversal and/or modification of this AST structure, we provide a visitor design pattern. This feature is implemented via François Pottier's OCaml visitors library.

Type definitions

type uident = string

Constructors are CamelCase

class virtual +'a uident_map : object ... end

class virtual +'a uident_iter : object ... end

type lident = string

Idents are snake_case

class virtual +'a lident_map : object ... end

class virtual +'a lident_iter : object ... end

type path = uident Catala_utils.Mark.pos list

class virtual +'b path_map : object ... end

class virtual +'b path_iter : object ... end

type scope_var = lident Catala_utils.Mark.pos list

foo.bar in binding position: used to specify variables of subscopes

class virtual +'b scope_var_map : object ... end

class virtual +'b scope_var_iter : object ... end

type primitive_typ =

| Integer

| Decimal

| Boolean

| Money

| Duration

| Text

| Date

| Named of path * uident Catala_utils.Mark.pos

class virtual +'b primitive_typ_map : object ... end

class virtual +'b primitive_typ_iter : object ... end

type base_typ_data =

| Primitive of primitive_typ

| Collection of base_typ_data Catala_utils.Mark.pos

class virtual +'b base_typ_data_map : object ... end

class virtual +'b base_typ_data_iter : object ... end

type base_typ =

| Condition

| Data of base_typ_data

class virtual +'b base_typ_map : object ... end

class virtual +'b base_typ_iter : object ... end

type func_typ = {

arg_typ : (lident Catala_utils.Mark.pos * base_typ Catala_utils.Mark.pos) list;

return_typ : base_typ Catala_utils.Mark.pos;

}

class virtual +'b func_typ_map : object ... end

class virtual +'b func_typ_iter : object ... end

type typ = naked_typ Catala_utils.Mark.pos

and naked_typ =

| Base of base_typ

| Func of func_typ

class virtual +'b typ_map : object ... end

class virtual +'b typ_iter : object ... end

type struct_decl_field = {

struct_decl_field_name : lident Catala_utils.Mark.pos;

struct_decl_field_typ : typ;

}

class virtual +'b struct_decl_field_map : object ... end

class virtual +'b struct_decl_field_iter : object ... end

type struct_decl = {

struct_decl_name : uident Catala_utils.Mark.pos;

struct_decl_fields : struct_decl_field Catala_utils.Mark.pos list;

}

class virtual +'b struct_decl_map : object ... end

class virtual +'b struct_decl_iter : object ... end

type enum_decl_case = {

enum_decl_case_name : uident Catala_utils.Mark.pos;

enum_decl_case_typ : typ option;

}

class virtual +'b enum_decl_case_map : object ... end

class virtual +'b enum_decl_case_iter : object ... end

type enum_decl = {

enum_decl_name : uident Catala_utils.Mark.pos;

enum_decl_cases : enum_decl_case Catala_utils.Mark.pos list;

}

class virtual +'b enum_decl_map : object ... end

class virtual +'b enum_decl_iter : object ... end

type match_case_pattern =
  (path * uident Catala_utils.Mark.pos) Catala_utils.Mark.pos list
  * lident Catala_utils.Mark.pos option

class virtual +'b match_case_pattern_map : object ... end

class virtual +'b match_case_pattern_iter : object ... end

type op_kind =

| KPoly

| KInt

| KDec

| KMoney

| KDate

| KDuration

class virtual +'a op_kind_map : object ... end

class virtual +'a op_kind_iter : object ... end

type binop =

| And

| Or

| Xor

| Add of op_kind

| Sub of op_kind

| Mult of op_kind

| Div of op_kind

| Lt of op_kind

| Lte of op_kind

| Gt of op_kind

| Gte of op_kind

| Eq

| Neq

| Concat

class virtual +'a binop_map : object ... end

class virtual +'a binop_iter : object ... end

type unop =

| Not

| Minus of op_kind

class virtual +'a unop_map : object ... end

class virtual +'a unop_iter : object ... end

type builtin_expression =

| Cardinal

| ToDecimal

| ToMoney

| GetDay

| GetMonth

| GetYear

| LastDayOfMonth

| FirstDayOfMonth

| Round

class virtual +'a builtin_expression_map : object ... end

class virtual +'a builtin_expression_iter : object ... end

type literal_date = {

literal_date_day : int;

literal_date_month : int;

literal_date_year : int;

}

class virtual +'b literal_date_map : object ... end

class virtual +'b literal_date_iter : object ... end

type literal_number =

| Int of string

| Dec of string * string

class virtual +'a literal_number_map : object ... end

class virtual +'a literal_number_iter : object ... end

type literal_unit =

| Percent

| Year

| Month

| Day

class virtual +'a literal_unit_map : object ... end

class virtual +'a literal_unit_iter : object ... end

type money_amount = {

money_amount_units : string;

money_amount_cents : string;

}

class virtual +'a money_amount_map : object ... end

class virtual +'a money_amount_iter : object ... end

type literal =

| LNumber of literal_number Catala_utils.Mark.pos
  * literal_unit Catala_utils.Mark.pos option

| LBool of bool

| LMoneyAmount of money_amount

| LDate of literal_date

class virtual +'b literal_map : object ... end

class virtual +'b literal_iter : object ... end

type collection_op =

| Exists of {

predicate : lident Catala_utils.Mark.pos * expression;

}

| Forall of {

predicate : lident Catala_utils.Mark.pos * expression;

}

| Map of {

f : lident Catala_utils.Mark.pos * expression;

}

| Filter of {

f : lident Catala_utils.Mark.pos * expression;

}

| AggregateSum of {

typ : primitive_typ;

}

| AggregateExtremum of {

max : bool;

default : expression;

}

| AggregateArgExtremum of {

max : bool;

default : expression;

f : lident Catala_utils.Mark.pos * expression;

}

and explicit_match_case = {

match_case_pattern : match_case_pattern Catala_utils.Mark.pos;

match_case_expr : expression;

}

and match_case =

| WildCard of expression

| MatchCase of explicit_match_case

and match_cases = match_case Catala_utils.Mark.pos list

and expression = naked_expression Catala_utils.Mark.pos

and naked_expression =

`\| Paren of expression`
`\| MatchWith of expression * match_cases Catala_utils.Mark.pos`
`\| IfThenElse of expression * expression * expression`
`\| Binop of binop Catala_utils.Mark.pos * expression * expression`
`\| Unop of unop Catala_utils.Mark.pos * expression`
`\| CollectionOp of collection_op * expression`
`\| MemCollection of expression * expression`
`\| TestMatchCase of expression * match_case_pattern Catala_utils.Mark.pos`
`\| FunCall of expression * expression list`
`\| ScopeCall of (path * uident Catala_utils.Mark.pos) Catala_utils.Mark.pos * (lident Catala_utils.Mark.pos * expression) list`
`\| LetIn of lident Catala_utils.Mark.pos * expression * expression`
`\| Builtin of builtin_expression`
`\| Literal of literal`
`\| EnumInject of (path * uident Catala_utils.Mark.pos) Catala_utils.Mark.pos * expression option`
`\| StructLit of (path * uident Catala_utils.Mark.pos) Catala_utils.Mark.pos * (lident Catala_utils.Mark.pos * expression) list`
`\| ArrayLit of expression list`
`\| Ident of path * lident Catala_utils.Mark.pos`
`\| Dotted of expression * (path * lident Catala_utils.Mark.pos) Catala_utils.Mark.pos`	(* Dotted is for both struct field projection and sub-scope variables *)

class virtual +'b expression_map : object ... end

class virtual +'b expression_iter : object ... end

type exception_to =

| NotAnException

| UnlabeledException

| ExceptionToLabel of lident Catala_utils.Mark.pos

class virtual +'b exception_to_map : object ... end

class virtual +'b exception_to_iter : object ... end

type rule = {

rule_label : lident Catala_utils.Mark.pos option;

rule_exception_to : exception_to;

rule_parameter : lident Catala_utils.Mark.pos list Catala_utils.Mark.pos option;

rule_condition : expression option;

rule_name : scope_var Catala_utils.Mark.pos;

rule_id : Shared_ast.RuleName.t;

rule_consequence : bool Catala_utils.Mark.pos;

rule_state : lident Catala_utils.Mark.pos option;

}

class virtual +'b rule_map : object ... end

class virtual +'b rule_iter : object ... end

type definition = {

definition_label : lident Catala_utils.Mark.pos option;

definition_exception_to : exception_to;

definition_name : scope_var Catala_utils.Mark.pos;

definition_parameter : lident Catala_utils.Mark.pos list Catala_utils.Mark.pos
                         option;

definition_condition : expression option;

definition_id : Shared_ast.RuleName.t;

definition_expr : expression;

definition_state : lident Catala_utils.Mark.pos option;

}

class virtual +'b definition_map : object ... end

class virtual +'b definition_iter : object ... end

type variation_typ =

| Increasing

| Decreasing

class virtual +'a variation_typ_map : object ... end

class virtual +'a variation_typ_iter : object ... end

type meta_assertion =

| FixedBy of scope_var Catala_utils.Mark.pos * lident Catala_utils.Mark.pos

| VariesWith of scope_var Catala_utils.Mark.pos
  * expression
  * variation_typ Catala_utils.Mark.pos option

class virtual +'b meta_assertion_map : object ... end

class virtual +'b meta_assertion_iter : object ... end

type assertion = {

assertion_condition : expression option;

assertion_content : expression;

}

class virtual +'b assertion_map : object ... end

class virtual +'b assertion_iter : object ... end

type scope_use_item =

| Rule of rule

| Definition of definition

| Assertion of assertion

| MetaAssertion of meta_assertion

| DateRounding of variation_typ Catala_utils.Mark.pos

class virtual +'b scope_use_item_map : object ... end

class virtual +'b scope_use_item_iter : object ... end

type scope_use = {

scope_use_condition : expression option;

scope_use_name : uident Catala_utils.Mark.pos;

scope_use_items : scope_use_item Catala_utils.Mark.pos list;

}

class virtual +'b scope_use_map : object ... end

class virtual +'b scope_use_iter : object ... end

type io_input =

| Input

| Context

| Internal

class virtual +'a io_input_map : object ... end

class virtual +'a io_input_iter : object ... end

type scope_decl_context_io = {

scope_decl_context_io_input : io_input Catala_utils.Mark.pos;

scope_decl_context_io_output : bool Catala_utils.Mark.pos;

}

class virtual +'b scope_decl_context_io_map : object ... end

class virtual +'b scope_decl_context_io_iter : object ... end

type scope_decl_context_scope = {

scope_decl_context_scope_name : lident Catala_utils.Mark.pos;

scope_decl_context_scope_sub_scope : uident Catala_utils.Mark.pos;

scope_decl_context_scope_attribute : scope_decl_context_io;

}

class virtual +'b scope_decl_context_scope_map : object ... end

class virtual +'b scope_decl_context_scope_iter : object ... end

type scope_decl_context_data = {

scope_decl_context_item_name : lident Catala_utils.Mark.pos;

scope_decl_context_item_typ : typ;

scope_decl_context_item_parameters : (lident Catala_utils.Mark.pos * typ) list
                                       Catala_utils.Mark.pos
                                       option;

scope_decl_context_item_attribute : scope_decl_context_io;

scope_decl_context_item_states : lident Catala_utils.Mark.pos list;

}

class virtual +'b scope_decl_context_data_map : object ... end

class virtual +'b scope_decl_context_data_iter : object ... end

type scope_decl_context_item =

| ContextData of scope_decl_context_data

| ContextScope of scope_decl_context_scope

class virtual +'b scope_decl_context_item_map : object ... end

class virtual +'b scope_decl_context_item_iter : object ... end

type scope_decl = {

scope_decl_name : uident Catala_utils.Mark.pos;

scope_decl_context : scope_decl_context_item Catala_utils.Mark.pos list;

}

class virtual +'b scope_decl_map : object ... end

class virtual +'b scope_decl_iter : object ... end

type top_def = {

`topdef_name : lident Catala_utils.Mark.pos;`
`topdef_args : (lident Catala_utils.Mark.pos * base_typ Catala_utils.Mark.pos) list Catala_utils.Mark.pos option;`	(* Empty list if this is not a function *)
`topdef_type : typ;`
`topdef_expr : expression;`

}

class virtual +'b top_def_map : object ... end

class virtual +'b top_def_iter : object ... end

type code_item =

| ScopeUse of scope_use

| ScopeDecl of scope_decl

| StructDecl of struct_decl

| EnumDecl of enum_decl

| Topdef of top_def

class virtual +'b code_item_map : object ... end

class virtual +'b code_item_iter : object ... end

type code_block = code_item Catala_utils.Mark.pos list

class virtual +'b code_block_map : object ... end

class virtual +'b code_block_iter : object ... end

type source_repr = string Catala_utils.Mark.pos

class virtual +'b source_repr_map : object ... end

class virtual +'b source_repr_iter : object ... end

type law_heading = {

law_heading_name : string Catala_utils.Mark.pos;

law_heading_id : string option;

law_heading_is_archive : bool;

law_heading_precedence : int;

}

class virtual +'b law_heading_map : object ... end

class virtual +'b law_heading_iter : object ... end

type law_include =

| PdfFile of string Catala_utils.Mark.pos * int option

| CatalaFile of string Catala_utils.Mark.pos

| LegislativeText of string Catala_utils.Mark.pos

class virtual +'b law_include_map : object ... end

class virtual +'b law_include_iter : object ... end

type law_structure =

| LawInclude of law_include

| LawHeading of law_heading * law_structure list

| LawText of string

| CodeBlock of code_block * source_repr * bool

class virtual +'b law_structure_map : object ... end

class virtual +'b law_structure_iter : object ... end

type program = {

program_items : law_structure list;

program_source_files : string list;

}

class virtual +'b program_map : object ... end

class virtual +'b program_iter : object ... end

type source_file = law_structure list

Helpers

val rule_to_def : rule -> definition

Translates a rule into the corresponding definition

val type_from_args : 
  (lident Catala_utils.Mark.pos * base_typ Catala_utils.Mark.pos) list
    Catala_utils.Mark.pos
    option ->
  base_typ Catala_utils.Mark.pos ->
  typ

`\| Paren of expression`
`\| MatchWith of expression * match_cases Catala_utils.Mark.pos`
`\| IfThenElse of expression * expression * expression`
`\| Binop of binop Catala_utils.Mark.pos * expression * expression`
`\| Unop of unop Catala_utils.Mark.pos * expression`
`\| CollectionOp of collection_op * expression`
`\| MemCollection of expression * expression`
`\| TestMatchCase of expression * match_case_pattern Catala_utils.Mark.pos`
`\| FunCall of expression * expression list`
`\| ScopeCall of (path * uident Catala_utils.Mark.pos) Catala_utils.Mark.pos * (lident Catala_utils.Mark.pos * expression) list`
`\| LetIn of lident Catala_utils.Mark.pos * expression * expression`
`\| Builtin of builtin_expression`
`\| Literal of literal`
`\| EnumInject of (path * uident Catala_utils.Mark.pos) Catala_utils.Mark.pos * expression option`
`\| StructLit of (path * uident Catala_utils.Mark.pos) Catala_utils.Mark.pos * (lident Catala_utils.Mark.pos * expression) list`
`\| ArrayLit of expression list`
`\| Ident of path * lident Catala_utils.Mark.pos`
`\| Dotted of expression * (path * lident Catala_utils.Mark.pos) Catala_utils.Mark.pos`	(* Dotted is for both struct field projection and sub-scope variables *)