2021-02-12 19:20:14 +03:00
|
|
|
(* This file is part of the Catala compiler, a specification language for tax
|
|
|
|
and social benefits computation rules. Copyright (C) 2020 Inria, contributor:
|
|
|
|
Nicolas Chataing <nicolas.chataing@ens.fr>
|
|
|
|
|
|
|
|
Licensed under the Apache License, Version 2.0 (the "License"); you may not
|
|
|
|
use this file except in compliance with the License. You may obtain a copy of
|
|
|
|
the License at
|
|
|
|
|
|
|
|
http://www.apache.org/licenses/LICENSE-2.0
|
|
|
|
|
|
|
|
Unless required by applicable law or agreed to in writing, software
|
|
|
|
distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
|
|
|
|
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
|
|
|
|
License for the specific language governing permissions and limitations under
|
|
|
|
the License. *)
|
|
|
|
|
|
|
|
(** Abstract syntax tree of the desugared representation *)
|
|
|
|
|
|
|
|
open Utils
|
|
|
|
|
|
|
|
(** {1 Names, Maps and Keys} *)
|
|
|
|
|
|
|
|
module IdentMap : Map.S with type key = String.t
|
|
|
|
module RuleName : Uid.Id with type info = Uid.MarkedString.info
|
|
|
|
module RuleMap : Map.S with type key = RuleName.t
|
|
|
|
module RuleSet : Set.S with type elt = RuleName.t
|
2022-01-04 20:19:15 +03:00
|
|
|
module LabelName : Uid.Id with type info = Uid.MarkedString.info
|
|
|
|
module LabelMap : Map.S with type key = LabelName.t
|
|
|
|
module LabelSet : Set.S with type elt = LabelName.t
|
2022-02-28 17:40:19 +03:00
|
|
|
module StateName : Uid.Id with type info = Uid.MarkedString.info
|
2022-02-28 19:19:06 +03:00
|
|
|
module ScopeVar : Uid.Id with type info = Uid.MarkedString.info
|
|
|
|
module ScopeVarSet : Set.S with type elt = ScopeVar.t
|
|
|
|
module ScopeVarMap : Map.S with type key = ScopeVar.t
|
|
|
|
|
2021-02-12 19:20:14 +03:00
|
|
|
(** Inside a scope, a definition can refer either to a scope def, or a subscope
|
|
|
|
def *)
|
|
|
|
module ScopeDef : sig
|
|
|
|
type t =
|
2022-02-28 19:19:06 +03:00
|
|
|
| Var of ScopeVar.t * StateName.t option
|
|
|
|
| SubScopeVar of Scopelang.Ast.SubScopeName.t * ScopeVar.t
|
2021-02-12 20:16:06 +03:00
|
|
|
|
2021-02-12 19:20:14 +03:00
|
|
|
val compare : t -> t -> int
|
|
|
|
val get_position : t -> Pos.t
|
|
|
|
val format_t : Format.formatter -> t -> unit
|
|
|
|
val hash : t -> int
|
|
|
|
end
|
|
|
|
|
|
|
|
module ScopeDefMap : Map.S with type key = ScopeDef.t
|
|
|
|
module ScopeDefSet : Set.S with type elt = ScopeDef.t
|
|
|
|
|
|
|
|
(** {1 AST} *)
|
|
|
|
|
2022-02-28 20:34:32 +03:00
|
|
|
(**{2 Expressions}*)
|
2022-02-28 19:19:06 +03:00
|
|
|
type location =
|
2022-05-30 12:20:48 +03:00
|
|
|
| ScopeVar of ScopeVar.t Marked.pos * StateName.t option
|
2022-02-28 19:19:06 +03:00
|
|
|
| SubScopeVar of
|
|
|
|
Scopelang.Ast.ScopeName.t
|
2022-05-30 12:20:48 +03:00
|
|
|
* Scopelang.Ast.SubScopeName.t Marked.pos
|
|
|
|
* ScopeVar.t Marked.pos
|
2022-02-28 19:19:06 +03:00
|
|
|
|
2022-05-30 12:20:48 +03:00
|
|
|
module LocationSet : Set.S with type elt = location Marked.pos
|
2022-02-28 19:19:06 +03:00
|
|
|
|
|
|
|
(** The expressions use the {{:https://lepigre.fr/ocaml-bindlib/} Bindlib}
|
|
|
|
library, based on higher-order abstract syntax*)
|
|
|
|
type expr =
|
|
|
|
| ELocation of location
|
2022-05-30 12:20:48 +03:00
|
|
|
| EVar of expr Bindlib.var Marked.pos
|
2022-02-28 19:19:06 +03:00
|
|
|
| EStruct of
|
|
|
|
Scopelang.Ast.StructName.t
|
2022-05-30 12:20:48 +03:00
|
|
|
* expr Marked.pos Scopelang.Ast.StructFieldMap.t
|
2022-02-28 19:19:06 +03:00
|
|
|
| EStructAccess of
|
2022-05-30 12:20:48 +03:00
|
|
|
expr Marked.pos
|
2022-02-28 19:19:06 +03:00
|
|
|
* Scopelang.Ast.StructFieldName.t
|
|
|
|
* Scopelang.Ast.StructName.t
|
|
|
|
| EEnumInj of
|
2022-05-30 12:20:48 +03:00
|
|
|
expr Marked.pos
|
2022-02-28 19:19:06 +03:00
|
|
|
* Scopelang.Ast.EnumConstructor.t
|
|
|
|
* Scopelang.Ast.EnumName.t
|
|
|
|
| EMatch of
|
2022-05-30 12:20:48 +03:00
|
|
|
expr Marked.pos
|
2022-02-28 19:19:06 +03:00
|
|
|
* Scopelang.Ast.EnumName.t
|
2022-05-30 12:20:48 +03:00
|
|
|
* expr Marked.pos Scopelang.Ast.EnumConstructorMap.t
|
2022-02-28 19:19:06 +03:00
|
|
|
| ELit of Dcalc.Ast.lit
|
|
|
|
| EAbs of
|
2022-05-30 12:20:48 +03:00
|
|
|
(expr, expr Marked.pos) Bindlib.mbinder Marked.pos
|
|
|
|
* Scopelang.Ast.typ Marked.pos list
|
|
|
|
| EApp of expr Marked.pos * expr Marked.pos list
|
2022-02-28 19:19:06 +03:00
|
|
|
| EOp of Dcalc.Ast.operator
|
2022-05-30 12:20:48 +03:00
|
|
|
| EDefault of expr Marked.pos list * expr Marked.pos * expr Marked.pos
|
|
|
|
| EIfThenElse of expr Marked.pos * expr Marked.pos * expr Marked.pos
|
|
|
|
| EArray of expr Marked.pos list
|
|
|
|
| ErrorOnEmpty of expr Marked.pos
|
2022-02-28 19:19:06 +03:00
|
|
|
|
2022-05-25 15:41:04 +03:00
|
|
|
module ExprMap : Map.S with type key = expr
|
|
|
|
|
2022-02-28 20:34:32 +03:00
|
|
|
(** {2 Variable helpers} *)
|
|
|
|
|
|
|
|
module Var : sig
|
|
|
|
type t = expr Bindlib.var
|
|
|
|
|
2022-05-30 12:20:48 +03:00
|
|
|
val make : string Marked.pos -> t
|
2022-02-28 20:34:32 +03:00
|
|
|
val compare : t -> t -> int
|
|
|
|
end
|
|
|
|
|
|
|
|
module VarMap : Map.S with type key = Var.t
|
|
|
|
|
|
|
|
type vars = expr Bindlib.mvar
|
|
|
|
|
2022-05-30 12:20:48 +03:00
|
|
|
val make_var : Var.t Marked.pos -> expr Marked.pos Bindlib.box
|
2022-02-28 20:34:32 +03:00
|
|
|
|
|
|
|
val make_abs :
|
|
|
|
vars ->
|
2022-05-30 12:20:48 +03:00
|
|
|
expr Marked.pos Bindlib.box ->
|
2022-02-28 20:34:32 +03:00
|
|
|
Pos.t ->
|
2022-05-30 12:20:48 +03:00
|
|
|
Scopelang.Ast.typ Marked.pos list ->
|
2022-02-28 20:34:32 +03:00
|
|
|
Pos.t ->
|
2022-05-30 12:20:48 +03:00
|
|
|
expr Marked.pos Bindlib.box
|
2022-02-28 20:34:32 +03:00
|
|
|
|
|
|
|
val make_app :
|
2022-05-30 12:20:48 +03:00
|
|
|
expr Marked.pos Bindlib.box ->
|
|
|
|
expr Marked.pos Bindlib.box list ->
|
2022-02-28 20:34:32 +03:00
|
|
|
Pos.t ->
|
2022-05-30 12:20:48 +03:00
|
|
|
expr Marked.pos Bindlib.box
|
2022-02-28 20:34:32 +03:00
|
|
|
|
|
|
|
val make_let_in :
|
|
|
|
Var.t ->
|
2022-05-30 12:20:48 +03:00
|
|
|
Scopelang.Ast.typ Marked.pos ->
|
|
|
|
expr Marked.pos Bindlib.box ->
|
|
|
|
expr Marked.pos Bindlib.box ->
|
|
|
|
expr Marked.pos Bindlib.box
|
2022-02-28 20:34:32 +03:00
|
|
|
|
|
|
|
(** {2 Rules and scopes}*)
|
|
|
|
|
2021-02-11 20:48:59 +03:00
|
|
|
type rule = {
|
2022-01-04 20:19:15 +03:00
|
|
|
rule_id : RuleName.t;
|
2022-05-30 12:20:48 +03:00
|
|
|
rule_just : expr Marked.pos Bindlib.box;
|
|
|
|
rule_cons : expr Marked.pos Bindlib.box;
|
|
|
|
rule_parameter : (Var.t * Scopelang.Ast.typ Marked.pos) option;
|
|
|
|
rule_exception_to_rules : RuleSet.t Marked.pos;
|
2021-02-11 20:48:59 +03:00
|
|
|
}
|
2021-02-12 19:20:14 +03:00
|
|
|
|
2022-05-25 15:41:04 +03:00
|
|
|
module Rule : Set.OrderedType with type t = rule
|
|
|
|
|
2022-05-30 12:20:48 +03:00
|
|
|
val empty_rule : Pos.t -> Scopelang.Ast.typ Marked.pos option -> rule
|
|
|
|
val always_false_rule : Pos.t -> Scopelang.Ast.typ Marked.pos option -> rule
|
2021-02-12 19:20:14 +03:00
|
|
|
|
2022-05-30 12:20:48 +03:00
|
|
|
type assertion = expr Marked.pos Bindlib.box
|
2021-02-11 20:48:59 +03:00
|
|
|
type variation_typ = Increasing | Decreasing
|
|
|
|
type reference_typ = Decree | Law
|
2021-02-12 19:20:14 +03:00
|
|
|
|
2021-02-11 20:48:59 +03:00
|
|
|
type meta_assertion =
|
2022-05-30 12:20:48 +03:00
|
|
|
| FixedBy of reference_typ Marked.pos
|
|
|
|
| VariesWith of unit * variation_typ Marked.pos option
|
2021-02-12 19:20:14 +03:00
|
|
|
|
2022-01-04 20:19:15 +03:00
|
|
|
type scope_def = {
|
|
|
|
scope_def_rules : rule RuleMap.t;
|
2022-05-30 12:20:48 +03:00
|
|
|
scope_def_typ : Scopelang.Ast.typ Marked.pos;
|
2022-01-04 20:19:15 +03:00
|
|
|
scope_def_is_condition : bool;
|
2022-02-07 12:30:36 +03:00
|
|
|
scope_def_io : Scopelang.Ast.io;
|
2022-01-04 20:19:15 +03:00
|
|
|
scope_def_label_groups : RuleSet.t LabelMap.t;
|
|
|
|
}
|
|
|
|
|
2022-02-28 19:19:06 +03:00
|
|
|
type var_or_states = WholeVar | States of StateName.t list
|
|
|
|
|
2021-02-11 20:48:59 +03:00
|
|
|
type scope = {
|
2022-02-28 19:19:06 +03:00
|
|
|
scope_vars : var_or_states ScopeVarMap.t;
|
2021-02-11 20:48:59 +03:00
|
|
|
scope_sub_scopes : Scopelang.Ast.ScopeName.t Scopelang.Ast.SubScopeMap.t;
|
|
|
|
scope_uid : Scopelang.Ast.ScopeName.t;
|
2022-01-04 20:19:15 +03:00
|
|
|
scope_defs : scope_def ScopeDefMap.t;
|
2021-02-11 20:48:59 +03:00
|
|
|
scope_assertions : assertion list;
|
|
|
|
scope_meta_assertions : meta_assertion list;
|
|
|
|
}
|
2021-02-12 19:20:14 +03:00
|
|
|
|
2021-02-11 20:48:59 +03:00
|
|
|
type program = {
|
|
|
|
program_scopes : scope Scopelang.Ast.ScopeMap.t;
|
|
|
|
program_enums : Scopelang.Ast.enum_ctx;
|
|
|
|
program_structs : Scopelang.Ast.struct_ctx;
|
|
|
|
}
|
2021-02-12 19:20:14 +03:00
|
|
|
|
|
|
|
(** {1 Helpers} *)
|
|
|
|
|
2022-05-30 12:20:48 +03:00
|
|
|
val locations_used : expr Marked.pos -> LocationSet.t
|
2021-02-12 19:20:14 +03:00
|
|
|
val free_variables : rule RuleMap.t -> Pos.t ScopeDefMap.t
|