Cleanup generated .mlis

This commit is contained in:
Louis Gesbert 2021-02-12 17:20:14 +01:00
parent 596e98b497
commit 5422107d6c
33 changed files with 1537 additions and 2555 deletions

View File

@ -30,8 +30,6 @@ module EnumConstructor : Uid.Id with type info = Uid.MarkedString.info =
module EnumMap : Map.S with type key = EnumName.t = Map.Make (EnumName)
(** Abstract syntax tree for the default calculus *)
(** {1 Abstract syntax tree} *)
type typ_lit = TBool | TUnit | TInt | TRat | TMoney | TDate | TDuration
@ -98,18 +96,12 @@ type unop =
type operator = Ternop of ternop | Binop of binop | Unop of unop
(** The expressions use the {{:https://lepigre.fr/ocaml-bindlib/} Bindlib} library, based on
higher-order abstract syntax*)
type expr =
| EVar of expr Bindlib.var Pos.marked
| ETuple of expr Pos.marked list * StructName.t option
(** The [MarkedString.info] is the former struct field name*)
| ETupleAccess of expr Pos.marked * int * StructName.t option * typ Pos.marked list
(** The [MarkedString.info] is the former struct field name *)
| EInj of expr Pos.marked * int * EnumName.t * typ Pos.marked list
(** The [MarkedString.info] is the former enum case name *)
| EMatch of expr Pos.marked * expr Pos.marked list * EnumName.t
(** The [MarkedString.info] is the former enum case name *)
| EArray of expr Pos.marked list
| ELit of lit
| EAbs of Pos.t * (expr, expr Pos.marked) Bindlib.mbinder * typ Pos.marked list

View File

@ -1,155 +1,54 @@
module ScopeName :
sig
type t
type info = Utils.Uid.MarkedString.info
val fresh : info -> t
val get_info : t -> info
val compare : t -> t -> int
val format_t : Format.formatter -> t -> unit
val hash : t -> int
end
module StructName :
sig
type t
type info = Utils.Uid.MarkedString.info
val fresh : info -> t
val get_info : t -> info
val compare : t -> t -> int
val format_t : Format.formatter -> t -> unit
val hash : t -> int
end
module StructFieldName :
sig
type t
type info = Utils.Uid.MarkedString.info
val fresh : info -> t
val get_info : t -> info
val compare : t -> t -> int
val format_t : Format.formatter -> t -> unit
val hash : t -> int
end
module StructMap :
sig
type key = StructName.t
type +'a t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
module EnumName :
sig
type t
type info = Utils.Uid.MarkedString.info
val fresh : info -> t
val get_info : t -> info
val compare : t -> t -> int
val format_t : Format.formatter -> t -> unit
val hash : t -> int
end
module EnumConstructor :
sig
type t
type info = Utils.Uid.MarkedString.info
val fresh : info -> t
val get_info : t -> info
val compare : t -> t -> int
val format_t : Format.formatter -> t -> unit
val hash : t -> int
end
module EnumMap :
sig
type key = EnumName.t
type +'a t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
open Utils
module ScopeName : Uid.Id with type info = Uid.MarkedString.info
module StructName : Uid.Id with type info = Uid.MarkedString.info
module StructFieldName : Uid.Id with type info = Uid.MarkedString.info
module StructMap : Map.S with type key = StructName.t
module EnumName : Uid.Id with type info = Uid.MarkedString.info
module EnumConstructor : Uid.Id with type info = Uid.MarkedString.info
module EnumMap : Map.S with type key = EnumName.t
(** Abstract syntax tree for the default calculus *)
(** {1 Abstract syntax tree} *)
type typ_lit = TBool | TUnit | TInt | TRat | TMoney | TDate | TDuration
type typ =
TLit of typ_lit
| TTuple of typ Utils.Pos.marked list * StructName.t option
| TEnum of typ Utils.Pos.marked list * EnumName.t
| TArrow of typ Utils.Pos.marked * typ Utils.Pos.marked
| TArray of typ Utils.Pos.marked
| TLit of typ_lit
| TTuple of typ Pos.marked list * StructName.t option
| TEnum of typ Pos.marked list * EnumName.t
| TArrow of typ Pos.marked * typ Pos.marked
| TArray of typ Pos.marked
| TAny
type date = CalendarLib.Date.t
type duration = CalendarLib.Date.Period.t
type lit =
LBool of bool
| LBool of bool
| LEmptyError
| LInt of Z.t
| LRat of Q.t
@ -157,10 +56,18 @@ type lit =
| LUnit
| LDate of date
| LDuration of duration
type op_kind = KInt | KRat | KMoney | KDate | KDuration
type op_kind =
| KInt
| KRat
| KMoney
| KDate
| KDuration (** All ops don't have a Kdate and KDuration *)
type ternop = Fold
type binop =
And
| And
| Or
| Add of op_kind
| Sub of op_kind
@ -174,9 +81,11 @@ type binop =
| Neq
| Map
| Filter
type log_entry = VarDef | BeginCall | EndCall | PosRecordIfTrueBool
type unop =
Not
| Not
| Minus of op_kind
| ErrorOnEmpty
| Log of log_entry * Utils.Uid.MarkedString.info list
@ -185,104 +94,71 @@ type unop =
| GetDay
| GetMonth
| GetYear
type operator = Ternop of ternop | Binop of binop | Unop of unop
(** The expressions use the {{:https://lepigre.fr/ocaml-bindlib/} Bindlib} library, based on
higher-order abstract syntax*)
type expr =
EVar of expr Bindlib.var Utils.Pos.marked
| ETuple of expr Utils.Pos.marked list * StructName.t option
| ETupleAccess of expr Utils.Pos.marked * int * StructName.t option *
typ Utils.Pos.marked list
| EInj of expr Utils.Pos.marked * int * EnumName.t *
typ Utils.Pos.marked list
| EMatch of expr Utils.Pos.marked * expr Utils.Pos.marked list * EnumName.t
| EArray of expr Utils.Pos.marked list
| EVar of expr Bindlib.var Pos.marked
| ETuple of expr Pos.marked list * StructName.t option
(** The [MarkedString.info] is the former struct field name*)
| ETupleAccess of expr Pos.marked * int * StructName.t option * typ Pos.marked list
(** The [MarkedString.info] is the former struct field name *)
| EInj of expr Pos.marked * int * EnumName.t * typ Pos.marked list
(** The [MarkedString.info] is the former enum case name *)
| EMatch of expr Pos.marked * expr Pos.marked list * EnumName.t
(** The [MarkedString.info] is the former enum case name *)
| EArray of expr Pos.marked list
| ELit of lit
| EAbs of Utils.Pos.t * (expr, expr Utils.Pos.marked) Bindlib.mbinder *
typ Utils.Pos.marked list
| EApp of expr Utils.Pos.marked * expr Utils.Pos.marked list
| EAssert of expr Utils.Pos.marked
| EAbs of Pos.t * (expr, expr Pos.marked) Bindlib.mbinder * typ Pos.marked list
| EApp of expr Pos.marked * expr Pos.marked list
| EAssert of expr Pos.marked
| EOp of operator
| EDefault of expr Utils.Pos.marked list * expr Utils.Pos.marked *
expr Utils.Pos.marked
| EIfThenElse of expr Utils.Pos.marked * expr Utils.Pos.marked *
expr Utils.Pos.marked
type struct_ctx = (StructFieldName.t * typ Utils.Pos.marked) list StructMap.t
type enum_ctx = (EnumConstructor.t * typ Utils.Pos.marked) list EnumMap.t
type decl_ctx = { ctx_enums : enum_ctx; ctx_structs : struct_ctx; }
module Var :
sig
type t = expr Bindlib.var
val make : string Utils.Pos.marked -> t
val compare : 'a Bindlib.var -> 'b Bindlib.var -> int
end
module VarMap :
sig
type key = Var.t
type 'a t = 'a Stdlib__map.Make(Var).t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
| EDefault of expr Pos.marked list * expr Pos.marked * expr Pos.marked
| EIfThenElse of expr Pos.marked * expr Pos.marked * expr Pos.marked
type struct_ctx = (StructFieldName.t * typ Pos.marked) list StructMap.t
type enum_ctx = (EnumConstructor.t * typ Pos.marked) list EnumMap.t
type decl_ctx = { ctx_enums : enum_ctx; ctx_structs : struct_ctx }
(** {1 Variable helpers} *)
module Var : sig
type t = expr Bindlib.var
val make : string Pos.marked -> t
val compare : t -> t -> int
end
module VarMap : Map.S with type key = Var.t
type vars = expr Bindlib.mvar
val make_var : Var.t Utils.Pos.marked -> expr Utils.Pos.marked Bindlib.box
val make_var : Var.t Pos.marked -> expr Pos.marked Bindlib.box
val make_abs :
vars ->
expr Utils.Pos.marked Bindlib.box ->
Utils.Pos.t ->
typ Utils.Pos.marked list ->
Utils.Pos.t -> expr Utils.Pos.marked Bindlib.box
vars -> expr Pos.marked Bindlib.box -> Pos.t -> typ Pos.marked list -> Pos.t ->
expr Pos.marked Bindlib.box
val make_app :
expr Utils.Pos.marked Bindlib.box ->
expr Utils.Pos.marked Bindlib.box list ->
Utils.Pos.t -> expr Utils.Pos.marked Bindlib.box
expr Pos.marked Bindlib.box -> expr Pos.marked Bindlib.box list -> Pos.t ->
expr Pos.marked Bindlib.box
val make_let_in :
Var.t ->
typ Utils.Pos.marked ->
expr Utils.Pos.marked Bindlib.box ->
expr Utils.Pos.marked Bindlib.box -> expr Utils.Pos.marked Bindlib.box
Var.t -> typ Pos.marked -> expr Pos.marked Bindlib.box -> expr Pos.marked Bindlib.box ->
expr Pos.marked Bindlib.box
val make_multiple_let_in :
Var.t array ->
typ Utils.Pos.marked list ->
expr Utils.Pos.marked list Bindlib.box ->
expr Utils.Pos.marked Bindlib.box -> expr Utils.Pos.marked Bindlib.box
type binder = (expr, expr Utils.Pos.marked) Bindlib.binder
Var.t array -> typ Pos.marked list ->
expr Pos.marked list Bindlib.box ->
expr Pos.marked Bindlib.box ->
expr Pos.marked Bindlib.box
type binder = (expr, expr Pos.marked) Bindlib.binder
type program = {
decl_ctx : decl_ctx;
scopes : (Var.t * expr Utils.Pos.marked) list;
scopes : (Var.t * expr Pos.marked) list;
}

View File

@ -450,8 +450,6 @@ and evaluate_expr (ctx : Ast.decl_ctx) (e : A.expr Pos.marked) : A.expr Pos.mark
(** {1 API} *)
(** Interpret a program. This function expects an expression typed as a function whose argument are
all thunked. The function is executed by providing for each argument a thunked empty default. *)
let interpret_program (ctx : Ast.decl_ctx) (e : Ast.expr Pos.marked) :
(Uid.MarkedString.info * Ast.expr Pos.marked) list =
match Pos.unmark (evaluate_expr ctx e) with

View File

@ -1,18 +1,41 @@
module A = Ast
val is_empty_error : A.expr Utils.Pos.marked -> bool
val empty_thunked_term : Ast.expr Utils.Pos.marked
val type_eq : A.typ Utils.Pos.marked -> A.typ Utils.Pos.marked -> bool
val log_indent : int ref
val compare_periods :
CalendarLib.Date.Period.t Utils.Pos.marked ->
CalendarLib.Date.Period.t Utils.Pos.marked -> int
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** Reference interpreter for the default calculus *)
open Utils
(** {1 Helpers} *)
val is_empty_error : Ast.expr Pos.marked -> bool
val empty_thunked_term : Ast.expr Pos.marked
val type_eq : Ast.typ Pos.marked -> Ast.typ Pos.marked -> bool
(** {1 Evaluation} *)
val evaluate_operator :
Ast.decl_ctx ->
A.operator Utils.Pos.marked ->
A.expr Utils.Pos.marked list -> A.expr Utils.Pos.marked
Ast.decl_ctx -> Ast.operator Pos.marked -> Ast.expr Pos.marked list ->
Ast.expr Pos.marked
val evaluate_expr :
Ast.decl_ctx -> A.expr Utils.Pos.marked -> A.expr Utils.Pos.marked
Ast.decl_ctx -> Ast.expr Pos.marked -> Ast.expr Pos.marked
(** {1 API} *)
(** Interpret a program. This function expects an expression typed as a function whose argument are
all thunked. The function is executed by providing for each argument a thunked empty default. *)
val interpret_program :
Ast.decl_ctx ->
Ast.expr Utils.Pos.marked ->
(Utils.Uid.MarkedString.info * Ast.expr Utils.Pos.marked) list
Ast.expr Pos.marked ->
(Uid.MarkedString.info * Ast.expr Pos.marked) list

View File

@ -1,22 +1,34 @@
val typ_needs_parens : Ast.typ Utils.Pos.marked -> bool
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
open Utils
(** {1 Helpers} *)
val is_uppercase : CamomileLibraryDefault.Camomile.UChar.t -> bool
val begins_with_uppercase : string -> bool
val format_uid_list :
Format.formatter -> Utils.Uid.MarkedString.info list -> unit
(** {1 Formatters} *)
val format_uid_list : Format.formatter -> Uid.MarkedString.info list -> unit
val format_tlit : Format.formatter -> Ast.typ_lit -> unit
val format_typ :
Ast.decl_ctx ->
Format.formatter -> Ast.typ Utils.Pos.marked -> unit
val format_lit : Format.formatter -> Ast.lit Utils.Pos.marked -> unit
val format_typ : Ast.decl_ctx -> Format.formatter -> Ast.typ Pos.marked -> unit
val format_lit : Format.formatter -> Ast.lit Pos.marked -> unit
val format_op_kind : Format.formatter -> Ast.op_kind -> unit
val format_binop :
Format.formatter -> Ast.binop Utils.Pos.marked -> unit
val format_ternop :
Format.formatter -> Ast.ternop Utils.Pos.marked -> unit
val format_binop : Format.formatter -> Ast.binop Pos.marked -> unit
val format_ternop : Format.formatter -> Ast.ternop Pos.marked -> unit
val format_log_entry : Format.formatter -> Ast.log_entry -> unit
val format_unop : Format.formatter -> Ast.unop Utils.Pos.marked -> unit
val needs_parens : Ast.expr Utils.Pos.marked -> bool
val format_unop : Format.formatter -> Ast.unop Pos.marked -> unit
val format_var : Format.formatter -> Ast.Var.t -> unit
val format_expr :
Ast.decl_ctx ->
Format.formatter -> Ast.expr Utils.Pos.marked -> unit
val format_expr : Ast.decl_ctx -> Format.formatter -> Ast.expr Pos.marked -> unit

View File

@ -1,46 +1,76 @@
module A = Ast
module Any :
sig
type t
type info = unit
val fresh : info -> t
val get_info : t -> info
val compare : t -> t -> int
val format_t : Format.formatter -> t -> unit
val hash : t -> int
end
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** Typing for the default calculus. Because of the error terms, we perform type inference using the
classical W algorithm with union-find unification. *)
open Utils
(** {1 Types and unification} *)
module Any : Uid.Id with type info = unit
(** We do not reuse {!type: Dcalc.Ast.typ} because we have to include a new [TAny] variant. Indeed,
error terms can have any type and this has to be captured by the type sytem. *)
type typ =
TLit of A.typ_lit
| TArrow of typ Utils.Pos.marked UnionFind.elem *
typ Utils.Pos.marked UnionFind.elem
| TTuple of typ Utils.Pos.marked UnionFind.elem list *
Ast.StructName.t option
| TEnum of typ Utils.Pos.marked UnionFind.elem list * Ast.EnumName.t
| TArray of typ Utils.Pos.marked UnionFind.elem
| TLit of Ast.typ_lit
| TArrow of typ Pos.marked UnionFind.elem * typ Pos.marked UnionFind.elem
| TTuple of typ Pos.marked UnionFind.elem list * Ast.StructName.t option
| TEnum of typ Pos.marked UnionFind.elem list * Ast.EnumName.t
| TArray of typ Pos.marked UnionFind.elem
| TAny of Any.t
val typ_needs_parens : typ Utils.Pos.marked UnionFind.elem -> bool
val typ_needs_parens :
typ Utils.Pos.marked UnionFind.elem -> bool
val format_typ :
Ast.decl_ctx ->
Format.formatter -> typ Utils.Pos.marked UnionFind.elem -> unit
Ast.decl_ctx -> Format.formatter -> typ Utils.Pos.marked UnionFind.elem -> unit
(** Raises an error if unification cannot be performed *)
val unify :
Ast.decl_ctx ->
typ Utils.Pos.marked UnionFind.elem ->
typ Utils.Pos.marked UnionFind.elem -> unit
Ast.decl_ctx -> typ Utils.Pos.marked UnionFind.elem -> typ Utils.Pos.marked UnionFind.elem -> unit
(** Operators have a single type, instead of being polymorphic with constraints. This allows us to
have a simpler type system, while we argue the syntactic burden of operator annotations helps
the programmer visualize the type flow in the code. *)
val op_type :
A.operator Utils.Pos.marked -> typ Utils.Pos.marked UnionFind.elem
val ast_to_typ : A.typ -> typ
Ast.operator Utils.Pos.marked -> typ Utils.Pos.marked UnionFind.elem
val ast_to_typ :
Ast.typ -> typ
val typ_to_ast :
typ Utils.Pos.marked UnionFind.elem -> A.typ Utils.Pos.marked
type env = typ Utils.Pos.marked UnionFind.elem A.VarMap.t
typ Utils.Pos.marked UnionFind.elem -> Ast.typ Utils.Pos.marked
(** {1 Double-directed typing} *)
type env = typ Utils.Pos.marked UnionFind.elem Ast.VarMap.t
(** Infers the most permissive type from an expression *)
val typecheck_expr_bottom_up :
Ast.decl_ctx ->
env -> A.expr Utils.Pos.marked -> typ Utils.Pos.marked UnionFind.elem
Ast.decl_ctx -> env -> Ast.expr Utils.Pos.marked ->
typ Utils.Pos.marked UnionFind.elem
(** Checks whether the expression can be typed with the provided type *)
val typecheck_expr_top_down :
Ast.decl_ctx ->
env ->
A.expr Utils.Pos.marked -> typ Utils.Pos.marked UnionFind.elem -> unit
Ast.decl_ctx -> env -> Ast.expr Utils.Pos.marked -> typ Utils.Pos.marked UnionFind.elem ->
unit
val infer_type :
Ast.decl_ctx -> A.expr Utils.Pos.marked -> A.typ Utils.Pos.marked
Ast.decl_ctx -> Ast.expr Utils.Pos.marked ->
Ast.typ Utils.Pos.marked
val check_type :
Ast.decl_ctx ->
A.expr Utils.Pos.marked -> A.typ Utils.Pos.marked -> unit
Ast.decl_ctx -> Ast.expr Utils.Pos.marked -> Ast.typ Utils.Pos.marked ->
unit

View File

@ -1,281 +1,87 @@
module IdentMap :
sig
type key = String.t
type +'a t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
module RuleName :
sig
type t
type info = Utils.Uid.MarkedString.info
val fresh : info -> t
val get_info : t -> info
val compare : t -> t -> int
val format_t : Format.formatter -> t -> unit
val hash : t -> int
end
module RuleMap :
sig
type key = RuleName.t
type +'a t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
module RuleSet :
sig
type elt = RuleName.t
type t
val empty : t
val is_empty : t -> bool
val mem : elt -> t -> bool
val add : elt -> t -> t
val singleton : elt -> t
val remove : elt -> t -> t
val union : t -> t -> t
val inter : t -> t -> t
val disjoint : t -> t -> bool
val diff : t -> t -> t
val compare : t -> t -> int
val equal : t -> t -> bool
val subset : t -> t -> bool
val iter : (elt -> unit) -> t -> unit
val map : (elt -> elt) -> t -> t
val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
val for_all : (elt -> bool) -> t -> bool
val exists : (elt -> bool) -> t -> bool
val filter : (elt -> bool) -> t -> t
val filter_map : (elt -> elt option) -> t -> t
val partition : (elt -> bool) -> t -> t * t
val cardinal : t -> int
val elements : t -> elt list
val min_elt : t -> elt
val min_elt_opt : t -> elt option
val max_elt : t -> elt
val max_elt_opt : t -> elt option
val choose : t -> elt
val choose_opt : t -> elt option
val split : elt -> t -> t * bool * t
val find : elt -> t -> elt
val find_opt : elt -> t -> elt option
val find_first : (elt -> bool) -> t -> elt
val find_first_opt : (elt -> bool) -> t -> elt option
val find_last : (elt -> bool) -> t -> elt
val find_last_opt : (elt -> bool) -> t -> elt option
val of_list : elt list -> t
val to_seq_from : elt -> t -> elt Seq.t
val to_seq : t -> elt Seq.t
val add_seq : elt Seq.t -> t -> t
val of_seq : elt Seq.t -> t
end
module ScopeDef :
sig
type t =
Var of Scopelang.Ast.ScopeVar.t
| SubScopeVar of Scopelang.Ast.SubScopeName.t *
Scopelang.Ast.ScopeVar.t
val compare : t -> t -> int
val get_position : t -> Utils.Pos.t
val format_t : Format.formatter -> t -> unit
val hash : t -> int
end
module ScopeDefMap :
sig
type key = ScopeDef.t
type +'a t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
module ScopeDefSet :
sig
type elt = ScopeDef.t
type t
val empty : t
val is_empty : t -> bool
val mem : elt -> t -> bool
val add : elt -> t -> t
val singleton : elt -> t
val remove : elt -> t -> t
val union : t -> t -> t
val inter : t -> t -> t
val disjoint : t -> t -> bool
val diff : t -> t -> t
val compare : t -> t -> int
val equal : t -> t -> bool
val subset : t -> t -> bool
val iter : (elt -> unit) -> t -> unit
val map : (elt -> elt) -> t -> t
val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
val for_all : (elt -> bool) -> t -> bool
val exists : (elt -> bool) -> t -> bool
val filter : (elt -> bool) -> t -> t
val filter_map : (elt -> elt option) -> t -> t
val partition : (elt -> bool) -> t -> t * t
val cardinal : t -> int
val elements : t -> elt list
val min_elt : t -> elt
val min_elt_opt : t -> elt option
val max_elt : t -> elt
val max_elt_opt : t -> elt option
val choose : t -> elt
val choose_opt : t -> elt option
val split : elt -> t -> t * bool * t
val find : elt -> t -> elt
val find_opt : elt -> t -> elt option
val find_first : (elt -> bool) -> t -> elt
val find_first_opt : (elt -> bool) -> t -> elt option
val find_last : (elt -> bool) -> t -> elt
val find_last_opt : (elt -> bool) -> t -> elt option
val of_list : elt list -> t
val to_seq_from : elt -> t -> elt Seq.t
val to_seq : t -> elt Seq.t
val add_seq : elt Seq.t -> t -> t
val of_seq : elt Seq.t -> t
end
(* 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
(** Inside a scope, a definition can refer either to a scope def, or a subscope def *)
module ScopeDef : sig
type t =
| Var of Scopelang.Ast.ScopeVar.t
| SubScopeVar of Scopelang.Ast.SubScopeName.t * Scopelang.Ast.ScopeVar.t
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} *)
type rule = {
just : Scopelang.Ast.expr Utils.Pos.marked Bindlib.box;
cons : Scopelang.Ast.expr Utils.Pos.marked Bindlib.box;
parameter :
(Scopelang.Ast.Var.t * Scopelang.Ast.typ Utils.Pos.marked) option;
exception_to_rule : RuleName.t Utils.Pos.marked option;
just : Scopelang.Ast.expr Pos.marked Bindlib.box;
cons : Scopelang.Ast.expr Pos.marked Bindlib.box;
parameter : (Scopelang.Ast.Var.t * Scopelang.Ast.typ Pos.marked) option;
exception_to_rule : RuleName.t Pos.marked option;
}
val empty_rule :
Utils.Pos.t -> Scopelang.Ast.typ Utils.Pos.marked option -> rule
Pos.t -> Scopelang.Ast.typ Pos.marked option -> rule
val always_false_rule :
Utils.Pos.t -> Scopelang.Ast.typ Utils.Pos.marked option -> rule
type assertion = Scopelang.Ast.expr Utils.Pos.marked Bindlib.box
Pos.t -> Scopelang.Ast.typ Pos.marked option -> rule
type assertion = Scopelang.Ast.expr Pos.marked Bindlib.box
type variation_typ = Increasing | Decreasing
type reference_typ = Decree | Law
type meta_assertion =
FixedBy of reference_typ Utils.Pos.marked
| VariesWith of unit * variation_typ Utils.Pos.marked option
| FixedBy of reference_typ Pos.marked
| VariesWith of unit * variation_typ Pos.marked option
type scope = {
scope_vars : Scopelang.Ast.ScopeVarSet.t;
scope_sub_scopes : Scopelang.Ast.ScopeName.t Scopelang.Ast.SubScopeMap.t;
scope_uid : Scopelang.Ast.ScopeName.t;
scope_defs :
(rule RuleMap.t * Scopelang.Ast.typ Utils.Pos.marked * bool)
ScopeDefMap.t;
(rule RuleMap.t * Scopelang.Ast.typ Pos.marked * bool) (* is it a condition? *) ScopeDefMap.t;
scope_assertions : assertion list;
scope_meta_assertions : meta_assertion list;
}
type program = {
program_scopes : scope Scopelang.Ast.ScopeMap.t;
program_enums : Scopelang.Ast.enum_ctx;
program_structs : Scopelang.Ast.struct_ctx;
}
val free_variables : rule RuleMap.t -> Utils.Pos.t ScopeDefMap.t
(** {1 Helpers} *)
val free_variables : rule RuleMap.t -> Pos.t ScopeDefMap.t

View File

@ -1,185 +1,95 @@
module Vertex :
sig
type t =
Var of Scopelang.Ast.ScopeVar.t
| SubScope of Scopelang.Ast.SubScopeName.t
val hash : t -> int
val compare : 'a -> 'a -> int
val equal : t -> t -> bool
val format_t : Format.formatter -> t -> unit
end
module Edge :
sig
type t = Utils.Pos.t
val compare : 'a -> 'a -> int
val default : Utils.Pos.t
end
module ScopeDependencies :
sig
type t =
Graph__Persistent.Digraph.ConcreteBidirectionalLabeled(Vertex)(Edge).t
module V :
sig
type t = Vertex.t
val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool
type label = Vertex.t
val create : label -> t
val label : t -> label
end
type vertex = V.t
module E :
sig
type t = Vertex.t * Edge.t * Vertex.t
val compare : t -> t -> int
type nonrec vertex = vertex
val src : t -> vertex
val dst : t -> vertex
type label = Edge.t
val create : vertex -> label -> vertex -> t
val label : t -> label
end
type edge = E.t
val is_directed : bool
val is_empty : t -> bool
val nb_vertex : t -> int
val nb_edges : t -> int
val out_degree : t -> vertex -> int
val in_degree : t -> vertex -> int
val mem_vertex : t -> vertex -> bool
val mem_edge : t -> vertex -> vertex -> bool
val mem_edge_e : t -> edge -> bool
val find_edge : t -> vertex -> vertex -> edge
val find_all_edges : t -> vertex -> vertex -> edge list
val succ : t -> vertex -> vertex list
val pred : t -> vertex -> vertex list
val succ_e : t -> vertex -> edge list
val pred_e : t -> vertex -> edge list
val iter_vertex : (vertex -> unit) -> t -> unit
val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges : (vertex -> vertex -> unit) -> t -> unit
val fold_edges : (vertex -> vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges_e : (edge -> unit) -> t -> unit
val fold_edges_e : (edge -> 'a -> 'a) -> t -> 'a -> 'a
val map_vertex : (vertex -> vertex) -> t -> t
val iter_succ : (vertex -> unit) -> t -> vertex -> unit
val iter_pred : (vertex -> unit) -> t -> vertex -> unit
val fold_succ : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val fold_pred : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
val fold_succ_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
val fold_pred_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val empty : t
val add_vertex : t -> vertex -> t
val remove_vertex : t -> vertex -> t
val add_edge : t -> vertex -> vertex -> t
val add_edge_e : t -> edge -> t
val remove_edge : t -> vertex -> vertex -> t
val remove_edge_e : t -> edge -> t
end
module TopologicalTraversal :
sig
val fold :
(ScopeDependencies.V.t -> 'a -> 'a) -> ScopeDependencies.t -> 'a -> 'a
val iter : (ScopeDependencies.V.t -> unit) -> ScopeDependencies.t -> unit
end
module SCC :
sig
val scc : ScopeDependencies.t -> int * (ScopeDependencies.V.t -> int)
val scc_array : ScopeDependencies.t -> ScopeDependencies.V.t list array
val scc_list : ScopeDependencies.t -> ScopeDependencies.V.t list list
end
(* 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. *)
(** Scope dependencies computations using {{:http://ocamlgraph.lri.fr/} OCamlgraph} *)
open Utils
(** {1 Scope variables dependency graph} *)
(** {2 Graph declaration} *)
(** Vertices: scope variables or subscopes.
The vertices of the scope dependency graph are either :
- the variables of the scope ;
- the subscopes of the scope.
Indeed, during interpretation, subscopes are executed atomically. *)
module Vertex : sig
type t =
| Var of Scopelang.Ast.ScopeVar.t
| SubScope of Scopelang.Ast.SubScopeName.t
val format_t : Format.formatter -> t -> unit
include Graph.Sig.COMPARABLE with type t := t
end
(** On the edges, the label is the position of the expression responsible for the use of the
variable. In the graph, [x -> y] if [x] is used in the definition of [y].*)
module Edge : Graph.Sig.ORDERED_TYPE_DFT with type t = Pos.t
(** Module of the graph, provided by OCamlGraph *)
module ScopeDependencies : Graph.Sig.P
with type V.t = Vertex.t
and type E.label = Edge.t
(** Module of the topological traversal of the graph, provided by OCamlGraph *)
module TopologicalTraversal : sig
val fold : (Vertex.t -> 'a -> 'a) -> ScopeDependencies.t -> 'a -> 'a
val iter : (Vertex.t -> unit) -> ScopeDependencies.t -> unit
end
(** Tarjan's stongly connected components algorithm, provided by OCamlGraph *)
module SCC : sig
val scc : ScopeDependencies.t -> int * (Vertex.t -> int)
val scc_array : ScopeDependencies.t -> Vertex.t list array
val scc_list : ScopeDependencies.t -> Vertex.t list list
end
(** {2 Graph computations} *)
(** Returns an ordering of the scope variables and subscope compatible with the dependencies of the
computation *)
(** Returns an ordering of the scope variables and subscope compatible with the dependencies of the
computation *)
val correct_computation_ordering : ScopeDependencies.t -> Vertex.t list
(** Outputs an error in case of cycles. *)
val check_for_cycle : Ast.scope -> ScopeDependencies.t -> unit
(** Builds the dependency graph of a particular scope *)
val build_scope_dependencies : Ast.scope -> ScopeDependencies.t
module ExceptionVertex :
sig
type t = Desugared__Ast.RuleName.t
type info = Utils.Uid.MarkedString.info
val fresh : info -> t
val get_info : t -> info
val compare : t -> t -> int
val format_t : Format.formatter -> t -> unit
val hash : t -> int
val equal : t -> t -> bool
end
module ExceptionsDependencies :
sig
type t =
Graph__Persistent.Digraph.ConcreteBidirectionalLabeled(ExceptionVertex)(Edge).t
module V :
sig
type t = ExceptionVertex.t
val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool
type label = ExceptionVertex.t
val create : label -> t
val label : t -> label
end
type vertex = V.t
module E :
sig
type t = ExceptionVertex.t * Edge.t * ExceptionVertex.t
val compare : t -> t -> int
type nonrec vertex = vertex
val src : t -> vertex
val dst : t -> vertex
type label = Edge.t
val create : vertex -> label -> vertex -> t
val label : t -> label
end
type edge = E.t
val is_directed : bool
val is_empty : t -> bool
val nb_vertex : t -> int
val nb_edges : t -> int
val out_degree : t -> vertex -> int
val in_degree : t -> vertex -> int
val mem_vertex : t -> vertex -> bool
val mem_edge : t -> vertex -> vertex -> bool
val mem_edge_e : t -> edge -> bool
val find_edge : t -> vertex -> vertex -> edge
val find_all_edges : t -> vertex -> vertex -> edge list
val succ : t -> vertex -> vertex list
val pred : t -> vertex -> vertex list
val succ_e : t -> vertex -> edge list
val pred_e : t -> vertex -> edge list
val iter_vertex : (vertex -> unit) -> t -> unit
val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges : (vertex -> vertex -> unit) -> t -> unit
val fold_edges : (vertex -> vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges_e : (edge -> unit) -> t -> unit
val fold_edges_e : (edge -> 'a -> 'a) -> t -> 'a -> 'a
val map_vertex : (vertex -> vertex) -> t -> t
val iter_succ : (vertex -> unit) -> t -> vertex -> unit
val iter_pred : (vertex -> unit) -> t -> vertex -> unit
val fold_succ : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val fold_pred : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
val fold_succ_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
val fold_pred_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val empty : t
val add_vertex : t -> vertex -> t
val remove_vertex : t -> vertex -> t
val add_edge : t -> vertex -> vertex -> t
val add_edge_e : t -> edge -> t
val remove_edge : t -> vertex -> vertex -> t
val remove_edge_e : t -> edge -> t
end
module ExceptionsSCC :
sig
val scc :
ExceptionsDependencies.t -> int * (ExceptionsDependencies.V.t -> int)
val scc_array :
ExceptionsDependencies.t -> ExceptionsDependencies.V.t list array
val scc_list :
ExceptionsDependencies.t -> ExceptionsDependencies.V.t list list
end
val build_exceptions_graph :
Ast.rule Ast.RuleMap.t ->
Ast.ScopeDef.t -> ExceptionsDependencies.t
(** {1 Exceptions dependency graph} *)
module ExceptionsDependencies : Graph.Sig.P
with type V.t = Ast.RuleName.t
and type E.label = Edge.t
module ExceptionsSCC : sig
val scc : ExceptionsDependencies.t -> int * (Ast.RuleName.t -> int)
val scc_array : ExceptionsDependencies.t -> Ast.RuleName.t list array
val scc_list : ExceptionsDependencies.t -> Ast.RuleName.t list list
end
val build_exceptions_graph : Ast.rule Ast.RuleMap.t -> Ast.ScopeDef.t -> ExceptionsDependencies.t
val check_for_exception_cycle : ExceptionsDependencies.t -> unit

View File

@ -1,18 +1,50 @@
type rule_tree =
Leaf of Ast.rule
| Node of rule_tree list * Ast.rule
val def_map_to_tree :
Ast.ScopeDef.t ->
Ast.rule Ast.RuleMap.t -> rule_tree list
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** Translation from {!module: Desugared.Ast} to {!module: Scopelang.Ast} *)
open Utils
(** {1 Rule tree construction} *)
type rule_tree = Leaf of Ast.rule | Node of rule_tree list * Ast.rule
(** Transforms a flat list of rules into a tree, taking into account the priorities declared between
rules *)
val def_map_to_tree : Ast.ScopeDef.t -> Ast.rule Ast.RuleMap.t -> rule_tree list
(** From the {!type: rule_tree}, builds an {!constructor: Dcalc.Ast.EDefault} expression in the
scope language. The [~toplevel] parameter is used to know when to place the toplevel binding in
the case of functions. *)
val rule_tree_to_expr :
toplevel:bool ->
Utils.Pos.t ->
Scopelang.Ast.Var.t option ->
rule_tree -> Scopelang.Ast.expr Utils.Pos.marked Bindlib.box
toplevel:bool -> Pos.t -> Scopelang.Ast.Var.t option -> rule_tree ->
Scopelang.Ast.expr Pos.marked Bindlib.box
(** {1 AST translation} *)
(** Translates a definition inside a scope, the resulting expression should be an {!constructor:
Dcalc.Ast.EDefault} *)
val translate_def :
Ast.ScopeDef.t ->
Ast.rule Ast.RuleMap.t ->
Scopelang.Ast.typ Utils.Pos.marked ->
bool -> Scopelang.Ast.expr Utils.Pos.marked
Scopelang.Ast.typ Pos.marked ->
bool ->
Scopelang.Ast.expr Pos.marked
val translate_scope : Ast.scope -> Scopelang.Ast.scope_decl
(** {1 API} *)
val translate_program : Ast.program -> Scopelang.Ast.program

View File

@ -1,103 +1,95 @@
module D = Dcalc.Ast
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
open Utils
(** Abstract syntax tree for the lambda calculus *)
(** {1 Abstract syntax tree} *)
(** The expressions use the {{:https://lepigre.fr/ocaml-bindlib/} Bindlib} library, based on
higher-order abstract syntax*)
type lit =
LBool of bool
| LBool of bool
| LInt of Z.t
| LRat of Q.t
| LMoney of Z.t
| LUnit
| LDate of D.date
| LDuration of D.duration
| LDate of Dcalc.Ast.date
| LDuration of Dcalc.Ast.duration
type except = ConflictError | EmptyError | Crash
type expr =
EVar of expr Bindlib.var Utils.Pos.marked
| ETuple of expr Utils.Pos.marked list * D.StructName.t option
| ETupleAccess of expr Utils.Pos.marked * int * D.StructName.t option *
D.typ Utils.Pos.marked list
| EInj of expr Utils.Pos.marked * int * D.EnumName.t *
D.typ Utils.Pos.marked list
| EMatch of expr Utils.Pos.marked * expr Utils.Pos.marked list *
D.EnumName.t
| EArray of expr Utils.Pos.marked list
| EVar of expr Bindlib.var Pos.marked
| ETuple of expr Pos.marked list * Dcalc.Ast.StructName.t option
(** The [MarkedString.info] is the former struct field name*)
| ETupleAccess of expr Pos.marked * int * Dcalc.Ast.StructName.t option * Dcalc.Ast.typ Pos.marked list
(** The [MarkedString.info] is the former struct field name *)
| EInj of expr Pos.marked * int * Dcalc.Ast.EnumName.t * Dcalc.Ast.typ Pos.marked list
(** The [MarkedString.info] is the former enum case name *)
| EMatch of expr Pos.marked * expr Pos.marked list * Dcalc.Ast.EnumName.t
(** The [MarkedString.info] is the former enum case name *)
| EArray of expr Pos.marked list
| ELit of lit
| EAbs of Utils.Pos.t * (expr, expr Utils.Pos.marked) Bindlib.mbinder *
D.typ Utils.Pos.marked list
| EApp of expr Utils.Pos.marked * expr Utils.Pos.marked list
| EAssert of expr Utils.Pos.marked
| EOp of D.operator
| EIfThenElse of expr Utils.Pos.marked * expr Utils.Pos.marked *
expr Utils.Pos.marked
| EAbs of Pos.t * (expr, expr Pos.marked) Bindlib.mbinder * Dcalc.Ast.typ Pos.marked list
| EApp of expr Pos.marked * expr Pos.marked list
| EAssert of expr Pos.marked
| EOp of Dcalc.Ast.operator
| EIfThenElse of expr Pos.marked * expr Pos.marked * expr Pos.marked
| ERaise of except
| ECatch of expr Utils.Pos.marked * except * expr Utils.Pos.marked
module Var :
sig
type t = expr Bindlib.var
val make : string Utils.Pos.marked -> t
val compare : 'a Bindlib.var -> 'b Bindlib.var -> int
end
module VarMap :
sig
type key = Var.t
type 'a t = 'a Stdlib__map.Make(Var).t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
| ECatch of expr Pos.marked * except * expr Pos.marked
(** {1 Variable helpers} *)
module Var : sig
type t = expr Bindlib.var
val make : string Pos.marked -> t
val compare : t -> t -> int
end
module VarMap : Map.S with type key = Var.t
type vars = expr Bindlib.mvar
val make_var : Var.t Utils.Pos.marked -> expr Utils.Pos.marked Bindlib.box
val make_var : Var.t Pos.marked -> expr Pos.marked Bindlib.box
val make_abs :
vars ->
expr Utils.Pos.marked Bindlib.box ->
Utils.Pos.t ->
D.typ Utils.Pos.marked list ->
Utils.Pos.t -> expr Utils.Pos.marked Bindlib.box
expr Pos.marked Bindlib.box ->
Pos.t ->
Dcalc.Ast.typ Pos.marked list ->
Pos.t ->
expr Pos.marked Bindlib.box
val make_app :
expr Utils.Pos.marked Bindlib.box ->
expr Utils.Pos.marked Bindlib.box list ->
Utils.Pos.t -> expr Utils.Pos.marked Bindlib.box
expr Pos.marked Bindlib.box ->
expr Pos.marked Bindlib.box list ->
Pos.t ->
expr Pos.marked Bindlib.box
val make_let_in :
Var.t ->
D.typ Utils.Pos.marked ->
expr Utils.Pos.marked Bindlib.box ->
expr Utils.Pos.marked Bindlib.box -> expr Utils.Pos.marked Bindlib.box
type binder = (expr, expr Utils.Pos.marked) Bindlib.binder
Dcalc.Ast.typ Pos.marked ->
expr Pos.marked Bindlib.box ->
expr Pos.marked Bindlib.box ->
expr Pos.marked Bindlib.box
type binder = (expr, expr Pos.marked) Bindlib.binder
type program = {
decl_ctx : D.decl_ctx;
scopes : (Var.t * expr Utils.Pos.marked) list;
decl_ctx : Dcalc.Ast.decl_ctx;
scopes : (Var.t * expr Pos.marked) list;
}

View File

@ -1,17 +1,39 @@
module D = Dcalc.Ast
module A = Ast
type ctx = A.expr Utils.Pos.marked Bindlib.box D.VarMap.t
val handle_default : Utils.Pos.t -> A.expr Utils.Pos.marked Bindlib.box
val translate_lit : D.lit -> A.expr
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
open Utils
type ctx = Ast.expr Pos.marked Bindlib.box Dcalc.Ast.VarMap.t
val handle_default : Pos.t -> Ast.expr Pos.marked Bindlib.box
val translate_lit : Dcalc.Ast.lit -> Ast.expr
val thunk_expr :
A.expr Utils.Pos.marked Bindlib.box ->
Utils.Pos.t -> A.expr Utils.Pos.marked Bindlib.box
Ast.expr Pos.marked Bindlib.box ->
Pos.t ->
Ast.expr Pos.marked Bindlib.box
val translate_default :
ctx ->
D.expr Utils.Pos.marked list ->
D.expr Utils.Pos.marked ->
D.expr Utils.Pos.marked ->
Utils.Pos.t -> A.expr Utils.Pos.marked Bindlib.box
Dcalc.Ast.expr Pos.marked list ->
Dcalc.Ast.expr Pos.marked ->
Dcalc.Ast.expr Pos.marked ->
Pos.t ->
Ast.expr Pos.marked Bindlib.box
val translate_expr :
ctx -> D.expr Utils.Pos.marked -> A.expr Utils.Pos.marked Bindlib.box
val translate_program : D.program -> A.program
ctx -> Dcalc.Ast.expr Pos.marked -> Ast.expr Pos.marked Bindlib.box
val translate_program : Dcalc.Ast.program -> Ast.program

View File

@ -14,6 +14,7 @@
open Utils
open Ast
module D = Dcalc.Ast
let format_lit (fmt : Format.formatter) (l : lit Pos.marked) : unit =
match Pos.unmark l with

View File

@ -1,30 +1,37 @@
val format_lit : Format.formatter -> Ast.lit Utils.Pos.marked -> unit
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
open Utils
val format_lit : Format.formatter -> Ast.lit Pos.marked -> unit
val format_op_kind : Format.formatter -> Dcalc.Ast.op_kind -> unit
val format_log_entry : Format.formatter -> Dcalc.Ast.log_entry -> unit
val format_binop :
Format.formatter -> Dcalc.Ast.binop Utils.Pos.marked -> unit
val format_ternop :
Format.formatter -> Dcalc.Ast.ternop Utils.Pos.marked -> unit
val format_unop : Format.formatter -> Dcalc.Ast.unop Utils.Pos.marked -> unit
val format_binop : Format.formatter -> Dcalc.Ast.binop Pos.marked -> unit
val format_ternop : Format.formatter -> Dcalc.Ast.ternop Pos.marked -> unit
val format_unop : Format.formatter -> Dcalc.Ast.unop Pos.marked -> unit
val to_ascii : string -> string
val to_lowercase : string -> string
val format_struct_name : Format.formatter -> Dcalc.Ast.StructName.t -> unit
val format_struct_field_name :
Format.formatter -> Dcalc.Ast.StructFieldName.t -> unit
val format_struct_field_name : Format.formatter -> Dcalc.Ast.StructFieldName.t -> unit
val format_enum_name : Format.formatter -> Dcalc.Ast.EnumName.t -> unit
val format_enum_cons_name :
Format.formatter -> Dcalc.Ast.EnumConstructor.t -> unit
val typ_needs_parens : Dcalc.Ast.typ Utils.Pos.marked -> bool
val format_typ : Format.formatter -> Dcalc.Ast.typ Utils.Pos.marked -> unit
val format_enum_cons_name : Format.formatter -> Dcalc.Ast.EnumConstructor.t -> unit
val typ_needs_parens : Dcalc.Ast.typ Pos.marked -> bool
val format_typ : Format.formatter -> Dcalc.Ast.typ Pos.marked -> unit
val format_var : Format.formatter -> Ast.Var.t -> unit
val needs_parens : Ast.expr Utils.Pos.marked -> bool
val needs_parens : Ast.expr Pos.marked -> bool
val format_exception : Format.formatter -> Ast.except -> unit
val format_expr :
Dcalc.Ast.decl_ctx ->
Format.formatter -> Ast.expr Utils.Pos.marked -> unit
val format_expr : Dcalc.Ast.decl_ctx -> Format.formatter -> Ast.expr Pos.marked -> unit
val format_ctx :
Scopelang.Dependency.TVertex.t list ->
Format.formatter -> Ast.D.decl_ctx -> unit
val format_program :
Format.formatter ->
Ast.program -> Scopelang.Dependency.TVertex.t list -> unit
Scopelang.Dependency.TVertex.t list -> Format.formatter -> Dcalc.Ast.decl_ctx -> unit
val format_program : Format.formatter -> Ast.program -> Scopelang.Dependency.TVertex.t list -> unit

View File

@ -1,24 +1,59 @@
module A = Surface.Ast
module P = Printf
module R = Re.Pcre
module C = Utils.Cli
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** This modules weaves the source code and the legislative text together into a document that law
professionals can understand. *)
open Utils
(** {1 Helpers} *)
(** Converts double lines into HTML newlines. *)
val pre_html : string -> string
(** Raise an error if pygments cannot be found *)
val raise_failed_pygments : string -> int -> 'a
(** Usage: [wrap_html source_files custom_pygments language fmt wrapped]
Prints an HTML complete page structure around the [wrapped] content. *)
val wrap_html :
string list ->
string option ->
Utils.Cli.backend_lang ->
Format.formatter -> (Format.formatter -> unit) -> unit
Cli.backend_lang ->
Format.formatter ->
(Format.formatter -> unit) -> unit
(** Performs syntax highlighting on a piece of code by using Pygments and the special Catala lexer. *)
val pygmentize_code :
string Utils.Pos.marked -> C.backend_lang -> string option -> string
string Pos.marked -> Cli.backend_lang -> string option -> string
(** {1 Weaving} *)
val law_article_item_to_html :
string option ->
C.backend_lang -> Format.formatter -> A.law_article_item -> unit
Cli.backend_lang -> Format.formatter -> Surface.Ast.law_article_item -> unit
val law_structure_to_html :
string option ->
C.backend_lang -> Format.formatter -> A.law_structure -> unit
Cli.backend_lang -> Format.formatter -> Surface.Ast.law_structure -> unit
val program_item_to_html :
string option ->
C.backend_lang -> Format.formatter -> A.program_item -> unit
Cli.backend_lang -> Format.formatter -> Surface.Ast.program_item -> unit
(** {1 API} *)
val ast_to_html :
string option -> C.backend_lang -> Format.formatter -> A.program -> unit
string option -> Cli.backend_lang -> Format.formatter -> Surface.Ast.program -> unit

View File

@ -1,16 +1,47 @@
module A = Surface.Ast
module R = Re.Pcre
module C = Utils.Cli
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** This modules weaves the source code and the legislative text together into a document that law
professionals can understand. *)
open Utils
(** {1 Helpers} *)
(** Espaces various LaTeX-sensitive characters *)
val pre_latexify : string -> string
(** Usage: [wrap_latex source_files custom_pygments language fmt wrapped]
Prints an LaTeX complete documùent structure around the [wrapped] content. *)
val wrap_latex :
string list ->
string option ->
C.backend_lang -> Format.formatter -> (Format.formatter -> unit) -> unit
Cli.backend_lang -> Format.formatter -> (Format.formatter -> unit) -> unit
(** Replaces math operators by their nice unicode counterparts *)
val math_syms_replace : string -> string
(** {1 Weaving} *)
val law_article_item_to_latex :
C.backend_lang -> Format.formatter -> A.law_article_item -> unit
Cli.backend_lang -> Format.formatter -> Surface.Ast.law_article_item -> unit
val law_structure_to_latex :
C.backend_lang -> Format.formatter -> A.law_structure -> unit
Cli.backend_lang -> Format.formatter -> Surface.Ast.law_structure -> unit
val program_item_to_latex :
C.backend_lang -> Format.formatter -> A.program_item -> unit
val ast_to_latex : C.backend_lang -> Format.formatter -> A.program -> unit
Cli.backend_lang -> Format.formatter -> Surface.Ast.program_item -> unit
(** {1 API} *)
val ast_to_latex : Cli.backend_lang -> Format.formatter -> Surface.Ast.program -> unit

View File

@ -1,551 +1,136 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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 scope language *)
open Utils
(** {1 Identifiers} *)
module ScopeName = Dcalc.Ast.ScopeName
module ScopeNameSet :
sig
type elt = ScopeName.t
type t
val empty : t
val is_empty : t -> bool
val mem : elt -> t -> bool
val add : elt -> t -> t
val singleton : elt -> t
val remove : elt -> t -> t
val union : t -> t -> t
val inter : t -> t -> t
val disjoint : t -> t -> bool
val diff : t -> t -> t
val compare : t -> t -> int
val equal : t -> t -> bool
val subset : t -> t -> bool
val iter : (elt -> unit) -> t -> unit
val map : (elt -> elt) -> t -> t
val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
val for_all : (elt -> bool) -> t -> bool
val exists : (elt -> bool) -> t -> bool
val filter : (elt -> bool) -> t -> t
val filter_map : (elt -> elt option) -> t -> t
val partition : (elt -> bool) -> t -> t * t
val cardinal : t -> int
val elements : t -> elt list
val min_elt : t -> elt
val min_elt_opt : t -> elt option
val max_elt : t -> elt
val max_elt_opt : t -> elt option
val choose : t -> elt
val choose_opt : t -> elt option
val split : elt -> t -> t * bool * t
val find : elt -> t -> elt
val find_opt : elt -> t -> elt option
val find_first : (elt -> bool) -> t -> elt
val find_first_opt : (elt -> bool) -> t -> elt option
val find_last : (elt -> bool) -> t -> elt
val find_last_opt : (elt -> bool) -> t -> elt option
val of_list : elt list -> t
val to_seq_from : elt -> t -> elt Seq.t
val to_seq : t -> elt Seq.t
val add_seq : elt Seq.t -> t -> t
val of_seq : elt Seq.t -> t
end
module ScopeMap :
sig
type key = ScopeName.t
type +'a t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
module SubScopeName :
sig
type t
type info = Utils.Uid.MarkedString.info
val fresh : info -> t
val get_info : t -> info
val compare : t -> t -> int
val format_t : Format.formatter -> t -> unit
val hash : t -> int
end
module SubScopeNameSet :
sig
type elt = SubScopeName.t
type t
val empty : t
val is_empty : t -> bool
val mem : elt -> t -> bool
val add : elt -> t -> t
val singleton : elt -> t
val remove : elt -> t -> t
val union : t -> t -> t
val inter : t -> t -> t
val disjoint : t -> t -> bool
val diff : t -> t -> t
val compare : t -> t -> int
val equal : t -> t -> bool
val subset : t -> t -> bool
val iter : (elt -> unit) -> t -> unit
val map : (elt -> elt) -> t -> t
val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
val for_all : (elt -> bool) -> t -> bool
val exists : (elt -> bool) -> t -> bool
val filter : (elt -> bool) -> t -> t
val filter_map : (elt -> elt option) -> t -> t
val partition : (elt -> bool) -> t -> t * t
val cardinal : t -> int
val elements : t -> elt list
val min_elt : t -> elt
val min_elt_opt : t -> elt option
val max_elt : t -> elt
val max_elt_opt : t -> elt option
val choose : t -> elt
val choose_opt : t -> elt option
val split : elt -> t -> t * bool * t
val find : elt -> t -> elt
val find_opt : elt -> t -> elt option
val find_first : (elt -> bool) -> t -> elt
val find_first_opt : (elt -> bool) -> t -> elt option
val find_last : (elt -> bool) -> t -> elt
val find_last_opt : (elt -> bool) -> t -> elt option
val of_list : elt list -> t
val to_seq_from : elt -> t -> elt Seq.t
val to_seq : t -> elt Seq.t
val add_seq : elt Seq.t -> t -> t
val of_seq : elt Seq.t -> t
end
module SubScopeMap :
sig
type key = SubScopeName.t
type +'a t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
module ScopeVar :
sig
type t
type info = Utils.Uid.MarkedString.info
val fresh : info -> t
val get_info : t -> info
val compare : t -> t -> int
val format_t : Format.formatter -> t -> unit
val hash : t -> int
end
module ScopeVarSet :
sig
type elt = ScopeVar.t
type t
val empty : t
val is_empty : t -> bool
val mem : elt -> t -> bool
val add : elt -> t -> t
val singleton : elt -> t
val remove : elt -> t -> t
val union : t -> t -> t
val inter : t -> t -> t
val disjoint : t -> t -> bool
val diff : t -> t -> t
val compare : t -> t -> int
val equal : t -> t -> bool
val subset : t -> t -> bool
val iter : (elt -> unit) -> t -> unit
val map : (elt -> elt) -> t -> t
val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
val for_all : (elt -> bool) -> t -> bool
val exists : (elt -> bool) -> t -> bool
val filter : (elt -> bool) -> t -> t
val filter_map : (elt -> elt option) -> t -> t
val partition : (elt -> bool) -> t -> t * t
val cardinal : t -> int
val elements : t -> elt list
val min_elt : t -> elt
val min_elt_opt : t -> elt option
val max_elt : t -> elt
val max_elt_opt : t -> elt option
val choose : t -> elt
val choose_opt : t -> elt option
val split : elt -> t -> t * bool * t
val find : elt -> t -> elt
val find_opt : elt -> t -> elt option
val find_first : (elt -> bool) -> t -> elt
val find_first_opt : (elt -> bool) -> t -> elt option
val find_last : (elt -> bool) -> t -> elt
val find_last_opt : (elt -> bool) -> t -> elt option
val of_list : elt list -> t
val to_seq_from : elt -> t -> elt Seq.t
val to_seq : t -> elt Seq.t
val add_seq : elt Seq.t -> t -> t
val of_seq : elt Seq.t -> t
end
module ScopeVarMap :
sig
type key = ScopeVar.t
type +'a t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
module ScopeNameSet : Set.S with type elt = ScopeName.t
module ScopeMap : Map.S with type key = ScopeName.t
module SubScopeName : Uid.Id with type info = Uid.MarkedString.info
module SubScopeNameSet : Set.S with type elt = SubScopeName.t
module SubScopeMap : Map.S with type key = SubScopeName.t
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
module StructName = Dcalc.Ast.StructName
module StructMap = Dcalc.Ast.StructMap
module StructFieldName = Dcalc.Ast.StructFieldName
module StructFieldMap :
sig
type key = StructFieldName.t
type +'a t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
module StructFieldMap : Map.S with type key = StructFieldName.t
module EnumName = Dcalc.Ast.EnumName
module EnumMap = Dcalc.Ast.EnumMap
module EnumConstructor = Dcalc.Ast.EnumConstructor
module EnumConstructorMap :
sig
type key = EnumConstructor.t
type +'a t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
module EnumConstructorMap : Map.S with type key = EnumConstructor.t
type location =
ScopeVar of ScopeVar.t Utils.Pos.marked
| SubScopeVar of ScopeName.t * SubScopeName.t Utils.Pos.marked *
ScopeVar.t Utils.Pos.marked
module LocationSet :
sig
type elt = location Utils.Pos.marked
type t
val empty : t
val is_empty : t -> bool
val mem : elt -> t -> bool
val add : elt -> t -> t
val singleton : elt -> t
val remove : elt -> t -> t
val union : t -> t -> t
val inter : t -> t -> t
val disjoint : t -> t -> bool
val diff : t -> t -> t
val compare : t -> t -> int
val equal : t -> t -> bool
val subset : t -> t -> bool
val iter : (elt -> unit) -> t -> unit
val map : (elt -> elt) -> t -> t
val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
val for_all : (elt -> bool) -> t -> bool
val exists : (elt -> bool) -> t -> bool
val filter : (elt -> bool) -> t -> t
val filter_map : (elt -> elt option) -> t -> t
val partition : (elt -> bool) -> t -> t * t
val cardinal : t -> int
val elements : t -> elt list
val min_elt : t -> elt
val min_elt_opt : t -> elt option
val max_elt : t -> elt
val max_elt_opt : t -> elt option
val choose : t -> elt
val choose_opt : t -> elt option
val split : elt -> t -> t * bool * t
val find : elt -> t -> elt
val find_opt : elt -> t -> elt option
val find_first : (elt -> bool) -> t -> elt
val find_first_opt : (elt -> bool) -> t -> elt option
val find_last : (elt -> bool) -> t -> elt
val find_last_opt : (elt -> bool) -> t -> elt option
val of_list : elt list -> t
val to_seq_from : elt -> t -> elt Seq.t
val to_seq : t -> elt Seq.t
val add_seq : elt Seq.t -> t -> t
val of_seq : elt Seq.t -> t
end
| ScopeVar of ScopeVar.t Pos.marked
| SubScopeVar of ScopeName.t * SubScopeName.t Pos.marked * ScopeVar.t Pos.marked
module LocationSet : Set.S with type elt = location Pos.marked
(** {1 Abstract syntax tree} *)
type typ =
TLit of Dcalc.Ast.typ_lit
| TLit of Dcalc.Ast.typ_lit
| TStruct of StructName.t
| TEnum of EnumName.t
| TArrow of typ Utils.Pos.marked * typ Utils.Pos.marked
| TArrow of typ Pos.marked * typ Pos.marked
| TArray of typ
| TAny
(** The expressions use the {{:https://lepigre.fr/ocaml-bindlib/} Bindlib} library, based on
higher-order abstract syntax*)
type expr =
ELocation of location
| EVar of expr Bindlib.var Utils.Pos.marked
| EStruct of StructName.t * expr Utils.Pos.marked StructFieldMap.t
| EStructAccess of expr Utils.Pos.marked * StructFieldName.t * StructName.t
| EEnumInj of expr Utils.Pos.marked * EnumConstructor.t * EnumName.t
| EMatch of expr Utils.Pos.marked * EnumName.t *
expr Utils.Pos.marked EnumConstructorMap.t
| ELocation of location
| EVar of expr Bindlib.var Pos.marked
| EStruct of StructName.t * expr Pos.marked StructFieldMap.t
| EStructAccess of expr Pos.marked * StructFieldName.t * StructName.t
| EEnumInj of expr Pos.marked * EnumConstructor.t * EnumName.t
| EMatch of expr Pos.marked * EnumName.t * expr Pos.marked EnumConstructorMap.t
| ELit of Dcalc.Ast.lit
| EAbs of Utils.Pos.t * (expr, expr Utils.Pos.marked) Bindlib.mbinder *
typ Utils.Pos.marked list
| EApp of expr Utils.Pos.marked * expr Utils.Pos.marked list
| EAbs of Pos.t * (expr, expr Pos.marked) Bindlib.mbinder * typ Pos.marked list
| EApp of expr Pos.marked * expr Pos.marked list
| EOp of Dcalc.Ast.operator
| EDefault of expr Utils.Pos.marked list * expr Utils.Pos.marked *
expr Utils.Pos.marked
| EIfThenElse of expr Utils.Pos.marked * expr Utils.Pos.marked *
expr Utils.Pos.marked
| EArray of expr Utils.Pos.marked list
val locations_used : expr Utils.Pos.marked -> LocationSet.t
| EDefault of expr Pos.marked list * expr Pos.marked * expr Pos.marked
| EIfThenElse of expr Pos.marked * expr Pos.marked * expr Pos.marked
| EArray of expr Pos.marked list
val locations_used : expr Pos.marked -> LocationSet.t
type rule =
Definition of location Utils.Pos.marked * typ Utils.Pos.marked *
expr Utils.Pos.marked
| Assertion of expr Utils.Pos.marked
| Definition of location Pos.marked * typ Pos.marked * expr Pos.marked
| Assertion of expr Pos.marked
| Call of ScopeName.t * SubScopeName.t
type scope_decl = {
scope_decl_name : ScopeName.t;
scope_sig : typ Utils.Pos.marked ScopeVarMap.t;
scope_sig : typ Pos.marked ScopeVarMap.t;
scope_decl_rules : rule list;
}
type struct_ctx = (StructFieldName.t * typ Utils.Pos.marked) list StructMap.t
type enum_ctx = (EnumConstructor.t * typ Utils.Pos.marked) list EnumMap.t
type struct_ctx = (StructFieldName.t * typ Pos.marked) list StructMap.t
type enum_ctx = (EnumConstructor.t * typ Pos.marked) list EnumMap.t
type program = {
program_scopes : scope_decl ScopeMap.t;
program_enums : enum_ctx;
program_structs : struct_ctx;
}
module Var :
sig
type t = expr Bindlib.var
val make : string Utils.Pos.marked -> t
val compare : 'a Bindlib.var -> 'b Bindlib.var -> int
end
(** {1 Variable helpers} *)
module Var : sig
type t = expr Bindlib.var
val make : string Pos.marked -> t
val compare : t -> t -> int
end
module VarMap : Map.S with type key = Var.t
type vars = expr Bindlib.mvar
val make_var : Var.t Utils.Pos.marked -> expr Utils.Pos.marked Bindlib.box
val make_var : Var.t Pos.marked -> expr Pos.marked Bindlib.box
val make_abs :
vars ->
expr Utils.Pos.marked Bindlib.box ->
Utils.Pos.t ->
typ Utils.Pos.marked list ->
Utils.Pos.t -> expr Utils.Pos.marked Bindlib.box
vars -> expr Pos.marked Bindlib.box -> Pos.t -> typ Pos.marked list -> Pos.t ->
expr Pos.marked Bindlib.box
val make_app :
expr Utils.Pos.marked Bindlib.box ->
expr Utils.Pos.marked Bindlib.box list ->
Utils.Pos.t -> expr Utils.Pos.marked Bindlib.box
expr Pos.marked Bindlib.box -> expr Pos.marked Bindlib.box list -> Pos.t ->
expr Pos.marked Bindlib.box
val make_let_in :
Var.t ->
typ Utils.Pos.marked ->
expr Utils.Pos.marked Bindlib.box ->
expr Utils.Pos.marked Bindlib.box -> expr Utils.Pos.marked Bindlib.box
module VarMap :
sig
type key = Var.t
type 'a t = 'a Stdlib__map.Make(Var).t
val empty : 'a t
val is_empty : 'a t -> bool
val mem : key -> 'a t -> bool
val add : key -> 'a -> 'a t -> 'a t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge :
(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : (key -> 'a -> unit) -> 'a t -> unit
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val for_all : (key -> 'a -> bool) -> 'a t -> bool
val exists : (key -> 'a -> bool) -> 'a t -> bool
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t
val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
val cardinal : 'a t -> int
val bindings : 'a t -> (key * 'a) list
val min_binding : 'a t -> key * 'a
val min_binding_opt : 'a t -> (key * 'a) option
val max_binding : 'a t -> key * 'a
val max_binding_opt : 'a t -> (key * 'a) option
val choose : 'a t -> key * 'a
val choose_opt : 'a t -> (key * 'a) option
val split : key -> 'a t -> 'a t * 'a option * 'a t
val find : key -> 'a t -> 'a
val find_opt : key -> 'a t -> 'a option
val find_first : (key -> bool) -> 'a t -> key * 'a
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
val find_last : (key -> bool) -> 'a t -> key * 'a
val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
val to_seq : 'a t -> (key * 'a) Seq.t
val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
val of_seq : (key * 'a) Seq.t -> 'a t
end
Var.t -> typ Pos.marked -> expr Pos.marked Bindlib.box -> expr Pos.marked Bindlib.box ->
expr Pos.marked Bindlib.box

View File

@ -25,8 +25,6 @@ module SVertex = struct
let compare = Ast.ScopeName.compare
let equal x y = Ast.ScopeName.compare x y = 0
let format_t (fmt : Format.formatter) (x : t) : unit = Ast.ScopeName.format_t fmt x
end
(** On the edges, the label is the expression responsible for the use of the function *)

View File

@ -1,240 +1,80 @@
module SVertex :
sig
type t = Ast.ScopeName.t
val hash : Ast.ScopeName.t -> int
val compare :
Ast.ScopeName.t -> Ast.ScopeName.t -> int
val equal :
Ast.ScopeName.t -> Ast.ScopeName.t -> bool
val format_t : Format.formatter -> t -> unit
end
module SEdge :
sig
type t = Utils.Pos.t
val compare : 'a -> 'a -> int
val default : Utils.Pos.t
end
module SDependencies :
sig
type t =
Graph__Persistent.Digraph.ConcreteBidirectionalLabeled(SVertex)(SEdge).t
module V :
sig
type t = SVertex.t
val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool
type label = SVertex.t
val create : label -> t
val label : t -> label
end
type vertex = V.t
module E :
sig
type t = SVertex.t * SEdge.t * SVertex.t
val compare : t -> t -> int
type nonrec vertex = vertex
val src : t -> vertex
val dst : t -> vertex
type label = SEdge.t
val create : vertex -> label -> vertex -> t
val label : t -> label
end
type edge = E.t
val is_directed : bool
val is_empty : t -> bool
val nb_vertex : t -> int
val nb_edges : t -> int
val out_degree : t -> vertex -> int
val in_degree : t -> vertex -> int
val mem_vertex : t -> vertex -> bool
val mem_edge : t -> vertex -> vertex -> bool
val mem_edge_e : t -> edge -> bool
val find_edge : t -> vertex -> vertex -> edge
val find_all_edges : t -> vertex -> vertex -> edge list
val succ : t -> vertex -> vertex list
val pred : t -> vertex -> vertex list
val succ_e : t -> vertex -> edge list
val pred_e : t -> vertex -> edge list
val iter_vertex : (vertex -> unit) -> t -> unit
val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges : (vertex -> vertex -> unit) -> t -> unit
val fold_edges : (vertex -> vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges_e : (edge -> unit) -> t -> unit
val fold_edges_e : (edge -> 'a -> 'a) -> t -> 'a -> 'a
val map_vertex : (vertex -> vertex) -> t -> t
val iter_succ : (vertex -> unit) -> t -> vertex -> unit
val iter_pred : (vertex -> unit) -> t -> vertex -> unit
val fold_succ : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val fold_pred : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
val fold_succ_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
val fold_pred_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val empty : t
val add_vertex : t -> vertex -> t
val remove_vertex : t -> vertex -> t
val add_edge : t -> vertex -> vertex -> t
val add_edge_e : t -> edge -> t
val remove_edge : t -> vertex -> vertex -> t
val remove_edge_e : t -> edge -> t
end
module STopologicalTraversal :
sig
val fold : (SDependencies.V.t -> 'a -> 'a) -> SDependencies.t -> 'a -> 'a
val iter : (SDependencies.V.t -> unit) -> SDependencies.t -> unit
end
module SSCC :
sig
val scc : SDependencies.t -> int * (SDependencies.V.t -> int)
val scc_array : SDependencies.t -> SDependencies.V.t list array
val scc_list : SDependencies.t -> SDependencies.V.t list list
end
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** Graph representation of the dependencies between scopes in the Catala program. Vertices are
functions, x -> y if x is used in the definition of y. *)
open Utils
module SDependencies : Graph.Sig.P
with type V.t = Ast.ScopeName.t
and type E.label = Pos.t
(** On the edges, the label is the expression responsible for the use of the function *)
module STopologicalTraversal : sig
val fold : (Ast.ScopeName.t -> 'a -> 'a) -> SDependencies.t -> 'a -> 'a
val iter : (Ast.ScopeName.t -> unit) -> SDependencies.t -> unit
end
(** Tarjan's stongly connected components algorithm, provided by OCamlGraph *)
module SSCC : sig
val scc : SDependencies.t -> int * (Ast.ScopeName.t -> int)
val scc_array : SDependencies.t -> Ast.ScopeName.t list array
val scc_list : SDependencies.t -> Ast.ScopeName.t list list
end
val build_program_dep_graph : Ast.program -> SDependencies.t
val check_for_cycle_in_scope : SDependencies.t -> unit
val get_scope_ordering : SDependencies.t -> Ast.ScopeName.t list
module TVertex :
sig
type t =
Struct of Ast.StructName.t
| Enum of Ast.EnumName.t
val hash : t -> int
val compare : t -> t -> int
val equal : t -> t -> bool
val format_t : Format.formatter -> t -> unit
val get_info : t -> Ast.StructName.info
end
module TVertexSet :
sig
type elt = TVertex.t
type t = Stdlib__set.Make(TVertex).t
val empty : t
val is_empty : t -> bool
val mem : elt -> t -> bool
val add : elt -> t -> t
val singleton : elt -> t
val remove : elt -> t -> t
val union : t -> t -> t
val inter : t -> t -> t
val disjoint : t -> t -> bool
val diff : t -> t -> t
val compare : t -> t -> int
val equal : t -> t -> bool
val subset : t -> t -> bool
val iter : (elt -> unit) -> t -> unit
val map : (elt -> elt) -> t -> t
val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
val for_all : (elt -> bool) -> t -> bool
val exists : (elt -> bool) -> t -> bool
val filter : (elt -> bool) -> t -> t
val filter_map : (elt -> elt option) -> t -> t
val partition : (elt -> bool) -> t -> t * t
val cardinal : t -> int
val elements : t -> elt list
val min_elt : t -> elt
val min_elt_opt : t -> elt option
val max_elt : t -> elt
val max_elt_opt : t -> elt option
val choose : t -> elt
val choose_opt : t -> elt option
val split : elt -> t -> t * bool * t
val find : elt -> t -> elt
val find_opt : elt -> t -> elt option
val find_first : (elt -> bool) -> t -> elt
val find_first_opt : (elt -> bool) -> t -> elt option
val find_last : (elt -> bool) -> t -> elt
val find_last_opt : (elt -> bool) -> t -> elt option
val of_list : elt list -> t
val to_seq_from : elt -> t -> elt Seq.t
val to_seq : t -> elt Seq.t
val add_seq : elt Seq.t -> t -> t
val of_seq : elt Seq.t -> t
end
module TEdge :
sig
type t = Utils.Pos.t
val compare : 'a -> 'a -> int
val default : Utils.Pos.t
end
module TDependencies :
sig
type t =
Graph__Persistent.Digraph.ConcreteBidirectionalLabeled(TVertex)(TEdge).t
module V :
sig
type t = TVertex.t
val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool
type label = TVertex.t
val create : label -> t
val label : t -> label
end
type vertex = V.t
module E :
sig
type t = TVertex.t * TEdge.t * TVertex.t
val compare : t -> t -> int
type nonrec vertex = vertex
val src : t -> vertex
val dst : t -> vertex
type label = TEdge.t
val create : vertex -> label -> vertex -> t
val label : t -> label
end
type edge = E.t
val is_directed : bool
val is_empty : t -> bool
val nb_vertex : t -> int
val nb_edges : t -> int
val out_degree : t -> vertex -> int
val in_degree : t -> vertex -> int
val mem_vertex : t -> vertex -> bool
val mem_edge : t -> vertex -> vertex -> bool
val mem_edge_e : t -> edge -> bool
val find_edge : t -> vertex -> vertex -> edge
val find_all_edges : t -> vertex -> vertex -> edge list
val succ : t -> vertex -> vertex list
val pred : t -> vertex -> vertex list
val succ_e : t -> vertex -> edge list
val pred_e : t -> vertex -> edge list
val iter_vertex : (vertex -> unit) -> t -> unit
val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges : (vertex -> vertex -> unit) -> t -> unit
val fold_edges : (vertex -> vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges_e : (edge -> unit) -> t -> unit
val fold_edges_e : (edge -> 'a -> 'a) -> t -> 'a -> 'a
val map_vertex : (vertex -> vertex) -> t -> t
val iter_succ : (vertex -> unit) -> t -> vertex -> unit
val iter_pred : (vertex -> unit) -> t -> vertex -> unit
val fold_succ : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val fold_pred : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
val fold_succ_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
val fold_pred_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val empty : t
val add_vertex : t -> vertex -> t
val remove_vertex : t -> vertex -> t
val add_edge : t -> vertex -> vertex -> t
val add_edge_e : t -> edge -> t
val remove_edge : t -> vertex -> vertex -> t
val remove_edge_e : t -> edge -> t
end
module TTopologicalTraversal :
sig
val fold : (TDependencies.V.t -> 'a -> 'a) -> TDependencies.t -> 'a -> 'a
val iter : (TDependencies.V.t -> unit) -> TDependencies.t -> unit
end
module TVertex : sig
type t =
| Struct of Ast.StructName.t
| Enum of Ast.EnumName.t
val format_t : Format.formatter -> t -> unit
val get_info : t -> Ast.StructName.info
include Graph.Sig.COMPARABLE with type t := t
end
module TVertexSet : Set.S with type elt = TVertex.t
(** On the edges, the label is the expression responsible for the use of the function *)
module TDependencies : Graph.Sig.P
with type V.t = TVertex.t
and type E.label = Pos.t
module TTopologicalTraversal : sig
val fold : (TVertex.t -> 'a -> 'a) -> TDependencies.t -> 'a -> 'a
val iter : (TVertex.t -> unit) -> TDependencies.t -> unit
end
(** Tarjan's stongly connected components algorithm, provided by OCamlGraph *)
module TSCC :
sig
val scc : TDependencies.t -> int * (TDependencies.V.t -> int)
val scc_array : TDependencies.t -> TDependencies.V.t list array
val scc_list : TDependencies.t -> TDependencies.V.t list list
end
val get_structs_or_enums_in_type :
Ast.typ Utils.Pos.marked -> TVertexSet.t
val build_type_graph :
Ast.struct_ctx -> Ast.enum_ctx -> TDependencies.t
val check_type_cycles :
Ast.struct_ctx -> Ast.enum_ctx -> TVertex.t list
sig
val scc : TDependencies.t -> int * (TVertex.t -> int)
val scc_array : TDependencies.t -> TVertex.t list array
val scc_list : TDependencies.t -> TVertex.t list list
end
val get_structs_or_enums_in_type : Ast.typ Pos.marked -> TVertexSet.t
val build_type_graph : Ast.struct_ctx -> Ast.enum_ctx -> TDependencies.t
val check_type_cycles : Ast.struct_ctx -> Ast.enum_ctx -> TVertex.t list

View File

@ -1,8 +1,23 @@
val needs_parens : Ast.expr Utils.Pos.marked -> bool
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
open Utils
val format_var : Format.formatter -> Ast.Var.t -> unit
val format_location : Format.formatter -> Ast.location -> unit
val typ_needs_parens : Ast.typ Utils.Pos.marked -> bool
val format_typ :
Format.formatter -> Ast.typ Utils.Pos.marked -> unit
val format_expr :
Format.formatter -> Ast.expr Utils.Pos.marked -> unit
val format_typ : Format.formatter -> Ast.typ Pos.marked -> unit
val format_expr : Format.formatter -> Ast.expr Pos.marked -> unit

View File

@ -1,66 +1,92 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
open Utils
type scope_sigs_ctx =
((Ast.ScopeVar.t * Dcalc.Ast.typ) list * Dcalc.Ast.Var.t *
Dcalc.Ast.Var.t * Ast.StructName.t *
Ast.StructName.t)
Ast.ScopeMap.t
(* list of scope variables with their types *)
( (Ast.ScopeVar.t * Dcalc.Ast.typ) list
* (* var representing the scope *) Dcalc.Ast.Var.t
* (* var representing the scope input inside the scope func *) Dcalc.Ast.Var.t
* (* scope input *) Ast.StructName.t
* (* scope output *) Ast.StructName.t )
Ast.ScopeMap.t
type ctx = {
structs : Ast.struct_ctx;
enums : Ast.enum_ctx;
scope_name : Ast.ScopeName.t;
scopes_parameters : scope_sigs_ctx;
scope_vars : (Dcalc.Ast.Var.t * Dcalc.Ast.typ) Ast.ScopeVarMap.t;
subscope_vars :
(Dcalc.Ast.Var.t * Dcalc.Ast.typ) Ast.ScopeVarMap.t
Ast.SubScopeMap.t;
subscope_vars : (Dcalc.Ast.Var.t * Dcalc.Ast.typ) Ast.ScopeVarMap.t Ast.SubScopeMap.t;
local_vars : Dcalc.Ast.Var.t Ast.VarMap.t;
}
val empty_ctx :
Ast.struct_ctx ->
Ast.enum_ctx ->
scope_sigs_ctx -> Ast.ScopeName.t -> ctx
val empty_ctx : Ast.struct_ctx -> Ast.enum_ctx -> scope_sigs_ctx -> Ast.ScopeName.t -> ctx
type scope_ctx = Dcalc.Ast.Var.t Ast.ScopeMap.t
val hole_var : Dcalc.Ast.Var.t
val translate_typ :
ctx -> Ast.typ Utils.Pos.marked -> Dcalc.Ast.typ Utils.Pos.marked
val translate_typ : ctx -> Ast.typ Pos.marked -> Dcalc.Ast.typ Pos.marked
val merge_defaults :
Dcalc.Ast.expr Utils.Pos.marked Bindlib.box ->
Dcalc.Ast.expr Utils.Pos.marked Bindlib.box ->
Dcalc.Ast.expr Utils.Pos.marked Bindlib.box
Dcalc.Ast.expr Pos.marked Bindlib.box ->
Dcalc.Ast.expr Pos.marked Bindlib.box ->
Dcalc.Ast.expr Pos.marked Bindlib.box
val tag_with_log_entry :
Dcalc.Ast.expr Utils.Pos.marked Bindlib.box ->
Dcalc.Ast.expr Pos.marked Bindlib.box ->
Dcalc.Ast.log_entry ->
Utils.Uid.MarkedString.info list ->
Dcalc.Ast.expr Utils.Pos.marked Bindlib.box
Uid.MarkedString.info list ->
Dcalc.Ast.expr Pos.marked Bindlib.box
val translate_expr :
ctx ->
Ast.expr Utils.Pos.marked ->
Dcalc.Ast.expr Utils.Pos.marked Bindlib.box
Ast.expr Pos.marked ->
Dcalc.Ast.expr Pos.marked Bindlib.box
val translate_rule :
ctx ->
Ast.rule ->
Ast.rule list ->
Utils.Uid.MarkedString.info ->
Uid.MarkedString.info ->
Ast.StructName.t ->
Dcalc.Ast.expr Utils.Pos.marked Bindlib.box * ctx
Dcalc.Ast.expr Pos.marked Bindlib.box * ctx
val translate_rules :
ctx ->
Ast.rule list ->
Utils.Uid.MarkedString.info ->
Uid.MarkedString.info ->
Ast.StructName.t ->
Dcalc.Ast.expr Utils.Pos.marked Bindlib.box * ctx
Dcalc.Ast.expr Pos.marked Bindlib.box * ctx
val translate_scope_decl :
Ast.struct_ctx ->
Ast.enum_ctx ->
scope_sigs_ctx ->
Ast.ScopeName.t ->
Ast.scope_decl ->
Dcalc.Ast.expr Utils.Pos.marked Bindlib.box * Dcalc.Ast.struct_ctx
Dcalc.Ast.expr Pos.marked Bindlib.box * Dcalc.Ast.struct_ctx
val build_scope_typ_from_sig :
(Ast.ScopeVar.t * Dcalc.Ast.typ) list ->
Ast.StructName.t ->
Ast.StructName.t -> Utils.Pos.t -> Dcalc.Ast.typ Utils.Pos.marked
Ast.StructName.t -> Pos.t -> Dcalc.Ast.typ Pos.marked
val translate_program :
Ast.program ->
Ast.ScopeName.t ->
Dcalc.Ast.program * Dcalc.Ast.expr Utils.Pos.marked *
Dcalc.Ast.program * Dcalc.Ast.expr Pos.marked *
Dependency.TVertex.t list

View File

@ -1,3 +1,19 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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 built by the Catala parser *)
open Utils
type constructor = (string[@opaque])
@ -235,36 +251,36 @@ class virtual ['self] program_map : object ('self)
method visit_Aggregate : 'monomorphic. 'env -> aggregate_func -> collection_op
method visit_AggregateArgExtremum :
'monomorphic. 'env ->
bool -> primitive_typ -> expression Utils.Pos.marked -> aggregate_func
bool -> primitive_typ -> expression Pos.marked -> aggregate_func
method visit_AggregateCount : 'monomorphic. 'env -> aggregate_func
method visit_AggregateExtremum :
'monomorphic. 'env ->
bool -> primitive_typ -> expression Utils.Pos.marked -> aggregate_func
bool -> primitive_typ -> expression Pos.marked -> aggregate_func
method visit_AggregateSum : 'monomorphic. 'env -> primitive_typ -> aggregate_func
method visit_And : 'monomorphic. 'env -> binop
method visit_ArrayLit :
'monomorphic. 'env -> expression Utils.Pos.marked list -> expression
'monomorphic. 'env -> expression Pos.marked list -> expression
method visit_Assertion : 'monomorphic. 'env -> assertion -> scope_use_item
method visit_Base : 'monomorphic. 'env -> base_typ -> typ
method visit_Binop :
'monomorphic. 'env ->
binop Utils.Pos.marked ->
expression Utils.Pos.marked ->
expression Utils.Pos.marked -> expression
binop Pos.marked ->
expression Pos.marked ->
expression Pos.marked -> expression
method visit_Boolean : 'monomorphic. 'env -> primitive_typ
method visit_Builtin : 'monomorphic. 'env -> builtin_expression -> expression
method visit_Cardinal : 'monomorphic. 'env -> builtin_expression
method visit_CatalaFile : 'monomorphic. 'env -> string Utils.Pos.marked -> law_include
method visit_CatalaFile : 'monomorphic. 'env -> string Pos.marked -> law_include
method visit_CodeBlock :
'monomorphic. 'env -> code_block -> string Utils.Pos.marked -> law_article_item
'monomorphic. 'env -> code_block -> string Pos.marked -> law_article_item
method visit_Collection :
'monomorphic. 'env -> base_typ_data Utils.Pos.marked -> base_typ_data
'monomorphic. 'env -> base_typ_data Pos.marked -> base_typ_data
method visit_CollectionOp :
'monomorphic. 'env ->
collection_op Utils.Pos.marked ->
ident Utils.Pos.marked ->
expression Utils.Pos.marked ->
expression Utils.Pos.marked -> expression
collection_op Pos.marked ->
ident Pos.marked ->
expression Pos.marked ->
expression Pos.marked -> expression
method visit_Condition : 'monomorphic. 'env -> base_typ
method visit_ContextData :
'monomorphic. 'env -> scope_decl_context_data -> scope_decl_context_item
@ -280,33 +296,33 @@ class virtual ['self] program_map : object ('self)
method visit_Div : 'monomorphic. 'env -> op_kind -> binop
method visit_Dotted :
'monomorphic. 'env ->
expression Utils.Pos.marked ->
constructor Utils.Pos.marked option ->
ident Utils.Pos.marked -> expression
expression Pos.marked ->
constructor Pos.marked option ->
ident Pos.marked -> expression
method visit_Duration : 'monomorphic. 'env -> primitive_typ
method visit_EnumDecl : 'monomorphic. 'env -> enum_decl -> code_item
method visit_EnumInject :
'monomorphic. 'env ->
constructor Utils.Pos.marked option ->
constructor Utils.Pos.marked ->
expression Utils.Pos.marked option -> expression
constructor Pos.marked option ->
constructor Pos.marked ->
expression Pos.marked option -> expression
method visit_EnumProject :
'monomorphic. 'env ->
expression Utils.Pos.marked ->
constructor Utils.Pos.marked -> expression
expression Pos.marked ->
constructor Pos.marked -> expression
method visit_Eq : 'monomorphic. 'env -> binop
method visit_ExceptionToLabel :
'monomorphic. 'env -> ident Utils.Pos.marked -> exception_to
'monomorphic. 'env -> ident Pos.marked -> exception_to
method visit_Exists : 'monomorphic. 'env -> collection_op
method visit_Filter : 'monomorphic. 'env -> collection_op
method visit_FixedBy :
'monomorphic. 'env ->
qident Utils.Pos.marked -> ident Utils.Pos.marked -> meta_assertion
qident Pos.marked -> ident Pos.marked -> meta_assertion
method visit_Forall : 'monomorphic. 'env -> collection_op
method visit_FunCall :
'monomorphic. 'env ->
expression Utils.Pos.marked ->
expression Utils.Pos.marked -> expression
expression Pos.marked ->
expression Pos.marked -> expression
method visit_Func : 'monomorphic. 'env -> func_typ -> typ
method visit_GetDay : 'monomorphic. 'env -> builtin_expression
method visit_GetMonth : 'monomorphic. 'env -> builtin_expression
@ -316,9 +332,9 @@ class virtual ['self] program_map : object ('self)
method visit_Ident : 'monomorphic. 'env -> ident -> expression
method visit_IfThenElse :
'monomorphic. 'env ->
expression Utils.Pos.marked ->
expression Utils.Pos.marked ->
expression Utils.Pos.marked -> expression
expression Pos.marked ->
expression Pos.marked ->
expression Pos.marked -> expression
method visit_Increasing : 'monomorphic. 'env -> variation_typ
method visit_Int : 'monomorphic. 'env -> Z.t -> literal_number
method visit_IntToDec : 'monomorphic. 'env -> builtin_expression
@ -334,8 +350,8 @@ class virtual ['self] program_map : object ('self)
method visit_LMoneyAmount : 'monomorphic. 'env -> money_amount -> literal
method visit_LNumber :
'monomorphic. 'env ->
literal_number Utils.Pos.marked ->
literal_unit Utils.Pos.marked option -> literal
literal_number Pos.marked ->
literal_unit Pos.marked option -> literal
method visit_LawArticle :
'monomorphic. 'env -> law_article -> law_article_item list -> law_structure
method visit_LawHeading :
@ -344,22 +360,22 @@ class virtual ['self] program_map : object ('self)
method visit_LawStructure : 'monomorphic. 'env -> law_structure -> program_item
method visit_LawText : 'monomorphic. 'env -> string -> law_article_item
method visit_LegislativeText :
'monomorphic. 'env -> string Utils.Pos.marked -> law_include
'monomorphic. 'env -> string Pos.marked -> law_include
method visit_Literal : 'monomorphic. 'env -> literal -> expression
method visit_Lt : 'monomorphic. 'env -> op_kind -> binop
method visit_Lte : 'monomorphic. 'env -> op_kind -> binop
method visit_Map : 'monomorphic. 'env -> collection_op
method visit_MatchWith :
'monomorphic. 'env ->
expression Utils.Pos.marked ->
match_cases Utils.Pos.marked -> expression
expression Pos.marked ->
match_cases Pos.marked -> expression
method visit_MemCollection :
'monomorphic. 'env ->
expression Utils.Pos.marked ->
expression Utils.Pos.marked -> expression
expression Pos.marked ->
expression Pos.marked -> expression
method visit_MetaAssertion : 'monomorphic. 'env -> meta_assertion -> scope_use_item
method visit_MetadataBlock :
'monomorphic. 'env -> code_block -> string Utils.Pos.marked -> law_structure
'monomorphic. 'env -> code_block -> string Pos.marked -> law_structure
method visit_Minus : 'monomorphic. 'env -> op_kind -> unop
method visit_Money : 'monomorphic. 'env -> primitive_typ
method visit_Month : 'monomorphic. 'env -> literal_unit
@ -370,7 +386,7 @@ class virtual ['self] program_map : object ('self)
method visit_NotAnException : 'monomorphic. 'env -> exception_to
method visit_Or : 'monomorphic. 'env -> binop
method visit_PdfFile :
'monomorphic. 'env -> string Utils.Pos.marked -> int option -> law_include
'monomorphic. 'env -> string Pos.marked -> int option -> law_include
method visit_Percent : 'monomorphic. 'env -> literal_unit
method visit_Primitive : 'monomorphic. 'env -> primitive_typ -> base_typ_data
method visit_Rule : 'monomorphic. 'env -> rule -> scope_use_item
@ -379,24 +395,24 @@ class virtual ['self] program_map : object ('self)
method visit_StructDecl : 'monomorphic. 'env -> struct_decl -> code_item
method visit_StructLit :
'monomorphic. 'env ->
constructor Utils.Pos.marked ->
(ident Utils.Pos.marked * expression Utils.Pos.marked) list ->
constructor Pos.marked ->
(ident Pos.marked * expression Pos.marked) list ->
expression
method visit_Sub : 'monomorphic. 'env -> op_kind -> binop
method visit_TestMatchCase :
'monomorphic. 'env ->
expression Utils.Pos.marked ->
match_case_pattern Utils.Pos.marked -> expression
expression Pos.marked ->
match_case_pattern Pos.marked -> expression
method visit_Text : 'monomorphic. 'env -> primitive_typ
method visit_UnlabeledException : 'monomorphic. 'env -> exception_to
method visit_Unop :
'monomorphic. 'env ->
unop Utils.Pos.marked -> expression Utils.Pos.marked -> expression
unop Pos.marked -> expression Pos.marked -> expression
method visit_VariesWith :
'monomorphic. 'env ->
qident Utils.Pos.marked ->
expression Utils.Pos.marked ->
variation_typ Utils.Pos.marked option -> meta_assertion
qident Pos.marked ->
expression Pos.marked ->
variation_typ Pos.marked option -> meta_assertion
method visit_Year : 'monomorphic. 'env -> literal_unit
method visit_aggregate_func : 'monomorphic. 'env -> aggregate_func -> aggregate_func
method visit_assertion : 'monomorphic. 'env -> assertion -> assertion
@ -407,7 +423,7 @@ class virtual ['self] program_map : object ('self)
'monomorphic. 'env -> builtin_expression -> builtin_expression
method visit_code_block :
'monomorphic. 'env ->
code_item Utils.Pos.marked list -> code_item Utils.Pos.marked list
code_item Pos.marked list -> code_item Pos.marked list
method visit_code_item : 'monomorphic. 'env -> code_item -> code_item
method visit_collection_op : 'monomorphic. 'env -> collection_op -> collection_op
method visit_constructor : 'monomorphic. 'env -> constructor -> constructor
@ -429,14 +445,14 @@ class virtual ['self] program_map : object ('self)
method visit_literal_number : 'monomorphic. 'env -> literal_number -> literal_number
method visit_literal_unit : 'monomorphic. 'env -> literal_unit -> literal_unit
method visit_marked :
'a. ('env -> 'a -> 'a) -> 'env -> 'a Utils.Pos.marked -> 'a Utils.Pos.marked
'a. ('env -> 'a -> 'a) -> 'env -> 'a Pos.marked -> 'a Pos.marked
method visit_match_case : 'monomorphic. 'env -> match_case -> match_case
method visit_match_case_pattern :
'monomorphic. 'env ->
(constructor Utils.Pos.marked option * constructor Utils.Pos.marked)
list * ident Utils.Pos.marked option ->
(constructor Utils.Pos.marked option * constructor Utils.Pos.marked)
list * ident Utils.Pos.marked option
(constructor Pos.marked option * constructor Pos.marked)
list * ident Pos.marked option ->
(constructor Pos.marked option * constructor Pos.marked)
list * ident Pos.marked option
method visit_match_cases : 'monomorphic. 'env -> match_cases -> match_cases
method visit_meta_assertion : 'monomorphic. 'env -> meta_assertion -> meta_assertion
method visit_money_amount : 'monomorphic. 'env -> money_amount -> money_amount
@ -445,7 +461,7 @@ class virtual ['self] program_map : object ('self)
method visit_program : 'monomorphic. 'env -> program -> program
method visit_program_item : 'monomorphic. 'env -> program_item -> program_item
method visit_qident :
'monomorphic. 'env -> ident Utils.Pos.marked list -> ident Utils.Pos.marked list
'monomorphic. 'env -> ident Pos.marked list -> ident Pos.marked list
method visit_rule : 'monomorphic. 'env -> rule -> rule
method visit_scope_decl : 'monomorphic. 'env -> scope_decl -> scope_decl
method visit_scope_decl_context_data :
@ -457,7 +473,7 @@ class virtual ['self] program_map : object ('self)
method visit_scope_use : 'monomorphic. 'env -> scope_use -> scope_use
method visit_scope_use_item : 'monomorphic. 'env -> scope_use_item -> scope_use_item
method visit_source_repr :
'monomorphic. 'env -> string Utils.Pos.marked -> string Utils.Pos.marked
'monomorphic. 'env -> string Pos.marked -> string Pos.marked
method visit_struct_decl : 'monomorphic. 'env -> struct_decl -> struct_decl
method visit_struct_decl_field :
'monomorphic. 'env -> struct_decl_field -> struct_decl_field
@ -470,31 +486,31 @@ class virtual ['self] program_iter : object ('self)
method visit_Add : 'monomorphic. 'env -> op_kind -> unit
method visit_Aggregate : 'monomorphic. 'env -> aggregate_func -> unit
method visit_AggregateArgExtremum :
'monomorphic. 'env -> bool -> primitive_typ -> expression Utils.Pos.marked -> unit
'monomorphic. 'env -> bool -> primitive_typ -> expression Pos.marked -> unit
method visit_AggregateCount : 'monomorphic. 'env -> unit
method visit_AggregateExtremum :
'monomorphic. 'env -> bool -> primitive_typ -> expression Utils.Pos.marked -> unit
'monomorphic. 'env -> bool -> primitive_typ -> expression Pos.marked -> unit
method visit_AggregateSum : 'monomorphic. 'env -> primitive_typ -> unit
method visit_And : 'monomorphic. 'env -> unit
method visit_ArrayLit : 'monomorphic. 'env -> expression Utils.Pos.marked list -> unit
method visit_ArrayLit : 'monomorphic. 'env -> expression Pos.marked list -> unit
method visit_Assertion : 'monomorphic. 'env -> assertion -> unit
method visit_Base : 'monomorphic. 'env -> base_typ -> unit
method visit_Binop :
'monomorphic. 'env ->
binop Utils.Pos.marked ->
expression Utils.Pos.marked -> expression Utils.Pos.marked -> unit
binop Pos.marked ->
expression Pos.marked -> expression Pos.marked -> unit
method visit_Boolean : 'monomorphic. 'env -> unit
method visit_Builtin : 'monomorphic. 'env -> builtin_expression -> unit
method visit_Cardinal : 'monomorphic. 'env -> unit
method visit_CatalaFile : 'monomorphic. 'env -> string Utils.Pos.marked -> unit
method visit_CatalaFile : 'monomorphic. 'env -> string Pos.marked -> unit
method visit_CodeBlock :
'monomorphic. 'env -> code_block -> string Utils.Pos.marked -> unit
method visit_Collection : 'monomorphic. 'env -> base_typ_data Utils.Pos.marked -> unit
'monomorphic. 'env -> code_block -> string Pos.marked -> unit
method visit_Collection : 'monomorphic. 'env -> base_typ_data Pos.marked -> unit
method visit_CollectionOp :
'monomorphic. 'env ->
collection_op Utils.Pos.marked ->
ident Utils.Pos.marked ->
expression Utils.Pos.marked -> expression Utils.Pos.marked -> unit
collection_op Pos.marked ->
ident Pos.marked ->
expression Pos.marked -> expression Pos.marked -> unit
method visit_Condition : 'monomorphic. 'env -> unit
method visit_ContextData : 'monomorphic. 'env -> scope_decl_context_data -> unit
method visit_ContextScope : 'monomorphic. 'env -> scope_decl_context_scope -> unit
@ -508,28 +524,28 @@ class virtual ['self] program_iter : object ('self)
method visit_Div : 'monomorphic. 'env -> op_kind -> unit
method visit_Dotted :
'monomorphic. 'env ->
expression Utils.Pos.marked ->
constructor Utils.Pos.marked option -> ident Utils.Pos.marked -> unit
expression Pos.marked ->
constructor Pos.marked option -> ident Pos.marked -> unit
method visit_Duration : 'monomorphic. 'env -> unit
method visit_EnumDecl : 'monomorphic. 'env -> enum_decl -> unit
method visit_EnumInject :
'monomorphic. 'env ->
constructor Utils.Pos.marked option ->
constructor Utils.Pos.marked ->
expression Utils.Pos.marked option -> unit
constructor Pos.marked option ->
constructor Pos.marked ->
expression Pos.marked option -> unit
method visit_EnumProject :
'monomorphic. 'env ->
expression Utils.Pos.marked -> constructor Utils.Pos.marked -> unit
expression Pos.marked -> constructor Pos.marked -> unit
method visit_Eq : 'monomorphic. 'env -> unit
method visit_ExceptionToLabel : 'monomorphic. 'env -> ident Utils.Pos.marked -> unit
method visit_ExceptionToLabel : 'monomorphic. 'env -> ident Pos.marked -> unit
method visit_Exists : 'monomorphic. 'env -> unit
method visit_Filter : 'monomorphic. 'env -> unit
method visit_FixedBy :
'monomorphic. 'env -> qident Utils.Pos.marked -> ident Utils.Pos.marked -> unit
'monomorphic. 'env -> qident Pos.marked -> ident Pos.marked -> unit
method visit_Forall : 'monomorphic. 'env -> unit
method visit_FunCall :
'monomorphic. 'env ->
expression Utils.Pos.marked -> expression Utils.Pos.marked -> unit
expression Pos.marked -> expression Pos.marked -> unit
method visit_Func : 'monomorphic. 'env -> func_typ -> unit
method visit_GetDay : 'monomorphic. 'env -> unit
method visit_GetMonth : 'monomorphic. 'env -> unit
@ -539,8 +555,8 @@ class virtual ['self] program_iter : object ('self)
method visit_Ident : 'monomorphic. 'env -> ident -> unit
method visit_IfThenElse :
'monomorphic. 'env ->
expression Utils.Pos.marked ->
expression Utils.Pos.marked -> expression Utils.Pos.marked -> unit
expression Pos.marked ->
expression Pos.marked -> expression Pos.marked -> unit
method visit_Increasing : 'monomorphic. 'env -> unit
method visit_Int : 'monomorphic. 'env -> Z.t -> unit
method visit_IntToDec : 'monomorphic. 'env -> unit
@ -556,28 +572,28 @@ class virtual ['self] program_iter : object ('self)
method visit_LMoneyAmount : 'monomorphic. 'env -> money_amount -> unit
method visit_LNumber :
'monomorphic. 'env ->
literal_number Utils.Pos.marked ->
literal_unit Utils.Pos.marked option -> unit
literal_number Pos.marked ->
literal_unit Pos.marked option -> unit
method visit_LawArticle :
'monomorphic. 'env -> law_article -> law_article_item list -> unit
method visit_LawHeading : 'monomorphic. 'env -> law_heading -> law_structure list -> unit
method visit_LawInclude : 'monomorphic. 'env -> law_include -> unit
method visit_LawStructure : 'monomorphic. 'env -> law_structure -> unit
method visit_LawText : 'monomorphic. 'env -> string -> unit
method visit_LegislativeText : 'monomorphic. 'env -> string Utils.Pos.marked -> unit
method visit_LegislativeText : 'monomorphic. 'env -> string Pos.marked -> unit
method visit_Literal : 'monomorphic. 'env -> literal -> unit
method visit_Lt : 'monomorphic. 'env -> op_kind -> unit
method visit_Lte : 'monomorphic. 'env -> op_kind -> unit
method visit_Map : 'monomorphic. 'env -> unit
method visit_MatchWith :
'monomorphic. 'env ->
expression Utils.Pos.marked -> match_cases Utils.Pos.marked -> unit
expression Pos.marked -> match_cases Pos.marked -> unit
method visit_MemCollection :
'monomorphic. 'env ->
expression Utils.Pos.marked -> expression Utils.Pos.marked -> unit
expression Pos.marked -> expression Pos.marked -> unit
method visit_MetaAssertion : 'monomorphic. 'env -> meta_assertion -> unit
method visit_MetadataBlock :
'monomorphic. 'env -> code_block -> string Utils.Pos.marked -> unit
'monomorphic. 'env -> code_block -> string Pos.marked -> unit
method visit_Minus : 'monomorphic. 'env -> op_kind -> unit
method visit_Money : 'monomorphic. 'env -> unit
method visit_Month : 'monomorphic. 'env -> unit
@ -588,7 +604,7 @@ class virtual ['self] program_iter : object ('self)
method visit_NotAnException : 'monomorphic. 'env -> unit
method visit_Or : 'monomorphic. 'env -> unit
method visit_PdfFile :
'monomorphic. 'env -> string Utils.Pos.marked -> int option -> unit
'monomorphic. 'env -> string Pos.marked -> int option -> unit
method visit_Percent : 'monomorphic. 'env -> unit
method visit_Primitive : 'monomorphic. 'env -> primitive_typ -> unit
method visit_Rule : 'monomorphic. 'env -> rule -> unit
@ -597,22 +613,22 @@ class virtual ['self] program_iter : object ('self)
method visit_StructDecl : 'monomorphic. 'env -> struct_decl -> unit
method visit_StructLit :
'monomorphic. 'env ->
constructor Utils.Pos.marked ->
(ident Utils.Pos.marked * expression Utils.Pos.marked) list -> unit
constructor Pos.marked ->
(ident Pos.marked * expression Pos.marked) list -> unit
method visit_Sub : 'monomorphic. 'env -> op_kind -> unit
method visit_TestMatchCase :
'monomorphic. 'env ->
expression Utils.Pos.marked ->
match_case_pattern Utils.Pos.marked -> unit
expression Pos.marked ->
match_case_pattern Pos.marked -> unit
method visit_Text : 'monomorphic. 'env -> unit
method visit_UnlabeledException : 'monomorphic. 'env -> unit
method visit_Unop :
'monomorphic. 'env -> unop Utils.Pos.marked -> expression Utils.Pos.marked -> unit
'monomorphic. 'env -> unop Pos.marked -> expression Pos.marked -> unit
method visit_VariesWith :
'monomorphic. 'env ->
qident Utils.Pos.marked ->
expression Utils.Pos.marked ->
variation_typ Utils.Pos.marked option -> unit
qident Pos.marked ->
expression Pos.marked ->
variation_typ Pos.marked option -> unit
method visit_Year : 'monomorphic. 'env -> unit
method visit_aggregate_func : 'monomorphic. 'env -> aggregate_func -> unit
method visit_assertion : 'monomorphic. 'env -> assertion -> unit
@ -620,7 +636,7 @@ class virtual ['self] program_iter : object ('self)
method visit_base_typ_data : 'monomorphic. 'env -> base_typ_data -> unit
method visit_binop : 'monomorphic. 'env -> binop -> unit
method visit_builtin_expression : 'monomorphic. 'env -> builtin_expression -> unit
method visit_code_block : 'monomorphic. 'env -> code_item Utils.Pos.marked list -> unit
method visit_code_block : 'monomorphic. 'env -> code_item Pos.marked list -> unit
method visit_code_item : 'monomorphic. 'env -> code_item -> unit
method visit_collection_op : 'monomorphic. 'env -> collection_op -> unit
method visit_constructor : 'monomorphic. 'env -> constructor -> unit
@ -641,12 +657,12 @@ class virtual ['self] program_iter : object ('self)
method visit_literal_number : 'monomorphic. 'env -> literal_number -> unit
method visit_literal_unit : 'monomorphic. 'env -> literal_unit -> unit
method visit_marked :
'a. ('env -> 'a -> unit) -> 'env -> 'a Utils.Pos.marked -> unit
'a. ('env -> 'a -> unit) -> 'env -> 'a Pos.marked -> unit
method visit_match_case : 'monomorphic. 'env -> match_case -> unit
method visit_match_case_pattern :
'monomorphic. 'env ->
(constructor Utils.Pos.marked option * constructor Utils.Pos.marked)
list * ident Utils.Pos.marked option -> unit
(constructor Pos.marked option * constructor Pos.marked)
list * ident Pos.marked option -> unit
method visit_match_cases : 'monomorphic. 'env -> match_cases -> unit
method visit_meta_assertion : 'monomorphic. 'env -> meta_assertion -> unit
method visit_money_amount : 'monomorphic. 'env -> money_amount -> unit
@ -654,7 +670,7 @@ class virtual ['self] program_iter : object ('self)
method visit_primitive_typ : 'monomorphic. 'env -> primitive_typ -> unit
method visit_program : 'monomorphic. 'env -> program -> unit
method visit_program_item : 'monomorphic. 'env -> program_item -> unit
method visit_qident : 'monomorphic. 'env -> ident Utils.Pos.marked list -> unit
method visit_qident : 'monomorphic. 'env -> ident Pos.marked list -> unit
method visit_rule : 'monomorphic. 'env -> rule -> unit
method visit_scope_decl : 'monomorphic. 'env -> scope_decl -> unit
method visit_scope_decl_context_data :
@ -665,7 +681,7 @@ class virtual ['self] program_iter : object ('self)
'monomorphic. 'env -> scope_decl_context_scope -> unit
method visit_scope_use : 'monomorphic. 'env -> scope_use -> unit
method visit_scope_use_item : 'monomorphic. 'env -> scope_use_item -> unit
method visit_source_repr : 'monomorphic. 'env -> string Utils.Pos.marked -> unit
method visit_source_repr : 'monomorphic. 'env -> string Pos.marked -> unit
method visit_struct_decl : 'monomorphic. 'env -> struct_decl -> unit
method visit_struct_decl_field : 'monomorphic. 'env -> struct_decl_field -> unit
method visit_typ : 'monomorphic. 'env -> typ -> unit

View File

@ -1,75 +1,138 @@
(* 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> Denis Merigoux <denis.merigoux@inria.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. *)
(** Translation from {!module: Surface.Ast} to {!module: Desugaring.Ast}.
- Removes syntactic sugars
- Separate code from legislation *)
open Utils
(** {1 Translating expressions} *)
val translate_op_kind : Ast.op_kind -> Dcalc.Ast.op_kind
val translate_binop : Ast.binop -> Dcalc.Ast.binop
val translate_unop : Ast.unop -> Dcalc.Ast.unop
module LiftStructFieldMap :
sig
val lift_box :
'a Bindlib.box Scopelang.Ast.StructFieldMap.t ->
'a Scopelang.Ast.StructFieldMap.t Bindlib.box
end
module LiftEnumConstructorMap :
sig
val lift_box :
'a Bindlib.box Scopelang.Ast.EnumConstructorMap.t ->
'a Scopelang.Ast.EnumConstructorMap.t Bindlib.box
end
(** The two modules below help performing operations on map with the {!type: Bindlib.box}. Indeed,
Catala uses the {{:https://lepigre.fr/ocaml-bindlib/} Bindlib} library to represent bound
variables in the AST. In this translation, bound variables are used to represent function
parameters or pattern macthing bindings. *)
module LiftStructFieldMap : sig
val lift_box :
'a Bindlib.box Scopelang.Ast.StructFieldMap.t ->
'a Scopelang.Ast.StructFieldMap.t Bindlib.box
end
module LiftEnumConstructorMap : sig
val lift_box :
'a Bindlib.box Scopelang.Ast.EnumConstructorMap.t ->
'a Scopelang.Ast.EnumConstructorMap.t Bindlib.box
end
val disambiguate_constructor :
Name_resolution.context ->
(string Utils.Pos.marked option * string Utils.Pos.marked) list ->
Utils.Pos.t -> Scopelang.Ast.EnumName.t * Scopelang.Ast.EnumConstructor.t
(string Pos.marked option * string Pos.marked) list ->
Pos.t ->
Scopelang.Ast.EnumName.t * Scopelang.Ast.EnumConstructor.t
(** Usage: [translate_expr scope ctxt expr]
Translates [expr] into its desugared equivalent. [scope] is used to disambiguate the scope and
subscopes variables than occur in the expresion *)
val translate_expr :
Scopelang.Ast.ScopeName.t ->
Name_resolution.context ->
Ast.expression Utils.Pos.marked ->
Scopelang.Ast.expr Utils.Pos.marked Bindlib.box
Ast.expression Pos.marked ->
Scopelang.Ast.expr Pos.marked Bindlib.box
val disambiguate_match_and_build_expression :
Scopelang.Ast.ScopeName.t ->
Name_resolution.context ->
Ast.match_cases ->
Scopelang.Ast.expr Utils.Pos.marked Bindlib.box
Scopelang.Ast.expr Pos.marked Bindlib.box
Scopelang.Ast.EnumConstructorMap.t * Scopelang.Ast.EnumName.t
(** {1 Translating scope definitions} *)
(** A scope use can be annotated with a pervasive precondition, in which case this precondition has
to be appended to the justifications of each definition in the subscope use. This is what this
function does. *)
val merge_conditions :
Scopelang.Ast.expr Utils.Pos.marked Bindlib.box option ->
Scopelang.Ast.expr Utils.Pos.marked Bindlib.box option ->
Utils.Pos.t -> Scopelang.Ast.expr Utils.Pos.marked Bindlib.box
Scopelang.Ast.expr Pos.marked Bindlib.box option ->
Scopelang.Ast.expr Pos.marked Bindlib.box option ->
Pos.t -> Scopelang.Ast.expr Pos.marked Bindlib.box
(** Translates a surface definition into condition into a desugared {!type: Desugared.Ast.rule} *)
val process_default :
Name_resolution.context ->
Scopelang.Ast.ScopeName.t ->
Desugared.Ast.ScopeDef.t Utils.Pos.marked ->
Scopelang.Ast.Var.t Utils.Pos.marked option ->
Scopelang.Ast.expr Utils.Pos.marked Bindlib.box option ->
Desugared.Ast.RuleName.t Utils.Pos.marked option ->
Ast.expression Utils.Pos.marked option ->
Ast.expression Utils.Pos.marked -> Desugared.Ast.rule
Desugared.Ast.ScopeDef.t Pos.marked ->
Scopelang.Ast.Var.t Pos.marked option ->
Scopelang.Ast.expr Pos.marked Bindlib.box option ->
Desugared.Ast.RuleName.t Pos.marked option ->
Ast.expression Pos.marked option ->
Ast.expression Pos.marked -> Desugared.Ast.rule
(** Wrapper around {!val: process_default} that performs some name disambiguation *)
val process_def :
Scopelang.Ast.expr Utils.Pos.marked Bindlib.box option ->
Scopelang.Ast.expr Pos.marked Bindlib.box option ->
Scopelang.Ast.ScopeName.t ->
Name_resolution.context ->
Desugared.Ast.program -> Ast.definition -> Desugared.Ast.program
(** Translates a {!type: Surface.Ast.rule} into the corresponding {!type: Surface.Ast.definition} *)
val rule_to_def : Ast.rule -> Ast.definition
(** Translates a {!type: Surface.Ast.rule} from the surface language *)
val process_rule :
Scopelang.Ast.expr Utils.Pos.marked Bindlib.box option ->
Scopelang.Ast.expr Pos.marked Bindlib.box option ->
Scopelang.Ast.ScopeName.t ->
Name_resolution.context ->
Desugared.Ast.program -> Ast.rule -> Desugared.Ast.program
(** Translates assertions *)
val process_assert :
Scopelang.Ast.expr Utils.Pos.marked Bindlib.box option ->
Scopelang.Ast.expr Pos.marked Bindlib.box option ->
Scopelang.Ast.ScopeName.t ->
Name_resolution.context ->
Desugared.Ast.program -> Ast.assertion -> Desugared.Ast.program
(** Translates a surface definition, rule or assertion *)
val process_scope_use_item :
Ast.expression Utils.Pos.marked option ->
Ast.expression Pos.marked option ->
Scopelang.Ast.ScopeName.t ->
Name_resolution.context ->
Desugared.Ast.program ->
Ast.scope_use_item Utils.Pos.marked -> Desugared.Ast.program
Ast.scope_use_item Pos.marked -> Desugared.Ast.program
(** {1 Translating top-level items} *)
(** If this is an unlabeled exception, ensures that it has a unique default definition *)
val check_unlabeled_exception :
Scopelang.Ast.ScopeName.t ->
Name_resolution.context ->
Ast.scope_use_item Utils.Pos.marked -> unit
Ast.scope_use_item Pos.marked -> unit
(** Translates a surface scope use, which is a bunch of definitions *)
val process_scope_use :
Name_resolution.context ->
Desugared.Ast.program -> Ast.scope_use -> Desugared.Ast.program
(** Main function of this module *)
val desugar_program :
Name_resolution.context ->
Ast.program -> Desugared.Ast.program

View File

@ -1,2 +1,15 @@
val fill_pos_with_legislative_info :
Ast.program -> Ast.program
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
val fill_pos_with_legislative_info : Ast.program -> Ast.program

View File

@ -1,221 +1,48 @@
val __sedlex_table_92 : string
val __sedlex_table_8 : string
val __sedlex_table_16 : string
val __sedlex_table_10 : string
val __sedlex_table_13 : string
val __sedlex_table_19 : string
val __sedlex_table_22 : string
val __sedlex_table_23 : string
val __sedlex_table_24 : string
val __sedlex_table_25 : string
val __sedlex_table_26 : string
val __sedlex_table_27 : string
val __sedlex_table_33 : string
val __sedlex_table_43 : string
val __sedlex_table_62 : string
val __sedlex_table_63 : string
val __sedlex_table_64 : string
val __sedlex_table_65 : string
val __sedlex_table_87 : string
val __sedlex_table_94 : string
val __sedlex_table_1 : string
val __sedlex_table_3 : string
val __sedlex_table_4 : string
val __sedlex_table_5 : string
val __sedlex_table_6 : string
val __sedlex_table_7 : string
val __sedlex_table_11 : string
val __sedlex_table_18 : string
val __sedlex_table_21 : string
val __sedlex_table_29 : string
val __sedlex_table_30 : string
val __sedlex_table_32 : string
val __sedlex_table_34 : string
val __sedlex_table_35 : string
val __sedlex_table_36 : string
val __sedlex_table_37 : string
val __sedlex_table_40 : string
val __sedlex_table_41 : string
val __sedlex_table_44 : string
val __sedlex_table_45 : string
val __sedlex_table_47 : string
val __sedlex_table_48 : string
val __sedlex_table_49 : string
val __sedlex_table_51 : string
val __sedlex_table_56 : string
val __sedlex_table_60 : string
val __sedlex_table_67 : string
val __sedlex_table_69 : string
val __sedlex_table_70 : string
val __sedlex_table_71 : string
val __sedlex_table_72 : string
val __sedlex_table_73 : string
val __sedlex_table_74 : string
val __sedlex_table_76 : string
val __sedlex_table_79 : string
val __sedlex_table_80 : string
val __sedlex_table_81 : string
val __sedlex_table_82 : string
val __sedlex_table_84 : string
val __sedlex_table_85 : string
val __sedlex_table_86 : string
val __sedlex_table_89 : string
val __sedlex_table_90 : string
val __sedlex_table_91 : string
val __sedlex_table_93 : string
val __sedlex_table_97 : string
val __sedlex_table_14 : string
val __sedlex_table_31 : string
val __sedlex_table_46 : string
val __sedlex_table_53 : string
val __sedlex_table_98 : string
val __sedlex_table_68 : string
val __sedlex_table_96 : string
val __sedlex_table_54 : string
val __sedlex_table_9 : string
val __sedlex_table_20 : string
val __sedlex_table_52 : string
val __sedlex_table_59 : string
val __sedlex_table_39 : string
val __sedlex_table_2 : string
val __sedlex_table_12 : string
val __sedlex_table_55 : string
val __sedlex_table_88 : string
val __sedlex_table_15 : string
val __sedlex_table_95 : string
val __sedlex_table_17 : string
val __sedlex_table_77 : string
val __sedlex_table_28 : string
val __sedlex_table_42 : string
val __sedlex_table_57 : string
val __sedlex_table_58 : string
val __sedlex_table_66 : string
val __sedlex_table_75 : string
val __sedlex_table_83 : string
val __sedlex_table_38 : string
val __sedlex_table_50 : string
val __sedlex_table_78 : string
val __sedlex_table_61 : string
val __sedlex_partition_51 : Uchar.t option -> int
val __sedlex_partition_3 : Uchar.t option -> int
val __sedlex_partition_30 : Uchar.t option -> int
val __sedlex_partition_44 : Uchar.t option -> int
val __sedlex_partition_19 : Uchar.t option -> int
val __sedlex_partition_93 : Uchar.t option -> int
val __sedlex_partition_37 : Uchar.t option -> int
val __sedlex_partition_27 : Uchar.t option -> int
val __sedlex_partition_78 : Uchar.t option -> int
val __sedlex_partition_74 : Uchar.t option -> int
val __sedlex_partition_6 : Uchar.t option -> int
val __sedlex_partition_11 : Uchar.t option -> int
val __sedlex_partition_103 : Uchar.t option -> int
val __sedlex_partition_33 : Uchar.t option -> int
val __sedlex_partition_41 : Uchar.t option -> int
val __sedlex_partition_102 : Uchar.t option -> int
val __sedlex_partition_4 : Uchar.t option -> int
val __sedlex_partition_12 : Uchar.t option -> int
val __sedlex_partition_15 : Uchar.t option -> int
val __sedlex_partition_82 : Uchar.t option -> int
val __sedlex_partition_5 : Uchar.t option -> int
val __sedlex_partition_61 : Uchar.t option -> int
val __sedlex_partition_86 : Uchar.t option -> int
val __sedlex_partition_90 : Uchar.t option -> int
val __sedlex_partition_60 : Uchar.t option -> int
val __sedlex_partition_101 : Uchar.t option -> int
val __sedlex_partition_104 : Uchar.t option -> int
val __sedlex_partition_106 : Uchar.t option -> int
val __sedlex_partition_108 : Uchar.t option -> int
val __sedlex_partition_110 : Uchar.t option -> int
val __sedlex_partition_112 : Uchar.t option -> int
val __sedlex_partition_13 : Uchar.t option -> int
val __sedlex_partition_46 : Uchar.t option -> int
val __sedlex_partition_56 : Uchar.t option -> int
val __sedlex_partition_65 : Uchar.t option -> int
val __sedlex_partition_94 : Uchar.t option -> int
val __sedlex_partition_64 : Uchar.t option -> int
val __sedlex_partition_39 : Uchar.t option -> int
val __sedlex_partition_105 : Uchar.t option -> int
val __sedlex_partition_31 : Uchar.t option -> int
val __sedlex_partition_34 : Uchar.t option -> int
val __sedlex_partition_22 : Uchar.t option -> int
val __sedlex_partition_54 : Uchar.t option -> int
val __sedlex_partition_98 : Uchar.t option -> int
val __sedlex_partition_1 : Uchar.t option -> int
val __sedlex_partition_29 : Uchar.t option -> int
val __sedlex_partition_7 : Uchar.t option -> int
val __sedlex_partition_18 : Uchar.t option -> int
val __sedlex_partition_89 : Uchar.t option -> int
val __sedlex_partition_63 : Uchar.t option -> int
val __sedlex_partition_109 : Uchar.t option -> int
val __sedlex_partition_57 : Uchar.t option -> int
val __sedlex_partition_58 : Uchar.t option -> int
val __sedlex_partition_91 : Uchar.t option -> int
val __sedlex_partition_66 : Uchar.t option -> int
val __sedlex_partition_17 : Uchar.t option -> int
val __sedlex_partition_96 : Uchar.t option -> int
val __sedlex_partition_23 : Uchar.t option -> int
val __sedlex_partition_55 : Uchar.t option -> int
val __sedlex_partition_83 : Uchar.t option -> int
val __sedlex_partition_2 : Uchar.t option -> int
val __sedlex_partition_45 : Uchar.t option -> int
val __sedlex_partition_81 : Uchar.t option -> int
val __sedlex_partition_95 : Uchar.t option -> int
val __sedlex_partition_97 : Uchar.t option -> int
val __sedlex_partition_10 : Uchar.t option -> int
val __sedlex_partition_36 : Uchar.t option -> int
val __sedlex_partition_80 : Uchar.t option -> int
val __sedlex_partition_70 : Uchar.t option -> int
val __sedlex_partition_72 : Uchar.t option -> int
val __sedlex_partition_28 : Uchar.t option -> int
val __sedlex_partition_87 : Uchar.t option -> int
val __sedlex_partition_100 : Uchar.t option -> int
val __sedlex_partition_107 : Uchar.t option -> int
val __sedlex_partition_111 : Uchar.t option -> int
val __sedlex_partition_113 : Uchar.t option -> int
val __sedlex_partition_9 : Uchar.t option -> int
val __sedlex_partition_26 : Uchar.t option -> int
val __sedlex_partition_85 : Uchar.t option -> int
val __sedlex_partition_40 : Uchar.t option -> int
val __sedlex_partition_42 : Uchar.t option -> int
val __sedlex_partition_52 : Uchar.t option -> int
val __sedlex_partition_59 : Uchar.t option -> int
val __sedlex_partition_25 : Uchar.t option -> int
val __sedlex_partition_43 : Uchar.t option -> int
val __sedlex_partition_62 : Uchar.t option -> int
val __sedlex_partition_20 : Uchar.t option -> int
val __sedlex_partition_99 : Uchar.t option -> int
val __sedlex_partition_21 : Uchar.t option -> int
val __sedlex_partition_68 : Uchar.t option -> int
val __sedlex_partition_88 : Uchar.t option -> int
val __sedlex_partition_53 : Uchar.t option -> int
val __sedlex_partition_32 : Uchar.t option -> int
val __sedlex_partition_16 : Uchar.t option -> int
val __sedlex_partition_67 : Uchar.t option -> int
val __sedlex_partition_71 : Uchar.t option -> int
val __sedlex_partition_8 : Uchar.t option -> int
val __sedlex_partition_24 : Uchar.t option -> int
val __sedlex_partition_35 : Uchar.t option -> int
val __sedlex_partition_50 : Uchar.t option -> int
val __sedlex_partition_76 : Uchar.t option -> int
val __sedlex_partition_79 : Uchar.t option -> int
val __sedlex_partition_14 : Uchar.t option -> int
val __sedlex_partition_38 : Uchar.t option -> int
val __sedlex_partition_49 : Uchar.t option -> int
val __sedlex_partition_77 : Uchar.t option -> int
val __sedlex_partition_48 : Uchar.t option -> int
val __sedlex_partition_73 : Uchar.t option -> int
val __sedlex_partition_84 : Uchar.t option -> int
val __sedlex_partition_69 : Uchar.t option -> int
val __sedlex_partition_47 : Uchar.t option -> int
val __sedlex_partition_75 : Uchar.t option -> int
val __sedlex_partition_92 : Uchar.t option -> int
module R = Re.Pcre
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** Concise syntax with English abbreviated keywords. *)
(** Boolean reference, used by the lexer as the mutable state to distinguish whether it is lexing
code or law. *)
val is_code : bool ref
(** Mutable string reference that accumulates the string representation of the body of code being
lexed. This string representation is used in the literate programming backends to faithfully
capture the spacing pattern of the original program *)
val code_string_acc : string ref
(** Updates {!val:code_string_acc} with the current lexeme *)
val update_acc : Sedlexing.lexbuf -> unit
(** Error-generating helper *)
val raise_lexer_error : Utils.Pos.t -> string -> 'a
(** Associative list matching each punctuation string part of the Catala syntax with its {!module:
Surface.Parser} token. Same for all the input languages (English, French, etc.) *)
val token_list_language_agnostic : (string * Parser.token) list
(** Same as {!val: token_list_language_agnostic}, but with tokens whose string varies with the input
language. *)
val token_list : (string * Parser.token) list
(** Main lexing function used in a code block *)
val lex_code : Sedlexing.lexbuf -> Parser.token
(** Main lexing function used outside code blocks *)
val lex_law : Sedlexing.lexbuf -> Parser.token
(** Entry point of the lexer, distributes to {!val: lex_code} or {!val: lex_law} depending of {!val:
is_code}. *)
val lexer : Sedlexing.lexbuf -> Parser.token

View File

@ -1,225 +1,27 @@
val __sedlex_table_93 : string
val __sedlex_table_9 : string
val __sedlex_table_17 : string
val __sedlex_table_11 : string
val __sedlex_table_13 : string
val __sedlex_table_20 : string
val __sedlex_table_23 : string
val __sedlex_table_24 : string
val __sedlex_table_25 : string
val __sedlex_table_26 : string
val __sedlex_table_27 : string
val __sedlex_table_28 : string
val __sedlex_table_36 : string
val __sedlex_table_46 : string
val __sedlex_table_65 : string
val __sedlex_table_66 : string
val __sedlex_table_67 : string
val __sedlex_table_68 : string
val __sedlex_table_88 : string
val __sedlex_table_95 : string
val __sedlex_table_1 : string
val __sedlex_table_3 : string
val __sedlex_table_4 : string
val __sedlex_table_5 : string
val __sedlex_table_6 : string
val __sedlex_table_7 : string
val __sedlex_table_8 : string
val __sedlex_table_15 : string
val __sedlex_table_19 : string
val __sedlex_table_22 : string
val __sedlex_table_30 : string
val __sedlex_table_31 : string
val __sedlex_table_32 : string
val __sedlex_table_34 : string
val __sedlex_table_35 : string
val __sedlex_table_37 : string
val __sedlex_table_38 : string
val __sedlex_table_39 : string
val __sedlex_table_40 : string
val __sedlex_table_41 : string
val __sedlex_table_43 : string
val __sedlex_table_44 : string
val __sedlex_table_48 : string
val __sedlex_table_49 : string
val __sedlex_table_50 : string
val __sedlex_table_51 : string
val __sedlex_table_53 : string
val __sedlex_table_58 : string
val __sedlex_table_60 : string
val __sedlex_table_63 : string
val __sedlex_table_70 : string
val __sedlex_table_72 : string
val __sedlex_table_73 : string
val __sedlex_table_74 : string
val __sedlex_table_75 : string
val __sedlex_table_76 : string
val __sedlex_table_77 : string
val __sedlex_table_79 : string
val __sedlex_table_81 : string
val __sedlex_table_82 : string
val __sedlex_table_85 : string
val __sedlex_table_86 : string
val __sedlex_table_87 : string
val __sedlex_table_90 : string
val __sedlex_table_91 : string
val __sedlex_table_92 : string
val __sedlex_table_94 : string
val __sedlex_table_97 : string
val __sedlex_table_99 : string
val __sedlex_table_14 : string
val __sedlex_table_33 : string
val __sedlex_table_47 : string
val __sedlex_table_55 : string
val __sedlex_table_100 : string
val __sedlex_table_71 : string
val __sedlex_table_98 : string
val __sedlex_table_56 : string
val __sedlex_table_10 : string
val __sedlex_table_21 : string
val __sedlex_table_54 : string
val __sedlex_table_62 : string
val __sedlex_table_83 : string
val __sedlex_table_2 : string
val __sedlex_table_12 : string
val __sedlex_table_57 : string
val __sedlex_table_89 : string
val __sedlex_table_16 : string
val __sedlex_table_96 : string
val __sedlex_table_18 : string
val __sedlex_table_29 : string
val __sedlex_table_45 : string
val __sedlex_table_59 : string
val __sedlex_table_61 : string
val __sedlex_table_69 : string
val __sedlex_table_78 : string
val __sedlex_table_84 : string
val __sedlex_table_42 : string
val __sedlex_table_52 : string
val __sedlex_table_80 : string
val __sedlex_table_64 : string
val __sedlex_partition_54 : Uchar.t option -> int
val __sedlex_partition_3 : Uchar.t option -> int
val __sedlex_partition_48 : Uchar.t option -> int
val __sedlex_partition_18 : Uchar.t option -> int
val __sedlex_partition_99 : Uchar.t option -> int
val __sedlex_partition_44 : Uchar.t option -> int
val __sedlex_partition_59 : Uchar.t option -> int
val __sedlex_partition_28 : Uchar.t option -> int
val __sedlex_partition_32 : Uchar.t option -> int
val __sedlex_partition_84 : Uchar.t option -> int
val __sedlex_partition_66 : Uchar.t option -> int
val __sedlex_partition_80 : Uchar.t option -> int
val __sedlex_partition_6 : Uchar.t option -> int
val __sedlex_partition_10 : Uchar.t option -> int
val __sedlex_partition_65 : Uchar.t option -> int
val __sedlex_partition_109 : Uchar.t option -> int
val __sedlex_partition_39 : Uchar.t option -> int
val __sedlex_partition_108 : Uchar.t option -> int
val __sedlex_partition_4 : Uchar.t option -> int
val __sedlex_partition_60 : Uchar.t option -> int
val __sedlex_partition_74 : Uchar.t option -> int
val __sedlex_partition_11 : Uchar.t option -> int
val __sedlex_partition_88 : Uchar.t option -> int
val __sedlex_partition_5 : Uchar.t option -> int
val __sedlex_partition_63 : Uchar.t option -> int
val __sedlex_partition_92 : Uchar.t option -> int
val __sedlex_partition_96 : Uchar.t option -> int
val __sedlex_partition_62 : Uchar.t option -> int
val __sedlex_partition_107 : Uchar.t option -> int
val __sedlex_partition_110 : Uchar.t option -> int
val __sedlex_partition_112 : Uchar.t option -> int
val __sedlex_partition_114 : Uchar.t option -> int
val __sedlex_partition_116 : Uchar.t option -> int
val __sedlex_partition_118 : Uchar.t option -> int
val __sedlex_partition_12 : Uchar.t option -> int
val __sedlex_partition_50 : Uchar.t option -> int
val __sedlex_partition_71 : Uchar.t option -> int
val __sedlex_partition_29 : Uchar.t option -> int
val __sedlex_partition_58 : Uchar.t option -> int
val __sedlex_partition_100 : Uchar.t option -> int
val __sedlex_partition_35 : Uchar.t option -> int
val __sedlex_partition_70 : Uchar.t option -> int
val __sedlex_partition_46 : Uchar.t option -> int
val __sedlex_partition_111 : Uchar.t option -> int
val __sedlex_partition_25 : Uchar.t option -> int
val __sedlex_partition_30 : Uchar.t option -> int
val __sedlex_partition_26 : Uchar.t option -> int
val __sedlex_partition_24 : Uchar.t option -> int
val __sedlex_partition_57 : Uchar.t option -> int
val __sedlex_partition_104 : Uchar.t option -> int
val __sedlex_partition_34 : Uchar.t option -> int
val __sedlex_partition_17 : Uchar.t option -> int
val __sedlex_partition_95 : Uchar.t option -> int
val __sedlex_partition_69 : Uchar.t option -> int
val __sedlex_partition_115 : Uchar.t option -> int
val __sedlex_partition_97 : Uchar.t option -> int
val __sedlex_partition_72 : Uchar.t option -> int
val __sedlex_partition_15 : Uchar.t option -> int
val __sedlex_partition_102 : Uchar.t option -> int
val __sedlex_partition_22 : Uchar.t option -> int
val __sedlex_partition_31 : Uchar.t option -> int
val __sedlex_partition_47 : Uchar.t option -> int
val __sedlex_partition_89 : Uchar.t option -> int
val __sedlex_partition_2 : Uchar.t option -> int
val __sedlex_partition_49 : Uchar.t option -> int
val __sedlex_partition_87 : Uchar.t option -> int
val __sedlex_partition_101 : Uchar.t option -> int
val __sedlex_partition_103 : Uchar.t option -> int
val __sedlex_partition_9 : Uchar.t option -> int
val __sedlex_partition_43 : Uchar.t option -> int
val __sedlex_partition_86 : Uchar.t option -> int
val __sedlex_partition_14 : Uchar.t option -> int
val __sedlex_partition_76 : Uchar.t option -> int
val __sedlex_partition_78 : Uchar.t option -> int
val __sedlex_partition_33 : Uchar.t option -> int
val __sedlex_partition_93 : Uchar.t option -> int
val __sedlex_partition_106 : Uchar.t option -> int
val __sedlex_partition_113 : Uchar.t option -> int
val __sedlex_partition_117 : Uchar.t option -> int
val __sedlex_partition_119 : Uchar.t option -> int
val __sedlex_partition_8 : Uchar.t option -> int
val __sedlex_partition_21 : Uchar.t option -> int
val __sedlex_partition_91 : Uchar.t option -> int
val __sedlex_partition_67 : Uchar.t option -> int
val __sedlex_partition_73 : Uchar.t option -> int
val __sedlex_partition_41 : Uchar.t option -> int
val __sedlex_partition_16 : Uchar.t option -> int
val __sedlex_partition_36 : Uchar.t option -> int
val __sedlex_partition_40 : Uchar.t option -> int
val __sedlex_partition_64 : Uchar.t option -> int
val __sedlex_partition_55 : Uchar.t option -> int
val __sedlex_partition_61 : Uchar.t option -> int
val __sedlex_partition_68 : Uchar.t option -> int
val __sedlex_partition_19 : Uchar.t option -> int
val __sedlex_partition_105 : Uchar.t option -> int
val __sedlex_partition_20 : Uchar.t option -> int
val __sedlex_partition_94 : Uchar.t option -> int
val __sedlex_partition_56 : Uchar.t option -> int
val __sedlex_partition_38 : Uchar.t option -> int
val __sedlex_partition_77 : Uchar.t option -> int
val __sedlex_partition_1 : Uchar.t option -> int
val __sedlex_partition_7 : Uchar.t option -> int
val __sedlex_partition_23 : Uchar.t option -> int
val __sedlex_partition_27 : Uchar.t option -> int
val __sedlex_partition_37 : Uchar.t option -> int
val __sedlex_partition_82 : Uchar.t option -> int
val __sedlex_partition_85 : Uchar.t option -> int
val __sedlex_partition_13 : Uchar.t option -> int
val __sedlex_partition_45 : Uchar.t option -> int
val __sedlex_partition_53 : Uchar.t option -> int
val __sedlex_partition_83 : Uchar.t option -> int
val __sedlex_partition_52 : Uchar.t option -> int
val __sedlex_partition_79 : Uchar.t option -> int
val __sedlex_partition_90 : Uchar.t option -> int
val __sedlex_partition_42 : Uchar.t option -> int
val __sedlex_partition_75 : Uchar.t option -> int
val __sedlex_partition_51 : Uchar.t option -> int
val __sedlex_partition_81 : Uchar.t option -> int
val __sedlex_partition_98 : Uchar.t option -> int
module L = Lexer
module R = Re.Pcre
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** Same as {!val: Surface.Lexer.token_list_language_agnostic}, but with tokens specialized to
English. *)
val token_list_en : (string * Parser.token) list
(** Main lexing function used in code blocks *)
val lex_code_en : Sedlexing.lexbuf -> Parser.token
(** Main lexing function used outside code blocks *)
val lex_law_en : Sedlexing.lexbuf -> Parser.token
(** Entry point of the lexer, distributes to {!val: lex_code_en} or {!val: lex_law_en} depending of
{!val: Surface.Lexer.is_code}. *)
val lexer_en : Sedlexing.lexbuf -> Parser.token

View File

@ -1,224 +1,27 @@
val __sedlex_table_89 : string
val __sedlex_table_25 : string
val __sedlex_table_43 : string
val __sedlex_table_18 : string
val __sedlex_table_52 : string
val __sedlex_table_16 : string
val __sedlex_table_37 : string
val __sedlex_table_8 : string
val __sedlex_table_12 : string
val __sedlex_table_20 : string
val __sedlex_table_22 : string
val __sedlex_table_23 : string
val __sedlex_table_24 : string
val __sedlex_table_63 : string
val __sedlex_table_65 : string
val __sedlex_table_85 : string
val __sedlex_table_1 : string
val __sedlex_table_3 : string
val __sedlex_table_4 : string
val __sedlex_table_5 : string
val __sedlex_table_6 : string
val __sedlex_table_7 : string
val __sedlex_table_9 : string
val __sedlex_table_10 : string
val __sedlex_table_13 : string
val __sedlex_table_15 : string
val __sedlex_table_19 : string
val __sedlex_table_26 : string
val __sedlex_table_29 : string
val __sedlex_table_30 : string
val __sedlex_table_31 : string
val __sedlex_table_33 : string
val __sedlex_table_34 : string
val __sedlex_table_35 : string
val __sedlex_table_36 : string
val __sedlex_table_39 : string
val __sedlex_table_41 : string
val __sedlex_table_44 : string
val __sedlex_table_46 : string
val __sedlex_table_47 : string
val __sedlex_table_49 : string
val __sedlex_table_51 : string
val __sedlex_table_53 : string
val __sedlex_table_58 : string
val __sedlex_table_66 : string
val __sedlex_table_67 : string
val __sedlex_table_68 : string
val __sedlex_table_70 : string
val __sedlex_table_72 : string
val __sedlex_table_73 : string
val __sedlex_table_74 : string
val __sedlex_table_75 : string
val __sedlex_table_76 : string
val __sedlex_table_77 : string
val __sedlex_table_79 : string
val __sedlex_table_80 : string
val __sedlex_table_81 : string
val __sedlex_table_82 : string
val __sedlex_table_83 : string
val __sedlex_table_86 : string
val __sedlex_table_87 : string
val __sedlex_table_88 : string
val __sedlex_table_93 : string
val __sedlex_table_94 : string
val __sedlex_table_17 : string
val __sedlex_table_27 : string
val __sedlex_table_28 : string
val __sedlex_table_32 : string
val __sedlex_table_42 : string
val __sedlex_table_56 : string
val __sedlex_table_57 : string
val __sedlex_table_95 : string
val __sedlex_table_69 : string
val __sedlex_table_45 : string
val __sedlex_table_48 : string
val __sedlex_table_92 : string
val __sedlex_table_55 : string
val __sedlex_table_91 : string
val __sedlex_table_21 : string
val __sedlex_table_54 : string
val __sedlex_table_62 : string
val __sedlex_table_11 : string
val __sedlex_table_2 : string
val __sedlex_table_60 : string
val __sedlex_table_14 : string
val __sedlex_table_84 : string
val __sedlex_table_90 : string
val __sedlex_table_40 : string
val __sedlex_table_59 : string
val __sedlex_table_61 : string
val __sedlex_table_71 : string
val __sedlex_table_38 : string
val __sedlex_table_50 : string
val __sedlex_table_78 : string
val __sedlex_table_64 : string
val __sedlex_partition_65 : Uchar.t option -> int
val __sedlex_partition_3 : Uchar.t option -> int
val __sedlex_partition_20 : Uchar.t option -> int
val __sedlex_partition_74 : Uchar.t option -> int
val __sedlex_partition_24 : Uchar.t option -> int
val __sedlex_partition_109 : Uchar.t option -> int
val __sedlex_partition_29 : Uchar.t option -> int
val __sedlex_partition_101 : Uchar.t option -> int
val __sedlex_partition_116 : Uchar.t option -> int
val __sedlex_partition_48 : Uchar.t option -> int
val __sedlex_partition_16 : Uchar.t option -> int
val __sedlex_partition_42 : Uchar.t option -> int
val __sedlex_partition_83 : Uchar.t option -> int
val __sedlex_partition_1 : Uchar.t option -> int
val __sedlex_partition_13 : Uchar.t option -> int
val __sedlex_partition_37 : Uchar.t option -> int
val __sedlex_partition_41 : Uchar.t option -> int
val __sedlex_partition_117 : Uchar.t option -> int
val __sedlex_partition_23 : Uchar.t option -> int
val __sedlex_partition_36 : Uchar.t option -> int
val __sedlex_partition_51 : Uchar.t option -> int
val __sedlex_partition_86 : Uchar.t option -> int
val __sedlex_partition_72 : Uchar.t option -> int
val __sedlex_partition_110 : Uchar.t option -> int
val __sedlex_partition_91 : Uchar.t option -> int
val __sedlex_partition_61 : Uchar.t option -> int
val __sedlex_partition_98 : Uchar.t option -> int
val __sedlex_partition_106 : Uchar.t option -> int
val __sedlex_partition_115 : Uchar.t option -> int
val __sedlex_partition_120 : Uchar.t option -> int
val __sedlex_partition_123 : Uchar.t option -> int
val __sedlex_partition_5 : Uchar.t option -> int
val __sedlex_partition_49 : Uchar.t option -> int
val __sedlex_partition_111 : Uchar.t option -> int
val __sedlex_partition_12 : Uchar.t option -> int
val __sedlex_partition_39 : Uchar.t option -> int
val __sedlex_partition_53 : Uchar.t option -> int
val __sedlex_partition_67 : Uchar.t option -> int
val __sedlex_partition_62 : Uchar.t option -> int
val __sedlex_partition_11 : Uchar.t option -> int
val __sedlex_partition_26 : Uchar.t option -> int
val __sedlex_partition_31 : Uchar.t option -> int
val __sedlex_partition_34 : Uchar.t option -> int
val __sedlex_partition_47 : Uchar.t option -> int
val __sedlex_partition_87 : Uchar.t option -> int
val __sedlex_partition_102 : Uchar.t option -> int
val __sedlex_partition_19 : Uchar.t option -> int
val __sedlex_partition_88 : Uchar.t option -> int
val __sedlex_partition_18 : Uchar.t option -> int
val __sedlex_partition_107 : Uchar.t option -> int
val __sedlex_partition_56 : Uchar.t option -> int
val __sedlex_partition_14 : Uchar.t option -> int
val __sedlex_partition_30 : Uchar.t option -> int
val __sedlex_partition_94 : Uchar.t option -> int
val __sedlex_partition_113 : Uchar.t option -> int
val __sedlex_partition_7 : Uchar.t option -> int
val __sedlex_partition_25 : Uchar.t option -> int
val __sedlex_partition_50 : Uchar.t option -> int
val __sedlex_partition_103 : Uchar.t option -> int
val __sedlex_partition_10 : Uchar.t option -> int
val __sedlex_partition_68 : Uchar.t option -> int
val __sedlex_partition_89 : Uchar.t option -> int
val __sedlex_partition_57 : Uchar.t option -> int
val __sedlex_partition_2 : Uchar.t option -> int
val __sedlex_partition_4 : Uchar.t option -> int
val __sedlex_partition_66 : Uchar.t option -> int
val __sedlex_partition_90 : Uchar.t option -> int
val __sedlex_partition_97 : Uchar.t option -> int
val __sedlex_partition_112 : Uchar.t option -> int
val __sedlex_partition_8 : Uchar.t option -> int
val __sedlex_partition_59 : Uchar.t option -> int
val __sedlex_partition_95 : Uchar.t option -> int
val __sedlex_partition_6 : Uchar.t option -> int
val __sedlex_partition_79 : Uchar.t option -> int
val __sedlex_partition_81 : Uchar.t option -> int
val __sedlex_partition_73 : Uchar.t option -> int
val __sedlex_partition_82 : Uchar.t option -> int
val __sedlex_partition_104 : Uchar.t option -> int
val __sedlex_partition_122 : Uchar.t option -> int
val __sedlex_partition_21 : Uchar.t option -> int
val __sedlex_partition_28 : Uchar.t option -> int
val __sedlex_partition_38 : Uchar.t option -> int
val __sedlex_partition_64 : Uchar.t option -> int
val __sedlex_partition_93 : Uchar.t option -> int
val __sedlex_partition_75 : Uchar.t option -> int
val __sedlex_partition_40 : Uchar.t option -> int
val __sedlex_partition_44 : Uchar.t option -> int
val __sedlex_partition_100 : Uchar.t option -> int
val __sedlex_partition_46 : Uchar.t option -> int
val __sedlex_partition_52 : Uchar.t option -> int
val __sedlex_partition_114 : Uchar.t option -> int
val __sedlex_partition_119 : Uchar.t option -> int
val __sedlex_partition_45 : Uchar.t option -> int
val __sedlex_partition_54 : Uchar.t option -> int
val __sedlex_partition_55 : Uchar.t option -> int
val __sedlex_partition_43 : Uchar.t option -> int
val __sedlex_partition_63 : Uchar.t option -> int
val __sedlex_partition_27 : Uchar.t option -> int
val __sedlex_partition_32 : Uchar.t option -> int
val __sedlex_partition_105 : Uchar.t option -> int
val __sedlex_partition_118 : Uchar.t option -> int
val __sedlex_partition_33 : Uchar.t option -> int
val __sedlex_partition_58 : Uchar.t option -> int
val __sedlex_partition_80 : Uchar.t option -> int
val __sedlex_partition_17 : Uchar.t option -> int
val __sedlex_partition_22 : Uchar.t option -> int
val __sedlex_partition_35 : Uchar.t option -> int
val __sedlex_partition_99 : Uchar.t option -> int
val __sedlex_partition_121 : Uchar.t option -> int
val __sedlex_partition_15 : Uchar.t option -> int
val __sedlex_partition_60 : Uchar.t option -> int
val __sedlex_partition_69 : Uchar.t option -> int
val __sedlex_partition_77 : Uchar.t option -> int
val __sedlex_partition_96 : Uchar.t option -> int
val __sedlex_partition_85 : Uchar.t option -> int
val __sedlex_partition_92 : Uchar.t option -> int
val __sedlex_partition_9 : Uchar.t option -> int
val __sedlex_partition_71 : Uchar.t option -> int
val __sedlex_partition_78 : Uchar.t option -> int
val __sedlex_partition_70 : Uchar.t option -> int
val __sedlex_partition_76 : Uchar.t option -> int
val __sedlex_partition_84 : Uchar.t option -> int
val __sedlex_partition_108 : Uchar.t option -> int
module L = Lexer
module R = Re.Pcre
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** Same as {!val: Surface.Lexer.token_list_language_agnostic}, but with tokens specialized to
French. *)
val token_list_fr : (string * Parser.token) list
(** Main lexing function used in code blocks *)
val lex_code_fr : Sedlexing.lexbuf -> Parser.token
(** Main lexing function used outside code blocks *)
val lex_law_fr : Sedlexing.lexbuf -> Parser.token
(** Entry point of the lexer, distributes to {!val: lex_code_fr} or {!val: lex_law_fr} depending of
{!val: Surface.Lexer.is_code}. *)
val lexer_fr : Sedlexing.lexbuf -> Parser.token

View File

@ -1,97 +1,195 @@
(* 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> Denis Merigoux <denis.merigoux@inria.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. *)
(** Builds a context that allows for mapping each name to a precise uid, taking lexical scopes into
account *)
open Utils
(** {1 Name resolution context} *)
type ident = string
type typ = Scopelang.Ast.typ
type unique_rulename = Ambiguous | Unique of Desugared.Ast.RuleName.t
type scope_context = {
var_idmap : Scopelang.Ast.ScopeVar.t Desugared.Ast.IdentMap.t;
var_idmap : Scopelang.Ast.ScopeVar.t Desugared.Ast.IdentMap.t; (** Scope variables *)
label_idmap : Desugared.Ast.RuleName.t Desugared.Ast.IdentMap.t;
default_rulemap : unique_rulename Desugared.Ast.ScopeDefMap.t;
(** What is the default rule to refer to for unnamed exceptions, if any *)
sub_scopes_idmap : Scopelang.Ast.SubScopeName.t Desugared.Ast.IdentMap.t;
(** Sub-scopes variables *)
sub_scopes : Scopelang.Ast.ScopeName.t Scopelang.Ast.SubScopeMap.t;
(** To what scope sub-scopes refer to? *)
}
type struct_context = typ Utils.Pos.marked Scopelang.Ast.StructFieldMap.t
type enum_context = typ Utils.Pos.marked Scopelang.Ast.EnumConstructorMap.t
(** Inside a scope, we distinguish between the variables and the subscopes. *)
type struct_context = typ Pos.marked Scopelang.Ast.StructFieldMap.t
(** Types of the fields of a struct *)
type enum_context = typ Pos.marked Scopelang.Ast.EnumConstructorMap.t
(** Types of the payloads of the cases of an enum *)
type context = {
local_var_idmap : Scopelang.Ast.Var.t Desugared.Ast.IdentMap.t;
scope_idmap : Scopelang.Ast.ScopeName.t Desugared.Ast.IdentMap.t;
(** Inside a definition, local variables can be introduced by functions arguments or pattern
matching *)
scope_idmap : Scopelang.Ast.ScopeName.t Desugared.Ast.IdentMap.t; (** The names of the scopes *)
struct_idmap : Scopelang.Ast.StructName.t Desugared.Ast.IdentMap.t;
field_idmap :
Scopelang.Ast.StructFieldName.t Scopelang.Ast.StructMap.t
Desugared.Ast.IdentMap.t;
enum_idmap : Scopelang.Ast.EnumName.t Desugared.Ast.IdentMap.t;
(** The names of the structs *)
field_idmap : Scopelang.Ast.StructFieldName.t Scopelang.Ast.StructMap.t Desugared.Ast.IdentMap.t;
(** The names of the struct fields. Names of fields can be shared between different structs *)
enum_idmap : Scopelang.Ast.EnumName.t Desugared.Ast.IdentMap.t; (** The names of the enums *)
constructor_idmap :
Scopelang.Ast.EnumConstructor.t Scopelang.Ast.EnumMap.t
Desugared.Ast.IdentMap.t;
scopes : scope_context Scopelang.Ast.ScopeMap.t;
structs : struct_context Scopelang.Ast.StructMap.t;
enums : enum_context Scopelang.Ast.EnumMap.t;
var_typs : (typ Utils.Pos.marked * bool) Scopelang.Ast.ScopeVarMap.t;
Scopelang.Ast.EnumConstructor.t Scopelang.Ast.EnumMap.t Desugared.Ast.IdentMap.t;
(** The names of the enum constructors. Constructor names can be shared between different
enums *)
scopes : scope_context Scopelang.Ast.ScopeMap.t; (** For each scope, its context *)
structs : struct_context Scopelang.Ast.StructMap.t; (** For each struct, its context *)
enums : enum_context Scopelang.Ast.EnumMap.t; (** For each enum, its context *)
var_typs : (typ Pos.marked * bool) (* is it a condition? *) Scopelang.Ast.ScopeVarMap.t;
(** The types of each scope variable declared *)
}
val raise_unsupported_feature : string -> Utils.Pos.t -> 'a
val raise_unknown_identifier : string -> ident Utils.Pos.marked -> 'a
val get_var_typ : context -> Scopelang.Ast.ScopeVar.t -> typ Utils.Pos.marked
(** Main context used throughout {!module: Surface.Desugaring} *)
(** {1 Helpers} *)
(** Temporary function raising an error message saying that a feature is not supported yet *)
val raise_unsupported_feature : string -> Pos.t -> 'a
(** Function to call whenever an identifier used somewhere has not been declared in the program
previously *)
val raise_unknown_identifier : string -> ident Pos.marked -> 'a
(** Gets the type associated to an uid *)
val get_var_typ : context -> Scopelang.Ast.ScopeVar.t -> typ Pos.marked
val is_var_cond : context -> Scopelang.Ast.ScopeVar.t -> bool
(** Get the variable uid inside the scope given in argument *)
val get_var_uid :
Scopelang.Ast.ScopeName.t ->
context -> ident Utils.Pos.marked -> Scopelang.Ast.ScopeVar.t
context -> ident Pos.marked -> Scopelang.Ast.ScopeVar.t
(** Get the subscope uid inside the scope given in argument *)
val get_subscope_uid :
Scopelang.Ast.ScopeName.t ->
context -> ident Utils.Pos.marked -> Scopelang.Ast.SubScopeName.t
context -> ident Pos.marked -> Scopelang.Ast.SubScopeName.t
(** [is_subscope_uid scope_uid ctxt y] returns true if [y] belongs to the subscopes of [scope_uid]. *)
val is_subscope_uid : Scopelang.Ast.ScopeName.t -> context -> ident -> bool
(** Checks if the var_uid belongs to the scope scope_uid *)
val belongs_to :
context -> Scopelang.Ast.ScopeVar.t -> Scopelang.Ast.ScopeName.t -> bool
val get_def_typ : context -> Desugared.Ast.ScopeDef.t -> typ Utils.Pos.marked
(** Retrieves the type of a scope definition from the context *)
val get_def_typ : context -> Desugared.Ast.ScopeDef.t -> typ Pos.marked
val is_def_cond : context -> Desugared.Ast.ScopeDef.t -> bool
(** {1 Declarations pass} *)
(** Process a subscope declaration *)
val process_subscope_decl :
Scopelang.Ast.ScopeName.t ->
context -> Ast.scope_decl_context_scope -> context
val is_type_cond : Ast.typ Utils.Pos.marked -> bool
val is_type_cond : Ast.typ Pos.marked -> bool
(** Process a basic type (all types except function types) *)
val process_base_typ :
context ->
Ast.base_typ Utils.Pos.marked -> Scopelang.Ast.typ Utils.Pos.marked
Ast.base_typ Pos.marked -> Scopelang.Ast.typ Pos.marked
(** Process a type (function or not) *)
val process_type :
context ->
Ast.typ Utils.Pos.marked -> Scopelang.Ast.typ Utils.Pos.marked
Ast.typ Pos.marked -> Scopelang.Ast.typ Pos.marked
val process_data_decl :
Scopelang.Ast.ScopeName.t ->
context -> Ast.scope_decl_context_data -> context
val process_item_decl :
Scopelang.Ast.ScopeName.t ->
context -> Ast.scope_decl_context_item -> context
(** Adds a binding to the context *)
val add_def_local_var :
context -> ident Utils.Pos.marked -> context * Scopelang.Ast.Var.t
context -> ident Pos.marked -> context * Scopelang.Ast.Var.t
val process_scope_decl : context -> Ast.scope_decl -> context
val process_struct_decl : context -> Ast.struct_decl -> context
val process_enum_decl : context -> Ast.enum_decl -> context
(** Process a code item that is a declaration *)
val process_decl_item :
context -> Ast.code_item Utils.Pos.marked -> context
context -> Ast.code_item Pos.marked -> context
val process_code_block :
context ->
Ast.code_block ->
(context -> Ast.code_item Utils.Pos.marked -> context) -> context
(context -> Ast.code_item Pos.marked -> context) -> context
(** Process a law article item, only considering the code blocks *)
val process_law_article_item :
context ->
Ast.law_article_item ->
(context -> Ast.code_item Utils.Pos.marked -> context) -> context
(context -> Ast.code_item Pos.marked -> context) -> context
(** Process a law structure, only considering the code blocks *)
val process_law_structure :
context ->
Ast.law_structure ->
(context -> Ast.code_item Utils.Pos.marked -> context) -> context
(context -> Ast.code_item Pos.marked -> context) -> context
(** Process a program item, only considering the code blocks *)
val process_program_item :
context ->
Ast.program_item ->
(context -> Ast.code_item Utils.Pos.marked -> context) -> context
(context -> Ast.code_item Pos.marked -> context) -> context
(** {1 Scope uses pass} *)
val get_def_key :
Ast.qident ->
Scopelang.Ast.ScopeName.t ->
context -> Utils.Pos.t -> Desugared.Ast.ScopeDef.t
context -> Pos.t -> Desugared.Ast.ScopeDef.t
val process_rule :
context -> Scopelang.Ast.ScopeName.t -> Ast.rule -> context
val process_definition :
context -> Scopelang.Ast.ScopeName.t -> Ast.definition -> context
val process_scope_use_item :
Scopelang.Ast.ScopeName.t ->
context -> Ast.scope_use_item Utils.Pos.marked -> context
context -> Ast.scope_use_item Pos.marked -> context
val process_scope_use : context -> Ast.scope_use -> context
val process_use_item :
context -> Ast.code_item Utils.Pos.marked -> context
context -> Ast.code_item Pos.marked -> context
(** {1 API} *)
(** Derive the context from metadata, in one pass over the declarations *)
val form_context : Ast.program -> context

View File

@ -1 +1,17 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** Helpers for parsing *)
val current_file : string ref

View File

@ -1,33 +1,24 @@
module I = Parser.MenhirInterpreter
val state : 'semantic_value I.env -> int
val minimum : 'a -> 'a -> 'a -> 'a
val levenshtein_distance : string -> string -> int
val law_struct_list_to_tree :
Ast.program_item list -> Ast.program_item list
val syntax_hints_style : ANSITerminal.style list
val raise_parser_error :
Utils.Pos.t -> Utils.Pos.t option -> string -> string -> 'a
val fail :
Sedlexing.lexbuf ->
'semantic_value I.env ->
(string * Parser.token) list -> 'semantic_value I.env option -> 'a
val loop :
(unit -> Parser.token * Lexing.position * Lexing.position) ->
(string * Parser.token) list ->
Sedlexing.lexbuf ->
Ast.source_file_or_master I.env option ->
Ast.source_file_or_master I.checkpoint ->
Ast.source_file_or_master
val sedlex_with_menhir :
(Sedlexing.lexbuf -> Parser.token) ->
(string * Parser.token) list ->
(Lexing.position -> Ast.source_file_or_master I.checkpoint) ->
Sedlexing.lexbuf -> Ast.source_file_or_master
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** Wrapping module around parser and lexer that offers the {!val: parse_source_file} API *)
open Utils
(** Parses a single source file *)
val parse_source_file :
Utils.Pos.input_file -> Utils.Cli.frontend_lang -> Ast.program
val expand_includes :
string ->
Ast.program_item list ->
Utils.Cli.frontend_lang -> Ast.program
Pos.input_file -> Cli.frontend_lang -> Ast.program
val parse_top_level_file :
Utils.Pos.input_file -> Utils.Cli.frontend_lang -> Ast.program
Pos.input_file -> Cli.frontend_lang -> Ast.program

View File

@ -1 +1,18 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** Interface of the module auto-generated based on "parser.messages". *)
(** @raise [Not_found] *)
val message : int -> string

View File

@ -1,2 +1,15 @@
val format_primitive_typ :
Format.formatter -> Ast.primitive_typ -> unit
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
val format_primitive_typ : Format.formatter -> Ast.primitive_typ -> unit

View File

@ -1,25 +1,71 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
type frontend_lang = [ `En | `Fr | `NonVerbose ]
type backend_lang = [ `En | `Fr ]
val to_backend_lang : frontend_lang -> backend_lang
(** {2 Configuration globals} *)
(** Source files to be compiled *)
val source_files : string list ref
val locale_lang : backend_lang ref
val contents : string ref
val debug_flag : bool ref
(** Styles the terminal output *)
val style_flag : bool ref
(** Max number of digits to show for decimal results *)
val max_prec_digits : int ref
val trace_flag : bool ref
(** {2 CLI terms} *)
val file : string Cmdliner.Term.t
val debug : bool Cmdliner.Term.t
val unstyled : bool Cmdliner.Term.t
val trace_opt : bool Cmdliner.Term.t
val wrap_weaved_output : bool Cmdliner.Term.t
val backend : string Cmdliner.Term.t
type backend_option = Latex | Makefile | Html | Run | OCaml
val language : string option Cmdliner.Term.t
val max_prec_digits_opt : int option Cmdliner.Term.t
val ex_scope : string option Cmdliner.Term.t
val output : string option Cmdliner.Term.t
val pygmentize_loc : string option Cmdliner.Term.t
(** Main entry point *)
val catala_t :
(string ->
bool ->
@ -30,20 +76,37 @@ val catala_t :
string option ->
int option -> bool -> string option -> string option -> 'a) ->
'a Cmdliner.Term.t
val version : string
val info : Cmdliner.Term.info
val print_with_style :
ANSITerminal.style list -> ('a, unit, string) format -> 'a
(**{1 Terminal formatting}*)
(**{2 Markers}*)
val print_with_style : ANSITerminal.style list -> ('a, unit, string) format -> 'a
val debug_marker : unit -> string
val error_marker : unit -> string
val warning_marker : unit -> string
val result_marker : unit -> string
val log_marker : unit -> string
(**{2 Printers}*)
(** All the printers below print their argument after the correct marker *)
val concat_with_line_depending_prefix_and_suffix :
(int -> string) -> (int -> string) -> string list -> string
(** The int argument of the prefix corresponds to the line number, starting at 0 *)
val add_prefix_to_each_line : string -> (int -> string) -> string
val debug_print : string -> unit
val error_print : string -> unit
val warning_print : string -> unit
val result_print : string -> unit
val log_print : string -> unit

View File

@ -1,11 +1,40 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.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. *)
(** Error formatting and helper functions *)
(** {1 Error exception and printing} *)
exception StructuredError of (string * (string option * Pos.t) list)
val print_structured_error :
string -> (string option * Pos.t) list -> string
(** The payload of the expression is a main error message, with a list of secondary positions
related to the error, each carrying an optional secondary message to describe what is pointed by
the position. *)
val print_structured_error : string -> (string option * Pos.t) list -> string
(** {1 Error exception and printing} *)
val raise_spanned_error : string -> ?span_msg:string -> Pos.t -> 'a
val raise_multispanned_error :
string -> (string option * Pos.t) list -> 'a
val raise_multispanned_error : string -> (string option * Pos.t) list -> 'a
val raise_error : string -> 'a
val print_multispanned_warning :
string -> (string option * Pos.t) list -> unit
(** {1 Warning printing}*)
val print_multispanned_warning : string -> (string option * Pos.t) list -> unit
val print_spanned_warning : string -> ?span_msg:string -> Pos.t -> unit
val print_warning : string -> unit