CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-09-19 16:28:12 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into rmonat_dates_calc_lib

Browse Source
This commit is contained in:
Denis Merigoux 2022-08-19 14:59:46 +02:00
commit e5aed3efcb
No known key found for this signature in database
GPG Key ID: EE99DCFA365C3EE3
113 changed files with 19758 additions and 20895 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.git-blame-ignore-revs
View File

@ -1,7 +1,7 @@
# Reformatting commits to be skipped when running 'git blame'
# Use `git config --global blame.ignoreRevsFile .git-blame-ignore-revs` to use it
# Add new reformatting commits at the top
99b6fc33b508c879f669172005b6c359d7d4f596
ba620fca280338139e015e316894a7cf49c450d5
7485c7f2ce726f59f1ec66ddfe1d3f7d640201d8

1
.github/workflows/run-make-all.yml vendored
View File

@ -33,6 +33,7 @@ jobs:
RELEASE_TAG=$(git describe --tags)
mkdir -p artifacts
docker run --rm catalalang/catala-build:${IMAGE_TAG} sh -uexc '
opam --cli=2.1 remove z3 >&2
opam --cli=2.1 exec -- dune build --profile=release french_law compiler/catala.bc.js >&2
mv _build/default/compiler/catala.bc.js catala_'"${RELEASE_TAG}"'_node.js >&2
tar c -h catala_'"${RELEASE_TAG}"'_node.js french_law --exclude french_law/js/node_modules --exclude french_law/python/env --exclude '"'"'.*'"'"'

3
.nix/catala.nix
View File

@ -28,7 +28,7 @@
buildDunePackage rec {
pname = "catala";
version = "0.6.0"; # TODO parse `catala.opam` with opam2json
version = "0.7.0"; # TODO parse `catala.opam` with opam2json
minimumOCamlVersion = "4.11";
@ -42,7 +42,6 @@ buildDunePackage rec {
benchmark
bindlib
calendar
camomile
cmdliner_1_1_0
cppo
js_of_ocaml

2
.nix/clerk.nix
View File

@ -11,7 +11,7 @@
buildDunePackage rec {
pname = "clerk";
version = "0.6.0"; # TODO parse `catala.opam` with opam2json
version = "0.7.0"; # TODO parse `catala.opam` with opam2json
minimumOCamlVersion = "4.11";

2
.nix/ninja_utils.nix
View File

@ -6,7 +6,7 @@
buildDunePackage rec {
pname = "ninja_utils";
version = "0.6.0"; # TODO parse `catala.opam` with opam2json
version = "0.7.0"; # TODO parse `catala.opam` with opam2json
minimumOCamlVersion = "4.11";

16
CITATION.cff
View File

@ -13,31 +13,31 @@ authors:
family-names: Merigoux
email: denis.merigoux@inria.fr
affiliation: INRIA
orcid: 'https://orcid.org/0000-0003-2247-0938'
orcid: "https://orcid.org/0000-0003-2247-0938"
- given-names: Nicolas
family-names: Chataing
email: nicolas.chataing@ens.fr
affiliation: 'INRIA, ENS'
affiliation: "INRIA, ENS"
- given-names: Emile
family-names: Rolley
email: emile.rolley@tuta.io
- given-names: Louis
family-names: Gesbert
affiliation: 'INRIA, OCamlPro'
affiliation: "INRIA, OCamlPro"
- given-names: Aymeric
family-names: Fromherz
affiliation: Inria
- given-names: Alain
family-names: Delaët-Tixeuil
affiliation: 'INRIA, ENS Lyon'
affiliation: "INRIA, ENS Lyon"
- given-names: Lilya
family-names: Slimani
repository-code: 'https://github.com/CatalaLang/catala'
url: 'https://catala-lang.org/'
repository-code: "https://github.com/CatalaLang/catala"
url: "https://catala-lang.org/"
abstract: >-
Catala is a domain-specific language for deriving
faithful-by-construction algorithms from
legislative texts.
license: Apache-2.0
version: 0.6.0
date-released: '2022-03-08'
version: 0.7.0
date-released: "2022-03-08"

2
Makefile
View File

@ -336,7 +336,7 @@ $(addprefix _build/default/,$(WEBSITE_ASSETS)):
dune build $@
#> website-assets : Builds all the assets necessary for the Catala website
website-assets: js_build literate_examples build_french_law_library_web_api doc
website-assets: build_french_law_library_web_api doc literate_examples build
dune build $(WEBSITE_ASSETS)
##########################################

7
README.md
View File

@ -127,6 +127,13 @@ them, use
make help
### Plugin backends
While the compiler has some builtin backends for Catala (Python, Ocaml, etc.),
it is also possible to add a custom backend to the Catala compiler without
having to modify its source code. This plugin solution relies on dynamic
linking: see [the dedicated README](compiler/plugins/README.md).
### Clerk
Use `clerk --help` if you have installed it to get more information about the command line

4
catala.opam
View File

@ -1,5 +1,5 @@
opam-version: "2.0"
version: "0.6.0"
version: "0.7.0"
synopsis:
"Compiler and library for the literate programming language for tax code specification"
description:
@ -25,7 +25,7 @@ depends: [
"cppo" {>= "1"}
"dates_calc" {>= "0.0.3"}
"dune" {>= "2.8"}
"js_of_ocaml-ppx" {>= "3.8.0"}
"js_of_ocaml-ppx" {>= "4.0.0"}
"menhir" {>= "20200211"}
"menhirLib" {>= "20200211"}
"ocaml" {>= "4.13.0"}

2
clerk.opam
View File

@ -1,5 +1,5 @@
opam-version: "2.0"
version: "0.6.0"
version: "0.7.0"
synopsis:
"Build system for Catala, a specification language for tax and social benefits computation rules"
description:

456
compiler/dcalc/ast.ml
View File

@ -15,240 +15,23 @@
License for the specific language governing permissions and limitations under
the License. *)
[@@@ocaml.warning "-7-34"]
open Utils
module Runtime = Runtime_ocaml.Runtime
include Astgen
include Astgen_utils
module ScopeName : Uid.Id with type info = Uid.MarkedString.info =
Uid.Make (Uid.MarkedString) ()
type lit = dcalc glit
module StructName : Uid.Id with type info = Uid.MarkedString.info =
Uid.Make (Uid.MarkedString) ()
module StructFieldName : Uid.Id with type info = Uid.MarkedString.info =
Uid.Make (Uid.MarkedString) ()
module StructMap : Map.S with type key = StructName.t = Map.Make (StructName)
module EnumName : Uid.Id with type info = Uid.MarkedString.info =
Uid.Make (Uid.MarkedString) ()
module EnumConstructor : Uid.Id with type info = Uid.MarkedString.info =
Uid.Make (Uid.MarkedString) ()
module EnumMap : Map.S with type key = EnumName.t = Map.Make (EnumName)
type typ_lit = TBool | TUnit | TInt | TRat | TMoney | TDate | TDuration
type marked_typ = typ Marked.pos
and typ =
| TLit of typ_lit
| TTuple of marked_typ list * StructName.t option
| TEnum of marked_typ list * EnumName.t
| TArrow of marked_typ * marked_typ
| TArray of marked_typ
| TAny
type date = Runtime.date
type duration = Runtime.duration
type integer = Runtime.integer
type decimal = Runtime.decimal
type money = Runtime.money
type lit =
| LBool of bool
| LEmptyError
| LInt of integer
| LRat of decimal
| LMoney of money
| LUnit
| LDate of date
| LDuration of duration
type op_kind = KInt | KRat | KMoney | KDate | KDuration
type ternop = Fold
type binop =
| And
| Or
| Xor
| Add of op_kind
| Sub of op_kind
| Mult of op_kind
| Div of op_kind
| Lt of op_kind
| Lte of op_kind
| Gt of op_kind
| Gte of op_kind
| Eq
| Neq
| Map
| Concat
| Filter
type log_entry = VarDef of typ | BeginCall | EndCall | PosRecordIfTrueBool
type unop =
| Not
| Minus of op_kind
| Log of log_entry * Utils.Uid.MarkedString.info list
| Length
| IntToRat
| MoneyToRat
| RatToMoney
| GetDay
| GetMonth
| GetYear
| FirstDayOfMonth
| LastDayOfMonth
| RoundMoney
| RoundDecimal
type operator = Ternop of ternop | Binop of binop | Unop of unop
(** Some structures used for type inference *)
module Infer = struct
module Any =
Utils.Uid.Make
(struct
type info = unit
let format_info fmt () = Format.fprintf fmt "any"
end)
()
type unionfind_typ = typ Marked.pos UnionFind.elem
(** 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. *)
and typ =
| TLit of typ_lit
| TArrow of unionfind_typ * unionfind_typ
| TTuple of unionfind_typ list * StructName.t option
| TEnum of unionfind_typ list * EnumName.t
| TArray of unionfind_typ
| TAny of Any.t
let rec typ_to_ast (ty : unionfind_typ) : marked_typ =
let ty, pos = UnionFind.get (UnionFind.find ty) in
match ty with
| TLit l -> TLit l, pos
| TTuple (ts, s) -> TTuple (List.map typ_to_ast ts, s), pos
| TEnum (ts, e) -> TEnum (List.map typ_to_ast ts, e), pos
| TArrow (t1, t2) -> TArrow (typ_to_ast t1, typ_to_ast t2), pos
| TAny _ -> TAny, pos
| TArray t1 -> TArray (typ_to_ast t1), pos
let rec ast_to_typ (ty : marked_typ) : unionfind_typ =
let ty' =
match Marked.unmark ty with
| TLit l -> TLit l
| TArrow (t1, t2) -> TArrow (ast_to_typ t1, ast_to_typ t2)
| TTuple (ts, s) -> TTuple (List.map (fun t -> ast_to_typ t) ts, s)
| TEnum (ts, e) -> TEnum (List.map (fun t -> ast_to_typ t) ts, e)
| TArray t -> TArray (ast_to_typ t)
| TAny -> TAny (Any.fresh ())
in
UnionFind.make (Marked.same_mark_as ty' ty)
end
type untyped = { pos : Pos.t } [@@ocaml.unboxed]
type typed = { pos : Pos.t; ty : marked_typ }
type inferring = { pos : Pos.t; uf : Infer.unionfind_typ }
(** The generic type of AST markings. Using a GADT allows functions to be
polymorphic in the marking, but still do transformations on types when
appropriate *)
type _ mark =
| Untyped : untyped -> untyped mark
| Typed : typed -> typed mark
| Inferring : inferring -> inferring mark
type ('a, 'm) marked = ('a, 'm mark) Marked.t
type 'm marked_expr = ('m expr, 'm) marked
and 'm expr =
| EVar of 'm expr Bindlib.var
| ETuple of 'm marked_expr list * StructName.t option
| ETupleAccess of
'm marked_expr * int * StructName.t option * typ Marked.pos list
| EInj of 'm marked_expr * int * EnumName.t * typ Marked.pos list
| EMatch of 'm marked_expr * 'm marked_expr list * EnumName.t
| EArray of 'm marked_expr list
| ELit of lit
| EAbs of
(('m expr, 'm marked_expr) Bindlib.mbinder[@opaque]) * typ Marked.pos list
| EApp of 'm marked_expr * 'm marked_expr list
| EAssert of 'm marked_expr
| EOp of operator
| EDefault of 'm marked_expr list * 'm marked_expr * 'm marked_expr
| EIfThenElse of 'm marked_expr * 'm marked_expr * 'm marked_expr
| ErrorOnEmpty of 'm marked_expr
type typed_expr = typed marked_expr
type struct_ctx = (StructFieldName.t * typ Marked.pos) list StructMap.t
type enum_ctx = (EnumConstructor.t * typ Marked.pos) list EnumMap.t
type decl_ctx = { ctx_enums : enum_ctx; ctx_structs : struct_ctx }
type 'm binder = ('m expr, 'm marked_expr) Bindlib.binder
type scope_let_kind =
| DestructuringInputStruct
| ScopeVarDefinition
| SubScopeVarDefinition
| CallingSubScope
| DestructuringSubScopeResults
| Assertion
type ('expr, 'm) scope_let = {
scope_let_kind : scope_let_kind;
scope_let_typ : typ Marked.pos;
scope_let_expr : ('expr, 'm) marked;
scope_let_next : ('expr, ('expr, 'm) scope_body_expr) Bindlib.binder;
scope_let_pos : Pos.t;
}
and ('expr, 'm) scope_body_expr =
| Result of ('expr, 'm) marked
| ScopeLet of ('expr, 'm) scope_let
type ('expr, 'm) scope_body = {
scope_body_input_struct : StructName.t;
scope_body_output_struct : StructName.t;
scope_body_expr : ('expr, ('expr, 'm) scope_body_expr) Bindlib.binder;
}
type ('expr, 'm) scope_def = {
scope_name : ScopeName.t;
scope_body : ('expr, 'm) scope_body;
scope_next : ('expr, ('expr, 'm) scopes) Bindlib.binder;
}
and ('expr, 'm) scopes = Nil | ScopeDef of ('expr, 'm) scope_def
type ('expr, 'm) program_generic = {
decl_ctx : decl_ctx;
scopes : ('expr, 'm) scopes;
}
type 'm expr = (dcalc, 'm mark) gexpr
and 'm marked_expr = (dcalc, 'm mark) marked_gexpr
type 'm program = ('m expr, 'm) program_generic
let no_mark (type m) : m mark -> m mark = function
| Untyped _ -> Untyped { pos = Pos.no_pos }
| Typed _ -> Typed { pos = Pos.no_pos; ty = Marked.mark Pos.no_pos TAny }
| Inferring _ ->
Inferring
{
pos = Pos.no_pos;
uf = UnionFind.make Infer.(TAny (Any.fresh ()), Pos.no_pos);
}
let mark_pos (type m) (m : m mark) : Pos.t =
match m with
| Untyped { pos } | Typed { pos; _ } | Inferring { pos; _ } -> pos
match m with Untyped { pos } | Typed { pos; _ } -> pos
let pos (type m) (x : ('a, m) marked) : Pos.t = mark_pos (Marked.get_mark x)
let ty (_, m) : marked_typ = match m with Typed { ty; _ } -> ty
@ -257,78 +40,11 @@ let with_ty (type m) (ty : marked_typ) (x : ('a, m) marked) : ('a, typed) marked
=
Marked.mark
(match Marked.get_mark x with
| Untyped { pos } | Inferring { pos; _ } -> Typed { pos; ty }
| Untyped { pos } -> Typed { pos; ty }
| Typed m -> Typed { m with ty })
(Marked.unmark x)
let evar v mark = Bindlib.box_apply (Marked.mark mark) (Bindlib.box_var v)
let etuple args s mark =
Bindlib.box_apply (fun args -> ETuple (args, s), mark) (Bindlib.box_list args)
let etupleaccess e1 i s typs mark =
Bindlib.box_apply (fun e1 -> ETupleAccess (e1, i, s, typs), mark) e1
let einj e1 i e_name typs mark =
Bindlib.box_apply (fun e1 -> EInj (e1, i, e_name, typs), mark) e1
let ematch arg arms e_name mark =
Bindlib.box_apply2
(fun arg arms -> EMatch (arg, arms, e_name), mark)
arg (Bindlib.box_list arms)
let earray args mark =
Bindlib.box_apply (fun args -> EArray args, mark) (Bindlib.box_list args)
let elit l mark = Bindlib.box (ELit l, mark)
let eabs binder typs mark =
Bindlib.box_apply (fun binder -> EAbs (binder, typs), mark) binder
let eapp e1 args mark =
Bindlib.box_apply2
(fun e1 args -> EApp (e1, args), mark)
e1 (Bindlib.box_list args)
let eassert e1 mark = Bindlib.box_apply (fun e1 -> EAssert e1, mark) e1
let eop op mark = Bindlib.box (EOp op, mark)
let edefault excepts just cons mark =
Bindlib.box_apply3
(fun excepts just cons -> EDefault (excepts, just, cons), mark)
(Bindlib.box_list excepts) just cons
let eifthenelse e1 e2 e3 mark =
Bindlib.box_apply3 (fun e1 e2 e3 -> EIfThenElse (e1, e2, e3), mark) e1 e2 e3
let eerroronempty e1 mark =
Bindlib.box_apply (fun e1 -> ErrorOnEmpty e1, mark) e1
let translate_var v = Bindlib.copy_var v (fun x -> EVar x) (Bindlib.name_of v)
let map_expr ctx ~f e =
let m = Marked.get_mark e in
match Marked.unmark e with
| EVar v -> evar (translate_var v) m
| EApp (e1, args) -> eapp (f ctx e1) (List.map (f ctx) args) m
| EAbs (binder, typs) ->
let vars, body = Bindlib.unmbind binder in
eabs (Bindlib.bind_mvar (Array.map translate_var vars) (f ctx body)) typs m
| ETuple (args, s) -> etuple (List.map (f ctx) args) s m
| ETupleAccess (e1, n, s_name, typs) ->
etupleaccess ((f ctx) e1) n s_name typs m
| EInj (e1, i, e_name, typs) -> einj ((f ctx) e1) i e_name typs m
| EMatch (arg, arms, e_name) ->
ematch ((f ctx) arg) (List.map (f ctx) arms) e_name m
| EArray args -> earray (List.map (f ctx) args) m
| ELit l -> elit l m
| EAssert e1 -> eassert ((f ctx) e1) m
| EOp op -> Bindlib.box (EOp op, m)
| EDefault (excepts, just, cons) ->
edefault (List.map (f ctx) excepts) ((f ctx) just) ((f ctx) cons) m
| EIfThenElse (e1, e2, e3) ->
eifthenelse ((f ctx) e1) ((f ctx) e2) ((f ctx) e3) m
| ErrorOnEmpty e1 -> eerroronempty ((f ctx) e1) m
let map_expr ctx ~f e = Astgen_utils.map_gexpr ctx ~f e
let rec map_expr_top_down ~f e =
map_expr () ~f:(fun () -> map_expr_top_down ~f) (f e)
@ -347,79 +63,7 @@ let box_expr : ('m expr, 'm) box_expr_sig =
let rec id_t () e = map_expr () ~f:id_t e in
id_t () e
let rec fold_left_scope_lets ~f ~init scope_body_expr =
match scope_body_expr with
| Result _ -> init
| ScopeLet scope_let ->
let var, next = Bindlib.unbind scope_let.scope_let_next in
fold_left_scope_lets ~f ~init:(f init scope_let var) next
let rec fold_right_scope_lets ~f ~init scope_body_expr =
match scope_body_expr with
| Result result -> init result
| ScopeLet scope_let ->
let var, next = Bindlib.unbind scope_let.scope_let_next in
let next_result = fold_right_scope_lets ~f ~init next in
f scope_let var next_result
let map_exprs_in_scope_lets ~f ~varf scope_body_expr =
fold_right_scope_lets
~f:(fun scope_let var_next acc ->
Bindlib.box_apply2
(fun scope_let_next scope_let_expr ->
ScopeLet { scope_let with scope_let_next; scope_let_expr })
(Bindlib.bind_var (varf var_next) acc)
(f scope_let.scope_let_expr))
~init:(fun res -> Bindlib.box_apply (fun res -> Result res) (f res))
scope_body_expr
let rec fold_left_scope_defs ~f ~init scopes =
match scopes with
| Nil -> init
| ScopeDef scope_def ->
let var, next = Bindlib.unbind scope_def.scope_next in
fold_left_scope_defs ~f ~init:(f init scope_def var) next
let rec fold_right_scope_defs ~f ~init scopes =
match scopes with
| Nil -> init
| ScopeDef scope_def ->
let var_next, next = Bindlib.unbind scope_def.scope_next in
let result_next = fold_right_scope_defs ~f ~init next in
f scope_def var_next result_next
let map_scope_defs ~f scopes =
fold_right_scope_defs
~f:(fun scope_def var_next acc ->
let new_scope_def = f scope_def in
let new_next = Bindlib.bind_var var_next acc in
Bindlib.box_apply2
(fun new_scope_def new_next ->
ScopeDef { new_scope_def with scope_next = new_next })
new_scope_def new_next)
~init:(Bindlib.box Nil) scopes
let map_exprs_in_scopes ~f ~varf scopes =
fold_right_scope_defs
~f:(fun scope_def var_next acc ->
let scope_input_var, scope_lets =
Bindlib.unbind scope_def.scope_body.scope_body_expr
in
let new_scope_body_expr = map_exprs_in_scope_lets ~f ~varf scope_lets in
let new_scope_body_expr =
Bindlib.bind_var (varf scope_input_var) new_scope_body_expr
in
let new_next = Bindlib.bind_var (varf var_next) acc in
Bindlib.box_apply2
(fun scope_body_expr scope_next ->
ScopeDef
{
scope_def with
scope_body = { scope_def.scope_body with scope_body_expr };
scope_next;
})
new_scope_body_expr new_next)
~init:(Bindlib.box Nil) scopes
open Astgen_utils
let untype_program prg =
{
@ -428,35 +72,17 @@ let untype_program prg =
Bindlib.unbox
(map_exprs_in_scopes
~f:(fun e -> untype_expr e)
~varf:translate_var prg.scopes);
~varf:Var.translate prg.scopes);
}
type 'm var = 'm expr Bindlib.var
type 'm vars = 'm expr Bindlib.mvar
type 'm var = 'm expr Var.t
type 'm vars = 'm expr Var.vars
let new_var s = Bindlib.new_var (fun x -> EVar x) s
module Var = struct
type t = V : 'a expr Bindlib.var -> t
(* We use this trivial GADT to make the 'm parameter disappear under an
existential. It's fine for a use as keys only. (bindlib defines [any_var]
similarly but it's not exported) todo: add [@@ocaml.unboxed] once it's
possible through abstract types *)
let t v = V v
let get (V v) = Bindlib.copy_var v (fun x -> EVar x) (Bindlib.name_of v)
let compare (V x) (V y) = Bindlib.compare_vars x y
let eq (V x) (V y) = Bindlib.eq_vars x y
end
module VarSet = Set.Make (Var)
module VarMap = Map.Make (Var)
let rec free_vars_expr (e : 'm marked_expr) : VarSet.t =
let rec free_vars_expr (e : 'm marked_expr) : 'm expr Var.Set.t =
match Marked.unmark e with
| EVar v -> VarSet.singleton (Var.t v)
| EVar v -> Var.Set.singleton v
| ETuple (es, _) | EArray es ->
es |> List.map free_vars_expr |> List.fold_left VarSet.union VarSet.empty
es |> List.map free_vars_expr |> List.fold_left Var.Set.union Var.Set.empty
| ETupleAccess (e1, _, _, _)
| EAssert e1
| ErrorOnEmpty e1
@ -465,43 +91,43 @@ let rec free_vars_expr (e : 'm marked_expr) : VarSet.t =
| EApp (e1, es) | EMatch (e1, es, _) ->
e1 :: es
|> List.map free_vars_expr
|> List.fold_left VarSet.union VarSet.empty
|> List.fold_left Var.Set.union Var.Set.empty
| EDefault (es, ejust, econs) ->
ejust :: econs :: es
|> List.map free_vars_expr
|> List.fold_left VarSet.union VarSet.empty
| EOp _ | ELit _ -> VarSet.empty
|> List.fold_left Var.Set.union Var.Set.empty
| EOp _ | ELit _ -> Var.Set.empty
| EIfThenElse (e1, e2, e3) ->
[e1; e2; e3]
|> List.map free_vars_expr
|> List.fold_left VarSet.union VarSet.empty
|> List.fold_left Var.Set.union Var.Set.empty
| EAbs (binder, _) ->
let vs, body = Bindlib.unmbind binder in
Array.fold_right VarSet.remove (Array.map Var.t vs) (free_vars_expr body)
Array.fold_right Var.Set.remove vs (free_vars_expr body)
let rec free_vars_scope_body_expr (scope_lets : ('m expr, 'm) scope_body_expr) :
VarSet.t =
'm expr Var.Set.t =
match scope_lets with
| Result e -> free_vars_expr e
| ScopeLet { scope_let_expr = e; scope_let_next = next; _ } ->
let v, body = Bindlib.unbind next in
VarSet.union (free_vars_expr e)
(VarSet.remove (Var.t v) (free_vars_scope_body_expr body))
Var.Set.union (free_vars_expr e)
(Var.Set.remove v (free_vars_scope_body_expr body))
let free_vars_scope_body (scope_body : ('m expr, 'm) scope_body) : VarSet.t =
let free_vars_scope_body (scope_body : ('m expr, 'm) scope_body) :
'm expr Var.Set.t =
let { scope_body_expr = binder; _ } = scope_body in
let v, body = Bindlib.unbind binder in
VarSet.remove (Var.t v) (free_vars_scope_body_expr body)
Var.Set.remove v (free_vars_scope_body_expr body)
let rec free_vars_scopes (scopes : ('m expr, 'm) scopes) : VarSet.t =
let rec free_vars_scopes (scopes : ('m expr, 'm) scopes) : 'm expr Var.Set.t =
match scopes with
| Nil -> VarSet.empty
| Nil -> Var.Set.empty
| ScopeDef { scope_body = body; scope_next = next; _ } ->
let v, next = Bindlib.unbind next in
VarSet.union
(VarSet.remove (Var.t v) (free_vars_scopes next))
Var.Set.union
(Var.Set.remove v (free_vars_scopes next))
(free_vars_scope_body body)
(* type vars = expr Bindlib.mvar *)
let make_var ((x, mark) : ('m expr Bindlib.var, 'm) marked) :
'm marked_expr Bindlib.box =
@ -542,11 +168,6 @@ let map_mark
match m with
| Untyped { pos } -> Untyped { pos = pos_f pos }
| Typed { pos; ty } -> Typed { pos = pos_f pos; ty = ty_f ty }
| Inferring { pos; uf } ->
Inferring
{ pos = pos_f pos; uf = Infer.ast_to_typ (ty_f (Infer.typ_to_ast uf)) }
let resolve_inferring { uf; pos } = { ty = Infer.typ_to_ast uf; pos }
let map_mark2
(type m)
@ -557,13 +178,6 @@ let map_mark2
match m1, m2 with
| Untyped m1, Untyped m2 -> Untyped { pos = pos_f m1.pos m2.pos }
| Typed m1, Typed m2 -> Typed { pos = pos_f m1.pos m2.pos; ty = ty_f m1 m2 }
| Inferring m1, Inferring m2 ->
Inferring
{
pos = pos_f m1.pos m2.pos;
uf =
Infer.ast_to_typ (ty_f (resolve_inferring m1) (resolve_inferring m2));
}
let fold_marks
(type m)
@ -580,17 +194,9 @@ let fold_marks
pos = pos_f (List.map (function Typed { pos; _ } -> pos) ms);
ty = ty_f (List.map (function Typed m -> m) ms);
}
| Inferring _ :: _ ->
Inferring
{
pos = pos_f (List.map (function Inferring { pos; _ } -> pos) ms);
uf =
Infer.ast_to_typ
(ty_f (List.map (function Inferring m -> resolve_inferring m) ms));
}
let empty_thunked_term mark : 'm marked_expr =
let silent = new_var "_" in
let silent = Var.make "_" in
let pos = mark_pos mark in
Bindlib.unbox
(make_abs [| silent |]

325
compiler/dcalc/ast.mli
View File

@ -18,224 +18,32 @@
(** Abstract syntax tree of the default calculus intermediate representation *)
open Utils
module Runtime = Runtime_ocaml.Runtime
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
include module type of Astgen
include module type of Astgen_utils
(** Abstract syntax tree for the default calculus *)
type lit = dcalc glit
(** {1 Abstract syntax tree} *)
type typ_lit = TBool | TUnit | TInt | TRat | TMoney | TDate | TDuration
type marked_typ = typ Marked.pos
and typ =
| TLit of typ_lit
| TTuple of marked_typ list * StructName.t option
| TEnum of marked_typ list * EnumName.t
| TArrow of marked_typ * marked_typ
| TArray of marked_typ
| TAny
type date = Runtime.date
type duration = Runtime.duration
type lit =
| LBool of bool
| LEmptyError
| LInt of Runtime.integer
| LRat of Runtime.decimal
| LMoney of Runtime.money
| LUnit
| LDate of date
| LDuration of duration
type op_kind =
| KInt
| KRat
| KMoney
| KDate
| KDuration (** All ops don't have a KDate and KDuration. *)
type ternop = Fold
type binop =
| And
| Or
| Xor
| Add of op_kind
| Sub of op_kind
| Mult of op_kind
| Div of op_kind
| Lt of op_kind
| Lte of op_kind
| Gt of op_kind
| Gte of op_kind
| Eq
| Neq
| Map
| Concat
| Filter
type log_entry =
| VarDef of typ
(** During code generation, we need to know the type of the variable being
logged for embedding *)
| BeginCall
| EndCall
| PosRecordIfTrueBool
type unop =
| Not
| Minus of op_kind
| Log of log_entry * Utils.Uid.MarkedString.info list
| Length
| IntToRat
| MoneyToRat
| RatToMoney
| GetDay
| GetMonth
| GetYear
| FirstDayOfMonth
| LastDayOfMonth
| RoundMoney
| RoundDecimal
type operator = Ternop of ternop | Binop of binop | Unop of unop
(** Contains some structures used for type inference *)
module Infer : sig
module Any : Utils.Uid.Id with type info = unit
type unionfind_typ = typ Marked.pos UnionFind.elem
(** We do not reuse {!type: 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. *)
and typ =
| TLit of typ_lit
| TArrow of unionfind_typ * unionfind_typ
| TTuple of unionfind_typ list * StructName.t option
| TEnum of unionfind_typ list * EnumName.t
| TArray of unionfind_typ
| TAny of Any.t
val typ_to_ast : unionfind_typ -> marked_typ
val ast_to_typ : marked_typ -> unionfind_typ
end
type untyped = { pos : Pos.t } [@@unboxed]
type typed = { pos : Pos.t; ty : marked_typ }
type inferring = { pos : Pos.t; uf : Infer.unionfind_typ }
(** The generic type of AST markings. Using a GADT allows functions to be
polymorphic in the marking, but still do transformations on types when
appropriate *)
type _ mark =
| Untyped : untyped -> untyped mark
| Typed : typed -> typed mark
| Inferring : inferring -> inferring mark
type ('a, 'm) marked = ('a, 'm mark) Marked.t
type 'm marked_expr = ('m expr, 'm) marked
(** The expressions use the {{:https://lepigre.fr/ocaml-bindlib/} Bindlib}
library, based on higher-order abstract syntax*)
and 'm expr =
| EVar of 'm expr Bindlib.var
| ETuple of 'm marked_expr list * StructName.t option
(** The [MarkedString.info] is the former struct field name*)
| ETupleAccess of 'm marked_expr * int * StructName.t option * marked_typ list
(** The [MarkedString.info] is the former struct field name *)
| EInj of 'm marked_expr * int * EnumName.t * marked_typ list
(** The [MarkedString.info] is the former enum case name *)
| EMatch of 'm marked_expr * 'm marked_expr list * EnumName.t
(** The [MarkedString.info] is the former enum case name *)
| EArray of 'm marked_expr list
| ELit of lit
| EAbs of
(('m expr, 'm marked_expr) Bindlib.mbinder[@opaque]) * marked_typ list
| EApp of 'm marked_expr * 'm marked_expr list
| EAssert of 'm marked_expr
| EOp of operator
| EDefault of 'm marked_expr list * 'm marked_expr * 'm marked_expr
| EIfThenElse of 'm marked_expr * 'm marked_expr * 'm marked_expr
| ErrorOnEmpty of 'm marked_expr
(** {3 Expression annotations ([Marked.t])} *)
type typed_expr = typed marked_expr
type struct_ctx = (StructFieldName.t * marked_typ) list StructMap.t
type enum_ctx = (EnumConstructor.t * marked_typ) list EnumMap.t
type decl_ctx = { ctx_enums : enum_ctx; ctx_structs : struct_ctx }
type 'm binder = ('m expr, 'm marked_expr) Bindlib.binder
(** This kind annotation signals that the let-binding respects a structural
invariant. These invariants concern the shape of the expression in the
let-binding, and are documented below. *)
type scope_let_kind =
| DestructuringInputStruct (** [let x = input.field]*)
| ScopeVarDefinition (** [let x = error_on_empty e]*)
| SubScopeVarDefinition
(** [let s.x = fun _ -> e] or [let s.x = error_on_empty e] for input-only
subscope variables. *)
| CallingSubScope (** [let result = s ({ x = s.x; y = s.x; ...}) ]*)
| DestructuringSubScopeResults (** [let s.x = result.x ]**)
| Assertion (** [let _ = assert e]*)
type ('expr, 'm) scope_let = {
scope_let_kind : scope_let_kind;
scope_let_typ : marked_typ;
scope_let_expr : ('expr, 'm) marked;
scope_let_next : ('expr, ('expr, 'm) scope_body_expr) Bindlib.binder;
scope_let_pos : Pos.t;
}
(** This type is parametrized by the expression type so it can be reused in
later intermediate representations. *)
(** A scope let-binding has all the information necessary to make a proper
let-binding expression, plus an annotation for the kind of the let-binding
that comes from the compilation of a {!module: Scopelang.Ast} statement. *)
and ('expr, 'm) scope_body_expr =
| Result of ('expr, 'm) marked
| ScopeLet of ('expr, 'm) scope_let
type ('expr, 'm) scope_body = {
scope_body_input_struct : StructName.t;
scope_body_output_struct : StructName.t;
scope_body_expr : ('expr, ('expr, 'm) scope_body_expr) Bindlib.binder;
}
(** Instead of being a single expression, we give a little more ad-hoc structure
to the scope body by decomposing it in an ordered list of let-bindings, and
a result expression that uses the let-binded variables. The first binder is
the argument of type [scope_body_input_struct]. *)
type ('expr, 'm) scope_def = {
scope_name : ScopeName.t;
scope_body : ('expr, 'm) scope_body;
scope_next : ('expr, ('expr, 'm) scopes) Bindlib.binder;
}
(** Finally, we do the same transformation for the whole program for the kinded
lets. This permit us to use bindlib variables for scopes names. *)
and ('expr, 'm) scopes = Nil | ScopeDef of ('expr, 'm) scope_def
type ('expr, 'm) program_generic = {
decl_ctx : decl_ctx;
scopes : ('expr, 'm) scopes;
}
type 'm expr = (dcalc, 'm mark) gexpr
and 'm marked_expr = (dcalc, 'm mark) marked_gexpr
type 'm program = ('m expr, 'm) program_generic
(** {1 Helpers} *)
(** {2 Variables} *)
type 'm var = 'm expr Var.t
type 'm vars = 'm expr Var.vars
val free_vars_expr : 'm marked_expr -> 'm expr Var.Set.t
val free_vars_scope_body_expr :
('m expr, 'm) scope_body_expr -> 'm expr Var.Set.t
val free_vars_scope_body : ('m expr, 'm) scope_body -> 'm expr Var.Set.t
val free_vars_scopes : ('m expr, 'm) scopes -> 'm expr Var.Set.t
val make_var : ('m var, 'm) marked -> 'm marked_expr Bindlib.box
(** {2 Manipulation of marks} *)
val no_mark : 'm mark -> 'm mark
@ -379,101 +187,6 @@ val map_expr_top_down :
val map_expr_marks :
f:('m1 mark -> 'm2 mark) -> 'm1 marked_expr -> 'm2 marked_expr Bindlib.box
val fold_left_scope_lets :
f:('a -> ('expr, 'm) scope_let -> 'expr Bindlib.var -> 'a) ->
init:'a ->
('expr, 'm) scope_body_expr ->
'a
(** Usage:
[fold_left_scope_lets ~f:(fun acc scope_let scope_let_var -> ...) ~init scope_lets],
where [scope_let_var] is the variable bound to the scope let in the next
scope lets to be examined. *)
val fold_right_scope_lets :
f:(('expr1, 'm1) scope_let -> 'expr1 Bindlib.var -> 'a -> 'a) ->
init:(('expr1, 'm1) marked -> 'a) ->
('expr1, 'm1) scope_body_expr ->
'a
(** Usage:
[fold_right_scope_lets ~f:(fun scope_let scope_let_var acc -> ...) ~init scope_lets],
where [scope_let_var] is the variable bound to the scope let in the next
scope lets to be examined (which are before in the program order). *)
val map_exprs_in_scope_lets :
f:(('expr1, 'm1) marked -> ('expr2, 'm2) marked Bindlib.box) ->
varf:('expr1 Bindlib.var -> 'expr2 Bindlib.var) ->
('expr1, 'm1) scope_body_expr ->
('expr2, 'm2) scope_body_expr Bindlib.box
val fold_left_scope_defs :
f:('a -> ('expr1, 'm1) scope_def -> 'expr1 Bindlib.var -> 'a) ->
init:'a ->
('expr1, 'm1) scopes ->
'a
(** Usage:
[fold_left_scope_defs ~f:(fun acc scope_def scope_var -> ...) ~init scope_def],
where [scope_var] is the variable bound to the scope in the next scopes to
be examined. *)
val fold_right_scope_defs :
f:(('expr1, 'm1) scope_def -> 'expr1 Bindlib.var -> 'a -> 'a) ->
init:'a ->
('expr1, 'm1) scopes ->
'a
(** Usage:
[fold_right_scope_defs ~f:(fun scope_def scope_var acc -> ...) ~init scope_def],
where [scope_var] is the variable bound to the scope in the next scopes to
be examined (which are before in the program order). *)
val map_scope_defs :
f:(('expr, 'm) scope_def -> ('expr, 'm) scope_def Bindlib.box) ->
('expr, 'm) scopes ->
('expr, 'm) scopes Bindlib.box
val map_exprs_in_scopes :
f:(('expr1, 'm1) marked -> ('expr2, 'm2) marked Bindlib.box) ->
varf:('expr1 Bindlib.var -> 'expr2 Bindlib.var) ->
('expr1, 'm1) scopes ->
('expr2, 'm2) scopes Bindlib.box
(** This is the main map visitor for all the expressions inside all the scopes
of the program. *)
(** {2 Variables} *)
type 'm var = 'm expr Bindlib.var
val new_var : string -> 'm var
val translate_var : 'm1 var -> 'm2 var
(** used to convert between e.g. [untyped expr var] into a [typed expr var] *)
module Var : sig
type t
val t : 'm expr Bindlib.var -> t
(** Hides the marking type parameter annotation behind an existential type so
that variables can be stored in non-polymorphic sets and maps *)
val get : t -> 'm expr Bindlib.var
(** Be careful with this, it breaks the type abstraction by casting the
existential type annotation. See [!Bindlib.copy_var] for more detail. *)
val compare : t -> t -> int
val eq : t -> t -> bool
end
module VarMap : Map.S with type key = Var.t
module VarSet : Set.S with type elt = Var.t
val free_vars_expr : 'm marked_expr -> VarSet.t
val free_vars_scope_body_expr : ('m expr, 'm) scope_body_expr -> VarSet.t
val free_vars_scope_body : ('m expr, 'm) scope_body -> VarSet.t
val free_vars_scopes : ('m expr, 'm) scopes -> VarSet.t
(* type vars = expr Bindlib.mvar *)
val make_var : ('m var, 'm) marked -> 'm marked_expr Bindlib.box
(** {2 Boxed term constructors} *)
type ('e, 'm) make_abs_sig =

3
compiler/dcalc/interpreter.ml
View File

@ -276,8 +276,7 @@ let rec evaluate_operator
Cli.log_format "%*s%a %a: %s" (!log_indent * 2) ""
Print.format_log_entry entry Print.format_uid_list infos
(match e' with
(* | Ast.EAbs _ -> Cli.with_style [ ANSITerminal.green ]
"<function>" *)
| Ast.EAbs _ -> Cli.with_style [ANSITerminal.green] "<function>"
| _ ->
let expr_str =
Format.asprintf "%a"

6
compiler/dcalc/optimizations.ml
View File

@ -18,7 +18,7 @@ open Utils
open Ast
type partial_evaluation_ctx = {
var_values : typed marked_expr Ast.VarMap.t;
var_values : (typed expr, typed marked_expr) Var.Map.t;
decl_ctx : decl_ctx;
}
@ -184,7 +184,7 @@ let rec partial_evaluation (ctx : partial_evaluation_ctx) (e : 'm marked_expr) :
Bindlib.box_apply (fun e1 -> ErrorOnEmpty e1, pos) (rec_helper e1)
let optimize_expr (decl_ctx : decl_ctx) (e : 'm marked_expr) =
partial_evaluation { var_values = VarMap.empty; decl_ctx } e
partial_evaluation { var_values = Var.Map.empty; decl_ctx } e
let rec scope_lets_map
(t : 'a -> 'm marked_expr -> 'm marked_expr Bindlib.box)
@ -250,6 +250,6 @@ let program_map
let optimize_program (p : 'm program) : untyped program =
Bindlib.unbox
(program_map partial_evaluation
{ var_values = VarMap.empty; decl_ctx = p.decl_ctx }
{ var_values = Var.Map.empty; decl_ctx = p.decl_ctx }
p)
|> untype_program

197
compiler/dcalc/typing.ml
View File

@ -18,8 +18,51 @@
inference using the classical W algorithm with union-find unification. *)
open Utils
module A = Ast
open A.Infer
module A = Astgen
module Any =
Utils.Uid.Make
(struct
type info = unit
let format_info fmt () = Format.fprintf fmt "any"
end)
()
type unionfind_typ = typ Marked.pos UnionFind.elem
(** 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. *)
and typ =
| TLit of A.typ_lit
| TArrow of unionfind_typ * unionfind_typ
| TTuple of unionfind_typ list * A.StructName.t option
| TEnum of unionfind_typ list * A.EnumName.t
| TArray of unionfind_typ
| TAny of Any.t
let rec typ_to_ast (ty : unionfind_typ) : A.marked_typ =
let ty, pos = UnionFind.get (UnionFind.find ty) in
match ty with
| TLit l -> TLit l, pos
| TTuple (ts, s) -> TTuple (List.map typ_to_ast ts, s), pos
| TEnum (ts, e) -> TEnum (List.map typ_to_ast ts, e), pos
| TArrow (t1, t2) -> TArrow (typ_to_ast t1, typ_to_ast t2), pos
| TAny _ -> TAny, pos
| TArray t1 -> TArray (typ_to_ast t1), pos
let rec ast_to_typ (ty : A.marked_typ) : unionfind_typ =
let ty' =
match Marked.unmark ty with
| TLit l -> TLit l
| TArrow (t1, t2) -> TArrow (ast_to_typ t1, ast_to_typ t2)
| TTuple (ts, s) -> TTuple (List.map (fun t -> ast_to_typ t) ts, s)
| TEnum (ts, e) -> TEnum (List.map (fun t -> ast_to_typ t) ts, e)
| TArray t -> TArray (ast_to_typ t)
| TAny -> TAny (Any.fresh ())
in
UnionFind.make (Marked.same_mark_as ty' ty)
(** {1 Types and unification} *)
@ -57,14 +100,16 @@ let rec format_typ
exception
Type_error of
A.untyped A.marked_expr
A.any_marked_expr
* typ Marked.pos UnionFind.elem
* typ Marked.pos UnionFind.elem
type mark = { pos : Pos.t; uf : unionfind_typ }
(** Raises an error if unification cannot be performed *)
let rec unify
(ctx : Ast.decl_ctx)
(e : 'm A.marked_expr) (* used for error context *)
(e : ('a, 'm A.mark) Ast.marked_gexpr) (* used for error context *)
(t1 : typ Marked.pos UnionFind.elem)
(t2 : typ Marked.pos UnionFind.elem) : unit =
let unify = unify ctx in
@ -72,9 +117,7 @@ let rec unify
t2; *)
let t1_repr = UnionFind.get (UnionFind.find t1) in
let t2_repr = UnionFind.get (UnionFind.find t2) in
let raise_type_error () =
raise (Type_error (Bindlib.unbox (A.untype_expr e), t1, t2))
in
let raise_type_error () = raise (Type_error (A.AnyExpr e, t1, t2)) in
let repr =
match Marked.unmark t1_repr, Marked.unmark t2_repr with
| TLit tl1, TLit tl2 when tl1 = tl2 -> None
@ -108,6 +151,11 @@ let rec unify
let handle_type_error ctx e t1 t2 =
(* TODO: if we get weird error messages, then it means that we should use the
persistent version of the union-find data structure. *)
let pos =
match e with
| A.AnyExpr e -> (
match Marked.get_mark e with Untyped { pos } | Typed { pos; _ } -> pos)
in
let t1_repr = UnionFind.get (UnionFind.find t1) in
let t2_repr = UnionFind.get (UnionFind.find t2) in
let t1_pos = Marked.get_mark t1_repr in
@ -132,7 +180,7 @@ let handle_type_error ctx e t1 t2 =
( Some
(Format.asprintf
"Error coming from typechecking the following expression:"),
A.pos e );
pos );
Some (Format.asprintf "Type %a coming from expression:" t1_s ()), t1_pos;
Some (Format.asprintf "Type %a coming from expression:" t2_s ()), t2_pos;
]
@ -213,11 +261,10 @@ let op_type (op : A.operator Marked.pos) : typ Marked.pos UnionFind.elem =
(** {1 Double-directed typing} *)
type env = typ Marked.pos UnionFind.elem A.VarMap.t
type 'e env = ('e, typ Marked.pos UnionFind.elem) Var.Map.t
let translate_var v = Bindlib.copy_var v (fun x -> A.EVar x) (Bindlib.name_of v)
let add_pos e ty = Marked.mark (A.pos e) ty
let ty (_, A.Inferring { A.uf; _ }) = uf
let add_pos e ty = Marked.mark (Ast.pos e) ty
let ty (_, { uf; _ }) = uf
let ( let+ ) x f = Bindlib.box_apply f x
let ( and+ ) x1 x2 = Bindlib.box_pair x1 x2
@ -244,24 +291,24 @@ let box_ty e = Bindlib.unbox (Bindlib.box_apply ty e)
(** Infers the most permissive type from an expression *)
let rec typecheck_expr_bottom_up
(ctx : Ast.decl_ctx)
(env : env)
(e : 'm A.marked_expr) : A.inferring A.marked_expr Bindlib.box =
(env : 'm Ast.expr env)
(e : 'm Ast.marked_expr) : (A.dcalc, mark) A.marked_gexpr Bindlib.box =
(* Cli.debug_format "Looking for type of %a" (Print.format_expr ~debug:true
ctx) e; *)
let pos_e = A.pos e in
let mark (e : A.inferring A.expr) uf =
Marked.mark (A.Inferring { A.uf; pos = pos_e }) e
let pos_e = Ast.pos e in
let mark (e : (A.dcalc, mark) A.gexpr) uf =
Marked.mark { uf; pos = pos_e } e
in
let unionfind_make ?(pos = e) t = UnionFind.make (add_pos pos t) in
let mark_with_uf e1 ?pos ty = mark e1 (unionfind_make ?pos ty) in
match Marked.unmark e with
| A.EVar v -> begin
match A.VarMap.find_opt (A.Var.t v) env with
match Var.Map.find_opt v env with
| Some t ->
let+ v' = Bindlib.box_var (translate_var v) in
let+ v' = Bindlib.box_var (Var.translate v) in
mark v' t
| None ->
Errors.raise_spanned_error (A.pos e)
Errors.raise_spanned_error (Ast.pos e)
"Variable %s not found in the current context." (Bindlib.name_of v)
end
| A.ELit (LBool _) as e1 -> Bindlib.box @@ mark_with_uf e1 (TLit TBool)
@ -285,7 +332,7 @@ let rec typecheck_expr_bottom_up
match List.nth_opt utyps n with
| Some t' -> mark (ETupleAccess (e1, n, s, typs)) t'
| None ->
Errors.raise_spanned_error (A.pos e1)
Errors.raise_spanned_error (Marked.get_mark e1).pos
"Expression should have a tuple type with at least %d elements but \
only has %d"
n (List.length typs)
@ -296,7 +343,7 @@ let rec typecheck_expr_bottom_up
match List.nth_opt ts' n with
| Some ts_n -> ts_n
| None ->
Errors.raise_spanned_error (A.pos e)
Errors.raise_spanned_error (Ast.pos e)
"Expression should have a sum type with at least %d cases but only \
has %d"
n (List.length ts')
@ -321,18 +368,16 @@ let rec typecheck_expr_bottom_up
mark (EMatch (e1', es', e_name)) t_ret
| A.EAbs (binder, taus) ->
if Bindlib.mbinder_arity binder <> List.length taus then
Errors.raise_spanned_error (A.pos e)
Errors.raise_spanned_error (Ast.pos e)
"function has %d variables but was supplied %d types"
(Bindlib.mbinder_arity binder)
(List.length taus)
else
let xs, body = Bindlib.unmbind binder in
let xs' = Array.map translate_var xs in
let xstaus = List.mapi (fun i tau -> xs'.(i), ast_to_typ tau) taus in
let xs' = Array.map Var.translate xs in
let xstaus = List.mapi (fun i tau -> xs.(i), ast_to_typ tau) taus in
let env =
List.fold_left
(fun env (x, tau) -> A.VarMap.add (A.Var.t x) tau env)
env xstaus
List.fold_left (fun env (x, tau) -> Var.Map.add x tau env) env xstaus
in
let body' = typecheck_expr_bottom_up ctx env body in
let t_func =
@ -402,27 +447,30 @@ let rec typecheck_expr_bottom_up
(** Checks whether the expression can be typed with the provided type *)
and typecheck_expr_top_down
(ctx : Ast.decl_ctx)
(env : env)
(env : 'm Ast.expr env)
(tau : typ Marked.pos UnionFind.elem)
(e : 'm A.marked_expr) : A.inferring A.marked_expr Bindlib.box =
(e : 'm Ast.marked_expr) : (A.dcalc, mark) A.marked_gexpr Bindlib.box =
(* Cli.debug_format "Propagating type %a for expr %a" (format_typ ctx) tau
(Print.format_expr ctx) e; *)
let pos_e = A.pos e in
let mark e = Marked.mark (A.Inferring { uf = tau; pos = pos_e }) e in
let unify_and_mark (e : A.inferring A.expr) tau' =
let e = Marked.mark (A.Inferring { uf = tau'; pos = pos_e }) e in
unify ctx (Bindlib.unbox (A.untype_expr e)) tau tau';
e
let pos_e = Ast.pos e in
let mark e = Marked.mark { uf = tau; pos = pos_e } e in
let unify_and_mark (e' : (A.dcalc, mark) A.gexpr) tau' =
(* This try...with was added because of
[tests/test_bool/bad/bad_assert.catala_en] but we shouldn't need it.
TODO: debug why it is needed here. *)
(try unify ctx e tau tau'
with Type_error (e', t1, t2) -> handle_type_error ctx e' t1 t2);
Marked.mark { uf = tau; pos = pos_e } e'
in
let unionfind_make ?(pos = e) t = UnionFind.make (add_pos pos t) in
match Marked.unmark e with
| A.EVar v -> begin
match A.VarMap.find_opt (A.Var.t v) env with
match Var.Map.find_opt v env with
| Some tau' ->
let+ v' = Bindlib.box_var (translate_var v) in
let+ v' = Bindlib.box_var (Var.translate v) in
unify_and_mark v' tau'
| None ->
Errors.raise_spanned_error (A.pos e)
Errors.raise_spanned_error pos_e
"Variable %s not found in the current context" (Bindlib.name_of v)
end
| A.ELit (LBool _) as e1 ->
@ -465,7 +513,7 @@ and typecheck_expr_top_down
match List.nth_opt ts' n with
| Some ts_n -> ts_n
| None ->
Errors.raise_spanned_error (A.pos e)
Errors.raise_spanned_error (Ast.pos e)
"Expression should have a sum type with at least %d cases but only \
has %d"
n (List.length ts)
@ -496,19 +544,19 @@ and typecheck_expr_top_down
unify_and_mark (EMatch (e1', es', e_name)) t_ret
| A.EAbs (binder, t_args) ->
if Bindlib.mbinder_arity binder <> List.length t_args then
Errors.raise_spanned_error (A.pos e)
Errors.raise_spanned_error (Ast.pos e)
"function has %d variables but was supplied %d types"
(Bindlib.mbinder_arity binder)
(List.length t_args)
else
let xs, body = Bindlib.unmbind binder in
let xs' = Array.map translate_var xs in
let xs' = Array.map Var.translate xs in
let xstaus =
List.map2 (fun x t_arg -> x, ast_to_typ t_arg) (Array.to_list xs) t_args
in
let env =
List.fold_left
(fun env (x, t_arg) -> A.VarMap.add (A.Var.t x) t_arg env)
(fun env (x, t_arg) -> Var.Map.add x t_arg env)
env xstaus
in
let body' = typecheck_expr_bottom_up ctx env body in
@ -577,30 +625,28 @@ let wrap ctx f e =
(** {1 API} *)
let get_ty_mark (A.Inferring { uf; pos }) =
A.Typed { ty = A.Infer.typ_to_ast uf; pos }
let get_ty_mark { uf; pos } = A.Typed { ty = typ_to_ast uf; pos }
(* Infer the type of an expression *)
let infer_types (ctx : Ast.decl_ctx) (e : 'm A.marked_expr) :
let infer_types (ctx : Ast.decl_ctx) (e : 'm Ast.marked_expr) :
Ast.typed Ast.marked_expr Bindlib.box =
A.map_expr_marks ~f:get_ty_mark
Astgen_utils.map_gexpr_marks ~f:get_ty_mark
@@ Bindlib.unbox
@@ wrap ctx (typecheck_expr_bottom_up ctx A.VarMap.empty) e
@@ wrap ctx (typecheck_expr_bottom_up ctx Var.Map.empty) e
let infer_type (type m) ctx (e : m A.marked_expr) =
let infer_type (type m) ctx (e : m Ast.marked_expr) =
match Marked.get_mark e with
| A.Typed { ty; _ } -> ty
| A.Inferring { uf; _ } -> typ_to_ast uf
| A.Untyped _ -> A.ty (Bindlib.unbox (infer_types ctx e))
| A.Untyped _ -> Ast.ty (Bindlib.unbox (infer_types ctx e))
(** Typechecks an expression given an expected type *)
let check_type
(ctx : Ast.decl_ctx)
(e : 'm A.marked_expr)
(e : 'm Ast.marked_expr)
(tau : A.typ Marked.pos) =
(* todo: consider using the already inferred type if ['m] = [typed] *)
ignore
@@ wrap ctx (typecheck_expr_top_down ctx A.VarMap.empty (ast_to_typ tau)) e
@@ wrap ctx (typecheck_expr_top_down ctx Var.Map.empty (ast_to_typ tau)) e
let infer_types_program prg =
let ctx = prg.A.decl_ctx in
@ -631,34 +677,36 @@ let infer_types_program prg =
in
let rec process_scope_body_expr env = function
| A.Result e ->
let e' = typecheck_expr_bottom_up ctx env e in
let e' = wrap ctx (typecheck_expr_bottom_up ctx env) e in
Bindlib.box_apply
(fun e ->
unify ctx e (ty e) ty_out;
A.Result e)
(fun e1 ->
wrap ctx (unify ctx e (ty e1)) ty_out;
let e1 = Astgen_utils.map_gexpr_marks ~f:get_ty_mark e1 in
A.Result (Bindlib.unbox e1))
e'
| A.ScopeLet
{
scope_let_kind;
scope_let_typ;
scope_let_expr = e;
scope_let_expr = e0;
scope_let_next;
scope_let_pos;
} ->
let ty_e = ast_to_typ scope_let_typ in
let e = typecheck_expr_bottom_up ctx env e in
let e = wrap ctx (typecheck_expr_bottom_up ctx env) e0 in
let var, next = Bindlib.unbind scope_let_next in
let env = A.VarMap.add (A.Var.t var) ty_e env in
let env = Var.Map.add var ty_e env in
let next = process_scope_body_expr env next in
let scope_let_next = Bindlib.bind_var (translate_var var) next in
let scope_let_next = Bindlib.bind_var (Var.translate var) next in
Bindlib.box_apply2
(fun scope_let_expr scope_let_next ->
unify ctx scope_let_expr (ty scope_let_expr) ty_e;
(fun e scope_let_next ->
wrap ctx (unify ctx e0 (ty e)) ty_e;
let e = Astgen_utils.map_gexpr_marks ~f:get_ty_mark e in
A.ScopeLet
{
scope_let_kind;
scope_let_typ;
scope_let_expr;
scope_let_expr = Bindlib.unbox e;
scope_let_next;
scope_let_pos;
})
@ -666,26 +714,15 @@ let infer_types_program prg =
in
let scope_body_expr =
let var, e = Bindlib.unbind body in
let env = A.VarMap.add (A.Var.t var) ty_in env in
let env = Var.Map.add var ty_in env in
let e' = process_scope_body_expr env e in
let e' =
Bindlib.box_apply
(fun e ->
Bindlib.unbox
@@ A.map_exprs_in_scope_lets ~varf:translate_var
~f:
(A.map_expr_top_down ~f:(fun e ->
Marked.(mark (get_ty_mark (get_mark e)) (unmark e))))
e)
e'
in
Bindlib.bind_var (translate_var var) e'
Bindlib.bind_var (Var.translate var) e'
in
let scope_next =
let scope_var, next = Bindlib.unbind scope_next in
let env = A.VarMap.add (A.Var.t scope_var) ty_scope env in
let env = Var.Map.add scope_var ty_scope env in
let next' = process_scopes env next in
Bindlib.bind_var (translate_var scope_var) next'
Bindlib.bind_var (Var.translate scope_var) next'
in
Bindlib.box_apply2
(fun scope_body_expr scope_next ->
@ -702,6 +739,6 @@ let infer_types_program prg =
})
scope_body_expr scope_next
in
let scopes = wrap ctx (process_scopes A.VarMap.empty) prg.scopes in
let scopes = wrap ctx (process_scopes Var.Map.empty) prg.scopes in
Bindlib.box_apply (fun scopes -> { A.decl_ctx = ctx; scopes }) scopes
|> Bindlib.unbox

17
compiler/desugared/desugared_to_scope.ml
View File

@ -357,8 +357,16 @@ let translate_def
aren't"
in
let top_list = def_map_to_tree def_info def in
let is_input =
match Marked.unmark io.Scopelang.Ast.io_input with
| OnlyInput -> true
| _ -> false
in
let top_value =
if is_cond then
if is_cond && ((not is_subscope_var) || (is_subscope_var && is_input)) then
(* We add the bottom [false] value for conditions, only for the scope
where the condition is declared. Except when the variable is an input,
where we want the [false] to be added at each caller parent scope. *)
Some
(Ast.always_false_rule
(Ast.ScopeDef.get_position def_info)
@ -385,12 +393,7 @@ let translate_def
for all subscope variables that are not defined. It covers the subtlety
with functions described above but also conditions with the false default
value. *)
&& not
(is_cond
&&
match Marked.unmark io.Scopelang.Ast.io_input with
| OnlyInput -> true
| _ -> false)
&& not (is_cond && is_input)
(* However, this special case suffers from an exception: when a condition is
defined as an OnlyInput to a subscope, since the [false] default value
will not be provided by the calee scope, it has to be placed in the

94
compiler/lcalc/ast.ml
View File

@ -15,45 +15,17 @@
the License. *)
open Utils
module Runtime = Runtime_ocaml.Runtime
include Astgen
module D = Dcalc.Ast
type lit =
| LBool of bool
| LInt of Runtime.integer
| LRat of Runtime.decimal
| LMoney of Runtime.money
| LUnit
| LDate of Runtime.date
| LDuration of Runtime.duration
type lit = lcalc glit
type except = ConflictError | EmptyError | NoValueProvided | Crash
type 'm mark = 'm D.mark
type 'm marked_expr = ('m expr, 'm) D.marked
and 'm expr =
| EVar of 'm expr Bindlib.var
| ETuple of 'm marked_expr list * D.StructName.t option
(** The [MarkedString.info] is the former struct field name*)
| ETupleAccess of
'm marked_expr * int * D.StructName.t option * D.typ Marked.pos list
(** The [MarkedString.info] is the former struct field name *)
| EInj of 'm marked_expr * int * D.EnumName.t * D.typ Marked.pos list
(** The [MarkedString.info] is the former enum case name *)
| EMatch of 'm marked_expr * 'm marked_expr list * D.EnumName.t
(** The [MarkedString.info] is the former enum case name *)
| EArray of 'm marked_expr list
| ELit of lit
| EAbs of ('m expr, 'm marked_expr) Bindlib.mbinder * D.typ Marked.pos list
| EApp of 'm marked_expr * 'm marked_expr list
| EAssert of 'm marked_expr
| EOp of D.operator
| EIfThenElse of 'm marked_expr * 'm marked_expr * 'm marked_expr
| ERaise of except
| ECatch of 'm marked_expr * except * 'm marked_expr
type 'm expr = (lcalc, 'm mark) gexpr
and 'm marked_expr = (lcalc, 'm mark) marked_gexpr
type 'm program = ('m expr, 'm) Dcalc.Ast.program_generic
type 'm var = 'm expr Var.t
type 'm vars = 'm expr Var.vars
(* <copy-paste from dcalc/ast.ml> *)
@ -92,23 +64,6 @@ let eop op mark = Bindlib.box (EOp op, mark)
let eifthenelse e1 e2 e3 pos =
Bindlib.box_apply3 (fun e1 e2 e3 -> EIfThenElse (e1, e2, e3), pos) e1 e2 e3
type 'm var = 'm expr Bindlib.var
type 'm vars = 'm expr Bindlib.mvar
let new_var s = Bindlib.new_var (fun x -> EVar x) s
module Var = struct
type t = V : 'a var -> t
(* See Dcalc.Ast.var *)
let t v = V v
let get (V v) = Bindlib.copy_var v (fun x -> EVar x) (Bindlib.name_of v)
let compare (V x) (V y) = Bindlib.compare_vars x y
end
module VarSet = Set.Make (Var)
module VarMap = Map.Make (Var)
(* </copy-paste> *)
let eraise e1 pos = Bindlib.box (ERaise e1, pos)
@ -116,32 +71,7 @@ let eraise e1 pos = Bindlib.box (ERaise e1, pos)
let ecatch e1 exn e2 pos =
Bindlib.box_apply2 (fun e1 e2 -> ECatch (e1, exn, e2), pos) e1 e2
let translate_var v = Bindlib.copy_var v (fun x -> EVar x) (Bindlib.name_of v)
let map_expr ctx ~f e =
let m = Marked.get_mark e in
match Marked.unmark e with
| EVar v -> evar (translate_var v) (Marked.get_mark e)
| EApp (e1, args) ->
eapp (f ctx e1) (List.map (f ctx) args) (Marked.get_mark e)
| EAbs (binder, typs) ->
let vars, body = Bindlib.unmbind binder in
eabs (Bindlib.bind_mvar (Array.map translate_var vars) (f ctx body)) typs m
| ETuple (args, s) -> etuple (List.map (f ctx) args) s (Marked.get_mark e)
| ETupleAccess (e1, n, s_name, typs) ->
etupleaccess ((f ctx) e1) n s_name typs (Marked.get_mark e)
| EInj (e1, i, e_name, typs) ->
einj ((f ctx) e1) i e_name typs (Marked.get_mark e)
| EMatch (arg, arms, e_name) ->
ematch ((f ctx) arg) (List.map (f ctx) arms) e_name (Marked.get_mark e)
| EArray args -> earray (List.map (f ctx) args) (Marked.get_mark e)
| ELit l -> elit l (Marked.get_mark e)
| EAssert e1 -> eassert ((f ctx) e1) (Marked.get_mark e)
| EOp op -> Bindlib.box (EOp op, Marked.get_mark e)
| ERaise exn -> eraise exn (Marked.get_mark e)
| EIfThenElse (e1, e2, e3) ->
eifthenelse ((f ctx) e1) ((f ctx) e2) ((f ctx) e3) (Marked.get_mark e)
| ECatch (e1, exn, e2) -> ecatch (f ctx e1) exn (f ctx e2) (Marked.get_mark e)
let map_expr ctx ~f e = Astgen_utils.map_gexpr ctx ~f e
let rec map_expr_top_down ~f e =
map_expr () ~f:(fun () -> map_expr_top_down ~f) (f e)
@ -159,7 +89,7 @@ let untype_program prg =
Bindlib.unbox
(D.map_exprs_in_scopes
~f:(fun e -> untype_expr e)
~varf:translate_var prg.D.scopes);
~varf:Var.translate prg.D.scopes);
}
(** See [Bindlib.box_term] documentation for why we are doing that. *)
@ -254,13 +184,11 @@ let make_matchopt_with_abs_arms arg e_none e_some =
e_some, permitting it to be used inside the expression. There is no
requirements on the form of both e_some and e_none. *)
let make_matchopt m v tau arg e_none e_some =
let x = new_var "_" in
let x = Var.make "_" in
make_matchopt_with_abs_arms arg
(make_abs (Array.of_list [x]) e_none [D.TLit D.TUnit, D.mark_pos m] m)
(make_abs (Array.of_list [v]) e_some [tau] m)
let handle_default = Var.t (new_var "handle_default")
let handle_default_opt = Var.t (new_var "handle_default_opt")
type 'm binder = ('m expr, 'm marked_expr) Bindlib.binder
let handle_default = Var.make "handle_default"
let handle_default_opt = Var.make "handle_default_opt"

72
compiler/lcalc/ast.mli
View File

@ -15,79 +15,23 @@
the License. *)
open Utils
module Runtime = Runtime_ocaml.Runtime
include module type of Astgen
(** 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 = lcalc glit
type lit =
| LBool of bool
| LInt of Runtime.integer
| LRat of Runtime.decimal
| LMoney of Runtime.money
| LUnit
| LDate of Runtime.date
| LDuration of Runtime.duration
type except = ConflictError | EmptyError | NoValueProvided | Crash
type 'm mark = 'm Dcalc.Ast.mark
type 'm marked_expr = ('m expr, 'm) Dcalc.Ast.marked
and 'm expr =
| EVar of 'm expr Bindlib.var
| ETuple of 'm marked_expr list * Dcalc.Ast.StructName.t option
(** The [MarkedString.info] is the former struct field name*)
| ETupleAccess of
'm marked_expr
* int
* Dcalc.Ast.StructName.t option
* Dcalc.Ast.typ Marked.pos list
(** The [MarkedString.info] is the former struct field name *)
| EInj of
'm marked_expr
* int
* Dcalc.Ast.EnumName.t
* Dcalc.Ast.typ Marked.pos list
(** The [MarkedString.info] is the former enum case name *)
| EMatch of 'm marked_expr * 'm marked_expr list * Dcalc.Ast.EnumName.t
(** The [MarkedString.info] is the former enum case name *)
| EArray of 'm marked_expr list
| ELit of lit
| EAbs of
('m expr, 'm marked_expr) Bindlib.mbinder * Dcalc.Ast.typ Marked.pos list
| EApp of 'm marked_expr * 'm marked_expr list
| EAssert of 'm marked_expr
| EOp of Dcalc.Ast.operator
| EIfThenElse of 'm marked_expr * 'm marked_expr * 'm marked_expr
| ERaise of except
| ECatch of 'm marked_expr * except * 'm marked_expr
type 'm expr = (lcalc, 'm mark) gexpr
and 'm marked_expr = (lcalc, 'm mark) marked_gexpr
type 'm program = ('m expr, 'm) Dcalc.Ast.program_generic
(** {1 Variable helpers} *)
type 'm var = 'm expr Bindlib.var
type 'm vars = 'm expr Bindlib.mvar
module Var : sig
type t
val t : 'm expr Bindlib.var -> t
val get : t -> 'm expr Bindlib.var
val compare : t -> t -> int
end
module VarMap : Map.S with type key = Var.t
module VarSet : Set.S with type elt = Var.t
val new_var : string -> 'm var
type 'm binder = ('m expr, 'm marked_expr) Bindlib.binder
type 'm var = 'm expr Var.t
type 'm vars = 'm expr Var.vars
(** {2 Program traversal} *)
@ -246,5 +190,5 @@ val box_expr : 'm marked_expr -> 'm marked_expr Bindlib.box
(** {1 Special symbols} *)
val handle_default : Var.t
val handle_default_opt : Var.t
val handle_default : untyped var
val handle_default_opt : untyped var

24
compiler/lcalc/closure_conversion.ml
View File

@ -21,12 +21,12 @@ module D = Dcalc.Ast
(** TODO: This version is not yet debugged and ought to be specialized when
Lcalc has more structure. *)
type ctx = { name_context : string; globally_bound_vars : VarSet.t }
type 'm ctx = { name_context : string; globally_bound_vars : 'm expr Var.Set.t }
(** Returns the expression with closed closures and the set of free variables
inside this new expression. Implementation guided by
http://gallium.inria.fr/~fpottier/mpri/cours04.pdf#page=9. *)
let closure_conversion_expr (type m) (ctx : ctx) (e : m marked_expr) :
let closure_conversion_expr (type m) (ctx : m ctx) (e : m marked_expr) :
m marked_expr Bindlib.box =
let module MVarSet = Set.Make (struct
type t = m var
@ -39,7 +39,7 @@ let closure_conversion_expr (type m) (ctx : ctx) (e : m marked_expr) :
( Bindlib.box_apply
(fun new_v -> new_v, Marked.get_mark e)
(Bindlib.box_var v),
if VarSet.mem (Var.t v) ctx.globally_bound_vars then MVarSet.empty
if Var.Set.mem v ctx.globally_bound_vars then MVarSet.empty
else MVarSet.singleton v )
| ETuple (args, s) ->
let new_args, free_vars =
@ -138,9 +138,9 @@ let closure_conversion_expr (type m) (ctx : ctx) (e : m marked_expr) :
in
let extra_vars_list = MVarSet.elements extra_vars in
(* x1, ..., xn *)
let code_var = new_var ctx.name_context in
let code_var = Var.make ctx.name_context in
(* code *)
let inner_c_var = new_var "env" in
let inner_c_var = Var.make "env" in
let any_ty = Dcalc.Ast.TAny, binder_pos in
let new_closure_body =
make_multiple_let_in
@ -200,8 +200,7 @@ let closure_conversion_expr (type m) (ctx : ctx) (e : m marked_expr) :
(fun new_e2 -> EApp ((EOp op, pos_op), new_e2), Marked.get_mark e)
(Bindlib.box_list new_args),
free_vars )
| EApp ((EVar v, v_pos), args)
when VarSet.mem (Var.t v) ctx.globally_bound_vars ->
| EApp ((EVar v, v_pos), args) when Var.Set.mem v ctx.globally_bound_vars ->
(* This corresponds to a scope call, which we don't want to transform*)
let new_args, free_vars =
List.fold_right
@ -217,8 +216,8 @@ let closure_conversion_expr (type m) (ctx : ctx) (e : m marked_expr) :
free_vars )
| EApp (e1, args) ->
let new_e1, free_vars = aux e1 in
let env_var = new_var "env" in
let code_var = new_var "code" in
let env_var = Var.make "env" in
let code_var = Var.make "code" in
let new_args, free_vars =
List.fold_right
(fun arg (new_args, free_vars) ->
@ -286,7 +285,7 @@ let closure_conversion (p : 'm program) : 'm program Bindlib.box =
let scope_input_var, scope_body_expr =
Bindlib.unbind scope.scope_body.scope_body_expr
in
let global_vars = VarSet.add (Var.t scope_var) global_vars in
let global_vars = Var.Set.add scope_var global_vars in
let ctx =
{
name_context =
@ -320,7 +319,10 @@ let closure_conversion (p : 'm program) : 'm program Bindlib.box =
new_scope_body_expr
(Bindlib.bind_var scope_var next))),
global_vars ))
~init:(Fun.id, VarSet.of_list [handle_default; handle_default_opt])
~init:
( Fun.id,
Var.Set.of_list
(List.map Var.translate [handle_default; handle_default_opt]) )
p.scopes
in
Bindlib.box_apply

30
compiler/lcalc/compile_with_exceptions.ml
View File

@ -18,7 +18,7 @@ open Utils
module D = Dcalc.Ast
module A = Ast
type 'm ctx = 'm A.var D.VarMap.t
type 'm ctx = ('m D.expr, 'm A.expr Var.t) Var.Map.t
(** This environment contains a mapping between the variables in Dcalc and their
correspondance in Lcalc. *)
@ -35,7 +35,7 @@ let translate_lit (l : D.lit) : 'm A.expr =
let thunk_expr (e : 'm A.marked_expr Bindlib.box) (mark : 'm A.mark) :
'm A.marked_expr Bindlib.box =
let dummy_var = A.new_var "_" in
let dummy_var = Var.make "_" in
A.make_abs [| dummy_var |] e [D.TAny, D.mark_pos mark] mark
let rec translate_default
@ -51,7 +51,7 @@ let rec translate_default
in
let exceptions =
A.make_app
(A.make_var (A.Var.get A.handle_default, mark_default))
(A.make_var (Var.translate A.handle_default, mark_default))
[
A.earray exceptions mark_default;
thunk_expr (translate_expr ctx just) mark_default;
@ -64,7 +64,7 @@ let rec translate_default
and translate_expr (ctx : 'm ctx) (e : 'm D.marked_expr) :
'm A.marked_expr Bindlib.box =
match Marked.unmark e with
| D.EVar v -> A.make_var (D.VarMap.find (D.Var.t v) ctx, Marked.get_mark e)
| D.EVar v -> A.make_var (Var.Map.find v ctx, Marked.get_mark e)
| D.ETuple (args, s) ->
A.etuple (List.map (translate_expr ctx) args) s (Marked.get_mark e)
| D.ETupleAccess (e1, i, s, ts) ->
@ -96,8 +96,8 @@ and translate_expr (ctx : 'm ctx) (e : 'm D.marked_expr) :
let ctx, lc_vars =
Array.fold_right
(fun var (ctx, lc_vars) ->
let lc_var = A.new_var (Bindlib.name_of var) in
D.VarMap.add (D.Var.t var) lc_var ctx, lc_var :: lc_vars)
let lc_var = Var.make (Bindlib.name_of var) in
Var.Map.add var lc_var ctx, lc_var :: lc_vars)
vars (ctx, [])
in
let lc_vars = Array.of_list lc_vars in
@ -126,11 +126,9 @@ let rec translate_scope_lets
let old_scope_let_var, scope_let_next =
Bindlib.unbind scope_let.scope_let_next
in
let new_scope_let_var = A.new_var (Bindlib.name_of old_scope_let_var) in
let new_scope_let_var = Var.make (Bindlib.name_of old_scope_let_var) in
let new_scope_let_expr = translate_expr ctx scope_let.scope_let_expr in
let new_ctx =
D.VarMap.add (D.Var.t old_scope_let_var) new_scope_let_var ctx
in
let new_ctx = Var.Map.add old_scope_let_var new_scope_let_var ctx in
let new_scope_next = translate_scope_lets decl_ctx new_ctx scope_let_next in
let new_scope_next = Bindlib.bind_var new_scope_let_var new_scope_next in
Bindlib.box_apply2
@ -154,15 +152,13 @@ let rec translate_scopes
| ScopeDef scope_def ->
let old_scope_var, scope_next = Bindlib.unbind scope_def.scope_next in
let new_scope_var =
A.new_var (Marked.unmark (D.ScopeName.get_info scope_def.scope_name))
Var.make (Marked.unmark (D.ScopeName.get_info scope_def.scope_name))
in
let old_scope_input_var, scope_body_expr =
Bindlib.unbind scope_def.scope_body.scope_body_expr
in
let new_scope_input_var = A.new_var (Bindlib.name_of old_scope_input_var) in
let new_ctx =
D.VarMap.add (D.Var.t old_scope_input_var) new_scope_input_var ctx
in
let new_scope_input_var = Var.make (Bindlib.name_of old_scope_input_var) in
let new_ctx = Var.Map.add old_scope_input_var new_scope_input_var ctx in
let new_scope_body_expr =
translate_scope_lets decl_ctx new_ctx scope_body_expr
in
@ -181,7 +177,7 @@ let rec translate_scopes
})
new_scope_body_expr
in
let new_ctx = D.VarMap.add (D.Var.t old_scope_var) new_scope_var new_ctx in
let new_ctx = Var.Map.add old_scope_var new_scope_var new_ctx in
let scope_next =
Bindlib.bind_var new_scope_var
(translate_scopes decl_ctx new_ctx scope_next)
@ -199,6 +195,6 @@ let rec translate_scopes
let translate_program (prgm : 'm D.program) : 'm A.program =
{
scopes =
Bindlib.unbox (translate_scopes prgm.decl_ctx D.VarMap.empty prgm.scopes);
Bindlib.unbox (translate_scopes prgm.decl_ctx Var.Map.empty prgm.scopes);
decl_ctx = prgm.decl_ctx;
}

65
compiler/lcalc/compile_without_exceptions.ml
View File

@ -40,7 +40,7 @@ module A = Ast
hoisted and later handled by the [translate_expr] function. Every other
cases is found in the translate_and_hoist function. *)
type 'm hoists = 'm D.marked_expr A.VarMap.t
type 'm hoists = ('m A.expr, 'm D.marked_expr) Var.Map.t
(** Hoists definition. It represent bindings between [A.Var.t] and [D.expr]. *)
type 'm info = {
@ -60,14 +60,13 @@ let pp_info (fmt : Format.formatter) (info : 'm info) =
type 'm ctx = {
decl_ctx : D.decl_ctx;
vars : 'm info D.VarMap.t;
vars : ('m D.expr, 'm info) Var.Map.t;
(** information context about variables in the current scope *)
}
let _pp_ctx (fmt : Format.formatter) (ctx : 'm ctx) =
let pp_binding (fmt : Format.formatter) ((v, info) : D.Var.t * 'm info) =
Format.fprintf fmt "%a: %a" Dcalc.Print.format_var (D.Var.get v) pp_info
info
let pp_binding (fmt : Format.formatter) ((v, info) : 'm D.var * 'm info) =
Format.fprintf fmt "%a: %a" Dcalc.Print.format_var v pp_info info
in
let pp_bindings =
@ -76,14 +75,14 @@ let _pp_ctx (fmt : Format.formatter) (ctx : 'm ctx) =
pp_binding
in
Format.fprintf fmt "@[<2>[%a]@]" pp_bindings (D.VarMap.bindings ctx.vars)
Format.fprintf fmt "@[<2>[%a]@]" pp_bindings (Var.Map.bindings ctx.vars)
(** [find ~info n ctx] is a warpper to ocaml's Map.find that handle errors in a
slightly better way. *)
let find ?(info : string = "none") (n : 'm D.var) (ctx : 'm ctx) : 'm info =
(* let _ = Format.asprintf "Searching for variable %a inside context %a"
Dcalc.Print.format_var n pp_ctx ctx |> Cli.debug_print in *)
try D.VarMap.find (D.Var.t n) ctx.vars
try Var.Map.find n ctx.vars
with Not_found ->
Errors.raise_spanned_error Pos.no_pos
"Internal Error: Variable %a was not found in the current environment. \
@ -96,7 +95,7 @@ let find ?(info : string = "none") (n : 'm D.var) (ctx : 'm ctx) : 'm info =
debuging purposes as it printing each of the Dcalc/Lcalc variable pairs. *)
let add_var (mark : 'm D.mark) (var : 'm D.var) (is_pure : bool) (ctx : 'm ctx)
: 'm ctx =
let new_var = A.new_var (Bindlib.name_of var) in
let new_var = Var.make (Bindlib.name_of var) in
let expr = A.make_var (new_var, mark) in
(* Cli.debug_print @@ Format.asprintf "D.%a |-> A.%a" Dcalc.Print.format_var
@ -104,7 +103,7 @@ let add_var (mark : 'm D.mark) (var : 'm D.var) (is_pure : bool) (ctx : 'm ctx)
{
ctx with
vars =
D.VarMap.update (D.Var.t var)
Var.Map.update var
(fun _ -> Some { expr; var = new_var; is_pure })
ctx.vars;
}
@ -147,16 +146,16 @@ let translate_lit (l : D.lit) (pos : Pos.t) : A.lit =
(** [c = disjoint_union_maps cs] Compute the disjoint union of multiple maps.
Raises an internal error if there is two identicals keys in differnts parts. *)
let disjoint_union_maps (pos : Pos.t) (cs : 'a A.VarMap.t list) : 'a A.VarMap.t
=
let disjoint_union_maps (pos : Pos.t) (cs : ('e, 'a) Var.Map.t list) :
('e, 'a) Var.Map.t =
let disjoint_union =
A.VarMap.union (fun _ _ _ ->
Var.Map.union (fun _ _ _ ->
Errors.raise_spanned_error pos
"Internal Error: Two supposed to be disjoints maps have one shared \
key.")
in
List.fold_left disjoint_union A.VarMap.empty cs
List.fold_left disjoint_union Var.Map.empty cs
(** [e' = translate_and_hoist ctx e ] Translate the Dcalc expression e into an
expression in Lcalc, given we translate each hoists correctly. It ensures
@ -176,34 +175,34 @@ let rec translate_and_hoist (ctx : 'm ctx) (e : 'm D.marked_expr) :
assumption can change in the future, and this case is here for this
reason. *)
if not (find ~info:"search for a variable" v ctx).is_pure then
let v' = A.new_var (Bindlib.name_of v) in
let v' = Var.make (Bindlib.name_of v) in
(* Cli.debug_print @@ Format.asprintf "Found an unpure variable %a,
created a variable %a to replace it" Dcalc.Print.format_var v
Print.format_var v'; *)
A.make_var (v', pos), A.VarMap.singleton (A.Var.t v') e
else (find ~info:"should never happend" v ctx).expr, A.VarMap.empty
A.make_var (v', pos), Var.Map.singleton v' e
else (find ~info:"should never happend" v ctx).expr, Var.Map.empty
| D.EApp ((D.EVar v, p), [(D.ELit D.LUnit, _)]) ->
if not (find ~info:"search for a variable" v ctx).is_pure then
let v' = A.new_var (Bindlib.name_of v) in
let v' = Var.make (Bindlib.name_of v) in
(* Cli.debug_print @@ Format.asprintf "Found an unpure variable %a,
created a variable %a to replace it" Dcalc.Print.format_var v
Print.format_var v'; *)
A.make_var (v', pos), A.VarMap.singleton (A.Var.t v') (D.EVar v, p)
A.make_var (v', pos), Var.Map.singleton v' (D.EVar v, p)
else
Errors.raise_spanned_error (D.pos e)
"Internal error: an pure variable was found in an unpure environment."
| D.EDefault (_exceptions, _just, _cons) ->
let v' = A.new_var "default_term" in
A.make_var (v', pos), A.VarMap.singleton (A.Var.t v') e
let v' = Var.make "default_term" in
A.make_var (v', pos), Var.Map.singleton v' e
| D.ELit D.LEmptyError ->
let v' = A.new_var "empty_litteral" in
A.make_var (v', pos), A.VarMap.singleton (A.Var.t v') e
let v' = Var.make "empty_litteral" in
A.make_var (v', pos), Var.Map.singleton v' e
(* This one is a very special case. It transform an unpure expression
environement to a pure expression. *)
| ErrorOnEmpty arg ->
(* [ match arg with | None -> raise NoValueProvided | Some v -> {{ v }} ] *)
let silent_var = A.new_var "_" in
let x = A.new_var "non_empty_argument" in
let silent_var = Var.make "_" in
let x = Var.make "non_empty_argument" in
let arg' = translate_expr ctx arg in
@ -213,9 +212,9 @@ let rec translate_and_hoist (ctx : 'm ctx) (e : 'm D.marked_expr) :
[D.TAny, D.pos e]
pos)
(A.make_abs [| x |] (A.make_var (x, pos)) [D.TAny, D.pos e] pos),
A.VarMap.empty )
Var.Map.empty )
(* pure terms *)
| D.ELit l -> A.elit (translate_lit l (D.pos e)) pos, A.VarMap.empty
| D.ELit l -> A.elit (translate_lit l (D.pos e)) pos, Var.Map.empty
| D.EIfThenElse (e1, e2, e3) ->
let e1', h1 = translate_and_hoist ctx e1 in
let e2', h2 = translate_and_hoist ctx e2 in
@ -293,12 +292,12 @@ let rec translate_and_hoist (ctx : 'm ctx) (e : 'm D.marked_expr) :
let es', hoists = es |> List.map (translate_and_hoist ctx) |> List.split in
A.earray es' pos, disjoint_union_maps (D.pos e) hoists
| EOp op -> Bindlib.box (A.EOp op, pos), A.VarMap.empty
| EOp op -> Bindlib.box (A.EOp op, pos), Var.Map.empty
and translate_expr ?(append_esome = true) (ctx : 'm ctx) (e : 'm D.marked_expr)
: 'm A.marked_expr Bindlib.box =
let e', hoists = translate_and_hoist ctx e in
let hoists = A.VarMap.bindings hoists in
let hoists = Var.Map.bindings hoists in
let _pos = Marked.get_mark e in
@ -321,7 +320,7 @@ and translate_expr ?(append_esome = true) (ctx : 'm ctx) (e : 'm D.marked_expr)
let cons' = translate_expr ctx cons in
(* calls handle_option. *)
A.make_app
(A.make_var (A.Var.get A.handle_default_opt, mark_hoist))
(A.make_var (Var.translate A.handle_default_opt, mark_hoist))
[
Bindlib.box_apply
(fun excep' -> A.EArray excep', mark_hoist)
@ -336,8 +335,8 @@ and translate_expr ?(append_esome = true) (ctx : 'm ctx) (e : 'm D.marked_expr)
(* [ match arg with | None -> raise NoValueProvided | Some v -> assert
{{ v }} ] *)
let silent_var = A.new_var "_" in
let x = A.new_var "assertion_argument" in
let silent_var = Var.make "_" in
let x = Var.make "assertion_argument" in
A.make_matchopt_with_abs_arms arg'
(A.make_abs [| silent_var |]
@ -360,7 +359,7 @@ and translate_expr ?(append_esome = true) (ctx : 'm ctx) (e : 'm D.marked_expr)
] *)
(* Cli.debug_print @@ Format.asprintf "build matchopt using %a"
Print.format_var v; *)
A.make_matchopt mark_hoist (A.Var.get v)
A.make_matchopt mark_hoist v
(D.TAny, D.mark_pos mark_hoist)
c' (A.make_none mark_hoist) acc)
@ -582,7 +581,7 @@ let translate_program (prgm : 'm D.program) : 'm A.program =
let scopes =
Bindlib.unbox
(translate_scopes { decl_ctx; vars = D.VarMap.empty } prgm.scopes)
(translate_scopes { decl_ctx; vars = Var.Map.empty } prgm.scopes)
in
{ scopes; decl_ctx }

4
compiler/lcalc/to_ocaml.ml
View File

@ -416,8 +416,8 @@ let rec format_expr
Format.fprintf fmt "@[<hov 2>%a@ %a@]" format_unop (op, Pos.no_pos)
format_with_parens arg1
| EApp ((EVar x, pos), args)
when Ast.Var.compare (Ast.Var.t x) Ast.handle_default = 0
|| Ast.Var.compare (Ast.Var.t x) Ast.handle_default_opt = 0 ->
when Var.compare x (Var.translate Ast.handle_default) = 0
|| Var.compare x (Var.translate Ast.handle_default_opt) = 0 ->
Format.fprintf fmt
"@[<hov 2>%a@ @[<hov 2>{filename = \"%s\";@ start_line=%d;@ \
start_column=%d;@ end_line=%d; end_column=%d;@ law_headings=%a}@]@ %a@]"

25
compiler/literate/html.ml
View File

@ -135,7 +135,7 @@ let pygmentize_code (c : string Marked.pos) (language : C.backend_lang) : string
"style=colorful,anchorlinenos=True,lineanchors=\""
^ String_common.to_ascii (Pos.get_file (Marked.get_mark c))
^ "\",linenos=table,linenostart="
^ string_of_int (Pos.get_start_line (Marked.get_mark c) - 1);
^ string_of_int (Pos.get_start_line (Marked.get_mark c));
"-o";
temp_file_out;
temp_file_in;
@ -161,7 +161,7 @@ let pygmentize_code (c : string Marked.pos) (language : C.backend_lang) : string
let sanitize_html_href str =
str
|> String_common.to_ascii
|> R.substitute ~rex:(R.regexp "[' '°]") ~subst:(function _ -> "%20")
|> R.substitute ~rex:(R.regexp "[' '°\"]") ~subst:(function _ -> "%20")
let rec law_structure_to_html
(language : C.backend_lang)
@ -208,15 +208,18 @@ let rec law_structure_to_html
%a"
h_number id id h_name
(match heading.law_heading_id, language with
| Some id, Fr ->
let ltime = Unix.localtime (Unix.time ()) in
P.sprintf
"<a class=\"link-article\" \
href=\"https://legifrance.gouv.fr/codes/id/%s/%d-%02d-%02d\" \
target=\"_blank\">Voir le texte sur Légifrance.gouv.fr</a>"
id
(1900 + ltime.Unix.tm_year)
(ltime.Unix.tm_mon + 1) ltime.Unix.tm_mday
| Some id, Fr -> (
try
P.sprintf
"<a class=\"link-article\" \
href=\"https://legifrance.gouv.fr/%s/id/%s\" \
target=\"_blank\">Voir le texte sur Légifrance.gouv.fr</a>"
(if String.starts_with ~prefix:"LEGIARTI" id then "codes"
else if String.starts_with ~prefix:"JORFARTI" id then "jorf"
else if String.starts_with ~prefix:"CETATEXT" id then "ceta"
else raise Not_found)
id
with Not_found -> "")
| _ -> "")
h_number fmt_details_open ()
(Format.pp_print_list

8
compiler/literate/latex.ml
View File

@ -185,7 +185,11 @@ let check_exceeding_lines
content
|> String.split_on_char '\n'
|> List.iteri (fun i s ->
if String.length s > max_len then (
if
String.length (Ubase.from_utf8 s)
(* we remove diacritics to avoid false positives due to UFT8 encoding
not taken into account by String *) > max_len
then (
Cli.warning_print "The line %s in %s is exceeding %s characters:"
(Cli.with_style
ANSITerminal.[Bold; yellow]
@ -243,7 +247,7 @@ let rec law_structure_to_latex
%s```\n\
\\end{minted}"
(pre_latexify (Filename.basename (Pos.get_file (Marked.get_mark c))))
(Pos.get_start_line (Marked.get_mark c) - 1)
(Pos.get_start_line (Marked.get_mark c) + 1)
(get_language_extension language)
(Marked.unmark c)
| A.CodeBlock (_, c, true) when not print_only_law ->

11
compiler/plugins/README.md Normal file
View File

@ -0,0 +1,11 @@
# Catala compiler plugins
You want to add a customized backend for the Catala compiler but don't
want to modify its source code? Thanks to dynamic linking, it is possible
to do so. The advantage of creating a customized backend is the possibility
to craft a generated target code that perfectly matches the naming conventions,
module structure or coding style of your application.
See the [online documentation](https://catala-lang.org/ocaml_docs/catala/plugins.html)
for more details on how to create them, or look at the existing plugins
in this directory for inspiration.

48
compiler/scalc/compile_from_lambda.ml
View File

@ -19,23 +19,23 @@ module A = Ast
module L = Lcalc.Ast
module D = Dcalc.Ast
type ctxt = {
func_dict : A.TopLevelName.t L.VarMap.t;
type 'm ctxt = {
func_dict : ('m L.expr, A.TopLevelName.t) Var.Map.t;
decl_ctx : D.decl_ctx;
var_dict : A.LocalName.t L.VarMap.t;
var_dict : ('m L.expr, A.LocalName.t) Var.Map.t;
inside_definition_of : A.LocalName.t option;
context_name : string;
}
(* Expressions can spill out side effect, hence this function also returns a
list of statements to be prepended before the expression is evaluated *)
let rec translate_expr (ctxt : ctxt) (expr : 'm L.marked_expr) :
let rec translate_expr (ctxt : 'm ctxt) (expr : 'm L.marked_expr) :
A.block * A.expr Marked.pos =
match Marked.unmark expr with
| L.EVar v ->
let local_var =
try A.EVar (L.VarMap.find (L.Var.t v) ctxt.var_dict)
with Not_found -> A.EFunc (L.VarMap.find (L.Var.t v) ctxt.func_dict)
try A.EVar (Var.Map.find v ctxt.var_dict)
with Not_found -> A.EFunc (Var.Map.find v ctxt.func_dict)
in
[], (local_var, D.pos expr)
| L.ETuple (args, Some s_name) ->
@ -115,8 +115,8 @@ let rec translate_expr (ctxt : ctxt) (expr : 'm L.marked_expr) :
:: tmp_stmts,
(A.EVar tmp_var, D.pos expr) )
and translate_statements (ctxt : ctxt) (block_expr : 'm L.marked_expr) : A.block
=
and translate_statements (ctxt : 'm ctxt) (block_expr : 'm L.marked_expr) :
A.block =
match Marked.unmark block_expr with
| L.EAssert e ->
(* Assertions are always encapsulated in a unit-typed let binding *)
@ -133,7 +133,7 @@ and translate_statements (ctxt : ctxt) (block_expr : 'm L.marked_expr) : A.block
var_dict =
List.fold_left
(fun var_dict (x, _) ->
L.VarMap.add (L.Var.t x)
Var.Map.add x
(A.LocalName.fresh (Bindlib.name_of x, binder_pos))
var_dict)
ctxt.var_dict vars_tau;
@ -142,15 +142,14 @@ and translate_statements (ctxt : ctxt) (block_expr : 'm L.marked_expr) : A.block
let local_decls =
List.map
(fun (x, tau) ->
( A.SLocalDecl
((L.VarMap.find (L.Var.t x) ctxt.var_dict, binder_pos), tau),
( A.SLocalDecl ((Var.Map.find x ctxt.var_dict, binder_pos), tau),
binder_pos ))
vars_tau
in
let vars_args =
List.map2
(fun (x, tau) arg ->
(L.VarMap.find (L.Var.t x) ctxt.var_dict, binder_pos), tau, arg)
(Var.Map.find x ctxt.var_dict, binder_pos), tau, arg)
vars_tau args
in
let def_blocks =
@ -185,7 +184,7 @@ and translate_statements (ctxt : ctxt) (block_expr : 'm L.marked_expr) : A.block
var_dict =
List.fold_left
(fun var_dict (x, _) ->
L.VarMap.add (L.Var.t x)
Var.Map.add x
(A.LocalName.fresh (Bindlib.name_of x, binder_pos))
var_dict)
ctxt.var_dict vars_tau;
@ -200,7 +199,7 @@ and translate_statements (ctxt : ctxt) (block_expr : 'm L.marked_expr) : A.block
func_params =
List.map
(fun (var, tau) ->
(L.VarMap.find (L.Var.t var) ctxt.var_dict, binder_pos), tau)
(Var.Map.find var ctxt.var_dict, binder_pos), tau)
vars_tau;
func_body = new_body;
} ),
@ -220,10 +219,7 @@ and translate_statements (ctxt : ctxt) (block_expr : 'm L.marked_expr) : A.block
A.LocalName.fresh (Bindlib.name_of var, D.pos arg)
in
let ctxt =
{
ctxt with
var_dict = L.VarMap.add (L.Var.t var) scalc_var ctxt.var_dict;
}
{ ctxt with var_dict = Var.Map.add var scalc_var ctxt.var_dict }
in
let new_arg = translate_statements ctxt body in
(new_arg, scalc_var) :: new_args
@ -275,8 +271,8 @@ and translate_statements (ctxt : ctxt) (block_expr : 'm L.marked_expr) : A.block
let rec translate_scope_body_expr
(scope_name : D.ScopeName.t)
(decl_ctx : D.decl_ctx)
(var_dict : A.LocalName.t L.VarMap.t)
(func_dict : A.TopLevelName.t L.VarMap.t)
(var_dict : ('m L.expr, A.LocalName.t) Var.Map.t)
(func_dict : ('m L.expr, A.TopLevelName.t) Var.Map.t)
(scope_expr : ('m L.expr, 'm) D.scope_body_expr) : A.block =
match scope_expr with
| Result e ->
@ -297,7 +293,7 @@ let rec translate_scope_body_expr
let let_var_id =
A.LocalName.fresh (Bindlib.name_of let_var, scope_let.scope_let_pos)
in
let new_var_dict = L.VarMap.add (L.Var.t let_var) let_var_id var_dict in
let new_var_dict = Var.Map.add let_var let_var_id var_dict in
(match scope_let.scope_let_kind with
| D.Assertion ->
translate_statements
@ -349,7 +345,7 @@ let translate_program (p : 'm L.program) : A.program =
A.LocalName.fresh (Bindlib.name_of scope_input_var, input_pos)
in
let var_dict =
L.VarMap.singleton (L.Var.t scope_input_var) scope_input_var_id
Var.Map.singleton scope_input_var scope_input_var_id
in
let new_scope_body =
translate_scope_body_expr scope_def.D.scope_name p.decl_ctx
@ -358,9 +354,7 @@ let translate_program (p : 'm L.program) : A.program =
let func_id =
A.TopLevelName.fresh (Bindlib.name_of scope_var, Pos.no_pos)
in
let func_dict =
L.VarMap.add (L.Var.t scope_var) func_id func_dict
in
let func_dict = Var.Map.add scope_var func_id func_dict in
( func_dict,
{
Ast.scope_body_name = scope_def.D.scope_name;
@ -387,8 +381,8 @@ let translate_program (p : 'm L.program) : A.program =
:: new_scopes ))
~init:
( (if !Cli.avoid_exceptions_flag then
L.VarMap.singleton L.handle_default_opt A.handle_default_opt
else L.VarMap.singleton L.handle_default A.handle_default),
Var.Map.singleton L.handle_default_opt A.handle_default_opt
else Var.Map.singleton L.handle_default A.handle_default),
[] )
p.D.scopes
in

27
compiler/scopelang/scope_to_dcalc.ml
View File

@ -332,9 +332,7 @@ let rec translate_expr (ctx : ctx) (e : Ast.expr Marked.pos) :
Bindlib.box_apply Marked.unmark new_e
| EAbs (binder, typ) ->
let xs, body = Bindlib.unmbind binder in
let new_xs =
Array.map (fun x -> Dcalc.Ast.new_var (Bindlib.name_of x)) xs
in
let new_xs = Array.map (fun x -> Var.make (Bindlib.name_of x)) xs in
let both_xs = Array.map2 (fun x new_x -> x, new_x) xs new_xs in
let body =
translate_expr
@ -415,7 +413,7 @@ let translate_rule
match rule with
| Definition ((ScopeVar a, var_def_pos), tau, a_io, e) ->
let a_name = Ast.ScopeVar.get_info (Marked.unmark a) in
let a_var = Dcalc.Ast.new_var (Marked.unmark a_name) in
let a_var = Var.make (Marked.unmark a_name) in
let tau = translate_typ ctx tau in
let new_e = translate_expr ctx e in
let a_expr = Dcalc.Ast.make_var (a_var, pos_mark var_def_pos) in
@ -469,14 +467,14 @@ let translate_rule
^ Marked.unmark (Ast.ScopeVar.get_info (Marked.unmark subs_var)))
(Ast.SubScopeName.get_info (Marked.unmark subs_index))
in
let a_var = Dcalc.Ast.new_var (Marked.unmark a_name) in
let a_var = Var.make (Marked.unmark a_name) in
let tau = translate_typ ctx tau in
let new_e =
tag_with_log_entry (translate_expr ctx e)
(Dcalc.Ast.VarDef (Marked.unmark tau))
[sigma_name, pos_sigma; a_name]
in
let silent_var = Dcalc.Ast.new_var "_" in
let silent_var = Var.make "_" in
let thunked_or_nonempty_new_e =
match Marked.unmark a_io.io_input with
| NoInput -> failwith "should not happen"
@ -582,7 +580,7 @@ let translate_rule
List.map
(fun (subvar : scope_var_ctx) ->
let sub_dcalc_var =
Dcalc.Ast.new_var
Var.make
(Marked.unmark (Ast.SubScopeName.get_info subindex)
^ "."
^ Marked.unmark (Ast.ScopeVar.get_info subvar.scope_var_name))
@ -613,7 +611,7 @@ let translate_rule
Ast.ScopeName.get_info subname;
]
in
let result_tuple_var = Dcalc.Ast.new_var "result" in
let result_tuple_var = Var.make "result" in
let result_tuple_typ =
( Dcalc.Ast.TTuple
( List.map
@ -698,7 +696,7 @@ let translate_rule
new_e;
Dcalc.Ast.scope_let_kind = Dcalc.Ast.Assertion;
})
(Bindlib.bind_var (Dcalc.Ast.new_var "_") next)
(Bindlib.bind_var (Var.make "_") next)
new_e),
ctx )
@ -753,7 +751,7 @@ let translate_scope_decl
(sigma : Ast.scope_decl) :
(Dcalc.Ast.untyped Dcalc.Ast.expr, Dcalc.Ast.untyped) Dcalc.Ast.scope_body
Bindlib.box
* Dcalc.Ast.struct_ctx =
* Astgen.struct_ctx =
let sigma_info = Ast.ScopeName.get_info sigma.scope_decl_name in
let scope_sig = Ast.ScopeMap.find sigma.scope_decl_name sctx in
let scope_variables = scope_sig.scope_sig_local_vars in
@ -765,9 +763,7 @@ let translate_scope_decl
match Marked.unmark scope_var.scope_var_io.io_input with
| OnlyInput ->
let scope_var_name = Ast.ScopeVar.get_info scope_var.scope_var_name in
let scope_var_dcalc =
Dcalc.Ast.new_var (Marked.unmark scope_var_name)
in
let scope_var_dcalc = Var.make (Marked.unmark scope_var_name) in
{
ctx with
scope_vars =
@ -916,7 +912,7 @@ let translate_program (prgm : Ast.program) :
Ast.ScopeMap.mapi
(fun scope_name scope ->
let scope_dvar =
Dcalc.Ast.new_var
Var.make
(Marked.unmark (Ast.ScopeName.get_info scope.Ast.scope_decl_name))
in
let scope_return_struct_name =
@ -926,8 +922,7 @@ let translate_program (prgm : Ast.program) :
(Ast.ScopeName.get_info scope_name))
in
let scope_input_var =
Dcalc.Ast.new_var
(Marked.unmark (Ast.ScopeName.get_info scope_name) ^ "_in")
Var.make (Marked.unmark (Ast.ScopeName.get_info scope_name) ^ "_in")
in
let scope_input_struct_name =
Ast.StructName.fresh

1
compiler/surface/ast.ml
View File

@ -421,6 +421,7 @@ and expression =
| MemCollection of expression Marked.pos * expression Marked.pos
| TestMatchCase of expression Marked.pos * match_case_pattern Marked.pos
| FunCall of expression Marked.pos * expression Marked.pos
| LetIn of ident Marked.pos * expression Marked.pos * expression Marked.pos
| Builtin of builtin_expression
| Literal of literal
| EnumInject of

13
compiler/surface/desugaring.ml
View File

@ -117,7 +117,7 @@ let disambiguate_constructor
(** 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 *)
disambiguate the scope and subscopes variables than occur in the expression *)
let rec translate_expr
(scope : Scopelang.Ast.ScopeName.t)
(inside_definition_of : Desugared.Ast.ScopeDef.t Marked.pos option)
@ -367,6 +367,17 @@ let rec translate_expr
Bindlib.box_apply2
(fun f arg -> Desugared.Ast.EApp (f, [arg]), pos)
(rec_helper f) (rec_helper arg)
| LetIn (x, e1, e2) ->
let ctxt, v = Name_resolution.add_def_local_var ctxt (Marked.unmark x) in
let tau = Scopelang.Ast.TAny, Marked.get_mark x in
let fn =
Desugared.Ast.make_abs [| v |]
(translate_expr scope inside_definition_of ctxt e2)
[tau] pos
in
Bindlib.box_apply2
(fun fn arg -> Desugared.Ast.(EApp (fn, [arg]), pos))
fn (rec_helper e1)
| StructLit (s_name, fields) ->
let s_uid =
try Desugared.Ast.IdentMap.find (Marked.unmark s_name) ctxt.struct_idmap

7
compiler/surface/lexer.cppo.ml
View File

@ -164,6 +164,9 @@ module R = Re.Pcre
#ifndef MR_RULE
#define MR_RULE MS_RULE
#endif
#ifndef MR_LET
#define MR_LET MS_LET
#endif
#ifndef MR_EXISTS
#define MR_EXISTS MS_EXISTS
#endif
@ -308,6 +311,7 @@ let token_list : (string * token) list =
(MS_FIXED, FIXED);
(MS_BY, BY);
(MS_RULE, RULE);
(MS_LET, LET);
(MS_EXISTS, EXISTS);
(MS_IN, IN);
(MS_SUCH, SUCH);
@ -522,6 +526,9 @@ let rec lex_code (lexbuf : lexbuf) : token =
| MR_RULE ->
L.update_acc lexbuf;
RULE
| MR_LET ->
L.update_acc lexbuf;
LET
| MR_EXISTS ->
L.update_acc lexbuf;
EXISTS

1
compiler/surface/lexer_en.cppo.ml
View File

@ -67,6 +67,7 @@
#define MS_FIXED "fixed"
#define MS_BY "by"
#define MS_RULE "rule"
#define MS_LET "let"
#define MS_EXISTS "exists"
#define MS_IN "in"
#define MS_SUCH "such"

1
compiler/surface/lexer_fr.cppo.ml
View File

@ -86,6 +86,7 @@
#define MS_BY "par"
#define MS_RULE "règle"
#define MR_RULE "r", 0xE8, "gle"
#define MS_LET "soit"
#define MS_EXISTS "existe"
#define MS_IN "dans"
#define MS_SUCH "tel"

2
compiler/surface/lexer_pl.cppo.ml
View File

@ -71,7 +71,9 @@
#define MS_FIXED "staloprzecinkowa"
#define MS_BY "przez"
#define MS_RULE "zasada"
#define MS_LET "niech"
#define MS_EXISTS "istnieje"
(* "in" or "w" ? *)
#define MS_IN "in"
#define MS_SUCH "takie ze"
#define MR_SUCH "takie", space_plus, "ze"

302
compiler/surface/parser.messages
View File

File diff suppressed because it is too large Load Diff

11
compiler/surface/parser.mly
View File

@ -352,6 +352,9 @@ let (pos, i,e1) = i_in_e1 in
| IF e1 = expression THEN e2 = expression ELSE e3 = expression {
(IfThenElse (e1, e2, e3), Pos.from_lpos $sloc)
}
| LET id = ident DEFINED_AS e1 = expression IN e2 = expression {
(LetIn (id, e1, e2), Pos.from_lpos $sloc)
}
| e = logical_expression { e }
condition:
@ -628,8 +631,8 @@ code:
metadata_block:
| BEGIN_METADATA option(law_text) code_and_pos = code text = END_CODE {
let (code, pos) = code_and_pos in
(code, (text, pos))
let (code, _) = code_and_pos in
(code, (text, Pos.from_lpos $sloc))
}
@ -649,8 +652,8 @@ law_text:
source_file_item:
| text = law_text { LawText text }
| BEGIN_CODE code_and_pos = code text = END_CODE {
let (code, pos) = code_and_pos in
CodeBlock (code, (text, pos), false)
let (code, _) = code_and_pos in
CodeBlock (code, (text, Pos.from_lpos $sloc), false)
}
| heading = law_heading {
LawHeading (heading, [])

2
compiler/surface/tokens.mly
View File

@ -45,7 +45,7 @@
%token LESSER_MONEY GREATER_MONEY LESSER_EQUAL_MONEY GREATER_EQUAL_MONEY
%token LESSER_DATE GREATER_DATE LESSER_EQUAL_DATE GREATER_EQUAL_DATE
%token LESSER_DURATION GREATER_DURATION LESSER_EQUAL_DURATION GREATER_EQUAL_DURATION
%token EXISTS IN SUCH THAT
%token LET EXISTS IN SUCH THAT
%token DOT AND OR XOR LPAREN RPAREN EQUAL
%token CARDINAL ASSERTION FIXED BY YEAR MONTH DAY
%token PLUS MINUS MULT DIV

293
compiler/utils/astgen.ml Normal file
View File

@ -0,0 +1,293 @@
(* This file is part of the Catala compiler, a specification language for tax
and social benefits computation rules. Copyright (C) 2020-2022 Inria,
contributor: Denis Merigoux <denis.merigoux@inria.fr>, Alain Delaët-Tixeuil
<alain.delaet--tixeuil@inria.fr>, Louis Gesbert <louis.gesbert@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. *)
module Runtime = Runtime_ocaml.Runtime
module ScopeName : Uid.Id with type info = Uid.MarkedString.info =
Uid.Make (Uid.MarkedString) ()
module StructName : Uid.Id with type info = Uid.MarkedString.info =
Uid.Make (Uid.MarkedString) ()
module StructFieldName : Uid.Id with type info = Uid.MarkedString.info =
Uid.Make (Uid.MarkedString) ()
module StructMap : Map.S with type key = StructName.t = Map.Make (StructName)
module EnumName : Uid.Id with type info = Uid.MarkedString.info =
Uid.Make (Uid.MarkedString) ()
module EnumConstructor : Uid.Id with type info = Uid.MarkedString.info =
Uid.Make (Uid.MarkedString) ()
module EnumMap : Map.S with type key = EnumName.t = Map.Make (EnumName)
(** Abstract syntax tree for the default calculus *)
(** {1 Abstract syntax tree} *)
(** {2 Types} *)
type typ_lit = TBool | TUnit | TInt | TRat | TMoney | TDate | TDuration
type marked_typ = typ Marked.pos
and typ =
| TLit of typ_lit
| TTuple of marked_typ list * StructName.t option
| TEnum of marked_typ list * EnumName.t
| TArrow of marked_typ * marked_typ
| TArray of marked_typ
| TAny
(** {2 Constants and operators} *)
type date = Runtime.date
type duration = Runtime.duration
type op_kind =
| KInt
| KRat
| KMoney
| KDate
| KDuration (** All ops don't have a KDate and KDuration. *)
type ternop = Fold
type binop =
| And
| Or
| Xor
| Add of op_kind
| Sub of op_kind
| Mult of op_kind
| Div of op_kind
| Lt of op_kind
| Lte of op_kind
| Gt of op_kind
| Gte of op_kind
| Eq
| Neq
| Map
| Concat
| Filter
type log_entry =
| VarDef of typ
(** During code generation, we need to know the type of the variable being
logged for embedding *)
| BeginCall
| EndCall
| PosRecordIfTrueBool
type unop =
| Not
| Minus of op_kind
| Log of log_entry * Uid.MarkedString.info list
| Length
| IntToRat
| MoneyToRat
| RatToMoney
| GetDay
| GetMonth
| GetYear
| FirstDayOfMonth
| LastDayOfMonth
| RoundMoney
| RoundDecimal
type operator = Ternop of ternop | Binop of binop | Unop of unop
type except = ConflictError | EmptyError | NoValueProvided | Crash
(** {2 Generic expressions} *)
(** Define a common base type for the expressions in most passes of the compiler *)
type desugared = [ `Desugared ]
type scopelang = [ `Scopelang ]
type dcalc = [ `Dcalc ]
type lcalc = [ `Lcalc ]
type scalc = [ `Scalc ]
type any = [ desugared | scopelang | dcalc | lcalc | scalc ]
(** Literals are the same throughout compilation except for the [LEmptyError]
case which is eliminated midway through. *)
type 'a glit =
| LBool : bool -> 'a glit
| LEmptyError : [< desugared | scopelang | dcalc ] glit
| LInt : Runtime.integer -> 'a glit
| LRat : Runtime.decimal -> 'a glit
| LMoney : Runtime.money -> 'a glit
| LUnit : 'a glit
| LDate : date -> 'a glit
| LDuration : duration -> 'a glit
type ('a, 't) marked_gexpr = (('a, 't) gexpr, 't) Marked.t
(** General expressions: groups all expression cases of the different ASTs, and
uses a GADT to eliminate irrelevant cases for each one. The ['t] annotations
are also totally unconstrained at this point. The dcalc exprs, for example,
are then defined with [type expr = dcalc gexpr] plus the annotations. *)
(** The expressions use the {{:https://lepigre.fr/ocaml-bindlib/} Bindlib}
library, based on higher-order abstract syntax *)
and ('a, 't) gexpr =
(* Constructors common to all ASTs *)
| ELit : 'a glit -> ('a, 't) gexpr
| EApp : ('a, 't) marked_gexpr * ('a, 't) marked_gexpr list -> ('a, 't) gexpr
| EOp : operator -> ('a, 't) gexpr
| EArray : ('a, 't) marked_gexpr list -> ('a, 't) gexpr
(* All but statement calculus *)
| EVar :
('a, 't) gexpr Bindlib.var
-> (([< desugared | scopelang | dcalc | lcalc ] as 'a), 't) gexpr
| EAbs :
(('a, 't) gexpr, ('a, 't) marked_gexpr) Bindlib.mbinder
* typ Marked.pos list
-> (([< desugared | scopelang | dcalc | lcalc ] as 'a), 't) gexpr
| EIfThenElse :
('a, 't) marked_gexpr * ('a, 't) marked_gexpr * ('a, 't) marked_gexpr
-> (([< desugared | scopelang | dcalc | lcalc ] as 'a), 't) gexpr
(* (* Early stages *) | ELocation: location -> ([< desugared | scopelang ] as
'a, 't) gexpr | EStruct: StructName.t * ('a, 't) marked_gexpr
StructFieldMap.t -> ([< desugared | scopelang ] as 'a, 't) gexpr |
EStructAccess: ('a, 't) marked_gexpr * StructFieldName.t * StructName.t ->
([< desugared | scopelang ] as 'a, 't) gexpr | EEnumInj: ('a, 't)
marked_gexpr * EnumConstructor.t * EnumName.t -> ([< desugared | scopelang
] as 'a, 't) gexpr | EMatchS: ('a, 't) marked_gexpr * EnumName.t * ('a, 't)
marked_gexpr EnumConstructorMap.t -> ([< desugared | scopelang ] as 'a, 't)
gexpr *)
(* Lambda-like *)
| ETuple :
('a, 't) marked_gexpr list * StructName.t option
-> (([< dcalc | lcalc ] as 'a), 't) gexpr
| ETupleAccess :
('a, 't) marked_gexpr * int * StructName.t option * typ Marked.pos list
-> (([< dcalc | lcalc ] as 'a), 't) gexpr
| EInj :
('a, 't) marked_gexpr * int * EnumName.t * typ Marked.pos list
-> (([< dcalc | lcalc ] as 'a), 't) gexpr
| EMatch :
('a, 't) marked_gexpr * ('a, 't) marked_gexpr list * EnumName.t
-> (([< dcalc | lcalc ] as 'a), 't) gexpr
| EAssert : ('a, 't) marked_gexpr -> (([< dcalc | lcalc ] as 'a), 't) gexpr
(* Default terms *)
| EDefault :
('a, 't) marked_gexpr list * ('a, 't) marked_gexpr * ('a, 't) marked_gexpr
-> (([< desugared | scopelang | dcalc ] as 'a), 't) gexpr
| ErrorOnEmpty :
('a, 't) marked_gexpr
-> (([< desugared | scopelang | dcalc ] as 'a), 't) gexpr
(* Lambda calculus with exceptions *)
| ERaise : except -> ((lcalc as 'a), 't) gexpr
| ECatch :
('a, 't) marked_gexpr * except * ('a, 't) marked_gexpr
-> ((lcalc as 'a), 't) gexpr
(* (\* Statement calculus *\)
* | ESVar: LocalName.t -> (scalc as 'a, 't) gexpr
* | ESStruct: ('a, 't) marked_gexpr list * StructName.t -> (scalc as 'a, 't) gexpr
* | ESStructFieldAccess: ('a, 't) marked_gexpr * StructFieldName.t * StructName.t -> (scalc as 'a, 't) gexpr
* | ESInj: ('a, 't) marked_gexpr * EnumConstructor.t * EnumName.t -> (scalc as 'a, 't) gexpr
* | ESFunc: TopLevelName.t -> (scalc as 'a, 't) gexpr *)
(** {2 Markings} *)
type untyped = { pos : Pos.t } [@@ocaml.unboxed]
type typed = { pos : Pos.t; ty : marked_typ }
(* type inferring = { pos : Pos.t; uf : Infer.unionfind_typ } *)
(** The generic type of AST markings. Using a GADT allows functions to be
polymorphic in the marking, but still do transformations on types when
appropriate. Expected to fill the ['t] parameter of [gexpr] and
[marked_gexpr] *)
type _ mark = Untyped : untyped -> untyped mark | Typed : typed -> typed mark
(* | Inferring : inferring -> inferring mark *)
type ('a, 'm) marked = ('a, 'm mark) Marked.t
(** Useful for errors and printing, for example *)
type any_marked_expr =
| AnyExpr : ([< any ], 'm mark) marked_gexpr -> any_marked_expr
(** {2 Higher-level program structure} *)
(** Constructs scopes and programs on top of expressions. We may use the [gexpr]
type above at some point, but at the moment this is polymorphic in the types
of the expressions. Their markings are constrained to belong to the [mark]
GADT defined above. *)
(** This kind annotation signals that the let-binding respects a structural
invariant. These invariants concern the shape of the expression in the
let-binding, and are documented below. *)
type scope_let_kind =
| DestructuringInputStruct (** [let x = input.field]*)
| ScopeVarDefinition (** [let x = error_on_empty e]*)
| SubScopeVarDefinition
(** [let s.x = fun _ -> e] or [let s.x = error_on_empty e] for input-only
subscope variables. *)
| CallingSubScope (** [let result = s ({ x = s.x; y = s.x; ...}) ]*)
| DestructuringSubScopeResults (** [let s.x = result.x ]**)
| Assertion (** [let _ = assert e]*)
type ('expr, 'm) scope_let = {
scope_let_kind : scope_let_kind;
scope_let_typ : marked_typ;
scope_let_expr : ('expr, 'm) marked;
scope_let_next : ('expr, ('expr, 'm) scope_body_expr) Bindlib.binder;
scope_let_pos : Pos.t;
}
(** This type is parametrized by the expression type so it can be reused in
later intermediate representations. *)
(** A scope let-binding has all the information necessary to make a proper
let-binding expression, plus an annotation for the kind of the let-binding
that comes from the compilation of a {!module: Scopelang.Ast} statement. *)
and ('expr, 'm) scope_body_expr =
| Result of ('expr, 'm) marked
| ScopeLet of ('expr, 'm) scope_let
type ('expr, 'm) scope_body = {
scope_body_input_struct : StructName.t;
scope_body_output_struct : StructName.t;
scope_body_expr : ('expr, ('expr, 'm) scope_body_expr) Bindlib.binder;
}
(** Instead of being a single expression, we give a little more ad-hoc structure
to the scope body by decomposing it in an ordered list of let-bindings, and
a result expression that uses the let-binded variables. The first binder is
the argument of type [scope_body_input_struct]. *)
type ('expr, 'm) scope_def = {
scope_name : ScopeName.t;
scope_body : ('expr, 'm) scope_body;
scope_next : ('expr, ('expr, 'm) scopes) Bindlib.binder;
}
(** Finally, we do the same transformation for the whole program for the kinded
lets. This permit us to use bindlib variables for scopes names. *)
and ('expr, 'm) scopes = Nil | ScopeDef of ('expr, 'm) scope_def
type struct_ctx = (StructFieldName.t * marked_typ) list StructMap.t
type decl_ctx = {
ctx_enums : (EnumConstructor.t * marked_typ) list EnumMap.t;
ctx_structs : struct_ctx;
}
type ('expr, 'm) program_generic = {
decl_ctx : decl_ctx;
scopes : ('expr, 'm) scopes;
}

180
compiler/utils/astgen_utils.ml Normal file
View File

@ -0,0 +1,180 @@
(* This file is part of the Catala compiler, a specification language for tax
and social benefits computation rules. Copyright (C) 2020-2022 Inria,
contributor: Denis Merigoux <denis.merigoux@inria.fr>, Alain Delaët-Tixeuil
<alain.delaet--tixeuil@inria.fr>, Louis Gesbert <louis.gesbert@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 Astgen
(** Functions handling the types in [Astgen] *)
let evar v mark = Bindlib.box_apply (Marked.mark mark) (Bindlib.box_var v)
let etuple args s mark =
Bindlib.box_apply (fun args -> ETuple (args, s), mark) (Bindlib.box_list args)
let etupleaccess e1 i s typs mark =
Bindlib.box_apply (fun e1 -> ETupleAccess (e1, i, s, typs), mark) e1
let einj e1 i e_name typs mark =
Bindlib.box_apply (fun e1 -> EInj (e1, i, e_name, typs), mark) e1
let ematch arg arms e_name mark =
Bindlib.box_apply2
(fun arg arms -> EMatch (arg, arms, e_name), mark)
arg (Bindlib.box_list arms)
let earray args mark =
Bindlib.box_apply (fun args -> EArray args, mark) (Bindlib.box_list args)
let elit l mark = Bindlib.box (ELit l, mark)
let eabs binder typs mark =
Bindlib.box_apply (fun binder -> EAbs (binder, typs), mark) binder
let eapp e1 args mark =
Bindlib.box_apply2
(fun e1 args -> EApp (e1, args), mark)
e1 (Bindlib.box_list args)
let eassert e1 mark = Bindlib.box_apply (fun e1 -> EAssert e1, mark) e1
let eop op mark = Bindlib.box (EOp op, mark)
let edefault excepts just cons mark =
Bindlib.box_apply3
(fun excepts just cons -> EDefault (excepts, just, cons), mark)
(Bindlib.box_list excepts) just cons
let eifthenelse e1 e2 e3 mark =
Bindlib.box_apply3 (fun e1 e2 e3 -> EIfThenElse (e1, e2, e3), mark) e1 e2 e3
let eerroronempty e1 mark =
Bindlib.box_apply (fun e1 -> ErrorOnEmpty e1, mark) e1
let eraise e1 pos = Bindlib.box (ERaise e1, pos)
let ecatch e1 exn e2 pos =
Bindlib.box_apply2 (fun e1 e2 -> ECatch (e1, exn, e2), pos) e1 e2
let translate_var v = Bindlib.copy_var v (fun x -> EVar x) (Bindlib.name_of v)
let map_gexpr
(type a)
(ctx : 'ctx)
~(f : 'ctx -> (a, 'm1) marked_gexpr -> (a, 'm2) marked_gexpr Bindlib.box)
(e : ((a, 'm1) gexpr, 'm2) Marked.t) : (a, 'm2) marked_gexpr Bindlib.box =
let m = Marked.get_mark e in
match Marked.unmark e with
| ELit l -> elit l m
| EApp (e1, args) -> eapp (f ctx e1) (List.map (f ctx) args) m
| EOp op -> Bindlib.box (EOp op, m)
| EArray args -> earray (List.map (f ctx) args) m
| EVar v -> evar (translate_var v) m
| EAbs (binder, typs) ->
let vars, body = Bindlib.unmbind binder in
eabs (Bindlib.bind_mvar (Array.map translate_var vars) (f ctx body)) typs m
| EIfThenElse (e1, e2, e3) ->
eifthenelse ((f ctx) e1) ((f ctx) e2) ((f ctx) e3) m
| ETuple (args, s) -> etuple (List.map (f ctx) args) s m
| ETupleAccess (e1, n, s_name, typs) ->
etupleaccess ((f ctx) e1) n s_name typs m
| EInj (e1, i, e_name, typs) -> einj ((f ctx) e1) i e_name typs m
| EMatch (arg, arms, e_name) ->
ematch ((f ctx) arg) (List.map (f ctx) arms) e_name m
| EAssert e1 -> eassert ((f ctx) e1) m
| EDefault (excepts, just, cons) ->
edefault (List.map (f ctx) excepts) ((f ctx) just) ((f ctx) cons) m
| ErrorOnEmpty e1 -> eerroronempty ((f ctx) e1) m
| ECatch (e1, exn, e2) -> ecatch (f ctx e1) exn (f ctx e2) (Marked.get_mark e)
| ERaise exn -> eraise exn (Marked.get_mark e)
let rec map_gexpr_top_down ~f e =
map_gexpr () ~f:(fun () -> map_gexpr_top_down ~f) (f e)
let map_gexpr_marks ~f e =
map_gexpr_top_down ~f:(fun e -> Marked.(mark (f (get_mark e)) (unmark e))) e
let rec fold_left_scope_lets ~f ~init scope_body_expr =
match scope_body_expr with
| Result _ -> init
| ScopeLet scope_let ->
let var, next = Bindlib.unbind scope_let.scope_let_next in
fold_left_scope_lets ~f ~init:(f init scope_let var) next
let rec fold_right_scope_lets ~f ~init scope_body_expr =
match scope_body_expr with
| Result result -> init result
| ScopeLet scope_let ->
let var, next = Bindlib.unbind scope_let.scope_let_next in
let next_result = fold_right_scope_lets ~f ~init next in
f scope_let var next_result
let map_exprs_in_scope_lets ~f ~varf scope_body_expr =
fold_right_scope_lets
~f:(fun scope_let var_next acc ->
Bindlib.box_apply2
(fun scope_let_next scope_let_expr ->
ScopeLet { scope_let with scope_let_next; scope_let_expr })
(Bindlib.bind_var (varf var_next) acc)
(f scope_let.scope_let_expr))
~init:(fun res -> Bindlib.box_apply (fun res -> Result res) (f res))
scope_body_expr
let rec fold_left_scope_defs ~f ~init scopes =
match scopes with
| Nil -> init
| ScopeDef scope_def ->
let var, next = Bindlib.unbind scope_def.scope_next in
fold_left_scope_defs ~f ~init:(f init scope_def var) next
let rec fold_right_scope_defs ~f ~init scopes =
match scopes with
| Nil -> init
| ScopeDef scope_def ->
let var_next, next = Bindlib.unbind scope_def.scope_next in
let result_next = fold_right_scope_defs ~f ~init next in
f scope_def var_next result_next
let map_scope_defs ~f scopes =
fold_right_scope_defs
~f:(fun scope_def var_next acc ->
let new_scope_def = f scope_def in
let new_next = Bindlib.bind_var var_next acc in
Bindlib.box_apply2
(fun new_scope_def new_next ->
ScopeDef { new_scope_def with scope_next = new_next })
new_scope_def new_next)
~init:(Bindlib.box Nil) scopes
let map_exprs_in_scopes ~f ~varf scopes =
fold_right_scope_defs
~f:(fun scope_def var_next acc ->
let scope_input_var, scope_lets =
Bindlib.unbind scope_def.scope_body.scope_body_expr
in
let new_scope_body_expr = map_exprs_in_scope_lets ~f ~varf scope_lets in
let new_scope_body_expr =
Bindlib.bind_var (varf scope_input_var) new_scope_body_expr
in
let new_next = Bindlib.bind_var (varf var_next) acc in
Bindlib.box_apply2
(fun scope_body_expr scope_next ->
ScopeDef
{
scope_def with
scope_body = { scope_def.scope_body with scope_body_expr };
scope_next;
})
new_scope_body_expr new_next)
~init:(Bindlib.box Nil) scopes

183
compiler/utils/astgen_utils.mli Normal file
View File

@ -0,0 +1,183 @@
(* This file is part of the Catala compiler, a specification language for tax
and social benefits computation rules. Copyright (C) 2020-2022 Inria,
contributor: Denis Merigoux <denis.merigoux@inria.fr>, Alain Delaët-Tixeuil
<alain.delaet--tixeuil@inria.fr>, Louis Gesbert <louis.gesbert@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. *)
(** Functions handling the types in [Astgen] *)
open Astgen
(** {2 Boxed constructors} *)
val evar :
(([< desugared | scopelang | dcalc | lcalc ] as 'a), 't) gexpr Bindlib.var ->
't ->
('a, 't) marked_gexpr Bindlib.box
val etuple :
(([< dcalc | lcalc ] as 'a), 't) marked_gexpr Bindlib.box list ->
StructName.t option ->
't ->
('a, 't) marked_gexpr Bindlib.box
val etupleaccess :
(([< dcalc | lcalc ] as 'a), 't) marked_gexpr Bindlib.box ->
int ->
StructName.t option ->
marked_typ list ->
't ->
('a, 't) marked_gexpr Bindlib.box
val einj :
(([< dcalc | lcalc ] as 'a), 't) marked_gexpr Bindlib.box ->
int ->
EnumName.t ->
marked_typ list ->
't ->
('a, 't) marked_gexpr Bindlib.box
val ematch :
(([< dcalc | lcalc ] as 'a), 't) marked_gexpr Bindlib.box ->
('a, 't) marked_gexpr Bindlib.box list ->
EnumName.t ->
't ->
('a, 't) marked_gexpr Bindlib.box
val earray :
('a, 't) marked_gexpr Bindlib.box list ->
't ->
('a, 't) marked_gexpr Bindlib.box
val elit : 'a glit -> 't -> ('a, 't) marked_gexpr Bindlib.box
val eabs :
( (([< desugared | scopelang | dcalc | lcalc ] as 'a), 't) gexpr,
('a, 't) marked_gexpr )
Bindlib.mbinder
Bindlib.box ->
marked_typ list ->
't ->
('a, 't) marked_gexpr Bindlib.box
val eapp :
('a, 't) marked_gexpr Bindlib.box ->
('a, 't) marked_gexpr Bindlib.box list ->
't ->
('a, 't) marked_gexpr Bindlib.box
val eassert :
(([< dcalc | lcalc ] as 'a), 't) marked_gexpr Bindlib.box ->
't ->
('a, 't) marked_gexpr Bindlib.box
val eop : operator -> 't -> ('a, 't) marked_gexpr Bindlib.box
val edefault :
(([< desugared | scopelang | dcalc ] as 'a), 't) marked_gexpr Bindlib.box list ->
('a, 't) marked_gexpr Bindlib.box ->
('a, 't) marked_gexpr Bindlib.box ->
't ->
('a, 't) marked_gexpr Bindlib.box
val eifthenelse :
(([< desugared | scopelang | dcalc | lcalc ] as 'a), 't) marked_gexpr
Bindlib.box ->
('a, 't) marked_gexpr Bindlib.box ->
('a, 't) marked_gexpr Bindlib.box ->
't ->
('a, 't) marked_gexpr Bindlib.box
val eerroronempty :
(([< desugared | scopelang | dcalc ] as 'a), 't) marked_gexpr Bindlib.box ->
't ->
('a, 't) marked_gexpr Bindlib.box
(** ---------- *)
val map_gexpr :
'ctx ->
f:('ctx -> ('a, 't1) marked_gexpr -> ('a, 't2) marked_gexpr Bindlib.box) ->
(('a, 't1) gexpr, 't2) Marked.t ->
('a, 't2) marked_gexpr Bindlib.box
val map_gexpr_top_down :
f:(('a, 't1) marked_gexpr -> (('a, 't1) gexpr, 't2) Marked.t) ->
('a, 't1) marked_gexpr ->
('a, 't2) marked_gexpr Bindlib.box
(** Recursively applies [f] to the nodes of the expression tree. The type
returned by [f] is hybrid since the mark at top-level has been rewritten,
but not yet the marks in the subtrees. *)
val map_gexpr_marks :
f:('t1 -> 't2) -> ('a, 't1) marked_gexpr -> ('a, 't2) marked_gexpr Bindlib.box
val fold_left_scope_lets :
f:('a -> ('expr, 'm) scope_let -> 'expr Bindlib.var -> 'a) ->
init:'a ->
('expr, 'm) scope_body_expr ->
'a
(** Usage:
[fold_left_scope_lets ~f:(fun acc scope_let scope_let_var -> ...) ~init scope_lets],
where [scope_let_var] is the variable bound to the scope let in the next
scope lets to be examined. *)
val fold_right_scope_lets :
f:(('expr1, 'm1) scope_let -> 'expr1 Bindlib.var -> 'a -> 'a) ->
init:(('expr1, 'm1) marked -> 'a) ->
('expr1, 'm1) scope_body_expr ->
'a
(** Usage:
[fold_right_scope_lets ~f:(fun scope_let scope_let_var acc -> ...) ~init scope_lets],
where [scope_let_var] is the variable bound to the scope let in the next
scope lets to be examined (which are before in the program order). *)
val map_exprs_in_scope_lets :
f:(('expr1, 'm1) marked -> ('expr2, 'm2) marked Bindlib.box) ->
varf:('expr1 Bindlib.var -> 'expr2 Bindlib.var) ->
('expr1, 'm1) scope_body_expr ->
('expr2, 'm2) scope_body_expr Bindlib.box
val fold_left_scope_defs :
f:('a -> ('expr1, 'm1) scope_def -> 'expr1 Bindlib.var -> 'a) ->
init:'a ->
('expr1, 'm1) scopes ->
'a
(** Usage:
[fold_left_scope_defs ~f:(fun acc scope_def scope_var -> ...) ~init scope_def],
where [scope_var] is the variable bound to the scope in the next scopes to
be examined. *)
val fold_right_scope_defs :
f:(('expr1, 'm1) scope_def -> 'expr1 Bindlib.var -> 'a -> 'a) ->
init:'a ->
('expr1, 'm1) scopes ->
'a
(** Usage:
[fold_right_scope_defs ~f:(fun scope_def scope_var acc -> ...) ~init scope_def],
where [scope_var] is the variable bound to the scope in the next scopes to
be examined (which are before in the program order). *)
val map_scope_defs :
f:(('expr, 'm) scope_def -> ('expr, 'm) scope_def Bindlib.box) ->
('expr, 'm) scopes ->
('expr, 'm) scopes Bindlib.box
val map_exprs_in_scopes :
f:(('expr1, 'm1) marked -> ('expr2, 'm2) marked Bindlib.box) ->
varf:('expr1 Bindlib.var -> 'expr2 Bindlib.var) ->
('expr1, 'm1) scopes ->
('expr2, 'm2) scopes Bindlib.box
(** This is the main map visitor for all the expressions inside all the scopes
of the program. *)

2
compiler/utils/cli.ml
View File

@ -307,7 +307,7 @@ let set_option_globals options : unit =
disable_counterexamples := options.disable_counterexamples;
avoid_exceptions_flag := options.avoid_exceptions
let version = "0.6.0"
let version = "0.7.0"
let info =
let doc =

2
compiler/utils/dune
View File

@ -1,7 +1,7 @@
(library
(name utils)
(public_name catala.utils)
(libraries cmdliner ubase ANSITerminal re))
(libraries cmdliner ubase ANSITerminal re bindlib catala.runtime_ocaml))
(documentation
(package catala)

1
compiler/utils/marked.ml
View File

@ -21,6 +21,7 @@ type 'a pos = ('a, Pos.t) t
let mark m e : ('a, 'm) t = e, m
let unmark ((x, _) : ('a, 'm) t) : 'a = x
let get_mark ((_, x) : ('a, 'm) t) : 'm = x
let map_mark (f : 'm1 -> 'm2) ((a, m) : ('a, 'm1) t) : ('a, 'm2) t = a, f m
let map_under_mark (f : 'a -> 'b) ((x, y) : ('a, 'm) t) : ('b, 'c) t = f x, y
let same_mark_as (x : 'a) ((_, y) : ('b, 'm) t) : ('a, 'm) t = x, y

1
compiler/utils/marked.mli
View File

@ -27,6 +27,7 @@ type 'a pos = ('a, Pos.t) t
val mark : 'm -> 'a -> ('a, 'm) t
val unmark : ('a, 'm) t -> 'a
val get_mark : ('a, 'm) t -> 'm
val map_mark : ('m1 -> 'm2) -> ('a, 'm1) t -> ('a, 'm2) t
val map_under_mark : ('a -> 'b) -> ('a, 'm) t -> ('b, 'm) t
val same_mark_as : 'a -> ('b, 'm) t -> ('a, 'm) t
val unmark_option : ('a, 'm) t option -> 'a option

104
compiler/utils/var.ml Normal file
View File

@ -0,0 +1,104 @@
(* This file is part of the Catala compiler, a specification language for tax
and social benefits computation rules. Copyright (C) 2020-2022 Inria,
contributor: Louis Gesbert <louis.gesbert@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 Astgen
(** {1 Variables and their collections} *)
(** This module provides types and helpers for Bindlib variables on the
[Astgen.gexpr] type *)
(* The subtypes of the generic AST that hold vars *)
type 'e expr = 'e
constraint 'e = ([< desugared | scopelang | dcalc | lcalc ], 't) gexpr
type 'e var = 'e expr Bindlib.var
type 'e t = 'e var
type 'e vars = 'e expr Bindlib.mvar
let make (name : string) : 'e var = Bindlib.new_var (fun x -> EVar x) name
let compare = Bindlib.compare_vars
let eq = Bindlib.eq_vars
let translate (v : 'e1 var) : 'e2 var =
Bindlib.copy_var v (fun x -> EVar x) (Bindlib.name_of v)
(* The purpose of this module is just to lift a type parameter outside of
[Set.S] and [Map.S], so that we can have ['e Var.Set.t] for sets of variables
bound to the ['e = ('a, 't) gexpr] expression type. This is made possible by
the fact that [Bindlib.compare_vars] is polymorphic in that parameter; we
first hide that parameter inside an existential, then re-add a phantom type
outside of the set to ensure consistency. Extracting the elements is then
done with [Bindlib.copy_var] but technically it's not much different from an
[Obj] conversion.
If anyone has a better solution, besides a copy-paste of Set.Make / Map.Make
code... *)
module Generic = struct
(* Existentially quantify the type parameters to allow application of
Set.Make *)
type t = Var : 'e var -> t
(* Note: adding [[@@ocaml.unboxed]] would be OK and make our wrappers live at
the type-level without affecting the actual data representation. But
[Bindlib.var] being abstract, we can't convince OCaml it's ok at the moment
and have to hold it *)
let t v = Var v
let get (Var v) = Bindlib.copy_var v (fun x -> EVar x) (Bindlib.name_of v)
let compare (Var x) (Var y) = Bindlib.compare_vars x y
end
(* Wrapper around Set.Make to re-add type parameters (avoid inconsistent
sets) *)
module Set = struct
open Generic
open Set.Make (Generic)
type nonrec 'e t = t constraint 'e = 'e expr
let empty = empty
let singleton x = singleton (t x)
let add x s = add (t x) s
let remove x s = remove (t x) s
let union s1 s2 = union s1 s2
let mem x s = mem (t x) s
let of_list l = of_list (List.map t l)
let elements s = elements s |> List.map get
(* Add more as needed *)
end
(* Wrapper around Map.Make to re-add type parameters (avoid inconsistent
maps) *)
module Map = struct
open Generic
open Map.Make (Generic)
type nonrec ('e, 'x) t = 'x t constraint 'e = 'e expr
let empty = empty
let singleton v x = singleton (t v) x
let add v x m = add (t v) x m
let update v f m = update (t v) f m
let find v m = find (t v) m
let find_opt v m = find_opt (t v) m
let bindings m = bindings m |> List.map (fun (v, x) -> get v, x)
let mem x m = mem (t x) m
let union f m1 m2 = union (fun v x1 x2 -> f (get v) x1 x2) m1 m2
let fold f m acc = fold (fun v x acc -> f (get v) x acc) m acc
(* Add more as needed *)
end

73
compiler/utils/var.mli Normal file
View File

@ -0,0 +1,73 @@
(* This file is part of the Catala compiler, a specification language for tax
and social benefits computation rules. Copyright (C) 2020-2022 Inria,
contributor: Louis Gesbert <louis.gesbert@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 Astgen
(** {1 Variables and their collections} *)
(** This module provides types and helpers for Bindlib variables on the
[Astgen.gexpr] type *)
type 'e expr = 'e
constraint 'e = ([< desugared | scopelang | dcalc | lcalc ], 't) gexpr
(** Subtype of Astgen.gexpr where variables are handled *)
type 'e var = 'e expr Bindlib.var
type 'e t = 'e var
type 'e vars = 'e expr Bindlib.mvar
val make : string -> 'e t
val compare : 'e t -> 'e t -> int
val eq : 'e t -> 'e t -> bool
val translate : 'e1 t -> 'e2 t
(** Needed when converting from one AST type to another. See the note of caution
on [Bindlib.copy_var]. *)
(** Wrapper over [Set.S] but with a type variable for the AST type parameters.
Extend as needed *)
module Set : sig
type 'e t constraint 'e = 'e expr
val empty : 'e t
val singleton : 'e var -> 'e t
val add : 'e var -> 'e t -> 'e t
val remove : 'e var -> 'e t -> 'e t
val union : 'e t -> 'e t -> 'e t
val mem : 'e var -> 'e t -> bool
val of_list : 'e var list -> 'e t
val elements : 'e t -> 'e var list
end
(** Wrapper over [Map.S] but with a type variable for the AST type parameters.
Extend as needed *)
module Map : sig
type ('e, 'x) t constraint 'e = 'e expr
val empty : ('e, 'x) t
val singleton : 'e var -> 'x -> ('e, 'x) t
val add : 'e var -> 'x -> ('e, 'x) t -> ('e, 'x) t
val update : 'e var -> ('x option -> 'x option) -> ('e, 'x) t -> ('e, 'x) t
val find : 'e var -> ('e, 'x) t -> 'x
val find_opt : 'e var -> ('e, 'x) t -> 'x option
val bindings : ('e, 'x) t -> ('e var * 'x) list
val mem : 'e var -> ('e, 'x) t -> bool
val union :
('e var -> 'x -> 'x -> 'x option) -> ('e, 'x) t -> ('e, 'x) t -> ('e, 'x) t
val fold : ('e var -> 'x -> 'acc -> 'acc) -> ('e, 'x) t -> 'acc -> 'acc
end

52
compiler/verification/conditions.ml
View File

@ -21,27 +21,28 @@ open Ast
(** {1 Helpers and type definitions}*)
type vc_return = typed marked_expr * typ Marked.pos VarMap.t
type vc_return = typed marked_expr * (typed expr, typ Marked.pos) Var.Map.t
(** The return type of VC generators is the VC expression plus the types of any
locally free variable inside that expression. *)
type ctx = {
current_scope_name : ScopeName.t;
decl : decl_ctx;
input_vars : Var.t list;
scope_variables_typs : typ Marked.pos VarMap.t;
input_vars : typed var list;
scope_variables_typs : (typed expr, typ Marked.pos) Var.Map.t;
}
let conjunction (args : vc_return list) (mark : typed mark) : vc_return =
let acc, list =
match args with
| hd :: tl -> hd, tl
| [] -> ((ELit (LBool true), mark), VarMap.empty), []
| [] -> ((ELit (LBool true), mark), Var.Map.empty), []
in
List.fold_left
(fun (acc, acc_ty) (arg, arg_ty) ->
( (EApp ((EOp (Binop And), mark), [arg; acc]), mark),
VarMap.union (fun _ _ _ -> failwith "should not happen") acc_ty arg_ty ))
Var.Map.union (fun _ _ _ -> failwith "should not happen") acc_ty arg_ty
))
acc list
let negation ((arg, arg_ty) : vc_return) (mark : typed mark) : vc_return =
@ -51,12 +52,13 @@ let disjunction (args : vc_return list) (mark : typed mark) : vc_return =
let acc, list =
match args with
| hd :: tl -> hd, tl
| [] -> ((ELit (LBool false), mark), VarMap.empty), []
| [] -> ((ELit (LBool false), mark), Var.Map.empty), []
in
List.fold_left
(fun ((acc, acc_ty) : vc_return) (arg, arg_ty) ->
( (EApp ((EOp (Binop Or), mark), [arg; acc]), mark),
VarMap.union (fun _ _ _ -> failwith "should not happen") acc_ty arg_ty ))
Var.Map.union (fun _ _ _ -> failwith "should not happen") acc_ty arg_ty
))
acc list
(** [half_product \[a1,...,an\] \[b1,...,bm\] returns \[(a1,b1),...(a1,bn),...(an,b1),...(an,bm)\]] *)
@ -80,7 +82,7 @@ let match_and_ignore_outer_reentrant_default (ctx : ctx) (e : typed marked_expr)
(ELit (LBool true), _),
cons ),
_ )
when List.exists (fun x' -> Var.eq (Var.t x) x') ctx.input_vars ->
when List.exists (fun x' -> Var.eq x x') ctx.input_vars ->
(* scope variables*)
cons
| EAbs (binder, [(TLit TUnit, _)]) ->
@ -130,7 +132,7 @@ let rec generate_vc_must_not_return_empty (ctx : ctx) (e : typed marked_expr) :
in
( vc_body_expr,
List.fold_left
(fun acc (var, ty) -> VarMap.add (Var.t var) ty acc)
(fun acc (var, ty) -> Var.Map.add var ty acc)
vc_body_ty
(List.map2 (fun x y -> x, y) (Array.to_list vars) typs) )
| EApp (f, args) ->
@ -147,18 +149,18 @@ let rec generate_vc_must_not_return_empty (ctx : ctx) (e : typed marked_expr) :
[
e1_vc, vc_typ1;
( (EIfThenElse (e1, e2_vc, e3_vc), Marked.get_mark e),
VarMap.union
Var.Map.union
(fun _ _ _ -> failwith "should not happen")
vc_typ2 vc_typ3 );
]
(Marked.get_mark e)
| ELit LEmptyError ->
Marked.same_mark_as (ELit (LBool false)) e, VarMap.empty
Marked.same_mark_as (ELit (LBool false)) e, Var.Map.empty
| EVar _
(* Per default calculus semantics, you cannot call a function with an argument
that evaluates to the empty error. Thus, all variable evaluate to non-empty-error terms. *)
| ELit _ | EOp _ ->
Marked.same_mark_as (ELit (LBool true)) e, VarMap.empty
Marked.same_mark_as (ELit (LBool true)) e, Var.Map.empty
| EDefault (exceptions, just, cons) ->
(* <e1 ... en | ejust :- econs > never returns empty if and only if:
- first we look if e1 .. en ejust can return empty;
@ -223,7 +225,7 @@ let rec generate_vs_must_not_return_confict (ctx : ctx) (e : typed marked_expr)
in
( vc_body_expr,
List.fold_left
(fun acc (var, ty) -> VarMap.add (Var.t var) ty acc)
(fun acc (var, ty) -> Var.Map.add var ty acc)
vc_body_ty
(List.map2 (fun x y -> x, y) (Array.to_list vars) typs) )
| EApp (f, args) ->
@ -238,13 +240,13 @@ let rec generate_vs_must_not_return_confict (ctx : ctx) (e : typed marked_expr)
[
e1_vc, vc_typ1;
( (EIfThenElse (e1, e2_vc, e3_vc), Marked.get_mark e),
VarMap.union
Var.Map.union
(fun _ _ _ -> failwith "should not happen")
vc_typ2 vc_typ3 );
]
(Marked.get_mark e)
| EVar _ | ELit _ | EOp _ ->
Marked.same_mark_as (ELit (LBool true)) e, VarMap.empty
Marked.same_mark_as (ELit (LBool true)) e, Var.Map.empty
| EDefault (exceptions, just, cons) ->
(* <e1 ... en | ejust :- econs > never returns conflict if and only if:
- neither e1 nor ... nor en nor ejust nor econs return conflict
@ -284,8 +286,8 @@ type verification_condition = {
(* should have type bool *)
vc_kind : verification_condition_kind;
vc_scope : ScopeName.t;
vc_variable : Var.t Marked.pos;
vc_free_vars_typ : typ Marked.pos VarMap.t;
vc_variable : typed var Marked.pos;
vc_free_vars_typ : (typed expr, typ Marked.pos) Var.Map.t;
}
let rec generate_verification_conditions_scope_body_expr
@ -301,7 +303,7 @@ let rec generate_verification_conditions_scope_body_expr
let new_ctx, vc_list =
match scope_let.scope_let_kind with
| DestructuringInputStruct ->
{ ctx with input_vars = Var.t scope_let_var :: ctx.input_vars }, []
{ ctx with input_vars = scope_let_var :: ctx.input_vars }, []
| ScopeVarDefinition | SubScopeVarDefinition ->
(* For scope variables, we should check both that they never evaluate to
emptyError nor conflictError. But for subscope variable definitions,
@ -324,11 +326,11 @@ let rec generate_verification_conditions_scope_body_expr
vc_guard = Marked.same_mark_as (Marked.unmark vc_confl) e;
vc_kind = NoOverlappingExceptions;
vc_free_vars_typ =
VarMap.union
Var.Map.union
(fun _ _ -> failwith "should not happen")
ctx.scope_variables_typs vc_confl_typs;
vc_scope = ctx.current_scope_name;
vc_variable = Var.t scope_let_var, scope_let.scope_let_pos;
vc_variable = scope_let_var, scope_let.scope_let_pos;
};
]
in
@ -347,11 +349,11 @@ let rec generate_verification_conditions_scope_body_expr
vc_guard = Marked.same_mark_as (Marked.unmark vc_empty) e;
vc_kind = NoEmptyError;
vc_free_vars_typ =
VarMap.union
Var.Map.union
(fun _ _ -> failwith "should not happen")
ctx.scope_variables_typs vc_empty_typs;
vc_scope = ctx.current_scope_name;
vc_variable = Var.t scope_let_var, scope_let.scope_let_pos;
vc_variable = scope_let_var, scope_let.scope_let_pos;
}
:: vc_list
| _ -> vc_list
@ -364,7 +366,7 @@ let rec generate_verification_conditions_scope_body_expr
{
new_ctx with
scope_variables_typs =
VarMap.add (Var.t scope_let_var) scope_let.scope_let_typ
Var.Map.add scope_let_var scope_let.scope_let_typ
new_ctx.scope_variables_typs;
}
scope_let_next
@ -396,7 +398,7 @@ let rec generate_verification_conditions_scopes
decl = decl_ctx;
input_vars = [];
scope_variables_typs =
VarMap.empty
Var.Map.empty
(* We don't need to add the typ of the scope input var here
because it will never appear in an expression for which we
generate a verification conditions (the big struct is
@ -423,7 +425,7 @@ let generate_verification_conditions
let to_str vc =
Format.asprintf "%s.%s"
(Format.asprintf "%a" ScopeName.format_t vc.vc_scope)
(Bindlib.name_of (Var.get (Marked.unmark vc.vc_variable)))
(Bindlib.name_of (Marked.unmark vc.vc_variable))
in
String.compare (to_str vc1) (to_str vc2))
vcs

7
compiler/verification/conditions.mli
View File

@ -17,6 +17,8 @@
(** Generates verification conditions from scope definitions *)
open Utils
type verification_condition_kind =
| NoEmptyError
(** This verification condition checks whether a definition never returns
@ -30,8 +32,9 @@ type verification_condition = {
(** This expression should have type [bool]*)
vc_kind : verification_condition_kind;
vc_scope : Dcalc.Ast.ScopeName.t;
vc_variable : Dcalc.Ast.Var.t Utils.Marked.pos;
vc_free_vars_typ : Dcalc.Ast.typ Utils.Marked.pos Dcalc.Ast.VarMap.t;
vc_variable : Astgen.typed Dcalc.Ast.var Marked.pos;
vc_free_vars_typ :
(Astgen.typed Dcalc.Ast.expr, Dcalc.Ast.typ Marked.pos) Var.Map.t;
(** Types of the locally free variables in [vc_guard]. The types of other
free variables linked to scope variables can be obtained with
[Dcalc.Ast.variable_types]. *)

24
compiler/verification/io.ml
View File

@ -23,7 +23,8 @@ module type Backend = sig
type backend_context
val make_context : decl_ctx -> typ Marked.pos VarMap.t -> backend_context
val make_context :
decl_ctx -> (typed expr, typ Marked.pos) Var.Map.t -> backend_context
type vc_encoding
@ -37,7 +38,9 @@ module type Backend = sig
val is_model_empty : model -> bool
val translate_expr :
backend_context -> 'm Dcalc.Ast.marked_expr -> backend_context * vc_encoding
backend_context ->
Astgen.typed Dcalc.Ast.marked_expr ->
backend_context * vc_encoding
end
module type BackendIO = sig
@ -45,12 +48,15 @@ module type BackendIO = sig
type backend_context
val make_context : decl_ctx -> typ Marked.pos VarMap.t -> backend_context
val make_context :
decl_ctx -> (Astgen.typed expr, typ Marked.pos) Var.Map.t -> backend_context
type vc_encoding
val translate_expr :
backend_context -> 'm Dcalc.Ast.marked_expr -> backend_context * vc_encoding
backend_context ->
Astgen.typed Dcalc.Ast.marked_expr ->
backend_context * vc_encoding
type model
@ -95,12 +101,12 @@ module MakeBackendIO (B : Backend) = struct
Format.asprintf "%s This variable never returns an empty error"
(Cli.with_style [ANSITerminal.yellow] "[%s.%s]"
(Format.asprintf "%a" ScopeName.format_t vc.vc_scope)
(Bindlib.name_of (Var.get (Marked.unmark vc.vc_variable))))
(Bindlib.name_of (Marked.unmark vc.vc_variable)))
| Conditions.NoOverlappingExceptions ->
Format.asprintf "%s No two exceptions to ever overlap for this variable"
(Cli.with_style [ANSITerminal.yellow] "[%s.%s]"
(Format.asprintf "%a" ScopeName.format_t vc.vc_scope)
(Bindlib.name_of (Var.get (Marked.unmark vc.vc_variable))))
(Bindlib.name_of (Marked.unmark vc.vc_variable)))
let print_negative_result
(vc : Conditions.verification_condition)
@ -112,14 +118,14 @@ module MakeBackendIO (B : Backend) = struct
Format.asprintf "%s This variable might return an empty error:\n%s"
(Cli.with_style [ANSITerminal.yellow] "[%s.%s]"
(Format.asprintf "%a" ScopeName.format_t vc.vc_scope)
(Bindlib.name_of (Var.get (Marked.unmark vc.vc_variable))))
(Bindlib.name_of (Marked.unmark vc.vc_variable)))
(Pos.retrieve_loc_text (Marked.get_mark vc.vc_variable))
| Conditions.NoOverlappingExceptions ->
Format.asprintf
"%s At least two exceptions overlap for this variable:\n%s"
(Cli.with_style [ANSITerminal.yellow] "[%s.%s]"
(Format.asprintf "%a" ScopeName.format_t vc.vc_scope)
(Bindlib.name_of (Var.get (Marked.unmark vc.vc_variable))))
(Bindlib.name_of (Marked.unmark vc.vc_variable)))
(Pos.retrieve_loc_text (Marked.get_mark vc.vc_variable))
in
let counterexample : string option =
@ -178,6 +184,6 @@ module MakeBackendIO (B : Backend) = struct
Cli.error_print "%s The translation to Z3 failed:\n%s"
(Cli.with_style [ANSITerminal.yellow] "[%s.%s]"
(Format.asprintf "%a" ScopeName.format_t vc.vc_scope)
(Bindlib.name_of (Var.get (Marked.unmark vc.vc_variable))))
(Bindlib.name_of (Marked.unmark vc.vc_variable)))
msg
end

14
compiler/verification/io.mli
View File

@ -17,6 +17,8 @@
(** Common code for handling the IO of all proof backends supported *)
open Utils
module type Backend = sig
val init_backend : unit -> unit
@ -24,7 +26,7 @@ module type Backend = sig
val make_context :
Dcalc.Ast.decl_ctx ->
Dcalc.Ast.typ Utils.Marked.pos Dcalc.Ast.VarMap.t ->
(Astgen.typed Dcalc.Ast.expr, Dcalc.Ast.typ Utils.Marked.pos) Var.Map.t ->
backend_context
type vc_encoding
@ -39,7 +41,9 @@ module type Backend = sig
val is_model_empty : model -> bool
val translate_expr :
backend_context -> 'm Dcalc.Ast.marked_expr -> backend_context * vc_encoding
backend_context ->
Astgen.typed Dcalc.Ast.marked_expr ->
backend_context * vc_encoding
end
module type BackendIO = sig
@ -49,13 +53,15 @@ module type BackendIO = sig
val make_context :
Dcalc.Ast.decl_ctx ->
Dcalc.Ast.typ Utils.Marked.pos Dcalc.Ast.VarMap.t ->
(Astgen.typed Dcalc.Ast.expr, Dcalc.Ast.typ Utils.Marked.pos) Var.Map.t ->
backend_context
type vc_encoding
val translate_expr :
backend_context -> 'm Dcalc.Ast.marked_expr -> backend_context * vc_encoding
backend_context ->
Astgen.typed Dcalc.Ast.marked_expr ->
backend_context * vc_encoding
type model

55
compiler/verification/z3backend.real.ml
View File

@ -27,20 +27,20 @@ type context = {
ctx_decl : decl_ctx;
(* The declaration context from the Catala program, containing information to
precisely pretty print Catala expressions *)
ctx_var : typ Marked.pos VarMap.t;
ctx_var : (typed expr, typ Marked.pos) Var.Map.t;
(* A map from Catala variables to their types, needed to create Z3 expressions
of the right sort *)
ctx_funcdecl : FuncDecl.func_decl VarMap.t;
ctx_funcdecl : (typed expr, FuncDecl.func_decl) Var.Map.t;
(* A map from Catala function names (represented as variables) to Z3 function
declarations, used to only define once functions in Z3 queries *)
ctx_z3vars : Var.t StringMap.t;
ctx_z3vars : typed var StringMap.t;
(* A map from strings, corresponding to Z3 symbol names, to the Catala
variable they represent. Used when to pretty-print Z3 models when a
counterexample is generated *)
ctx_z3datatypes : Sort.sort EnumMap.t;
(* A map from Catala enumeration names to the corresponding Z3 sort, from
which we can retrieve constructors and accessors *)
ctx_z3matchsubsts : Expr.expr VarMap.t;
ctx_z3matchsubsts : (typed expr, Expr.expr) Var.Map.t;
(* A map from Catala temporary variables, generated when translating a match,
to the corresponding enum accessor call as a Z3 expression *)
ctx_z3structs : Sort.sort StructMap.t;
@ -65,13 +65,13 @@ type context = {
(** [add_funcdecl] adds the mapping between the Catala variable [v] and the Z3
function declaration [fd] to the context **)
let add_funcdecl (v : Var.t) (fd : FuncDecl.func_decl) (ctx : context) : context
=
{ ctx with ctx_funcdecl = VarMap.add v fd ctx.ctx_funcdecl }
let add_funcdecl (v : typed var) (fd : FuncDecl.func_decl) (ctx : context) :
context =
{ ctx with ctx_funcdecl = Var.Map.add v fd ctx.ctx_funcdecl }
(** [add_z3var] adds the mapping between [name] and the Catala variable [v] to
the context **)
let add_z3var (name : string) (v : Var.t) (ctx : context) : context =
let add_z3var (name : string) (v : typed var) (ctx : context) : context =
{ ctx with ctx_z3vars = StringMap.add name v ctx.ctx_z3vars }
(** [add_z3enum] adds the mapping between the Catala enumeration [enum] and the
@ -82,8 +82,8 @@ let add_z3enum (enum : EnumName.t) (sort : Sort.sort) (ctx : context) : context
(** [add_z3var] adds the mapping between temporary variable [v] and the Z3
expression [e] representing an accessor application to the context **)
let add_z3matchsubst (v : Var.t) (e : Expr.expr) (ctx : context) : context =
{ ctx with ctx_z3matchsubsts = VarMap.add v e ctx.ctx_z3matchsubsts }
let add_z3matchsubst (v : typed var) (e : Expr.expr) (ctx : context) : context =
{ ctx with ctx_z3matchsubsts = Var.Map.add v e ctx.ctx_z3matchsubsts }
(** [add_z3struct] adds the mapping between the Catala struct [s] and the
corresponding Z3 datatype [sort] to the context **)
@ -223,9 +223,8 @@ let print_model (ctx : context) (model : Model.model) : string =
let v = StringMap.find symbol_name ctx.ctx_z3vars in
Format.fprintf fmt "%s %s : %s"
(Cli.with_style [ANSITerminal.blue] "%s" "-->")
(Cli.with_style [ANSITerminal.yellow] "%s"
(Bindlib.name_of (Var.get v)))
(print_z3model_expr ctx (VarMap.find v ctx.ctx_var) e)
(Cli.with_style [ANSITerminal.yellow] "%s" (Bindlib.name_of v))
(print_z3model_expr ctx (Var.Map.find v ctx.ctx_var) e)
else
(* Declaration d is a function *)
match Model.get_func_interp model d with
@ -239,8 +238,7 @@ let print_model (ctx : context) (model : Model.model) : string =
let v = StringMap.find symbol_name ctx.ctx_z3vars in
Format.fprintf fmt "%s %s : %s"
(Cli.with_style [ANSITerminal.blue] "%s" "-->")
(Cli.with_style [ANSITerminal.yellow] "%s"
(Bindlib.name_of (Var.get v)))
(Cli.with_style [ANSITerminal.yellow] "%s" (Bindlib.name_of v))
(* TODO: Model of a Z3 function should be pretty-printed *)
(Model.FuncInterp.to_string f)))
decls
@ -387,18 +385,18 @@ let translate_lit (ctx : context) (l : lit) : Expr.expr =
corresponding to the variable [v]. If no such function declaration exists
yet, we construct it and add it to the context, thus requiring to return a
new context *)
let find_or_create_funcdecl (ctx : context) (v : Var.t) :
let find_or_create_funcdecl (ctx : context) (v : typed var) :
context * FuncDecl.func_decl =
match VarMap.find_opt v ctx.ctx_funcdecl with
match Var.Map.find_opt v ctx.ctx_funcdecl with
| Some fd -> ctx, fd
| None -> (
(* Retrieves the Catala type of the function [v] *)
let f_ty = VarMap.find v ctx.ctx_var in
let f_ty = Var.Map.find v ctx.ctx_var in
match Marked.unmark f_ty with
| TArrow (t1, t2) ->
let ctx, z3_t1 = translate_typ ctx (Marked.unmark t1) in
let ctx, z3_t2 = translate_typ ctx (Marked.unmark t2) in
let name = unique_name (Var.get v) in
let name = unique_name v in
let fd = FuncDecl.mk_func_decl_s ctx.ctx_z3 name [z3_t1] z3_t2 in
let ctx = add_funcdecl v fd ctx in
let ctx = add_z3var name v ctx in
@ -631,7 +629,7 @@ and translate_expr (ctx : context) (vc : 'm marked_expr) : context * Expr.expr =
match Marked.unmark e with
| EAbs (e, _) ->
(* Create a fresh Catala variable to substitue and obtain the body *)
let fresh_v = new_var "arm!tmp" in
let fresh_v = Var.make "arm!tmp" in
let fresh_e = EVar fresh_v in
(* Invariant: Catala enums always have exactly one argument *)
@ -639,7 +637,7 @@ and translate_expr (ctx : context) (vc : 'm marked_expr) : context * Expr.expr =
let proj = Expr.mk_app ctx.ctx_z3 accessor [head] in
(* The fresh variable should be substituted by a projection into the enum
in the body, we add this to the context *)
let ctx = add_z3matchsubst (Var.t fresh_v) proj ctx in
let ctx = add_z3matchsubst fresh_v proj ctx in
let body = Bindlib.msubst e [| fresh_e |] in
translate_expr ctx body
@ -649,12 +647,12 @@ and translate_expr (ctx : context) (vc : 'm marked_expr) : context * Expr.expr =
match Marked.unmark vc with
| EVar v -> (
match VarMap.find_opt (Var.t v) ctx.ctx_z3matchsubsts with
match Var.Map.find_opt v ctx.ctx_z3matchsubsts with
| None ->
(* We are in the standard case, where this is a true Catala variable *)
let t = VarMap.find (Var.t v) ctx.ctx_var in
let t = Var.Map.find v ctx.ctx_var in
let name = unique_name v in
let ctx = add_z3var name (Var.t v) ctx in
let ctx = add_z3var name v ctx in
let ctx, ty = translate_typ ctx (Marked.unmark t) in
let z3_var = Expr.mk_const_s ctx.ctx_z3 name ty in
let ctx =
@ -726,7 +724,7 @@ and translate_expr (ctx : context) (vc : 'm marked_expr) : context * Expr.expr =
match Marked.unmark head with
| EOp op -> translate_op ctx op args
| EVar v ->
let ctx, fd = find_or_create_funcdecl ctx (Var.t v) in
let ctx, fd = find_or_create_funcdecl ctx v in
(* Fold_right to preserve the order of the arguments: The head argument is
appended at the head *)
let ctx, z3_args =
@ -804,7 +802,8 @@ module Backend = struct
let make_context
(decl_ctx : decl_ctx)
(free_vars_typ : typ Marked.pos VarMap.t) : backend_context =
(free_vars_typ : (typed expr, typ Marked.pos) Var.Map.t) : backend_context
=
let cfg =
(if !Cli.disable_counterexamples then [] else ["model", "true"])
@ ["proof", "false"]
@ -815,10 +814,10 @@ module Backend = struct
ctx_z3 = z3_ctx;
ctx_decl = decl_ctx;
ctx_var = free_vars_typ;
ctx_funcdecl = VarMap.empty;
ctx_funcdecl = Var.Map.empty;
ctx_z3vars = StringMap.empty;
ctx_z3datatypes = EnumMap.empty;
ctx_z3matchsubsts = VarMap.empty;
ctx_z3matchsubsts = Var.Map.empty;
ctx_z3structs = StructMap.empty;
ctx_z3unit = z3unit;
ctx_z3constraints = [];

2
doc/catala-dev-dependencies.opam
View File

@ -1,5 +1,5 @@
opam-version: "2.0"
version: "0.6.0"
version: "0.7.0"
synopsis: "Virtual package listing the requirements for a complete Catala dev environment"
maintainer: ["contact@catala-lang.org"]
authors: [

BIN
doc/syntax/syntax.pdf
View File

Binary file not shown.

17
doc/syntax/syntax.tex
View File

@ -1589,6 +1589,23 @@ accès_année de ...
```catala
<^ <=^ >^ >=^
```
\end{minted}
\vspace*{-1.75em}
\\
Collection merging &
\vspace*{-1.75em}
\begin{minted}{catala_en}
```catala
(collection) ++ (collection)
```
\end{minted}
\vspace*{-1.75em}
&
\vspace*{-1.75em}
\begin{minted}{catala_fr}
```catala
(collection) ++ (collection)
```
\end{minted}
\vspace*{-1.75em}
\\

4
dune
View File

@ -18,7 +18,7 @@
(rule
(alias runtest)
(package catala)
(package clerk)
(deps
(source_tree tests))
(action
@ -26,7 +26,7 @@
(rule
(alias runtest)
(package catala)
(package clerk)
(deps
(source_tree examples))
(action

2
dune-project
View File

@ -2,7 +2,7 @@
(name catala)
(version 0.6.0)
(version 0.7.0)
(generate_opam_files false)

6
examples/aides_logement/arrete_2019-09-27.catala_fr
View File

@ -155,7 +155,7 @@ Bénéficiaires Zones Montants
------------------------- ----- --------
Cas général I 268,26
II 233,80
II 233,80
III 219,13
@ -4265,7 +4265,7 @@ b) 131,00 euros lorsqu'il s'agit d'un couple ;
champ d'application CalculAllocationLogementFoyer
sous condition date_courante >=@ |2021-10-01|:
définition équivalence_loyer sous condition
catégorie_équivalence_loyer_d842_16 sous forme ÉtudiantLogéEnChambre
catégorie_équivalence_loyer_d842_16 sous forme ÉtudiantLogéEnChambreCROUS
conséquence égal à
selon situation_familiale_calcul_apl sous forme
-- PersonneSeule: 84,14 €
@ -4283,7 +4283,7 @@ champ d'application CalculAllocationLogementFoyer
sous condition date_courante >=@ |2021-10-01|:
définition équivalence_loyer sous condition
catégorie_équivalence_loyer_d842_16 sous forme
ÉtudiantLogéEnChambreRéhabilitée
ÉtudiantLogéEnChambreCROUSRéhabilitée
conséquence égal à
selon situation_familiale_calcul_apl sous forme
-- PersonneSeule: 170,12 €

175
examples/aides_logement/code_construction_legislatif.catala_fr
View File

@ -65,13 +65,12 @@ champ d'application ÉligibilitéAidesPersonnelleLogement:
condition_logement_résidence_principale et # L821-2
condition_logement_mode_occupation et
condition_logement_location_tiers et
condition_logement_surface
condition_ouverture_l822_10_peuplement_logement
conséquence rempli
exception règle éligibilité_logement sous condition
condition_non_ouverture_l822_8 ou
condition_non_ouverture_l822_9_decence_logement ou
condition_non_ouverture_l822_10_peuplement_logement
condition_non_ouverture_l822_9_decence_logement
conséquence non rempli
```
@ -107,7 +106,8 @@ champ d'application ÉligibilitéAidesPersonnelleLogement:
règle condition_nationalité sous condition
selon demandeur.nationalité sous forme
-- Française: vrai
-- Étrangère: demandeur.satisfait_conditions_l512_2_code_sécurité_sociale
-- Étrangère de conditions:
conditions.satisfait_conditions_l512_2_code_sécurité_sociale
conséquence rempli
```
@ -203,7 +203,8 @@ exception cas_base_l822_4 règle condition_logement_location_tiers
selon ménage.logement.loué_ou_sous_loué_à_des_tiers sous forme
-- LouéOuSousLouéÀDesTiers.Non: vrai
-- LouéOuSousLouéÀDesTiers.Oui de personne:
personne.age_personne_sous_location <= 30 ou
personne.date_naissance_personne_sous_location +@ 30 an >@
date_courante ou
personne.conforme_article_l442_1
conséquence rempli
```
@ -376,9 +377,11 @@ L'attribution d'une aide personnelle au logement est subordonnée au
respect de conditions de peuplement des logements.
```catala
# Cet article fait référence à la condition sur la surface minimale du logement
# de R822-25
champ d'application ÉligibilitéAidesPersonnelleLogement:
règle condition_non_ouverture_l822_10_peuplement_logement
sous condition condition_peuplement_logement_l822_10
règle condition_ouverture_l822_10_peuplement_logement
sous condition condition_logement_surface
conséquence rempli
```
@ -630,14 +633,16 @@ régies par la section 3 du chapitre Ier du titre II du livre III ;
```catala
champ d'application ÉligibilitéAidePersonnaliséeLogement:
étiquette l831_1_2 règle condition_logement_bailleur sous condition
règle condition_logement_bailleur sous condition
selon ménage.logement.mode_occupation sous forme
-- Locataire de location:
(selon location.bailleur.type_bailleur sous forme
-- BailleurSocial:
location.bailleur.respecte_convention_titre_V
-- BailleurPrivé:
location.bailleur.respecte_convention_titre_II)
(selon location.Location.bailleur sous forme
-- BailleurSocial de convention:
convention.ConventionBailleurSocial.
conventionné_livre_III_titre_V_chap_III
-- BailleurPrivéAvecConventionnementSocial de convention:
convention.conventionné_livre_III_titre_II_chap_I_sec_3
-- n'importe quel: faux)
-- n'importe quel: faux
conséquence rempli
```
@ -649,27 +654,9 @@ bailleurs de respecter les obligations précisées par des conventions régies
par le chapitre III du titre V du livre III ;
```catala
champ d'application ÉligibilitéAidePersonnaliséeLogement:
# TODO recherche: citer cet exemple intéréssant d'un point de vue
# computationel.
# Ici attention à la structure d'exception! Le 2°) est le cas de base, le
# 4°) est une exception au 2°) plus permissive que le cas de base, tandis
# que le 3°) est une exception plus stricte que le cas de base. Si 3°) et
# 4°) s'appliquent en même temps alors il faudra prioriser le cas strict
# sur le cas permissif, d'où la structure d'exceptions ci-dessous.
exception l831_1_4 règle condition_logement_bailleur sous condition
selon ménage.logement.mode_occupation sous forme
-- Locataire de location:
(selon location.bailleur.type_bailleur sous forme
-- BailleurSocial: faux
-- BailleurPrivé:
location.bailleur.acquisition_aides_état_prêt_titre_II_ou_livre_III et
(non location.bailleur.respecte_convention_titre_V))
# Ici il faut la négation car si le bailleur privé ne respecte
# pas le titre V, alors il ne doit pas bénéficier du cas de base du
# 2°)
-- n'importe quel: faux
conséquence non rempli
# Cet alinéa apport une précision sur l'origine de la convention pour le
# bailleur social, mais ne nous intéresse pas pour la formalisation puisque
# tout ce qui nous intéresse c'est de savoir si la convention existe ou pas.
```
4° Logements à usage locatif construits ou améliorés dans des conditions fixées
@ -678,22 +665,9 @@ obligations précisées par des conventions régies par le chapitre III du titre
ou par la section 3 du chapitre Ier du titre II du livre III ;
```catala
champ d'application ÉligibilitéAidePersonnaliséeLogement:
étiquette l831_1_4 exception l831_1_2
règle condition_logement_bailleur sous condition
selon ménage.logement.mode_occupation sous forme
-- Locataire de location:
(selon location.bailleur.type_bailleur sous forme
-- BailleurSocial:
location.bailleur.construit_amélioré_conditions_l831_1_4 et
(location.bailleur.respecte_convention_titre_V ou
location.bailleur.respecte_convention_titre_II)
-- BailleurPrivé:
location.bailleur.construit_amélioré_conditions_l831_1_4 et
(location.bailleur.respecte_convention_titre_V ou
location.bailleur.respecte_convention_titre_II))
-- n'importe quel: faux
conséquence rempli
# Cet alinéa apport une précision sur l'origine de la convention pour le
# bailleur social, mais ne nous intéresse pas pour la formalisation puisque
# tout ce qui nous intéresse c'est de savoir si la convention existe ou pas.
```
5° Logements-foyers assimilés dans des conditions fixées par voie réglementaire
@ -701,7 +675,13 @@ aux logements mentionnés aux 2° et 3° ci-dessus, dès lors qu'ils font l'obje
des conventions régies par le chapitre III du titre V du livre III ;
```catala
# Voir R832-21.
champ d'application ÉligibilitéAidePersonnaliséeLogement:
règle condition_logement_bailleur sous condition
selon ménage.logement.mode_occupation sous forme
-- RésidentLogementFoyer de location:
location.LogementFoyer.conventionné_livre_III_titre_V_chap_III
-- n'importe quel: faux
conséquence rempli
```
6° Logements occupés par des titulaires de contrats de location-accession
@ -712,7 +692,6 @@ de l'Etat ou de prêts dont les caractéristiques et les conditions d'octroi son
fixées par voie réglementaire, sous les réserves énoncées à l ‘ article L. 831-2.
```catala
# TODO juridique: trouver quelles sont ces mystérieuses conditions d'octroi.
champ d'application ÉligibilitéAidePersonnaliséeLogement:
règle condition_logement_bailleur sous condition
selon ménage.logement.mode_occupation sous forme
@ -759,13 +738,13 @@ champ d'application ÉligibilitéAidePersonnaliséeLogement:
# 2018 nous a été confirmé le 25/05/2022 par DGALN/DHUP/FE4.
propriété.prêt.date_signature >=@ |2018-01-01| et
propriété.prêt.date_signature <@ |2020-01-01| et
ménage.logement.est_ancien_l831_2 et
ménage.logement.situé_commune_déséquilibre_l831_2
propriété.ancienneté_logement sous forme Ancien et
propriété.logement_situé_commune_déséquilibre_l831_2
-- AccessionPropriétéLocalUsageExclusifHabitation de propriété:
propriété.prêt.date_signature >=@ |2018-01-01| et
propriété.prêt.date_signature <@ |2020-01-01| et
ménage.logement.est_ancien_l831_2 et
ménage.logement.situé_commune_déséquilibre_l831_2
propriété.ancienneté_logement sous forme Ancien et
propriété.logement_situé_commune_déséquilibre_l831_2
-- n'importe quel: faux
conséquence rempli
```
@ -821,13 +800,11 @@ est fixée par voie réglementaire.
```catala
champ d'application CalculAidePersonnaliséeLogementLocatif:
définition traitement_aide_finale de aide_finale état réduction_loyer_solidarité égal à
soit aide_finale égal à traitement_aide_finale de aide_finale dans
si
traitement_aide_finale de aide_finale -€
réduction_loyer_solidarité *€ fraction_l832_3 >=€
0€
aide_finale -€ réduction_loyer_solidarité *€ fraction_l832_3 >=€ 0€
alors
traitement_aide_finale de aide_finale -€
réduction_loyer_solidarité *€ fraction_l832_3
aide_finale -€ réduction_loyer_solidarité *€ fraction_l832_3
sinon 0€
assertion fraction_l832_3 >=. 90% et fraction_l832_3 <=. 98%
@ -854,7 +831,10 @@ champ d'application ÉligibilitéAllocationLogement:
# personnelles au logement. Comme il n'existe pas d'article de loi ou de
# règlement rappelant ce fait, nous le traduisons en code ici.
définition éligibilité état dispositions_communes égal à
si non éligibilité_commune.éligibilité alors
si
(non éligibilité_commune.éligibilité) ou
(non condition_accession_propriété)
alors
PasÉligible
sinon
# Valeur par défaut, sera réécrit à l'application de L841-2.
@ -908,15 +888,11 @@ champ d'application ÉligibilitéAllocationLogement:
-- obligation_scolaire: enfant.EnfantÀCharge.obligation_scolaire
-- rémuneration_mensuelle: enfant.EnfantÀCharge.rémuneration_mensuelle
-- date_de_naissance: enfant.EnfantÀCharge.date_de_naissance
-- âge: enfant.EnfantÀCharge.âge
-- prise_en_charge: (selon enfant.EnfantÀCharge.prise_en_charge sous forme
-- PriseEnCharge.EffectiveEtPermanente:
PriseEnChargeEnfant.EffectiveEtPermanente
-- PriseEnCharge.RésidenceAlternéeAllocataireUnique:
PriseEnChargeEnfant.GardeAlternéeAllocataireUnique
-- PriseEnCharge.RésidenceAlternéeAllocationsPartagée:
-- prise_en_charge: (selon enfant.situation_garde_alternée sous forme
-- GardeAlternéeCoefficientPriseEnCharge:
PriseEnChargeEnfant.GardeAlternéePartageAllocations
)
-- PasDeGardeAlternée:
PriseEnChargeEnfant.EffectiveEtPermanente)
-- a_déjà_ouvert_droit_aux_allocations_familiales:
enfant.EnfantÀCharge.a_déjà_ouvert_droit_aux_allocations_familiales
-- bénéficie_titre_personnel_aide_personnelle_logement:
@ -943,15 +919,11 @@ champ d'application ÉligibilitéAllocationLogement:
-- obligation_scolaire: enfant.EnfantÀCharge.obligation_scolaire
-- rémuneration_mensuelle: enfant.EnfantÀCharge.rémuneration_mensuelle
-- date_de_naissance: enfant.EnfantÀCharge.date_de_naissance
-- âge: enfant.EnfantÀCharge.âge
-- prise_en_charge: (selon enfant.EnfantÀCharge.prise_en_charge sous forme
-- PriseEnCharge.EffectiveEtPermanente:
PriseEnChargeEnfant.EffectiveEtPermanente
-- PriseEnCharge.RésidenceAlternéeAllocataireUnique:
PriseEnChargeEnfant.GardeAlternéeAllocataireUnique
-- PriseEnCharge.RésidenceAlternéeAllocationsPartagée:
-- prise_en_charge: (selon enfant.situation_garde_alternée sous forme
-- GardeAlternéeCoefficientPriseEnCharge:
PriseEnChargeEnfant.GardeAlternéePartageAllocations
)
-- PasDeGardeAlternée:
PriseEnChargeEnfant.EffectiveEtPermanente)
-- a_déjà_ouvert_droit_aux_allocations_familiales:
enfant.EnfantÀCharge.a_déjà_ouvert_droit_aux_allocations_familiales
-- bénéficie_titre_personnel_aide_personnelle_logement:
@ -1050,10 +1022,9 @@ champ d'application ÉligibilitéAllocationLogement:
si éligibilité = PasÉligible ou bénéficie_aide_personnalisée_logement alors
PasÉligible
sinon (si éligibilité_allocation_logement_familiale alors
ÉligibilitéAllocationLogement.AllocationLogementFamiliale
sinon (si éligibilité_allocation_logement_sociale alors
ÉligibilitéAllocationLogement.AllocationLogementSociale
sinon PasÉligible))
ÉligibilitéAllocationLogement.AllocationLogementFamiliale
sinon
ÉligibilitéAllocationLogement.AllocationLogementSociale)
champ d'application CalculetteAidesAuLogement:
# Le champ d'application CalculetteAidesAuLogement suppose un scenario type
@ -1107,22 +1078,27 @@ champ d'application CalculetteAidesAuLogement:
sinon calcul_allocation_logement.aide_finale_formule
définition traitement_aide_finale de aide_finale égal à
si non éligibilité alors aide_finale sinon si
éligibilité_aide_personnalisée_logement.éligibilité et
non (éligibilité_allocation_logement.éligibilité sous forme PasÉligible)
alors
(si calcul_aide_personnalisée_logement.traitement_aide_finale de
calcul_aide_personnalisée_logement.aide_finale_formule >€
calcul_allocation_logement.traitement_aide_finale de
calcul_allocation_logement.aide_finale_formule
alors
calcul_aide_personnalisée_logement.traitement_aide_finale de aide_finale
sinon
calcul_allocation_logement.traitement_aide_finale de aide_finale)
sinon si éligibilité_aide_personnalisée_logement.éligibilité
alors
soit aide_finale_apl égal à
calcul_aide_personnalisée_logement.traitement_aide_finale de aide_finale
sinon calcul_allocation_logement.traitement_aide_finale de aide_finale
dans
soit aide_finale_al égal à
calcul_allocation_logement.traitement_aide_finale de aide_finale
dans
si non éligibilité alors
aide_finale
sinon si
éligibilité_aide_personnalisée_logement.éligibilité et
non (éligibilité_allocation_logement.éligibilité sous forme PasÉligible)
alors
(si aide_finale_apl >€ aide_finale_al
alors aide_finale_apl
sinon aide_finale_al)
sinon si
éligibilité_aide_personnalisée_logement.éligibilité
alors
aide_finale_apl
sinon
aide_finale_al
```
###### Article L841-3 | LEGIARTI000038814860
@ -1132,9 +1108,10 @@ soins de longue durée mentionnés au 3° de l'article L. 162-22 du code de la s
```catala
champ d'application ÉligibilitéAllocationLogement:
règle éligibilité_allocation_logement_sociale sous condition
exception définition éligibilité état l841_2 sous condition
demandeur.personne_hébergée_centre_soin_l_L162_22_3_sécurité_sociale
conséquence rempli
conséquence égal à
ÉligibilitéAllocationLogement.AllocationLogementSociale
```
###### Article L841-4 | LEGIARTI000038814858

1014
examples/aides_logement/code_construction_reglementaire.catala_fr
View File

File diff suppressed because it is too large Load Diff

184
examples/aides_logement/prologue.catala_fr
View File

@ -13,28 +13,27 @@ dans les sections suivantes.
#### Calcul et éligibilité pour le secteur locatif
```catala-metadata
déclaration structure ConventionBailleurSocial:
donnée conventionné_livre_III_titre_V_chap_III contenu booléen
donnée réduction_loyer_solidarité_perçue contenu argent
déclaration structure ConventionANHA:
donnée conventionné_livre_III_titre_II_chap_I_sec_3 contenu booléen
déclaration énumération TypeBailleur:
-- BailleurSocial
-- BailleurSocial contenu ConventionBailleurSocial
-- BailleurPrivéAvecConventionnementSocial contenu
ConventionANHA
-- BailleurPrivé
déclaration structure Bailleur:
donnée type_bailleur contenu TypeBailleur
donnée respecte_convention_titre_V contenu booléen
donnée respecte_convention_titre_II contenu booléen
donnée construit_amélioré_conditions_l831_1_4 contenu booléen
donnée acquisition_aides_état_prêt_titre_II_ou_livre_III contenu booléen
déclaration structure Location:
donnée bailleur contenu Bailleur
déclaration structure InformationsCalculAPLLocatif:
donnée bailleur contenu TypeBailleur
donnée loyer_principal contenu argent
donnée bénéficiaire_aide_adulte_ou_enfant_handicapés contenu booléen
donnée logement_est_chambre contenu booléen
donnée colocation contenu booléen
donnée âgées_ou_handicap_adultes_hébergées_onéreux_particuliers
contenu booléen
donnée réduction_loyer_solidarité contenu argent
donnée logement_meublé_d842_2 contenu booléen
donnée changement_logement_d842_4 contenu ChangementLogementD842_4
```
@ -59,6 +58,16 @@ déclaration structure Prêt:
donnée titulaire_prêt contenu TitulairePrêt
déclaration structure Propriétaire:
donnée logement_situé_commune_déséquilibre_l831_2 contenu booléen
donnée mensualité_principale contenu argent
donnée charges_mensuelles_prêt contenu argent
donnée date_entrée_logement contenu date
donnée type_travaux_logement_d832_15 contenu TypeTravauxLogementD832_15
donnée type_travaux_logement_r842_5 contenu TypeTravauxLogementR842_5
donnée local_habité_première_fois_bénéficiaire contenu booléen
donnée copropriété contenu booléen
donnée situation_r822_11_13_17 contenu booléen
donnée ancienneté_logement contenu NeufOuAncien
donnée prêt contenu Prêt
déclaration énumération TypeTravauxLogementD832_15:
@ -79,20 +88,6 @@ déclaration énumération AmélioréParOccupant:
déclaration énumération NeufOuAncien:
-- Neuf
-- Ancien contenu AmélioréParOccupant
déclaration structure InformationsCalculAPLAccessionPropriété:
donnée mensualité_principale contenu argent
donnée charges_mensuelles_prêt contenu argent
donnée date_signature_prêt contenu date
donnée date_entrée_logement contenu date
donnée type_travaux_logement_d832_15 contenu TypeTravauxLogementD832_15
donnée type_travaux_logement_r842_5 contenu TypeTravauxLogementR842_5
donnée local_habité_première_fois_bénéficiaire contenu booléen
donnée copropriété contenu booléen
donnée situation_r822_11_13_17 contenu booléen
donnée type_prêt contenu TypePrêt
donnée ancienneté_logement contenu NeufOuAncien
```
#### Calcul et éligibilité pour le secteur logement-foyer
@ -118,15 +113,14 @@ déclaration structure TrancheRevenuDécimal:
déclaration structure LogementFoyer:
donnée type contenu TypeLogementFoyer
donnée date_conventionnement contenu date
donnée location contenu Location
donnée remplit_conditions_r832_21 contenu booléen
donnée conventionné_livre_III_titre_V_chap_III contenu booléen
donnée date_conventionnement contenu date
donnée construit_application_loi_1957_12_III contenu booléen
déclaration structure InformationsCalculAPLLogementFoyer:
donnée redevance contenu argent
donnée catégorie_équivalence_loyer_d842_16 contenu
CatégorieÉquivalenceLoyerAllocationLogementFoyer
```
#### Calcul et éligibilité pour tous les secteurs
@ -140,9 +134,6 @@ déclaration énumération PrestationReçue:
-- AllocationSoutienEnfantHandicapé
-- AllocationAdulteHandicapé
déclaration énumération TypeContratTravail:
-- CDI
-- Autres
déclaration énumération ModeOccupation:
-- Locataire contenu Location
@ -157,7 +148,7 @@ déclaration énumération ParentOuAutre:
-- Autre
déclaration structure PersonneSousLocation:
donnée age_personne_sous_location contenu entier
donnée date_naissance_personne_sous_location contenu date
donnée conforme_article_l442_1 contenu booléen
déclaration énumération LouéOuSousLouéÀDesTiers:
@ -173,8 +164,6 @@ déclaration structure Logement:
donnée usufruit contenu ParentOuAutre
donnée logement_decent_l89_462 contenu booléen
donnée surface_m_carrés contenu entier
donnée est_ancien_l831_2 contenu booléen
donnée situé_commune_déséquilibre_l831_2 contenu booléen
donnée zone contenu ZoneDHabitation
déclaration énumération SituationGardeAlternée:
@ -189,8 +178,6 @@ déclaration structure EnfantÀCharge:
donnée date_de_naissance contenu date
donnée rémuneration_mensuelle contenu argent
donnée obligation_scolaire contenu SituationObligationScolaire
donnée prise_en_charge contenu PriseEnCharge
donnée âge contenu entier
donnée situation_garde_alternée contenu SituationGardeAlternée
déclaration énumération Parenté:
@ -228,31 +215,26 @@ déclaration structure Ménage:
donnée nombre_autres_occupants_logement contenu entier
donnée situation_familiale contenu SituationFamiliale
donnée condition_rattaché_foyer_fiscal_parent_ifi contenu booléen
donnée nombre_enfants_à_naître_après_troisième_mois_grossesse
contenu entier
donnée enfant_à_naître_après_quatrième_mois_grossesse
contenu booléen
donnée date_naissance_troisième_enfant_ou_dernier_si_plus contenu
DateNaissanceTroisièmeOuDernierPlusEnfant
donnée enfant_à_naître_après_quatrième_mois_grossesse contenu booléen
déclaration structure Patrimoine:
donnée produisant_revenu_période_r822_3_3_r822_4 contenu argent
donnée ne_produisant_pas_revenu_période_r822_3_3_r822_4 contenu argent
déclaration structure Demandeur:
donnée satisfait_conditions_l512_2_code_sécurité_sociale
contenu booléen
donnée age_demandeur contenu entier
donnée date_naissance contenu date
donnée contrat_de_travail contenu TypeContratTravail
donnée nationalité contenu Nationalité
donnée patrimoine contenu Patrimoine
donnée personne_hébergée_centre_soin_l_L162_22_3_sécurité_sociale
contenu booléen
déclaration structure ConditionsÉtrangers:
donnée satisfait_conditions_l512_2_code_sécurité_sociale
contenu booléen
déclaration énumération Nationalité:
-- Française
-- Étrangère
-- Étrangère contenu ConditionsÉtrangers
déclaration énumération ZoneDHabitation:
-- Zone1
@ -263,12 +245,6 @@ déclaration énumération CatégorieCalculAPL:
-- Location
-- AccessionPropriété
-- LogementFoyer
déclaration énumération InformationsCalculAPL:
-- InfosLocatif contenu InformationsCalculAPLLocatif
-- InfosLogementFoyer contenu InformationsCalculAPLLogementFoyer
-- InfosAccessionPropriété contenu
InformationsCalculAPLAccessionPropriété
```
### Informations concernant l'évaluation des ressources du ménage
@ -318,12 +294,10 @@ déclaration champ d'application ÉligibilitéAidesPersonnelleLogement:
contexte condition_logement_résidence_principale condition
interne condition_logement_mode_occupation condition
interne condition_logement_location_tiers condition
interne condition_logement_surface_minimale_sans_seuil_m_carrés
contenu entier
contexte condition_logement_surface condition
interne condition_non_ouverture_l822_8 condition
interne condition_non_ouverture_l822_9_decence_logement condition
interne condition_non_ouverture_l822_10_peuplement_logement condition
interne condition_ouverture_l822_10_peuplement_logement condition
interne condition_peuplement_logement_l822_10 condition
interne éligibilité_logement condition
interne prise_en_compte_personne_à_charge condition
@ -333,7 +307,6 @@ déclaration champ d'application ÉligibilitéAidesPersonnelleLogement:
# Autres variables
interne patrimoine_total_demandeur contenu argent
interne nombre_personnes_logement contenu entier
interne usufruit_ou_propriété_famille contenu booléen
interne seuil_l822_3_parts_propriété contenu décimal
interne seuil_l822_3_parts_usufruit contenu décimal
@ -424,12 +397,10 @@ déclaration champ d'application ÉligibilitéAllocationLogement:
entrée ménage contenu Ménage
entrée demandeur contenu Demandeur
entrée bénéficie_aide_personnalisée_logement contenu booléen
entrée informations_calcul contenu InformationsCalculAPL
interne condition_logement condition
interne condition_accession_propriété condition
interne éligibilité_allocation_logement_familiale condition
interne éligibilité_allocation_logement_sociale condition
interne durée_l841_1_3 contenu durée
prestations_familiales champ d'application ÉligibilitéPrestationsFamiliales
@ -439,7 +410,6 @@ déclaration champ d'application ÉligibilitéAllocationLogement:
sortie éligibilité contenu ÉligibilitéAllocationLogement
état dispositions_communes
état l841_2
état avec_condition_logement
sortie nombre_personnes_à_charge_prises_en_compte contenu entier
sortie coefficents_enfants_garde_alternée_pris_en_compte contenu
collection décimal
@ -458,12 +428,6 @@ champ d'application ÉligibilitéAllocationLogement:
définition éligibilité_commune.demandeur égal à demandeur
définition éligibilité_commune.date_courante égal à
date_courante
définition éligibilité état avec_condition_logement égal à
si non condition_logement alors
PasÉligible
sinon
éligibilité
définition nombre_personnes_à_charge_prises_en_compte égal à
éligibilité_commune.nombre_personnes_à_charge_prises_en_compte
définition coefficents_enfants_garde_alternée_pris_en_compte égal à
@ -473,7 +437,14 @@ champ d'application ÉligibilitéAllocationLogement:
### Éligibilité à la prime de déménagement
```catala-metadata
déclaration structure InformationsPrimeDeDéménagement:
donnée nombre_enfants_à_naître_après_troisième_mois_grossesse
contenu entier
donnée date_naissance_troisième_enfant_ou_dernier_si_plus
contenu DateNaissanceTroisièmeOuDernierPlusEnfant
déclaration champ d'application ÉligibilitéPrimeDeDéménagement:
entrée informations contenu InformationsPrimeDeDéménagement
entrée date_emménagement contenu date
entrée ménage contenu Ménage
entrée demandeur contenu Demandeur
@ -556,6 +527,8 @@ déclaration champ d'application ContributionsSocialesAidesPersonnelleLogement:
```catala-metadata
déclaration champ d'application CalculAidePersonnaliséeLogementLocatif:
entrée loyer_principal contenu argent
état base
état avec_réduction_meublé
entrée ressources_ménage_arrondies contenu argent
entrée bénéficiaire_aide_adulte_ou_enfant_handicapés
contenu booléen
@ -569,6 +542,7 @@ déclaration champ d'application CalculAidePersonnaliséeLogementLocatif:
entrée type_aide contenu TypeAidesPersonnelleLogement
entrée colocation contenu booléen
entrée réduction_loyer_solidarité contenu argent
entrée logement_meublé_d842_2 contenu booléen
interne loyer_éligible contenu argent
interne taux_loyer_éligible contenu décimal
@ -629,7 +603,8 @@ déclaration champ d'application CalculNombrePartLogementFoyer:
sortie n_nombre_parts_d832_25 contenu décimal
déclaration champ d'application CalculAidePersonnaliséeLogementFoyer:
entrée mode_occupation contenu ModeOccupation
entrée type_logement_foyer contenu TypeLogementFoyer
entrée date_conventionnement contenu date
entrée ressources_ménage_arrondies contenu argent
entrée nombre_personnes_à_charge contenu entier
entrée situation_familiale_calcul_apl contenu SituationFamilialeCalculAPL
@ -750,7 +725,6 @@ champ d'application CalculAidePersonnaliséeLogementAccessionPropriété:
déclaration champ d'application CalculAidePersonnaliséeLogement:
entrée mode_occupation contenu ModeOccupation
entrée type_aide contenu TypeAidesPersonnelleLogement
entrée informations_calcul contenu InformationsCalculAPL
entrée ressources_ménage contenu argent
état sans_arrondi
état avec_arrondi
@ -801,9 +775,9 @@ déclaration champ d'application CalculAllocationLogementLocatif:
entrée type_aide contenu TypeAidesPersonnelleLogement
entrée colocation contenu booléen
entrée réduction_loyer_solidarité contenu argent
entrée logement_meublé_d842_2 contenu booléen
# Entrées spécifiques
entrée logement_meublé_d842_2 contenu booléen
entrée changement_logement_d842_4 contenu ChangementLogementD842_4
calcul_apl_locatif champ d'application CalculAidePersonnaliséeLogementLocatif
@ -841,6 +815,8 @@ champ d'application CalculAllocationLogementLocatif:
colocation
définition calcul_apl_locatif.réduction_loyer_solidarité égal à
réduction_loyer_solidarité
définition calcul_apl_locatif.logement_meublé_d842_2 égal à
logement_meublé_d842_2
définition aide_finale_formule égal à calcul_apl_locatif.aide_finale_formule
@ -905,27 +881,16 @@ déclaration champ d'application CalculAllocationLogementAccessionPropriété:
état montant_minimal
champ d'application CalculAllocationLogementAccessionPropriété:
définition calcul_apl_logement_foyer.mode_occupation égal à
# Ici la valeur du mode d'occupation n'a pas de sens puisque l'on est
# dans le cas d'une accession à la propriété mais on nous demande de
# calculer des quantités comme si on était en logement foyer. Or il nous
# faut donner un argument au sous-champ d'application donc on met ici une
# valeur bidon.
RésidentLogementFoyer contenu (LogementFoyer {
-- type: RésidenceSociale
-- date_conventionnement: |2022-01-01|
-- construit_application_loi_1957_12_III: faux
-- location: Location {
-- bailleur: Bailleur {
-- type_bailleur: BailleurSocial
-- respecte_convention_titre_V: vrai
-- respecte_convention_titre_II: vrai
-- construit_amélioré_conditions_l831_1_4: vrai
-- acquisition_aides_état_prêt_titre_II_ou_livre_III: vrai
}
}
-- remplit_conditions_r832_21: faux
})
# Ici la valeur du type de foyer et de la date de conventionnement
# n'a pas de sens puisque l'on est
# dans le cas d'une accession à la propriété mais on nous demande de
# calculer des quantités comme si on était en logement foyer. Or il nous
# faut donner un argument au sous-champ d'application donc on met ici une
# valeur bidon.
définition calcul_apl_logement_foyer.type_logement_foyer égal à
TypeLogementFoyer.Autre # Valeur par défaut
définition calcul_apl_logement_foyer.date_conventionnement égal à
|1970-01-01| # Valeur par défaut
définition calcul_apl_logement_foyer.redevance égal à
0 € # Valeur par défaut
définition calcul_apl_logement_foyer.ressources_ménage_arrondies égal à
@ -945,8 +910,9 @@ champ d'application CalculAllocationLogementAccessionPropriété:
```catala-metadata
déclaration champ d'application CalculAllocationLogementFoyer:
entrée type_logement_foyer contenu TypeLogementFoyer
entrée date_conventionnement contenu date
entrée redevance contenu argent
entrée mode_occupation contenu ModeOccupation
entrée ressources_ménage_arrondies contenu argent
entrée nombre_personnes_à_charge contenu entier
entrée situation_familiale_calcul_apl contenu SituationFamilialeCalculAPL
@ -982,8 +948,10 @@ déclaration champ d'application CalculAllocationLogementFoyer:
état montant_minimal
champ d'application CalculAllocationLogementFoyer:
définition calcul_apl_logement_foyer.mode_occupation égal à
mode_occupation
définition calcul_apl_logement_foyer.type_logement_foyer égal à
type_logement_foyer
définition calcul_apl_logement_foyer.date_conventionnement égal à
date_conventionnement
définition calcul_apl_logement_foyer.redevance égal à
redevance
définition calcul_apl_logement_foyer.ressources_ménage_arrondies égal à
@ -1004,7 +972,6 @@ champ d'application CalculAllocationLogementFoyer:
```catala-metadata
déclaration champ d'application CalculAllocationLogement:
entrée mode_occupation contenu ModeOccupation
entrée informations_calcul contenu InformationsCalculAPL
entrée ressources_ménage contenu argent
état sans_arrondi
état avec_arrondi
@ -1065,7 +1032,6 @@ de toutes les aides disponibles : APL, ALS, ALF.
déclaration champ d'application CalculetteAidesAuLogement:
entrée ménage contenu Ménage
entrée demandeur contenu Demandeur
entrée informations_calcul contenu InformationsCalculAPL
entrée date_courante contenu date
# TODO informatique et juridique: brancher le champ d'application de prise en
# compte des ressources. Pour l'instant on ne fait pas calcul de prise en
@ -1104,17 +1070,6 @@ champ d'application CalculetteAidesAuLogement:
date_courante
définition éligibilité_allocation_logement.date_courante égal à
date_courante
définition éligibilité_allocation_logement.informations_calcul égal à
informations_calcul
définition calcul_aide_personnalisée_logement.informations_calcul égal à
informations_calcul
définition calcul_allocation_logement.informations_calcul égal à
informations_calcul
définition calcul_aide_personnalisée_logement.informations_calcul égal à
informations_calcul
définition calcul_allocation_logement.informations_calcul égal à
informations_calcul
définition calcul_aide_personnalisée_logement.mode_occupation égal à
ménage.logement.mode_occupation
définition calcul_allocation_logement.mode_occupation égal à
@ -1159,7 +1114,6 @@ d'État.
déclaration champ d'application CalculetteAidesAuLogementGardeAlternée:
entrée ménage contenu Ménage
entrée demandeur contenu Demandeur
entrée informations_calcul contenu InformationsCalculAPL
entrée date_courante contenu date
entrée ressources_ménage_prises_en_compte contenu argent
@ -1178,8 +1132,6 @@ champ d'application CalculetteAidesAuLogementGardeAlternée:
ménage
définition calculette.demandeur égal à
demandeur
définition calculette.informations_calcul égal à
informations_calcul
définition calculette.date_courante égal à
date_courante
définition calculette.ressources_ménage_prises_en_compte égal à
@ -1188,8 +1140,6 @@ champ d'application CalculetteAidesAuLogementGardeAlternée:
ménage_sans_enfants_garde_alternée
définition calculette_sans_garde_alternée.demandeur égal à
demandeur
définition calculette_sans_garde_alternée.informations_calcul égal à
informations_calcul
définition calculette_sans_garde_alternée.date_courante égal à
date_courante
définition
@ -1223,12 +1173,8 @@ champ d'application CalculetteAidesAuLogementGardeAlternée:
ménage.situation_familiale
-- condition_rattaché_foyer_fiscal_parent_ifi :
ménage.condition_rattaché_foyer_fiscal_parent_ifi
-- nombre_enfants_à_naître_après_troisième_mois_grossesse :
ménage.nombre_enfants_à_naître_après_troisième_mois_grossesse
-- enfant_à_naître_après_quatrième_mois_grossesse :
-- enfant_à_naître_après_quatrième_mois_grossesse:
ménage.enfant_à_naître_après_quatrième_mois_grossesse
-- date_naissance_troisième_enfant_ou_dernier_si_plus :
ménage.date_naissance_troisième_enfant_ou_dernier_si_plus
}
définition éligibilité égal à calculette.éligibilité
```

2
examples/aides_logement/tests/output/tests_calcul_apl_locatif.catala_fr.Exemple5.Interpret
View File

@ -1,2 +1,2 @@
[RESULT] Computation successful! Results:
[RESULT] montant = 375.88 €
[RESULT] montant = 311.56 €

2
examples/aides_logement/tests/output/tests_calcul_apl_locatif.catala_fr.Exemple9.Interpret Normal file
View File

@ -0,0 +1,2 @@
[RESULT] Computation successful! Results:
[RESULT] montant = 210.06 €

18
examples/aides_logement/tests/tests_calcul_al_logement_foyer.catala_fr
View File

@ -9,21 +9,9 @@ déclaration champ d'application CasTest1 :
sortie montant contenu argent
champ d'application CasTest1:
définition calcul.mode_occupation égal à RésidentLogementFoyer contenu (LogementFoyer {
-- type : TypeLogementFoyer.RésidenceSociale
-- date_conventionnement : |2020-01-01|
-- construit_application_loi_1957_12_III: faux
-- location : Location {
-- bailleur: Bailleur {
-- type_bailleur: BailleurSocial
-- respecte_convention_titre_V: vrai
-- respecte_convention_titre_II: vrai
-- construit_amélioré_conditions_l831_1_4: vrai
-- acquisition_aides_état_prêt_titre_II_ou_livre_III: vrai
}
}
-- remplit_conditions_r832_21 : vrai
})
définition calcul.date_conventionnement égal à |2020-01-01|
définition calcul.type_logement_foyer égal à
TypeLogementFoyer.RésidenceSociale
définition calcul.redevance égal à 350 €
définition calcul.ressources_ménage_arrondies égal à 7 500€
définition calcul.nombre_personnes_à_charge égal à 0

46
examples/aides_logement/tests/tests_calcul_apl_locatif.catala_fr
View File

@ -18,12 +18,11 @@ champ d'application Exemple1:
définition calcul.situation_familiale_calcul_apl égal à Couple
définition calcul.nombre_personnes_à_charge égal à 3
définition calcul.type_aide égal à AidePersonnaliséeLogement
# TODO juridique: trouver articles loi qui calculent le type d'aide
# à partir des caractéristiques du ménage et l'implémenter.
définition calcul.colocation égal à faux
définition calcul.réduction_loyer_solidarité égal à 0 €
définition calcul.ressources_ménage_arrondies égal à 36 000 €
définition calcul.bénéficiaire_aide_adulte_ou_enfant_handicapés égal à faux
définition calcul.logement_meublé_d842_2 égal à faux
assertion montant = 0 €
assertion calcul.montant_forfaitaire_charges_d823_16 = 91,09 €
assertion calcul.plafond_loyer_d823_16_2 = 524,20 €
@ -53,6 +52,7 @@ champ d'application Exemple2:
calcul.âgées_ou_handicap_adultes_hébergées_onéreux_particuliers
égal à faux
définition calcul.bénéficiaire_aide_adulte_ou_enfant_handicapés égal à faux
définition calcul.logement_meublé_d842_2 égal à faux
assertion montant = 352,77 €
assertion calcul.montant_forfaitaire_charges_d823_16 = 78,80 €
assertion calcul.plafond_loyer_d823_16_2 = 409,88 €
@ -82,6 +82,7 @@ champ d'application Exemple3:
définition calcul.réduction_loyer_solidarité égal à 0 €
définition calcul.ressources_ménage_arrondies égal à 14300 €
définition calcul.bénéficiaire_aide_adulte_ou_enfant_handicapés égal à faux
définition calcul.logement_meublé_d842_2 égal à faux
assertion montant = 321,61 €
assertion calcul.montant_forfaitaire_charges_d823_16 = 91,09 €
assertion calcul.plafond_loyer_d823_16_2 = 425,80 €
@ -111,6 +112,7 @@ champ d'application Exemple4:
définition calcul.réduction_loyer_solidarité égal à 0 €
définition calcul.ressources_ménage_arrondies égal à 39500 €
définition calcul.bénéficiaire_aide_adulte_ou_enfant_handicapés égal à faux
définition calcul.logement_meublé_d842_2 égal à faux
assertion montant = 0 €
assertion calcul.montant_forfaitaire_charges_d823_16 = 66,51 €
assertion calcul.plafond_loyer_d823_16_2 = 406,30 €
@ -140,12 +142,13 @@ champ d'application Exemple5:
définition calcul.réduction_loyer_solidarité égal à 0 €
définition calcul.ressources_ménage_arrondies égal à 2700 €
définition calcul.bénéficiaire_aide_adulte_ou_enfant_handicapés égal à faux
assertion montant = 375,88 €
définition calcul.logement_meublé_d842_2 égal à faux
assertion montant = 311,56 €
assertion calcul.montant_forfaitaire_charges_d823_16 = 54,22 €
assertion calcul.plafond_loyer_d823_16_2 = 298,07 €
assertion calcul.participation_minimale = 35,39 €
assertion calcul.taux_composition_familiale = 2,83%
assertion calcul.participation_personnelle = 0€ -€ 28,80 €
assertion calcul.participation_personnelle = 35,39€
```
```catala
@ -169,6 +172,7 @@ champ d'application Exemple6:
définition calcul.réduction_loyer_solidarité égal à 0 €
définition calcul.ressources_ménage_arrondies égal à 19500 €
définition calcul.bénéficiaire_aide_adulte_ou_enfant_handicapés égal à faux
définition calcul.logement_meublé_d842_2 égal à faux
assertion montant = 0 €
assertion calcul.montant_forfaitaire_charges_d823_16 = 54,22 €
assertion calcul.plafond_loyer_d823_16_2 = 317,97 €
@ -198,6 +202,7 @@ champ d'application Exemple7:
définition calcul.réduction_loyer_solidarité égal à 0 €
définition calcul.ressources_ménage_arrondies égal à 32200 €
définition calcul.bénéficiaire_aide_adulte_ou_enfant_handicapés égal à faux
définition calcul.logement_meublé_d842_2 égal à faux
assertion montant = 153,77 €
assertion calcul.montant_forfaitaire_charges_d823_16 = 127,96 €
assertion calcul.plafond_loyer_d823_16_2 = 618,20 €
@ -227,6 +232,7 @@ champ d'application Exemple8:
définition calcul.réduction_loyer_solidarité égal à 0 €
définition calcul.ressources_ménage_arrondies égal à 14800 €
définition calcul.bénéficiaire_aide_adulte_ou_enfant_handicapés égal à faux
définition calcul.logement_meublé_d842_2 égal à faux
assertion montant = 11,06 €
assertion calcul.montant_forfaitaire_charges_d823_16 = 54,22 €
assertion calcul.plafond_loyer_d823_16_2 = 268,26 €
@ -235,6 +241,34 @@ champ d'application Exemple8:
assertion calcul.participation_personnelle = 306,11 €
```
```catala
déclaration champ d'application Exemple9 :
calcul champ d'application CalculAidePersonnaliséeLogementLocatif
sortie montant contenu argent
champ d'application Exemple9:
définition montant égal à
calcul.traitement_aide_finale de
calcul.aide_finale_formule
définition calcul.loyer_principal égal à 400 €
définition calcul.date_courante égal à |2022-06-10|
définition calcul.logement_est_chambre égal à faux
définition
calcul.âgées_ou_handicap_adultes_hébergées_onéreux_particuliers
égal à faux
définition calcul.zone égal à Zone1
définition calcul.situation_familiale_calcul_apl égal à PersonneSeule
définition calcul.nombre_personnes_à_charge égal à 0
définition calcul.type_aide égal à AidePersonnaliséeLogement
définition calcul.colocation égal à faux
définition calcul.réduction_loyer_solidarité égal à 0 €
# Étudiant, R822-20 CCH et article 6 arrêté 27 septembre 2019
définition calcul.ressources_ménage_arrondies égal à 7800 €
définition calcul.bénéficiaire_aide_adulte_ou_enfant_handicapés égal à faux
définition calcul.logement_meublé_d842_2 égal à faux
assertion montant = 210,06 €
```
```catala-test {id="Exemple1.Interpret"}
catala Interpret -s Exemple1
```
@ -266,3 +300,7 @@ catala Interpret -s Exemple7
```catala-test {id="Exemple8.Interpret"}
catala Interpret -s Exemple8
```
```catala-test {id="Exemple9.Interpret"}
catala Interpret -s Exemple9
```

86
examples/aides_logement/tests/tests_calcul_apl_logement_foyer.catala_fr
View File

@ -8,21 +8,8 @@ déclaration champ d'application CasTest1 :
sortie montant contenu argent
champ d'application CasTest1:
définition calcul.mode_occupation égal à RésidentLogementFoyer contenu (LogementFoyer {
-- type : TypeLogementFoyer.Autre
-- date_conventionnement : |2022-01-01|
-- construit_application_loi_1957_12_III: faux
-- location : Location {
-- bailleur: Bailleur {
-- type_bailleur: BailleurSocial
-- respecte_convention_titre_V: vrai
-- respecte_convention_titre_II: vrai
-- construit_amélioré_conditions_l831_1_4: vrai
-- acquisition_aides_état_prêt_titre_II_ou_livre_III: vrai
}
}
-- remplit_conditions_r832_21 : vrai
})
définition calcul.date_conventionnement égal à |2022-01-01|
définition calcul.type_logement_foyer égal à TypeLogementFoyer.Autre
définition calcul.redevance égal à 360 €
définition calcul.ressources_ménage_arrondies égal à 15 000€
définition calcul.nombre_personnes_à_charge égal à 0
@ -43,21 +30,8 @@ déclaration champ d'application CasTest2 :
sortie montant contenu argent
champ d'application CasTest2:
définition calcul.mode_occupation égal à RésidentLogementFoyer contenu (LogementFoyer {
-- type : TypeLogementFoyer.Autre
-- date_conventionnement : |2022-01-01|
-- construit_application_loi_1957_12_III: faux
-- location : Location {
-- bailleur: Bailleur {
-- type_bailleur: BailleurSocial
-- respecte_convention_titre_V: vrai
-- respecte_convention_titre_II: vrai
-- construit_amélioré_conditions_l831_1_4: vrai
-- acquisition_aides_état_prêt_titre_II_ou_livre_III: vrai
}
}
-- remplit_conditions_r832_21 : vrai
})
définition calcul.date_conventionnement égal à |2022-01-01|
définition calcul.type_logement_foyer égal à TypeLogementFoyer.Autre
définition calcul.redevance égal à 360 €
définition calcul.ressources_ménage_arrondies égal à 15 000€
définition calcul.nombre_personnes_à_charge égal à 0
@ -84,21 +58,8 @@ déclaration champ d'application CasTest3 :
sortie montant contenu argent
champ d'application CasTest3:
définition calcul.mode_occupation égal à RésidentLogementFoyer contenu (LogementFoyer {
-- type : TypeLogementFoyer.Autre
-- date_conventionnement : |2020-01-01|
-- construit_application_loi_1957_12_III: faux
-- location : Location {
-- bailleur: Bailleur {
-- type_bailleur: BailleurSocial
-- respecte_convention_titre_V: vrai
-- respecte_convention_titre_II: vrai
-- construit_amélioré_conditions_l831_1_4: vrai
-- acquisition_aides_état_prêt_titre_II_ou_livre_III: vrai
}
}
-- remplit_conditions_r832_21 : vrai
})
définition calcul.date_conventionnement égal à |2020-01-01|
définition calcul.type_logement_foyer égal à TypeLogementFoyer.Autre
définition calcul.redevance égal à 350 €
définition calcul.ressources_ménage_arrondies égal à 7 500€
définition calcul.nombre_personnes_à_charge égal à 0
@ -121,21 +82,8 @@ déclaration champ d'application CasTest4 :
sortie montant contenu argent
champ d'application CasTest4:
définition calcul.mode_occupation égal à RésidentLogementFoyer contenu (LogementFoyer {
-- type : TypeLogementFoyer.Autre
-- date_conventionnement : |2020-01-01|
-- construit_application_loi_1957_12_III: faux
-- location : Location {
-- bailleur: Bailleur {
-- type_bailleur: BailleurSocial
-- respecte_convention_titre_V: vrai
-- respecte_convention_titre_II: vrai
-- construit_amélioré_conditions_l831_1_4: vrai
-- acquisition_aides_état_prêt_titre_II_ou_livre_III: vrai
}
}
-- remplit_conditions_r832_21 : vrai
})
définition calcul.date_conventionnement égal à |2020-01-01|
définition calcul.type_logement_foyer égal à TypeLogementFoyer.Autre
définition calcul.redevance égal à 350 €
définition calcul.ressources_ménage_arrondies égal à 7 500€
définition calcul.nombre_personnes_à_charge égal à 0
@ -159,21 +107,9 @@ déclaration champ d'application CasTest5 :
sortie montant contenu argent
champ d'application CasTest5:
définition calcul.mode_occupation égal à RésidentLogementFoyer contenu (LogementFoyer {
-- type : TypeLogementFoyer.RésidenceSociale
-- date_conventionnement : |2020-01-01|
-- construit_application_loi_1957_12_III: faux
-- location : Location {
-- bailleur: Bailleur {
-- type_bailleur: BailleurSocial
-- respecte_convention_titre_V: vrai
-- respecte_convention_titre_II: vrai
-- construit_amélioré_conditions_l831_1_4: vrai
-- acquisition_aides_état_prêt_titre_II_ou_livre_III: vrai
}
}
-- remplit_conditions_r832_21 : vrai
})
définition calcul.date_conventionnement égal à |2020-01-01|
définition calcul.type_logement_foyer égal à
TypeLogementFoyer.RésidenceSociale
définition calcul.redevance égal à 350 €
définition calcul.ressources_ménage_arrondies égal à 7 500€
définition calcul.nombre_personnes_à_charge égal à 0

1
examples/aides_logement/tests/tests_calculette_globale.catala_fr
View File

@ -85,7 +85,6 @@ champ d'application Exemple1 :
-- satisfait_conditions_l512_2_code_sécurité_sociale : vrai
-- age_demandeur : 52
-- date_naissance : |1970-05-02|
-- contrat_de_travail : CDI
-- nationalité : Française
-- patrimoine : Patrimoine {
-- produisant_revenu_période_r822_3_3_r822_4: 0€

208
examples/aides_logement/tests/tests_eligibilite_apl.catala_fr
View File

@ -12,78 +12,67 @@ champ d'application Exemple1 :
assertion éligible
définition éligibilité.date_courante égal à |2020-03-10|
définition éligibilité.ménage égal à Ménage {
-- prestations_reçues: [
PrestationReçue.AllocationSoutienEnfantHandicapé;
PrestationReçue.ComplémentFamilial;
PrestationReçue.AllocationsFamiliales
]
-- situation_familiale: Mariés contenu |2010-11-26|
-- personnes_à_charge: [
EnfantÀCharge contenu (EnfantÀCharge {
-- bénéficie_titre_personnel_aide_personnelle_logement : faux
-- prise_en_charge : PriseEnCharge.EffectiveEtPermanente
-- âge : 19
-- identifiant: 0
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
-- date_de_naissance: |2001-01-01|
-- rémuneration_mensuelle: 0€
-- obligation_scolaire: Après
-- situation_garde_alternée: PasDeGardeAlternée
}); EnfantÀCharge contenu (EnfantÀCharge {
-- bénéficie_titre_personnel_aide_personnelle_logement : faux
-- prise_en_charge : PriseEnCharge.EffectiveEtPermanente
-- âge : 11
-- identifiant: 1
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
-- date_de_naissance: |2009-01-01|
-- rémuneration_mensuelle: 0€
-- obligation_scolaire: Pendant
-- situation_garde_alternée: PasDeGardeAlternée
}); EnfantÀCharge contenu (EnfantÀCharge {
-- bénéficie_titre_personnel_aide_personnelle_logement : faux
-- prise_en_charge : PriseEnCharge.EffectiveEtPermanente
-- âge : 8
-- identifiant: 2
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
-- date_de_naissance: |2012-01-01|
-- rémuneration_mensuelle: 0€
-- obligation_scolaire: Pendant
-- situation_garde_alternée: PasDeGardeAlternée
})]
-- logement: Logement {
-- zone: Zone1
-- résidence_principale : vrai
-- est_ehpad_ou_maison_autonomie_l313_12_asf : faux
-- mode_occupation : Locataire contenu (Location {
-- bailleur: Bailleur {
-- type_bailleur: BailleurPrivé
-- respecte_convention_titre_V: vrai
-- respecte_convention_titre_II: vrai
-- construit_amélioré_conditions_l831_1_4: faux
-- acquisition_aides_état_prêt_titre_II_ou_livre_III: faux
}
})
-- propriétaire : ParentOuAutre.Autre
-- loué_ou_sous_loué_à_des_tiers : LouéOuSousLouéÀDesTiers.Non
-- usufruit : ParentOuAutre.Autre
-- logement_decent_l89_462 : vrai
-- surface_m_carrés : 80
-- est_ancien_l831_2 : faux
-- situé_commune_déséquilibre_l831_2 : faux
}
-- nombre_autres_occupants_logement: 1
-- condition_rattaché_foyer_fiscal_parent_ifi: faux
-- nombre_enfants_à_naître_après_troisième_mois_grossesse: 0
-- enfant_à_naître_après_quatrième_mois_grossesse: faux
-- date_naissance_troisième_enfant_ou_dernier_si_plus :
PlusDeTroisEnfants contenu (DateDeNaissance contenu |2012-01-01|)
-- prestations_reçues: [
PrestationReçue.AllocationSoutienEnfantHandicapé;
PrestationReçue.ComplémentFamilial;
PrestationReçue.AllocationsFamiliales
]
-- situation_familiale: Mariés contenu |2010-11-26|
-- personnes_à_charge: [
EnfantÀCharge contenu (EnfantÀCharge {
-- bénéficie_titre_personnel_aide_personnelle_logement : faux
-- identifiant: 0
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
-- date_de_naissance: |2001-01-01|
-- rémuneration_mensuelle: 0€
-- obligation_scolaire: Après
-- situation_garde_alternée: PasDeGardeAlternée
}); EnfantÀCharge contenu (EnfantÀCharge {
-- bénéficie_titre_personnel_aide_personnelle_logement : faux
-- identifiant: 1
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
-- date_de_naissance: |2009-01-01|
-- rémuneration_mensuelle: 0€
-- obligation_scolaire: Pendant
-- situation_garde_alternée: PasDeGardeAlternée
}); EnfantÀCharge contenu (EnfantÀCharge {
-- bénéficie_titre_personnel_aide_personnelle_logement : faux
-- identifiant: 2
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
-- date_de_naissance: |2012-01-01|
-- rémuneration_mensuelle: 0€
-- obligation_scolaire: Pendant
-- situation_garde_alternée: PasDeGardeAlternée
})]
-- logement: Logement {
-- zone: Zone1
-- résidence_principale : vrai
-- est_ehpad_ou_maison_autonomie_l313_12_asf : faux
-- mode_occupation : Locataire contenu (Location {
-- loyer_principal: 750 €
-- bénéficiaire_aide_adulte_ou_enfant_handicapés: faux
-- logement_est_chambre: faux
-- colocation: faux
-- âgées_ou_handicap_adultes_hébergées_onéreux_particuliers: faux
-- logement_meublé_d842_2: faux
-- changement_logement_d842_4: PasDeChangement
-- bailleur: BailleurSocial contenu (ConventionBailleurSocial{
-- conventionné_livre_III_titre_V_chap_III: vrai
-- réduction_loyer_solidarité_perçue: 0 €
})
})
-- propriétaire : ParentOuAutre.Autre
-- loué_ou_sous_loué_à_des_tiers : LouéOuSousLouéÀDesTiers.Non
-- usufruit : ParentOuAutre.Autre
-- logement_decent_l89_462 : vrai
-- surface_m_carrés : 80
}
-- nombre_autres_occupants_logement: 1
-- condition_rattaché_foyer_fiscal_parent_ifi: faux
-- enfant_à_naître_après_quatrième_mois_grossesse: faux
}
définition éligibilité.demandeur égal à Demandeur {
-- satisfait_conditions_l512_2_code_sécurité_sociale : vrai
-- age_demandeur : 52
-- date_naissance : |1970-05-02|
-- contrat_de_travail : CDI
-- nationalité : Française
-- patrimoine : Patrimoine {
-- produisant_revenu_période_r822_3_3_r822_4: 0€
@ -92,6 +81,77 @@ champ d'application Exemple1 :
-- personne_hébergée_centre_soin_l_L162_22_3_sécurité_sociale: faux
}
déclaration champ d'application Exemple2 :
éligibilité champ d'application ÉligibilitéAllocationLogement
sortie éligible contenu ÉligibilitéAllocationLogement
champ d'application Exemple2 :
définition éligible égal à éligibilité.éligibilité
assertion éligible = ÉligibilitéAllocationLogement.AllocationLogementFamiliale
définition éligibilité.date_courante égal à |2022-05-01|
définition éligibilité.ménage égal à Ménage {
-- prestations_reçues: [
PrestationReçue.AllocationsFamiliales
]
-- situation_familiale: Concubins
-- personnes_à_charge: [
EnfantÀCharge contenu (EnfantÀCharge {
-- bénéficie_titre_personnel_aide_personnelle_logement : faux
-- identifiant: 0
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
-- date_de_naissance: |2016-01-01|
-- rémuneration_mensuelle: 0€
-- obligation_scolaire: Pendant
-- situation_garde_alternée: PasDeGardeAlternée
}); EnfantÀCharge contenu (EnfantÀCharge {
-- bénéficie_titre_personnel_aide_personnelle_logement : faux
-- identifiant: 1
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
-- date_de_naissance: |2015-01-01|
-- rémuneration_mensuelle: 0€
-- obligation_scolaire: Pendant
-- situation_garde_alternée: PasDeGardeAlternée
})]
-- logement: Logement {
-- zone: Zone2
-- résidence_principale : vrai
-- est_ehpad_ou_maison_autonomie_l313_12_asf : faux
-- mode_occupation : Locataire contenu (Location {
-- bailleur: BailleurSocial contenu (ConventionBailleurSocial{
-- conventionné_livre_III_titre_V_chap_III: vrai
-- réduction_loyer_solidarité_perçue: 0 €
})
-- loyer_principal: 450 €
-- bénéficiaire_aide_adulte_ou_enfant_handicapés: faux
-- logement_est_chambre: faux
-- colocation: faux
-- âgées_ou_handicap_adultes_hébergées_onéreux_particuliers: faux
-- logement_meublé_d842_2: faux
-- changement_logement_d842_4: PasDeChangement
})
-- propriétaire : ParentOuAutre.Autre
-- loué_ou_sous_loué_à_des_tiers : LouéOuSousLouéÀDesTiers.Non
-- usufruit : ParentOuAutre.Autre
-- logement_decent_l89_462 : vrai
-- surface_m_carrés : 60
}
-- nombre_autres_occupants_logement: 0
-- condition_rattaché_foyer_fiscal_parent_ifi: faux
-- enfant_à_naître_après_quatrième_mois_grossesse: faux
}
définition éligibilité.demandeur égal à Demandeur {
-- date_naissance : |1992-01-01|
-- nationalité : Française
-- patrimoine : Patrimoine {
-- produisant_revenu_période_r822_3_3_r822_4: 0€
-- ne_produisant_pas_revenu_période_r822_3_3_r822_4: 0€
}
-- personne_hébergée_centre_soin_l_L162_22_3_sécurité_sociale: faux
}
définition éligibilité.bénéficie_aide_personnalisée_logement égal à faux
# déclaration champ d'application Exemple2 :
# éligibilité champ d'application ÉligibilitéAidesPersonnelleLogement
# sortie éligible contenu booléen
@ -124,15 +184,10 @@ champ d'application Exemple1 :
# }
# -- nombre_autres_occupants_logement: 0
# -- condition_rattaché_foyer_fiscal_parent_ifi: vrai
# -- nombre_enfants_à_naître_après_troisième_mois_grossesse: 0
# -- date_naissance_troisième_enfant_ou_dernier_si_plus :
# MoinsDeTroisEnfants
# }
# définition éligibilité.demandeur égal à Demandeur {
# -- satisfait_conditions_l512_2_code_sécurité_sociale : vrai
# -- age_demandeur : 22
# -- date_naissance : |2000-01-03|
# -- contrat_de_travail : Autres
# -- nationalité : Française
# -- patrimoine : Patrimoine {
# # D'après le R822_3_3, la periode est annuelle.
@ -173,15 +228,10 @@ champ d'application Exemple1 :
# }
# -- nombre_autres_occupants_logement: 0
# -- condition_rattaché_foyer_fiscal_parent_ifi: faux
# -- nombre_enfants_à_naître_après_troisième_mois_grossesse: 0
# -- date_naissance_troisième_enfant_ou_dernier_si_plus :
# MoinsDeTroisEnfants
# }
# définition éligibilité.demandeur égal à Demandeur {
# -- satisfait_conditions_l512_2_code_sécurité_sociale : vrai
# -- age_demandeur : 22
# -- date_naissance : |2000-01-03|
# -- contrat_de_travail : Autres
# -- nationalité : Française
# -- patrimoine : Patrimoine {
# # D'après le R822_3_3, la periode est annuelle.

9
examples/allocations_familiales/epilogue.catala_fr
View File

@ -10,17 +10,16 @@ la fonction du bloc de code ci-dessous.
```catala-metadata
champ d'application EnfantLePlusÂgé:
définition le_plus_âgé égal à
contenu maximum entier initial Enfant {
contenu minimum date initial Enfant {
-- identifiant: -1
-- obligation_scolaire: Pendant
-- rémuneration_mensuelle: 0€
-- date_de_naissance: |1900-01-01|
-- âge: 0
-- date_de_naissance: |2999-12-31|
-- prise_en_charge: EffectiveEtPermanente
-- a_déjà_ouvert_droit_aux_allocations_familiales: faux
-- bénéficie_titre_personnel_aide_personnelle_logement: faux
}
pour potentiel_plus_âgé dans enfants de potentiel_plus_âgé.âge
pour potentiel_plus_âgé dans enfants de potentiel_plus_âgé.date_de_naissance
champ d'application AllocationsFamiliales:
@ -120,8 +119,6 @@ champ d'application InterfaceAllocationsFamiliales:
-- rémuneration_mensuelle : enfant.d_rémuneration_mensuelle
-- date_de_naissance : enfant.d_date_de_naissance
-- prise_en_charge : enfant.d_prise_en_charge
-- âge: accès_année de
(|0000-01-01| +@ (i_date_courante -@ enfant.d_date_de_naissance))
-- obligation_scolaire :
(si enfant.d_date_de_naissance +@ 3 an >=@ i_date_courante alors
Avant

7
examples/allocations_familiales/prologue.catala_fr
View File

@ -24,7 +24,6 @@ déclaration structure Enfant :
donnée obligation_scolaire contenu SituationObligationScolaire
donnée rémuneration_mensuelle contenu argent
donnée date_de_naissance contenu date
donnée âge contenu entier
donnée prise_en_charge contenu PriseEnCharge
donnée a_déjà_ouvert_droit_aux_allocations_familiales contenu booléen
donnée bénéficie_titre_personnel_aide_personnelle_logement contenu booléen
@ -58,7 +57,7 @@ déclaration champ d'application PrestationsFamiliales:
sortie droit_ouvert condition dépend de Enfant
sortie conditions_hors_âge condition dépend de Enfant
interne plafond_l512_3_2 contenu argent
sortie âge_l512_3_2 contenu entier
sortie âge_l512_3_2 contenu durée
sortie régime_outre_mer_l751_1 condition
entrée date_courante contenu date
entrée prestation_courante contenu ÉlémentPrestationsFamiliales
@ -74,7 +73,7 @@ champ d'application PrestationsFamiliales:
```catala-metadata
déclaration champ d'application AllocationFamilialesAvril2008:
sortie âge_minimum_alinéa_1_l521_3 contenu entier
sortie âge_minimum_alinéa_1_l521_3 contenu durée
déclaration champ d'application EnfantLePlusÂgé:
entrée enfants contenu collection Enfant
@ -144,7 +143,7 @@ déclaration champ d'application AllocationsFamiliales:
# Plafonds, âges limites et autres constantes
interne nombre_enfants_l521_1 contenu entier
interne âge_minimum_alinéa_1_l521_3 contenu entier dépend de Enfant
interne âge_minimum_alinéa_1_l521_3 contenu durée dépend de Enfant
interne nombre_enfants_alinéa_2_l521_3 contenu entier
interne est_enfant_le_plus_âgé contenu booléen dépend de Enfant
interne plafond_I_d521_3 contenu argent

5
examples/allocations_familiales/securite_sociale_D.catala_fr
View File

@ -376,7 +376,8 @@ champ d'application AllocationsFamiliales :
(droit_ouvert_majoration de enfant) et
prestations_familiales.régime_outre_mer_l751_1 et
(nombre de enfants_à_charge_droit_ouvert_prestation_familiale = 1) et
(enfant.âge >= 11 et enfant.âge < 16)
(enfant.date_de_naissance +@ 11 an <=@ date_courante et
enfant.date_de_naissance +@ 16 an >@ date_courante)
conséquence égal à
bmaf.montant *€ 3,69 %
@ -385,7 +386,7 @@ champ d'application AllocationsFamiliales :
(droit_ouvert_majoration de enfant) et
prestations_familiales.régime_outre_mer_l751_1 et
(nombre de enfants_à_charge_droit_ouvert_prestation_familiale = 1) et
(enfant.âge >= 16)
(enfant.date_de_naissance +@ 16 an <=@ date_courante)
conséquence égal à
bmaf.montant *€ 5,67 %
```

11
examples/allocations_familiales/securite_sociale_L.catala_fr
View File

@ -59,7 +59,7 @@ champ d'application PrestationsFamiliales :
étiquette cas_base règle droit_ouvert de enfant sous condition
enfant.obligation_scolaire sous forme Après et
(enfant.rémuneration_mensuelle <=€ plafond_l512_3_2) et
(enfant.âge < âge_l512_3_2)
(enfant.date_de_naissance +@ âge_l512_3_2 >@ date_courante)
conséquence rempli
# On définit les conditions hors âge d'abord car elles
@ -120,7 +120,8 @@ champ d'application AllocationsFamiliales :
# Puisqu'un enfant ne garde un âge donné que pour une période d'un an,
# cette condition assure que l'allocation ne peut être distribuée que pour
# un an.
(enfant.âge = prestations_familiales.âge_l512_3_2) et
((enfant.date_de_naissance +@ prestations_familiales.âge_l512_3_2) -@
date_courante <^ 365 jour) et
(enfant.a_déjà_ouvert_droit_aux_allocations_familiales) et
(prestations_familiales.conditions_hors_âge de enfant)
conséquence rempli
@ -297,7 +298,8 @@ champ d'application AllocationsFamiliales :
règle droit_ouvert_majoration de enfant
sous condition
(non (est_enfant_le_plus_âgé de enfant)) et
(enfant.âge >= âge_minimum_alinéa_1_l521_3 de enfant)
(enfant.date_de_naissance +@ âge_minimum_alinéa_1_l521_3 de enfant <=@
date_courante)
conséquence rempli
```
@ -312,7 +314,8 @@ champ d'application AllocationsFamiliales :
sous condition
(nombre de enfants_à_charge_droit_ouvert_prestation_familiale >=
nombre_enfants_alinéa_2_l521_3) et
(enfant.âge >= âge_minimum_alinéa_1_l521_3 de enfant)
(enfant.date_de_naissance +@ âge_minimum_alinéa_1_l521_3 de enfant <=@
date_courante)
conséquence rempli
```

6
examples/allocations_familiales/securite_sociale_R.catala_fr
View File

@ -18,7 +18,7 @@ alinéa du présent article.
# à cette limitation.
champ d'application PrestationsFamiliales :
définition âge_l512_3_2 égal à 20
définition âge_l512_3_2 égal à 20 an
```
Le plafond de rémunération mentionné au 2° de l'article L. 512-3 est égal, pour
@ -53,7 +53,7 @@ enfants ouvrent droit à la majoration des allocations familiales est fixé à
```catala
champ d'application AllocationsFamiliales :
définition âge_minimum_alinéa_1_l521_3 de enfant égal à 14
définition âge_minimum_alinéa_1_l521_3 de enfant égal à 14 an
```
Le nombre minimum d'enfants à charge, mentionné au deuxième alinéa de l'article
@ -75,7 +75,7 @@ le onzième anniversaire est postérieur au 30 avril 2008.
# du décret de 2008 pour des raisons de place seulement.
champ d'application AllocationFamilialesAvril2008:
# Âge limite avant décret n° 2008-409 du 28 avril 2008
définition âge_minimum_alinéa_1_l521_3 égal à 16
définition âge_minimum_alinéa_1_l521_3 égal à 16 an
champ d'application AllocationsFamiliales :
exception

1
examples/allocations_familiales/tests/output/tests_allocations_familiales.catala_fr.Test14.Interpret Normal file
View File

@ -0,0 +1 @@
[RESULT] Computation successful!

30
examples/allocations_familiales/tests/tests_allocations_familiales.catala_fr
View File

@ -320,6 +320,32 @@ champ d'application Test13:
définition f.i_résidence égal à Mayotte
règle f.i_personne_charge_effective_permanente_est_parent rempli
assertion f.i_montant_versé = 34,99€
déclaration champ d'application Test14:
f champ d'application InterfaceAllocationsFamiliales
champ d'application Test14:
définition f.i_enfants égal à [EnfantEntrée {
-- d_identifiant: 0
-- d_date_de_naissance: |2004-12-22|
-- d_rémuneration_mensuelle: 435€
-- d_prise_en_charge: EffectiveEtPermanente
-- d_a_déjà_ouvert_droit_aux_allocations_familiales: vrai
-- d_bénéficie_titre_personnel_aide_personnelle_logement: faux
};
EnfantEntrée {
-- d_identifiant: 1
-- d_date_de_naissance: |2001-12-05|
-- d_rémuneration_mensuelle: 1682€
-- d_prise_en_charge: GardeAlternéeAllocataireUnique
-- d_a_déjà_ouvert_droit_aux_allocations_familiales: vrai
-- d_bénéficie_titre_personnel_aide_personnelle_logement: faux
}]
définition f.i_ressources_ménage égal à 64033 €
définition f.i_date_courante égal à |2022-05-01|
définition f.i_résidence égal à Guadeloupe
règle f.i_personne_charge_effective_permanente_est_parent rempli
assertion f.i_montant_versé = 48,77€
```
```catala-test {id="Test1.Interpret"}
@ -373,3 +399,7 @@ catala Interpret -s Test12
```catala-test {id="Test13.Interpret"}
catala Interpret -s Test13
```
```catala-test {id="Test14.Interpret"}
catala Interpret -s Test13
```

4
examples/allocations_familiales/tests/tests_ouverture_droits.catala_fr
View File

@ -14,7 +14,6 @@ champ d'application Données:
-- identifiant: 1
-- obligation_scolaire : Pendant
-- date_de_naissance: |2007-01-01|
-- âge: 13
-- rémuneration_mensuelle: 0€
-- prise_en_charge: EffectiveEtPermanente
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
@ -24,7 +23,6 @@ champ d'application Données:
-- identifiant: 2
-- obligation_scolaire : Après
-- date_de_naissance: |2003-01-01|
-- âge: 18
-- rémuneration_mensuelle: 1000€
-- prise_en_charge: EffectiveEtPermanente
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
@ -34,7 +32,6 @@ champ d'application Données:
-- identifiant: 3
-- obligation_scolaire : Après
-- date_de_naissance: |2003-01-01|
-- âge: 18
-- rémuneration_mensuelle: 400€
-- prise_en_charge: EffectiveEtPermanente
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
@ -44,7 +41,6 @@ champ d'application Données:
-- identifiant: 4
-- obligation_scolaire : Après
-- date_de_naissance: |1999-01-01|
-- âge: 21
-- rémuneration_mensuelle: 0€
-- prise_en_charge: EffectiveEtPermanente
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai

3
examples/prestations_familiales/prologue.catala_fr
View File

@ -22,7 +22,6 @@ déclaration structure EnfantPrestationsFamiliales :
donnée obligation_scolaire contenu SituationObligationScolaire
donnée rémuneration_mensuelle contenu argent
donnée date_de_naissance contenu date
donnée âge contenu entier
donnée prise_en_charge contenu PriseEnChargeEnfant
donnée a_déjà_ouvert_droit_aux_allocations_familiales contenu booléen
donnée bénéficie_titre_personnel_aide_personnelle_logement contenu booléen
@ -41,7 +40,7 @@ déclaration champ d'application ÉligibilitéPrestationsFamiliales:
sortie droit_ouvert condition dépend de EnfantPrestationsFamiliales
sortie conditions_hors_âge condition dépend de EnfantPrestationsFamiliales
interne plafond_l512_3_2 contenu argent
sortie âge_l512_3_2 contenu entier
sortie âge_l512_3_2 contenu durée
sortie régime_outre_mer_l751_1 condition
entrée date_courante contenu date
entrée prestation_courante contenu ÉlémentPrestationsFamiliales

3
examples/prestations_familiales/sécurité_sociale_L.catala_fr
View File

@ -57,7 +57,8 @@ champ d'application ÉligibilitéPrestationsFamiliales :
étiquette cas_base règle droit_ouvert de enfant sous condition
enfant.EnfantPrestationsFamiliales.obligation_scolaire sous forme Après et
(enfant.EnfantPrestationsFamiliales.rémuneration_mensuelle <=€ plafond_l512_3_2) et
(enfant.EnfantPrestationsFamiliales.âge < âge_l512_3_2)
(enfant.EnfantPrestationsFamiliales.date_de_naissance +@ âge_l512_3_2 >@
date_courante)
conséquence rempli
# On définit les conditions hors âge d'abord car elles

2
examples/prestations_familiales/sécurité_sociale_R.catala_fr
View File

@ -18,7 +18,7 @@ alinéa du présent article.
# à cette limitation.
champ d'application ÉligibilitéPrestationsFamiliales :
définition âge_l512_3_2 égal à 20
définition âge_l512_3_2 égal à 20 an
```
Le plafond de rémunération mentionné au 2° de l'article L. 512-3 est égal, pour

4
examples/prestations_familiales/tests/tests_ouverture_droits.catala_fr
View File

@ -14,7 +14,6 @@ champ d'application Données:
-- identifiant: 1
-- obligation_scolaire : Pendant
-- date_de_naissance: |2007-01-01|
-- âge: 13
-- rémuneration_mensuelle: 0€
-- prise_en_charge: EffectiveEtPermanente
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
@ -24,7 +23,6 @@ champ d'application Données:
-- identifiant: 2
-- obligation_scolaire : Après
-- date_de_naissance: |2003-01-01|
-- âge: 18
-- rémuneration_mensuelle: 1000€
-- prise_en_charge: EffectiveEtPermanente
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
@ -34,7 +32,6 @@ champ d'application Données:
-- identifiant: 3
-- obligation_scolaire : Après
-- date_de_naissance: |2003-01-01|
-- âge: 18
-- rémuneration_mensuelle: 400€
-- prise_en_charge: EffectiveEtPermanente
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai
@ -44,7 +41,6 @@ champ d'application Données:
-- identifiant: 4
-- obligation_scolaire : Après
-- date_de_naissance: |1999-01-01|
-- âge: 21
-- rémuneration_mensuelle: 0€
-- prise_en_charge: EffectiveEtPermanente
-- a_déjà_ouvert_droit_aux_allocations_familiales: vrai

2
french_law.opam
View File

@ -1,5 +1,5 @@
opam-version: "2.0"
version: "0.6.0"
version: "0.7.0"
synopsis: "A collection of algorithms and computations defined by French law"
description:
"This library contains the implementations of algorithmic portions of French law. The library source code was generated from Catala annotations of the relevant portions of the French law, see https://catala-lang.org"

17032
french_law/js/french_law.js generated
View File

File diff suppressed because one or more lines are too long

2
french_law/ocaml/README.md
View File

@ -30,7 +30,7 @@ make run_french_law_library_ocaml_tests
```
The `law_source` files rely on the Catala OCaml runtime, located in
`compiler/runtime.{ml, mli}`. This runtime defines the types of the values
`runtimes/ocaml/runtime.{ml, mli}`. This runtime defines the types of the values
manipulated by the Catala programs in OCaml and the operations available for them.
### Wrappers

5
french_law/ocaml/dune
View File

@ -11,6 +11,11 @@
(:standard \ bench api))
(preprocess
(pps js_of_ocaml-ppx))
(js_of_ocaml
(flags --disable=shortvar --opt 3))
; We need to disable shortvar because
; otherwise Webpack wrongly minifies
; the library and it gives bugs.
(libraries
catala.runtime_ocaml
catala.runtime_jsoo

9584
french_law/ocaml/law_source/aides_logement.ml generated
View File

File diff suppressed because it is too large Load Diff

834
french_law/ocaml/law_source/aides_logement_api_web.ml generated
View File

File diff suppressed because it is too large Load Diff

968
french_law/ocaml/law_source/allocations_familiales.ml generated
View File

File diff suppressed because it is too large Load Diff

17
french_law/ocaml/law_source/allocations_familiales_api_web.ml generated
View File

@ -386,7 +386,6 @@ class type enfant =
situation_obligation_scolaire Js.t Js.readonly_prop
method remunerationMensuelle: Js.number Js.t Js.readonly_prop
method dateDeNaissance: Js.js_string Js.t Js.readonly_prop
method age: int Js.readonly_prop
method priseEnCharge: prise_en_charge Js.t Js.readonly_prop
method aDejaOuvertDroitAuxAllocationsFamiliales:
bool Js.t Js.readonly_prop
@ -401,7 +400,6 @@ class type enfant =
val remunerationMensuelle =
Js.number_of_float @@ money_to_float enfant.remuneration_mensuelle
val dateDeNaissance = date_to_jsoo enfant.date_de_naissance
val age = integer_to_int enfant.age
val priseEnCharge = prise_en_charge_to_jsoo enfant.prise_en_charge
val aDejaOuvertDroitAuxAllocationsFamiliales =
Js.bool enfant.a_deja_ouvert_droit_aux_allocations_familiales
@ -417,7 +415,6 @@ class type enfant =
money_of_decimal @@ decimal_of_float @@ Js.float_of_number
enfant##.remunerationMensuelle;
date_de_naissance = date_of_jsoo enfant##.dateDeNaissance;
age = integer_of_int enfant##.age;
prise_en_charge = prise_en_charge_of_jsoo enfant##.priseEnCharge;
a_deja_ouvert_droit_aux_allocations_familiales =
Js.to_bool enfant##.aDejaOuvertDroitAuxAllocationsFamiliales;
@ -430,7 +427,7 @@ class type prestations_familiales_out =
method droitOuvertOut: (enfant Js.t, bool Js.t) Js.meth_callback Js.meth
method conditionsHorsAgeOut:
(enfant Js.t, bool Js.t) Js.meth_callback Js.meth
method ageL51232Out: int Js.readonly_prop
method ageL51232Out: Runtime_jsoo.Runtime.duration Js.t Js.readonly_prop
method regimeOutreMerL7511Out: bool Js.t Js.readonly_prop
end
let prestations_familiales_out_to_jsoo (prestations_familiales_out
@ -445,7 +442,7 @@ class type prestations_familiales_out =
fun input ->
Js.bool (prestations_familiales_out.conditions_hors_age_out (enfant_of_jsoo input)))
val ageL51232Out =
integer_to_int prestations_familiales_out.age_l512_3_2_out
duration_to_jsoo prestations_familiales_out.age_l512_3_2_out
val regimeOutreMerL7511Out =
Js.bool prestations_familiales_out.regime_outre_mer_l751_1_out
end
@ -456,7 +453,7 @@ class type prestations_familiales_out =
droit_ouvert_out = failwith "The function 'droit_ouvert_out' translation isn't yet supported...";
conditions_hors_age_out = failwith "The function 'conditions_hors_age_out' translation isn't yet supported...";
age_l512_3_2_out =
integer_of_int prestations_familiales_out##.ageL51232Out;
duration_of_jsoo prestations_familiales_out##.ageL51232Out;
regime_outre_mer_l751_1_out =
Js.to_bool prestations_familiales_out##.regimeOutreMerL7511Out
}
@ -492,7 +489,9 @@ class type prestations_familiales_in =
}
class type allocation_familiales_avril2008_out =
object method ageMinimumAlinea1L5213Out: int Js.readonly_prop
object
method ageMinimumAlinea1L5213Out:
Runtime_jsoo.Runtime.duration Js.t Js.readonly_prop
end
let allocation_familiales_avril2008_out_to_jsoo
(allocation_familiales_avril2008_out
@ -500,7 +499,7 @@ class type allocation_familiales_avril2008_out =
: allocation_familiales_avril2008_out Js.t =
object%js
val ageMinimumAlinea1L5213Out =
integer_to_int allocation_familiales_avril2008_out.age_minimum_alinea_1_l521_3_out
duration_to_jsoo allocation_familiales_avril2008_out.age_minimum_alinea_1_l521_3_out
end
let allocation_familiales_avril2008_out_of_jsoo
(allocation_familiales_avril2008_out
@ -508,7 +507,7 @@ class type allocation_familiales_avril2008_out =
AllocationFamilialesAvril2008Out.t =
{
age_minimum_alinea_1_l521_3_out =
integer_of_int
duration_of_jsoo
allocation_familiales_avril2008_out##.ageMinimumAlinea1L5213Out
}

1
french_law/ocaml/law_source/unit_tests/run_tests.ml
View File

@ -26,4 +26,5 @@ let _ =
try_test "Allocations familiales #11" Tests_allocations_familiales.test11;
try_test "Allocations familiales #12" Tests_allocations_familiales.test12;
try_test "Allocations familiales #13" Tests_allocations_familiales.test13;
try_test "Allocations familiales #14" Tests_allocations_familiales.test14;
exit (if !failure then -1 else 0)

6
french_law/python/README.md
View File

@ -19,9 +19,9 @@ of the repository:
make generate_french_law_library_python
```
The Python files generated by the Catala compiler expect the presence of the
`src/catala.py` file which contains the definitions of the values and operations
used by the generated code.
The Python files generated by the Catala compiler depends on the `catala.runtime`
package, whose source doe can be found in `runtimes/python/catala` from the
root of the Catala repository.
All theses Python files feature type annotations which can be checked against
using the following command inside this directory (`french_law/python`):

7030
french_law/python/src/aides_logement.py generated
View File

File diff suppressed because it is too large Load Diff

384
french_law/python/src/allocations_familiales.py generated
View File

@ -191,12 +191,11 @@ class EnfantEntree:
self.d_beneficie_titre_personnel_aide_personnelle_logement)
class Enfant:
def __init__(self, identifiant: Integer, obligation_scolaire: SituationObligationScolaire, remuneration_mensuelle: Money, date_de_naissance: Date, age: Integer, prise_en_charge: PriseEnCharge, a_deja_ouvert_droit_aux_allocations_familiales: bool, beneficie_titre_personnel_aide_personnelle_logement: bool) -> None:
def __init__(self, identifiant: Integer, obligation_scolaire: SituationObligationScolaire, remuneration_mensuelle: Money, date_de_naissance: Date, prise_en_charge: PriseEnCharge, a_deja_ouvert_droit_aux_allocations_familiales: bool, beneficie_titre_personnel_aide_personnelle_logement: bool) -> None:
self.identifiant = identifiant
self.obligation_scolaire = obligation_scolaire
self.remuneration_mensuelle = remuneration_mensuelle
self.date_de_naissance = date_de_naissance
self.age = age
self.prise_en_charge = prise_en_charge
self.a_deja_ouvert_droit_aux_allocations_familiales = a_deja_ouvert_droit_aux_allocations_familiales
self.beneficie_titre_personnel_aide_personnelle_logement = beneficie_titre_personnel_aide_personnelle_logement
@ -207,7 +206,6 @@ class Enfant:
self.obligation_scolaire == other.obligation_scolaire and
self.remuneration_mensuelle == other.remuneration_mensuelle and
self.date_de_naissance == other.date_de_naissance and
self.age == other.age and
self.prise_en_charge == other.prise_en_charge and
self.a_deja_ouvert_droit_aux_allocations_familiales == other.a_deja_ouvert_droit_aux_allocations_familiales and
self.beneficie_titre_personnel_aide_personnelle_logement == other.beneficie_titre_personnel_aide_personnelle_logement)
@ -218,14 +216,14 @@ class Enfant:
return not (self == other)
def __str__(self) -> str:
return "Enfant(identifiant={},obligation_scolaire={},remuneration_mensuelle={},date_de_naissance={},age={},prise_en_charge={},a_deja_ouvert_droit_aux_allocations_familiales={},beneficie_titre_personnel_aide_personnelle_logement={})".format(self.identifiant,
return "Enfant(identifiant={},obligation_scolaire={},remuneration_mensuelle={},date_de_naissance={},prise_en_charge={},a_deja_ouvert_droit_aux_allocations_familiales={},beneficie_titre_personnel_aide_personnelle_logement={})".format(self.identifiant,
self.obligation_scolaire, self.remuneration_mensuelle,
self.date_de_naissance, self.age, self.prise_en_charge,
self.date_de_naissance, self.prise_en_charge,
self.a_deja_ouvert_droit_aux_allocations_familiales,
self.beneficie_titre_personnel_aide_personnelle_logement)
class PrestationsFamilialesOut:
def __init__(self, droit_ouvert_out: Callable[[Enfant], bool], conditions_hors_age_out: Callable[[Enfant], bool], age_l512_3_2_out: Integer, regime_outre_mer_l751_1_out: bool) -> None:
def __init__(self, droit_ouvert_out: Callable[[Enfant], bool], conditions_hors_age_out: Callable[[Enfant], bool], age_l512_3_2_out: Duration, regime_outre_mer_l751_1_out: bool) -> None:
self.droit_ouvert_out = droit_ouvert_out
self.conditions_hors_age_out = conditions_hors_age_out
self.age_l512_3_2_out = age_l512_3_2_out
@ -270,7 +268,7 @@ class PrestationsFamilialesIn:
self.prestation_courante_in, self.residence_in)
class AllocationFamilialesAvril2008Out:
def __init__(self, age_minimum_alinea_1_l521_3_out: Integer) -> None:
def __init__(self, age_minimum_alinea_1_l521_3_out: Duration) -> None:
self.age_minimum_alinea_1_l521_3_out = age_minimum_alinea_1_l521_3_out
def __eq__(self, other: object) -> bool:
@ -501,12 +499,12 @@ class InterfaceAllocationsFamilialesIn:
def allocation_familiales_avril2008(allocation_familiales_avril2008_in:AllocationFamilialesAvril2008In):
try:
temp_age_minimum_alinea_1_l521_3 = integer_of_string("16")
temp_age_minimum_alinea_1_l521_3 = duration_of_numbers(16,0,0)
except EmptyError:
temp_age_minimum_alinea_1_l521_3 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=77, start_column=10,
end_line=77, end_column=37,
start_line=76, start_column=10,
end_line=76, end_column=37,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -517,7 +515,7 @@ def enfant_le_plus_age(enfant_le_plus_age_in:EnfantLePlusAgeIn):
enfants = enfant_le_plus_age_in.enfants_in
try:
def temp_le_plus_age(acc:Any, item:Any):
if (acc.age > item.age):
if (acc.date_de_naissance < item.date_de_naissance):
return acc
else:
return item
@ -526,8 +524,7 @@ def enfant_le_plus_age(enfant_le_plus_age_in:EnfantLePlusAgeIn):
obligation_scolaire = SituationObligationScolaire(SituationObligationScolaire_Code.Pendant,
Unit()),
remuneration_mensuelle = money_of_cents_string("0"),
date_de_naissance = date_of_numbers(1900,1,1),
age = integer_of_string("0"),
date_de_naissance = date_of_numbers(2999,12,31),
prise_en_charge = PriseEnCharge(PriseEnCharge_Code.EffectiveEtPermanente,
Unit()),
a_deja_ouvert_droit_aux_allocations_familiales = False,
@ -536,8 +533,8 @@ def enfant_le_plus_age(enfant_le_plus_age_in:EnfantLePlusAgeIn):
except EmptyError:
temp_le_plus_age_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=81, start_column=10,
end_line=81, end_column=21,
start_line=80, start_column=10,
end_line=80, end_column=21,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -769,12 +766,12 @@ def prestations_familiales(prestations_familiales_in:PrestationsFamilialesIn):
prestation_courante = prestations_familiales_in.prestation_courante_in
residence_1 = prestations_familiales_in.residence_in
try:
temp_age_l512_3_2 = integer_of_string("20")
temp_age_l512_3_2 = duration_of_numbers(20,0,0)
except EmptyError:
temp_age_l512_3_2 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=61, start_column=10,
end_line=61, end_column=22,
start_line=60, start_column=10,
end_line=60, end_column=22,
law_headings=["Prestations familiales",
"Champs d'applications",
"Prologue"]))
@ -823,8 +820,8 @@ def prestations_familiales(prestations_familiales_in:PrestationsFamilialesIn):
except EmptyError:
temp_regime_outre_mer_l751_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=62, start_column=10,
end_line=62, end_column=33,
start_line=61, start_column=10,
end_line=61, end_column=33,
law_headings=["Prestations familiales",
"Champs d'applications",
"Prologue"]))
@ -843,8 +840,8 @@ def prestations_familiales(prestations_familiales_in:PrestationsFamilialesIn):
except EmptyError:
temp_plafond_l512_3_2 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=60, start_column=11,
end_line=60, end_column=27,
start_line=59, start_column=11,
end_line=59, end_column=27,
law_headings=["Prestations familiales",
"Champs d'applications",
"Prologue"]))
@ -895,9 +892,9 @@ def prestations_familiales(prestations_familiales_in:PrestationsFamilialesIn):
return False
except EmptyError:
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=59,
start_line=58,
start_column=10,
end_line=59,
end_line=58,
end_column=29,
law_headings=["Prestations familiales",
"Champs d'applications",
@ -905,8 +902,8 @@ def prestations_familiales(prestations_familiales_in:PrestationsFamilialesIn):
except EmptyError:
temp_conditions_hors_age = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=59, start_column=10,
end_line=59, end_column=29,
start_line=58, start_column=10,
end_line=58, end_column=29,
law_headings=["Prestations familiales",
"Champs d'applications",
"Prologue"]))
@ -934,8 +931,9 @@ def prestations_familiales(prestations_familiales_in:PrestationsFamilialesIn):
temp_droit_ouvert_1 = True
if (temp_droit_ouvert_1 and
((param_1.remuneration_mensuelle <=
plafond_l512_3_2) and (param_1.age <
age_l512_3_2))):
plafond_l512_3_2) and
((param_1.date_de_naissance + age_l512_3_2) >
date_courante_2))):
return True
else:
raise EmptyError
@ -969,9 +967,9 @@ def prestations_familiales(prestations_familiales_in:PrestationsFamilialesIn):
return False
except EmptyError:
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=58,
start_line=57,
start_column=10,
end_line=58,
end_line=57,
end_column=22,
law_headings=["Prestations familiales",
"Champs d'applications",
@ -979,8 +977,8 @@ def prestations_familiales(prestations_familiales_in:PrestationsFamilialesIn):
except EmptyError:
temp_droit_ouvert = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=58, start_column=10,
end_line=58, end_column=22,
start_line=57, start_column=10,
end_line=57, end_column=22,
law_headings=["Prestations familiales",
"Champs d'applications",
"Prologue"]))
@ -1117,8 +1115,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
else:
raise EmptyError
return handle_default(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=98, start_column=11,
end_line=98, end_column=26,
start_line=97, start_column=11,
end_line=97, end_column=26,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]), [temp_prise_en_compte_9,
@ -1128,9 +1126,9 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
temp_prise_en_compte_1)
except EmptyError:
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=98,
start_line=97,
start_column=11,
end_line=98,
end_line=97,
end_column=26,
law_headings=["Allocations familiales",
"Champs d'applications",
@ -1138,8 +1136,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_prise_en_compte = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=98, start_column=11,
end_line=98, end_column=26,
start_line=97, start_column=11,
end_line=97, end_column=26,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1265,8 +1263,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
else:
raise EmptyError
return handle_default(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=99, start_column=11,
end_line=99, end_column=20,
start_line=98, start_column=11,
end_line=98, end_column=20,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]), [temp_versement_8,
@ -1274,9 +1272,9 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
temp_versement_1)
except EmptyError:
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=99,
start_line=98,
start_column=11,
end_line=99,
end_line=98,
end_column=20,
law_headings=["Allocations familiales",
"Champs d'applications",
@ -1284,8 +1282,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_versement = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=99, start_column=11,
end_line=99, end_column=20,
start_line=98, start_column=11,
end_line=98, end_column=20,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1295,8 +1293,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_nombre_enfants_l521_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=146, start_column=11,
end_line=146, end_column=32,
start_line=145, start_column=11,
end_line=145, end_column=32,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1306,8 +1304,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_nombre_enfants_alinea_2_l521_3 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=148, start_column=11,
end_line=148, end_column=41,
start_line=147, start_column=11,
end_line=147, end_column=41,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1330,8 +1328,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_prestations_familiales_dot_date_courante = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=63, start_column=10,
end_line=63, end_column=23,
start_line=62, start_column=10,
end_line=62, end_column=23,
law_headings=["Prestations familiales",
"Champs d'applications",
"Prologue"]))
@ -1342,8 +1340,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_prestations_familiales_dot_prestation_courante = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=64, start_column=10,
end_line=64, end_column=29,
start_line=63, start_column=10,
end_line=63, end_column=29,
law_headings=["Prestations familiales",
"Champs d'applications",
"Prologue"]))
@ -1353,8 +1351,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_prestations_familiales_dot_residence = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=65, start_column=10,
end_line=65, end_column=19,
start_line=64, start_column=10,
end_line=64, end_column=19,
law_headings=["Prestations familiales",
"Champs d'applications",
"Prologue"]))
@ -1371,8 +1369,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_enfant_le_plus_age_dot_enfants = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=80, start_column=10,
end_line=80, end_column=17,
start_line=79, start_column=10,
end_line=79, end_column=17,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1390,12 +1388,12 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
else:
raise EmptyError
except EmptyError:
return integer_of_string("14")
return duration_of_numbers(14,0,0)
except EmptyError:
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=147,
start_line=146,
start_column=11,
end_line=147,
end_line=146,
end_column=38,
law_headings=["Allocations familiales",
"Champs d'applications",
@ -1403,8 +1401,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_age_minimum_alinea_1_l521_3_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=147, start_column=11,
end_line=147, end_column=38,
start_line=146, start_column=11,
end_line=146, end_column=38,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1417,8 +1415,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_enfants_a_charge_droit_ouvert_prestation_familiale_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=96, start_column=11,
end_line=96, end_column=61,
start_line=95, start_column=11,
end_line=95, end_column=61,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1429,9 +1427,9 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
return (enfant_le_plus_age_dot_le_plus_age == param_5)
except EmptyError:
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=149,
start_line=148,
start_column=11,
end_line=149,
end_line=148,
end_column=33,
law_headings=["Allocations familiales",
"Champs d'applications",
@ -1439,8 +1437,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_est_enfant_le_plus_age = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=149, start_column=11,
end_line=149, end_column=33,
start_line=148, start_column=11,
end_line=148, end_column=33,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1488,9 +1486,9 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
else:
raise EmptyError
temp_plafond__i_i_d521_3_6 = handle_default(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=151,
start_line=150,
start_column=11,
end_line=151, end_column=28,
end_line=150, end_column=28,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]), [temp_plafond__i_i_d521_3_5,
@ -1506,8 +1504,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_plafond__i_i_d521_3_6 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=151, start_column=11,
end_line=151, end_column=28,
start_line=150, start_column=11,
end_line=150, end_column=28,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1555,9 +1553,9 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
else:
raise EmptyError
temp_plafond__i_d521_3_6 = handle_default(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=150,
start_line=149,
start_column=11,
end_line=150, end_column=27,
end_line=149, end_column=27,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]), [temp_plafond__i_d521_3_5,
@ -1573,8 +1571,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_plafond__i_d521_3_6 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=150, start_column=11,
end_line=150, end_column=27,
start_line=149, start_column=11,
end_line=149, end_column=27,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1596,8 +1594,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_droit_ouvert_complement = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=133, start_column=11,
end_line=133, end_column=34,
start_line=132, start_column=11,
end_line=132, end_column=34,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1616,8 +1614,10 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
if ((list_length(enfants_a_charge) >=
nombre_enfants_alinea_2_l521_3) and
((param_6.age ==
prestations_familiales_dot_age_l512_3_2) and
((((param_6.date_de_naissance +
prestations_familiales_dot_age_l512_3_2) -
date_courante_3) <
duration_of_numbers(0,0,365)) and
(param_6.a_deja_ouvert_droit_aux_allocations_familiales and
prestations_familiales_dot_conditions_hors_age(
param_6)))):
@ -1628,9 +1628,9 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
return False
except EmptyError:
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=121,
start_line=120,
start_column=11,
end_line=121,
end_line=120,
end_column=35,
law_headings=["Allocations familiales",
"Champs d'applications",
@ -1638,8 +1638,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_droit_ouvert_forfaitaire = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=121, start_column=11,
end_line=121, end_column=35,
start_line=120, start_column=11,
end_line=120, end_column=35,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1656,8 +1656,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_initial_base_quatrieme_enfant_et_plus_mayotte = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=118, start_column=11,
end_line=118, end_column=64,
start_line=117, start_column=11,
end_line=117, end_column=64,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1800,7 +1800,7 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
raise EmptyError
temp_montant_initial_base_troisieme_enfant_mayotte_12 = handle_default(
SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=117, start_column=11, end_line=117, end_column=56,
start_line=116, start_column=11, end_line=116, end_column=56,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]), [temp_montant_initial_base_troisieme_enfant_mayotte_11,
@ -1825,8 +1825,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_initial_base_troisieme_enfant_mayotte_12 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=117, start_column=11,
end_line=117, end_column=56,
start_line=116, start_column=11,
end_line=116, end_column=56,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1836,8 +1836,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_nombre_total_enfants = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=111, start_column=11,
end_line=111, end_column=31,
start_line=110, start_column=11,
end_line=110, end_column=31,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -1861,8 +1861,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_nombre_moyen_enfants_2 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=110, start_column=11,
end_line=110, end_column=31,
start_line=109, start_column=11,
end_line=109, end_column=31,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2037,8 +2037,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
else:
raise EmptyError
return handle_default(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=106, start_column=11,
end_line=106, end_column=46,
start_line=105, start_column=11,
end_line=105, end_column=46,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]), [temp_montant_initial_base_premier_enfant_16,
@ -2067,7 +2067,7 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
raise EmptyError
temp_montant_initial_base_premier_enfant_17 = handle_default(
SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=106, start_column=11, end_line=106, end_column=46,
start_line=105, start_column=11, end_line=105, end_column=46,
law_headings=["Allocations familiales", "Champs d'applications",
"Prologue"]), [temp_montant_initial_base_premier_enfant_3,
temp_montant_initial_base_premier_enfant_2],
@ -2076,8 +2076,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_initial_base_premier_enfant_17 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=106, start_column=11,
end_line=106, end_column=46,
start_line=105, start_column=11,
end_line=105, end_column=46,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2114,8 +2114,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_droit_ouvert_base = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=104, start_column=11,
end_line=104, end_column=28,
start_line=103, start_column=11,
end_line=103, end_column=28,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2127,15 +2127,17 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
try:
if ((list_length(enfants_a_charge_droit_ouvert_prestation_familiale) >=
nombre_enfants_alinea_2_l521_3) and
(param_7.age >=
age_minimum_alinea_1_l521_3_1(param_7))):
((param_7.date_de_naissance +
age_minimum_alinea_1_l521_3_1(param_7)) <=
date_courante_3)):
return True
else:
raise EmptyError
except EmptyError:
if (not est_enfant_le_plus_age(param_7) and
(param_7.age >=
age_minimum_alinea_1_l521_3_1(param_7))):
((param_7.date_de_naissance +
age_minimum_alinea_1_l521_3_1(param_7)) <=
date_courante_3)):
return True
else:
raise EmptyError
@ -2143,9 +2145,9 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
return False
except EmptyError:
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=126,
start_line=125,
start_column=11,
end_line=126,
end_line=125,
end_column=34,
law_headings=["Allocations familiales",
"Champs d'applications",
@ -2153,8 +2155,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_droit_ouvert_majoration = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=126, start_column=11,
end_line=126, end_column=34,
start_line=125, start_column=11,
end_line=125, end_column=34,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2191,9 +2193,9 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
return money_of_cents_string("0")
except EmptyError:
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=135,
start_line=134,
start_column=11,
end_line=135,
end_line=134,
end_column=31,
law_headings=["Allocations familiales",
"Champs d'applications",
@ -2201,8 +2203,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_complement_degressif = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=135, start_column=11,
end_line=135, end_column=31,
start_line=134, start_column=11,
end_line=134, end_column=31,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2233,7 +2235,7 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
raise EmptyError
temp_montant_verse_forfaitaire_par_enfant_5 = handle_default(
SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=122, start_column=11, end_line=122, end_column=47,
start_line=121, start_column=11, end_line=121, end_column=47,
law_headings=["Allocations familiales", "Champs d'applications",
"Prologue"]), [temp_montant_verse_forfaitaire_par_enfant_4,
temp_montant_verse_forfaitaire_par_enfant_3,
@ -2243,8 +2245,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_verse_forfaitaire_par_enfant_5 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=122, start_column=11,
end_line=122, end_column=47,
start_line=121, start_column=11,
end_line=121, end_column=47,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2294,7 +2296,7 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
raise EmptyError
temp_montant_initial_base_troisieme_enfant_et_plus_5 = handle_default(
SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=108, start_column=11, end_line=108, end_column=56,
start_line=107, start_column=11, end_line=107, end_column=56,
law_headings=["Allocations familiales", "Champs d'applications",
"Prologue"]), [temp_montant_initial_base_troisieme_enfant_et_plus_4,
temp_montant_initial_base_troisieme_enfant_et_plus_3,
@ -2304,8 +2306,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_initial_base_troisieme_enfant_et_plus_5 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=108, start_column=11,
end_line=108, end_column=56,
start_line=107, start_column=11,
end_line=107, end_column=56,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2459,8 +2461,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
raise EmptyError
temp_montant_initial_base_deuxieme_enfant_12 = handle_default(
SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=107, start_column=11,
end_line=107, end_column=47,
start_line=106, start_column=11,
end_line=106, end_column=47,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]), [temp_montant_initial_base_deuxieme_enfant_11,
@ -2525,7 +2527,7 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
raise EmptyError
temp_montant_initial_base_deuxieme_enfant_12 = handle_default(
SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=107, start_column=11, end_line=107, end_column=47,
start_line=106, start_column=11, end_line=106, end_column=47,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]), [temp_montant_initial_base_deuxieme_enfant_17,
@ -2536,8 +2538,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_initial_base_deuxieme_enfant_12 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=107, start_column=11,
end_line=107, end_column=47,
start_line=106, start_column=11,
end_line=106, end_column=47,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2552,8 +2554,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_rapport_enfants_total_moyen = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=109, start_column=11,
end_line=109, end_column=38,
start_line=108, start_column=11,
end_line=108, end_column=38,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2590,8 +2592,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
else:
raise EmptyError
return handle_default(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=127, start_column=11,
end_line=127, end_column=47,
start_line=126, start_column=11,
end_line=126, end_column=47,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]), [temp_montant_initial_metropole_majoration_6,
@ -2602,9 +2604,9 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
temp_montant_initial_metropole_majoration_1)
except EmptyError:
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=127,
start_line=126,
start_column=11,
end_line=127,
end_line=126,
end_column=47,
law_headings=["Allocations familiales",
"Champs d'applications",
@ -2612,8 +2614,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_initial_metropole_majoration = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=127, start_column=11,
end_line=127, end_column=47,
start_line=126, start_column=11,
end_line=126, end_column=47,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2631,8 +2633,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_verse_forfaitaire_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=123, start_column=11,
end_line=123, end_column=36,
start_line=122, start_column=11,
end_line=122, end_column=36,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2660,9 +2662,9 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
else:
raise EmptyError
temp_montant_initial_base_4 = handle_default(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=105,
start_line=104,
start_column=11,
end_line=105, end_column=31,
end_line=104, end_column=31,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]), [temp_montant_initial_base_3,
@ -2675,8 +2677,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_initial_base_4 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=105, start_column=11,
end_line=105, end_column=31,
start_line=104, start_column=11,
end_line=104, end_column=31,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2693,8 +2695,10 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
if (droit_ouvert_majoration(param_10) and
(prestations_familiales_dot_regime_outre_mer_l751_1 and
((list_length(enfants_a_charge_droit_ouvert_prestation_familiale) ==
integer_of_string("1")) and (param_10.age >=
integer_of_string("16"))))):
integer_of_string("1")) and
((param_10.date_de_naissance +
duration_of_numbers(16,0,0)) <=
date_courante_3)))):
return (bmaf_dot_montant *
decimal_of_string("0.0567"))
else:
@ -2703,16 +2707,20 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
if (droit_ouvert_majoration(param_10) and
(prestations_familiales_dot_regime_outre_mer_l751_1 and
((list_length(enfants_a_charge_droit_ouvert_prestation_familiale) ==
integer_of_string("1")) and ((param_10.age >=
integer_of_string("11")) and (param_10.age <
integer_of_string("16")))))):
integer_of_string("1")) and
(((param_10.date_de_naissance +
duration_of_numbers(11,0,0)) <=
date_courante_3) and
((param_10.date_de_naissance +
duration_of_numbers(16,0,0)) >
date_courante_3))))):
return (bmaf_dot_montant *
decimal_of_string("0.0369"))
else:
raise EmptyError
return handle_default(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=128, start_column=11,
end_line=128, end_column=37,
start_line=127, start_column=11,
end_line=127, end_column=37,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]), [temp_montant_initial_majoration_4,
@ -2723,9 +2731,9 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
return montant_initial_metropole_majoration(param_10)
except EmptyError:
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=128,
start_line=127,
start_column=11,
end_line=128,
end_line=127,
end_column=37,
law_headings=["Allocations familiales",
"Champs d'applications",
@ -2733,8 +2741,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_initial_majoration = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=128, start_column=11,
end_line=128, end_column=37,
start_line=127, start_column=11,
end_line=127, end_column=37,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2770,8 +2778,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_verse_complement_pour_forfaitaire = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=137, start_column=11,
end_line=137, end_column=52,
start_line=136, start_column=11,
end_line=136, end_column=52,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2782,8 +2790,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_avec_garde_alternee_base = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=112, start_column=11,
end_line=112, end_column=43,
start_line=111, start_column=11,
end_line=111, end_column=43,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2805,9 +2813,9 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
temp_montant_avec_garde_alternee_majoration_1)
except EmptyError:
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=129,
start_line=128,
start_column=11,
end_line=129,
end_line=128,
end_column=49,
law_headings=["Allocations familiales",
"Champs d'applications",
@ -2815,8 +2823,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_avec_garde_alternee_majoration = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=129, start_column=11,
end_line=129, end_column=49,
start_line=128, start_column=11,
end_line=128, end_column=49,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2829,8 +2837,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_verse_base = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=113, start_column=11,
end_line=113, end_column=29,
start_line=112, start_column=11,
end_line=112, end_column=29,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2848,8 +2856,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_verse_majoration_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=130, start_column=11,
end_line=130, end_column=35,
start_line=129, start_column=11,
end_line=129, end_column=35,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2860,8 +2868,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_base_complement_pour_base_et_majoration = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=134, start_column=11,
end_line=134, end_column=58,
start_line=133, start_column=11,
end_line=133, end_column=58,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2875,8 +2883,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_verse_complement_pour_base_et_majoration = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=136, start_column=11,
end_line=136, end_column=59,
start_line=135, start_column=11,
end_line=135, end_column=59,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2892,8 +2900,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_montant_verse = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=101, start_column=10,
end_line=101, end_column=23,
start_line=100, start_column=10,
end_line=100, end_column=23,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2905,8 +2913,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp__ = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/securite_sociale_L.catala_fr",
start_line=230, start_column=5,
end_line=234, end_column=6,
start_line=231, start_column=5,
end_line=235, end_column=6,
law_headings=["Article L521-2",
"Chapitre 1er : Allocations familiales",
"Titre 2 : Prestations générales d'entretien",
@ -2915,8 +2923,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
"Code de la sécurité sociale"]))
if not (temp__):
raise AssertionFailure(SourcePosition(filename="examples/allocations_familiales/securite_sociale_L.catala_fr",
start_line=230, start_column=5,
end_line=234, end_column=6,
start_line=231, start_column=5,
end_line=235, end_column=6,
law_headings=["Article L521-2",
"Chapitre 1er : Allocations familiales",
"Titre 2 : Prestations générales d'entretien",
@ -2953,8 +2961,6 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
obligation_scolaire = temp_enfants_a_charge_1,
remuneration_mensuelle = enfant_4.d_remuneration_mensuelle,
date_de_naissance = enfant_4.d_date_de_naissance,
age = year_of_date((date_of_numbers(0,1,1) +
(i_date_courante - enfant_4.d_date_de_naissance))),
prise_en_charge = enfant_4.d_prise_en_charge,
a_deja_ouvert_droit_aux_allocations_familiales = enfant_4.d_a_deja_ouvert_droit_aux_allocations_familiales,
beneficie_titre_personnel_aide_personnelle_logement = enfant_4.d_beneficie_titre_personnel_aide_personnelle_logement)
@ -2962,8 +2968,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_enfants_a_charge_2 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/epilogue.catala_fr",
start_line=76, start_column=11,
end_line=76, end_column=27,
start_line=75, start_column=11,
end_line=75, end_column=27,
law_headings=["Interface du programme",
"Épilogue"]))
enfants_a_charge_1 = temp_enfants_a_charge_2
@ -2980,8 +2986,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_personne_charge_effective_permanente_est_parent_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=86, start_column=10,
end_line=86, end_column=57,
start_line=85, start_column=10,
end_line=85, end_column=57,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -2999,8 +3005,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_personne_charge_effective_permanente_remplit_titre__i_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=87, start_column=10,
end_line=87, end_column=62,
start_line=86, start_column=10,
end_line=86, end_column=62,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -3010,8 +3016,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_ressources_menage = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=88, start_column=10,
end_line=88, end_column=27,
start_line=87, start_column=10,
end_line=87, end_column=27,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -3021,8 +3027,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_residence = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=89, start_column=10,
end_line=89, end_column=19,
start_line=88, start_column=10,
end_line=88, end_column=19,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -3032,8 +3038,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_date_courante = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=92, start_column=10,
end_line=92, end_column=23,
start_line=91, start_column=10,
end_line=91, end_column=23,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -3043,8 +3049,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_enfants_a_charge = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=95, start_column=10,
end_line=95, end_column=26,
start_line=94, start_column=10,
end_line=94, end_column=26,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -3062,8 +3068,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_avait_enfant_a_charge_avant_1er_janvier_2012_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/prologue.catala_fr",
start_line=116, start_column=10,
end_line=116, end_column=54,
start_line=115, start_column=10,
end_line=115, end_column=54,
law_headings=["Allocations familiales",
"Champs d'applications",
"Prologue"]))
@ -3081,8 +3087,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_i_montant_verse = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/epilogue.catala_fr",
start_line=80, start_column=10,
end_line=80, end_column=25,
start_line=79, start_column=10,
end_line=79, end_column=25,
law_headings=["Interface du programme",
"Épilogue"]))
i_montant_verse = temp_i_montant_verse

2
ninja_utils.opam
View File

@ -1,5 +1,5 @@
opam-version: "2.0"
version: "0.6.0"
version: "0.7.0"
synopsis:
"A collection of utility functions used to generate Ninja build files"
description:

4
syntax_highlighting/emacs/catala-mode.el
View File

@ -23,7 +23,7 @@
'("#")
'("contexte" "entrée" "sortie" "interne"
"champ d'application" "si et seulement si" "dépend de" "déclaration" "inclus" "collection" "contenu" "optionnel" "structure" "énumération" "contexte" "entrée" "sortie" "interne" "règle" "sous condition" "condition" "donnée" "conséquence" "rempli" "égal à" "assertion" "définition" "état" "étiquette" "exception")
'(("\\<\\(selon\\|sous\s+forme\\|fixé\\|par\\|décroissante\\|croissante\\|varie\\|avec\\|on\s+a\\|dans\\|tel\s+que\\|existe\\|pour\\|tout\\|de\\|si\\|alors\\|sinon\\|initial\\)\\>" . font-lock-builtin-face)
'(("\\<\\(selon\\|sous\s+forme\\|fixé\\|par\\|décroissante\\|croissante\\|varie\\|avec\\|on\s+a\\|soit\\|dans\\|tel\s+que\\|existe\\|pour\\|tout\\|de\\|si\\|alors\\|sinon\\|initial\\)\\>" . font-lock-builtin-face)
("\\<\\(vrai\\|faux\\)\\>" . font-lock-constant-face)
("\\<\\([0-9][0-9 ]*\\(,[0-9]*\\|\\)\\)\\>" . font-lock-constant-face)
("\\(->\\|+.\\|+@\\|+^\\|+€\\|+\\|-.\\|-@\\|-^\\|-€\\|-\\|*.\\|*@\\|*^\\|*€\\|*\\|/.\\|/@\\|/^\\|/€\\|/\\|!\\|>.\\|>=.\\|<=.\\|<.\\|>@\\|>=@\\|<=@\\|<@\\|>€\\|>=€\\|<=€\\|<€\\|>^\\|>=^\\|<=^\\|<^\\|>\\|>=\\|<=\\|<\\|=\\)" . font-lock-keyword-face)
@ -42,7 +42,7 @@
'("#")
'("context" "input" "output" "internal"
"scope" "depends on" "declaration" "includes" "collection" "content" "optional" "structure" "enumeration" "context" "input" "output" "internal" "rule" "under condition" "condition" "data" "consequence" "fulfilled" "equals" "assertion" "definition" "state" "label" "exception")
'(("\\<\\(match\\|with\s+pattern\\|fixed\\|by\\|decreasing\\|increasing\\|varies\\|with\\|we\s+have\\|in\\|such\s+that\\|exists\\|for\\|all\\|of\\|if\\|then\\|else\\|initial\\)\\>" . font-lock-builtin-face)
'(("\\<\\(match\\|with\s+pattern\\|fixed\\|by\\|decreasing\\|increasing\\|varies\\|with\\|we\s+have\\|let\\|in\\|such\s+that\\|exists\\|for\\|all\\|of\\|if\\|then\\|else\\|initial\\)\\>" . font-lock-builtin-face)
("|[0-9]\\+-[0-9]\\+-[0-9]\\+|" . font-lock-constant-face)
("\\<\\(true\\|false\\)\\>" . font-lock-constant-face)
("\\<\\([0-9][0-9,]*\\(\\.[0-9]*\\|\\)\\)\\>" . font-lock-constant-face)

2
syntax_highlighting/en/ace/mode-catala_en.js
View File

@ -70,7 +70,7 @@ ace.define(
{
token: "keyword.control",
regex:
"\\b(match|with\\s+pattern|fixed|by|decreasing|increasing|varies|with|we\\s+have|in|such\\s+that|exists|for|all|of|if|then|else|initial)\\b",
"\\b(match|with\\s+pattern|fixed|by|decreasing|increasing|varies|with|we\\s+have|let|in|such\\s+that|exists|for|all|of|if|then|else|initial)\\b",
},
{
token: "keyword.other",

2
syntax_highlighting/en/atom/grammars/catala_en.cson
View File

@ -121,7 +121,7 @@
}
}
{
'match' : '\\b(match|with\\s+pattern|fixed|by|decreasing|increasing|varies|with|we\\s+have|in|such\\s+that|exists|for|all|of|if|then|else|initial)\\b'
'match' : '\\b(match|with\\s+pattern|fixed|by|decreasing|increasing|varies|with|we\\s+have|let|in|such\\s+that|exists|for|all|of|if|then|else|initial)\\b'
'name' : 'keyword.control.catala_en'
}
{

2
syntax_highlighting/en/catala_en.iro
View File

@ -198,7 +198,7 @@ code : context {
}
: pattern {
regex \= \b(match|with\s+pattern|fixed|by|decreasing|increasing|varies|with|we\s+have|in|such\s+that|exists|for|all|of|if|then|else|initial)\b
regex \= \b(match|with\s+pattern|fixed|by|decreasing|increasing|varies|with|we\s+have|let|in|such\s+that|exists|for|all|of|if|then|else|initial)\b
styles [] = .keyword_expression ;
}

2
syntax_highlighting/en/pygments/catala_en_lexer/lexer.py
View File

@ -27,7 +27,7 @@ class CatalaEnLexer(RegexLexer):
(u'(\\s*\\#.*$)', bygroups(Comment.Single)),
(u'(context|input|output|internal)(\\s*)(|output)(\\s+)([a-z\xe9\xe8\xe0\xe2\xf9\xee\xea\u0153\xe7][a-z\xe9\xe8\xe0\xe2\xf9\xee\xea\u0153\xe7A-Z\xc9\xc8\xc0\xc2\xd9\xce\xca\u0152\xc70-9_\\\']*)',
bygroups(Keyword.Declaration, Text, Keyword.Declaration, Text, Name.Variable)),
(u'\\b(match|with\\s+pattern|fixed|by|decreasing|increasing|varies|with|we\\s+have|in|such\\s+that|exists|for|all|of|if|then|else|initial)\\b',
(u'\\b(match|with\\s+pattern|fixed|by|decreasing|increasing|varies|with|we\\s+have|let|in|such\\s+that|exists|for|all|of|if|then|else|initial)\\b',
bygroups(Keyword.Reserved)),
(u'\\b(scope|depends\\s+on|declaration|includes|collection|content|optional|structure|enumeration|context|input|output|internal|rule|under\\s+condition|condition|data|consequence|fulfilled|equals|assertion|definition|state|label|exception|anything)\\b',
bygroups(Keyword.Declaration)),

2
syntax_highlighting/en/vim/catala_en.vim
View File

@ -23,7 +23,7 @@ syn match Include "^\s*>\s*Include:.*$"
syn match sc_id_def contained "\<\([a-zéèàâùîôêœç][a-zéèàâùîôêœçA-ZÉÈÀÂÙÎÔÊŒÇ0-9_\']*\)\>"
syn match cc_id contained "\<\([A-ZÉÈÀÂÙÎÔÊŒÇ][a-zéèàâùîôêœçA-ZÉÈÀÂÙÎÔÊŒÇ0-9_\']*\)\>"
syn match Keyword contained "\<\(scope\|depends\s\+on\|declaration\|includes\|collection\|content\|optional\|structure\|enumeration\|context\|rule\|under\s\+condition\|condition\|data\|consequence\|fulfilled\|equals\|assertion\|definition\|state\|label\|exception\|anything\)\>"
syn match Statement contained "\<\(match\|with\s\+pattern\|fixed\|by\|decreasing\|increasing\|varies\|with\|we\s\+have\|in\|such\s\+that\|exists\|for\|all\|of\|if\|then\|else\|initial\)\>"
syn match Statement contained "\<\(match\|with\s\+pattern\|fixed\|by\|decreasing\|increasing\|varies\|with\|we\s\+have\|let\|in\|such\s\+that\|exists\|for\|all\|of\|if\|then\|else\|initial\)\>"
syn keyword Conditional contained if then else
syn match Comment contained "#.*$"
syn match Number contained "|[0-9]\+-[0-9]\+-[0-9]\+|"

2
syntax_highlighting/en/vscode/syntaxes/catalavs.xml
View File

@ -194,7 +194,7 @@
</dict>
<dict>
<key>match</key>
<string>\b(match|with\s+pattern|fixed|by|decreasing|increasing|varies|with|we\s+have|in|such\s+that|exists|for|all|of|if|then|else|initial)\b</string>
<string>\b(match|with\s+pattern|fixed|by|decreasing|increasing|varies|with|we\s+have|let|in|such\s+that|exists|for|all|of|if|then|else|initial)\b</string>
<key>name</key>
<string>keyword.control.catala_en</string>
</dict>

2
syntax_highlighting/fr/ace/mode-catala_fr.js
View File

@ -70,7 +70,7 @@ ace.define(
{
token: "keyword.control",
regex:
"\\b(selon|sous\\s+forme|fix\u00e9|par|d\u00e9croissante|croissante|varie|avec|on\\s+a|dans|tel\\s+que|existe|pour|tout|de|si|alors|sinon|initial)\\b",
"\\b(selon|sous\\s+forme|fix\u00e9|par|d\u00e9croissante|croissante|varie|avec|on\\s+a|soit|dans|tel\\s+que|existe|pour|tout|de|si|alors|sinon|initial)\\b",
},
{
token: "keyword.other",

2
syntax_highlighting/fr/atom/grammars/catala_fr.cson
View File

@ -121,7 +121,7 @@
}
}
{
'match' : '\\b(selon|sous\\s+forme|fixé|par|décroissante|croissante|varie|avec|on\\s+a|dans|tel\\s+que|existe|pour|tout|de|si|alors|sinon|initial)\\b'
'match' : '\\b(selon|sous\\s+forme|fixé|par|décroissante|croissante|varie|avec|on\\s+a|soit|dans|tel\\s+que|existe|pour|tout|de|si|alors|sinon|initial)\\b'
'name' : 'keyword.control.catala_fr'
}
{

Some files were not shown because too many files have changed in this diff Show More