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

Merge pull request #135 from CatalaLang/python-backend

Browse Source 
Python backend
This commit is contained in:
Denis Merigoux 2021-06-25 10:56:09 +02:00 committed by GitHub
commit c0a47aa487
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
39 changed files with 5262 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -2,3 +2,4 @@
french_law/js/french_law.js binary
french_law/ocaml/law_source/allocations_familiales.ml binary
french_law/ocaml/law_source/unit_tests/tests_allocations_famiales.ml binary
french_law/python/src/allocations_familiales.py binary

3
.github/workflows/build.yml vendored
View File

@ -46,10 +46,11 @@ jobs:
eval $(opam env)
make dependencies
sudo apt update
sudo apt install python3-dev python3-setuptools man2html rsync colordiff
sudo apt install python3-dev python3-setuptools man2html rsync colordiff libmpc-dev
sudo python3 -m pip install --upgrade pip
sudo python3 -m pip install virtualenv
sudo make pygments
./french_law/python/setup_env.sh
- name: Make all
run: |

1
.gitignore vendored
View File

@ -4,3 +4,4 @@ _opam/
compiler/**/.merlin
legifrance_oauth*
*.html
.vscode/

12
CONTRIBUTING.md
View File

@ -38,7 +38,7 @@ and articles markers:
### Sub-heading (the more '#', the less important)
#### [Legislative atom]
#### Legislative atom
```
Please look at the code of other examples to see how to format things properly.
@ -53,19 +53,19 @@ to see if you've made any syntax errors. Once the text formatting is done, you
can start to annotate each legislative atom (article, provision, etc.) with
some Catala code. To open up a code section in Catala, simply use
~~~markdown
````markdown
```catala
# In code sections, comments start with #
scope Foo:
<your code goes here>
```
~~~
````
While all the code sections are equivalent in terms of execution, you can
mark some as "metadata" so that they are printed differently on lawyer-facing
documents. Here's how it works:
~~~markdown
````markdown
> Begin metadata # > Début métadonnées en français
```catala
@ -77,7 +77,7 @@ declaration structure FooBar:
```
> End metadata # > Fin métadonnées en français
~~~
````
Again, make sure to regularly check that your example is parsing correctly. The error message from the compiler should help you debug the syntax if need be. You can also
live-test the programs you wrote by feeding them to the interpreter
@ -124,7 +124,7 @@ general-to-specifics statutes order. Therefore, there exists multiple versions
of the Catala surface syntax, adapted to the language of the legislative text.
Currently, Catala supports English and French legislative text via the
`--language=en`, `--language=fr` or `--language=pl` option.
`--language=en`, `--language=fr` or `--language=pl` option.
Technically, support for new languages can be added via a new lexer. If you want
to add a new language, you can start from

134
Makefile
View File

@ -3,6 +3,9 @@ help : Makefile
ROOT_DIR:=$(shell dirname $(realpath $(firstword $(MAKEFILE_LIST))))
# Export all variables to sub-make
export
##########################################
# Dependencies
##########################################
@ -112,7 +115,7 @@ vscode_en: ${CURDIR}/syntax_highlighting/en/setup_vscode.sh
vscode: vscode_fr vscode_en
##########################################
# Examples-related rules
# Literate programming and examples
##########################################
EXAMPLES_DIR=examples
@ -151,6 +154,81 @@ literate_polish_taxes: build
literate_examples: literate_allocations_familiales literate_code_general_impots \
literate_us_tax_code literate_tutorial_en literate_tutoriel_fr literate_polish_taxes
##########################################
# French law library
##########################################
#-----------------------------------------
# OCaml
#-----------------------------------------
FRENCH_LAW_OCAML_LIB_DIR=french_law/ocaml
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source/allocations_familiales.ml: .FORCE
CATALA_OPTS="$(CATALA_OPTS) -O -t" $(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.ml
cp -f $(ALLOCATIONS_FAMILIALES_DIR)/allocations_familiales.ml $@
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source/unit_tests/tests_allocations_familiales.ml: .FORCE
CATALA_OPTS="$(CATALA_OPTS) -O -t" $(MAKE) -s -C $(ALLOCATIONS_FAMILIALES_DIR) tests/tests_allocations_familiales.ml
cp -f $(ALLOCATIONS_FAMILIALES_DIR)/tests/tests_allocations_familiales.ml $@
#> generate_french_law_library_ocaml : Generates the French law library OCaml sources from Catala
generate_french_law_library_ocaml:\
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source/allocations_familiales.ml \
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source/unit_tests/tests_allocations_familiales.ml
$(MAKE) format
#> build_french_law_library_ocaml : Builds the OCaml French law library
build_french_law_library_ocaml: generate_french_law_library_ocaml format
dune build $(FRENCH_LAW_OCAML_LIB_DIR)/api.a
run_french_law_library_benchmark_ocaml: generate_french_law_library_ocaml
dune exec --profile release $(FRENCH_LAW_OCAML_LIB_DIR)/bench.exe
run_french_law_library_ocaml_tests: build_french_law_library_ocaml
dune exec $(FRENCH_LAW_OCAML_LIB_DIR)/law_source/unit_tests/run_tests.exe
#-----------------------------------------
# JS
#-----------------------------------------
FRENCH_LAW_JS_LIB_DIR=french_law/js
run_french_law_library_benchmark_js: build_french_law_library_js
$(MAKE) -C $(FRENCH_LAW_JS_LIB_DIR) bench
#> build_french_law_library_js : Builds the JS version of the OCaml French law library
build_french_law_library_js: generate_french_law_library_ocaml format
dune build --profile release $(FRENCH_LAW_OCAML_LIB_DIR)/api_web.bc.js
cp -f $(ROOT_DIR)/_build/default/$(FRENCH_LAW_OCAML_LIB_DIR)/api_web.bc.js $(FRENCH_LAW_JS_LIB_DIR)/french_law.js
#-----------------------------------------
# Python
#-----------------------------------------
FRENCH_LAW_PYTHON_LIB_DIR=french_law/python
$(FRENCH_LAW_PYTHON_LIB_DIR)/src/allocations_familiales.py: .FORCE
CATALA_OPTS="$(CATALA_OPTS) -O -t" $(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.py
cp -f $(ALLOCATIONS_FAMILIALES_DIR)/allocations_familiales.py $@
#> generate_french_law_library_python : Generates the French law library Python sources from Catala
generate_french_law_library_python:\
$(FRENCH_LAW_PYTHON_LIB_DIR)/src/allocations_familiales.py
. $(FRENCH_LAW_PYTHON_LIB_DIR)/env/bin/activate ;\
$(MAKE) -C $(FRENCH_LAW_PYTHON_LIB_DIR) format
#> type_french_law_library_python : Types the French law library Python sources with mypy
type_french_law_library_python: generate_french_law_library_python
. $(FRENCH_LAW_PYTHON_LIB_DIR)/env/bin/activate ;\
$(MAKE) -C $(FRENCH_LAW_PYTHON_LIB_DIR) type
run_french_law_library_benchmark_python: type_french_law_library_python
. $(FRENCH_LAW_PYTHON_LIB_DIR)/env/bin/activate ;\
$(MAKE) -C $(FRENCH_LAW_PYTHON_LIB_DIR) test
##########################################
# High-level test and benchmarks commands
##########################################
@ -167,7 +245,7 @@ test_examples: .FORCE
tests: test_suite test_examples
#> tests_ocaml : Run OCaml unit tests for the Catala-generated code
tests_ocaml: run_french_law_library_tests
tests_ocaml: run_french_law_library_ocaml_tests
#> bench_ocaml : Run OCaml benchmarks for the Catala-generated code
bench_ocaml: run_french_law_library_benchmark_ocaml
@ -175,46 +253,10 @@ bench_ocaml: run_french_law_library_benchmark_ocaml
#> bench_js : Run JS benchmarks for the Catala-generated code
bench_js: run_french_law_library_benchmark_js
##########################################
# French law library
##########################################
#> bench_python : Run Python benchmarks for the Catala-generated code
bench_python: run_french_law_library_benchmark_python
FRENCH_LAW_OCAML_LIB_DIR=french_law/ocaml
FRENCH_LAW_JS_LIB_DIR=french_law/js
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source/allocations_familiales.ml: .FORCE
CATALA_OPTS="-O -t" $(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.ml
cp -f $(ALLOCATIONS_FAMILIALES_DIR)/allocations_familiales.ml \
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source/unit_tests/tests_allocations_familiales.ml: .FORCE
CATALA_OPTS="-O -t" $(MAKE) -s -C $(ALLOCATIONS_FAMILIALES_DIR) tests/tests_allocations_familiales.ml
cp -f $(ALLOCATIONS_FAMILIALES_DIR)/tests/tests_allocations_familiales.ml \
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source/unit_tests/
#> generate_french_law_library_ocaml : Generates the French law library OCaml sources from Catala
generate_french_law_library_ocaml:\
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source/allocations_familiales.ml \
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source/unit_tests/tests_allocations_familiales.ml
$(MAKE) format
#> build_french_law_library_ocaml : Builds the OCaml French law library
build_french_law_library_ocaml: generate_french_law_library_ocaml format
dune build $(FRENCH_LAW_OCAML_LIB_DIR)/api.a
run_french_law_library_benchmark_ocaml: generate_french_law_library_ocaml
dune exec --profile release $(FRENCH_LAW_OCAML_LIB_DIR)/bench.exe
run_french_law_library_benchmark_js: build_french_law_library_js
$(MAKE) -C $(FRENCH_LAW_JS_LIB_DIR) bench
run_french_law_library_tests: generate_french_law_library_ocaml
dune exec $(FRENCH_LAW_OCAML_LIB_DIR)/law_source/unit_tests/run_tests.exe
#> build_french_law_library_js : Builds the JS version of the OCaml French law library
build_french_law_library_js: generate_french_law_library_ocaml format
dune build --profile release $(FRENCH_LAW_OCAML_LIB_DIR)/api_web.bc.js
cp -f $(ROOT_DIR)/_build/default/$(FRENCH_LAW_OCAML_LIB_DIR)/api_web.bc.js $(FRENCH_LAW_JS_LIB_DIR)/french_law.js
##########################################
# Website assets
@ -235,8 +277,16 @@ website-assets: doc literate_examples grammar.html catala.html js_build build_fr
##########################################
#> all : Run all make commands
all: dependencies build doc tests generate_french_law_library_ocaml build_french_law_library_ocaml build_french_law_library_js \
tests_ocaml bench_ocaml bench_js website-assets
all: \
dependencies build doc website-assets\
tests \
generate_french_law_library_ocaml build_french_law_library_ocaml \
tests_ocaml bench_ocaml \
build_french_law_library_js \
bench_js \
generate_french_law_library_python type_french_law_library_python\
bench_python
#> clean : Clean build artifacts
clean:

21
README.md
View File

@ -75,21 +75,30 @@ them, use
## Examples
See [the dedicated readme](examples/README.md).
To explore the different programs written in Catala, see
[the dedicated readme](examples/README.md).
## API
To know how to use the code generated by the Catala compiler in your favorite
programming language, head to the [readme of the French law library](french_law/README.md)
## Contributing
See [the dedicated readme](CONTRIBUTING.md).
To know how you can contribute to the project, see
[the dedicated readme](CONTRIBUTING.md).
## Test suite
See [the dedicated readme](tests/README.md).
To know how to run or improve the Catala reference test suite,
see [the dedicated readme](tests/README.md).
## Documentation
### Formal semantics
See [the dedicated readme](doc/formalization/README.md).
To audit the formal proof of the partial certification of the Catala compiler,
see [the dedicated readme](doc/formalization/README.md).
### Compiler documentation
@ -103,7 +112,9 @@ The documentation is also accessible [online](https://catala-lang.org/ocaml_docs
## License
The library is released under the [Apache license (version 2)](LICENSE.txt).
The compiler and all the code contained in this repository is released under
the [Apache license (version 2)](LICENSE.txt) unless another license is explicited
for a sub-directory.
## Limitations and disclaimer

35
compiler/driver.ml
View File

@ -68,6 +68,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
else if backend = "ocaml" then Cli.OCaml
else if backend = "dcalc" then Cli.Dcalc
else if backend = "scopelang" then Cli.Scopelang
else if backend = "python" then Cli.Python
else
Errors.raise_error
(Printf.sprintf "The selected backend (%s) is not supported by Catala" backend)
@ -88,6 +89,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
| Some f -> f
| None -> Filename.remove_extension source_file ^ ".d"
in
Cli.debug_print (Format.asprintf "Writing list of dependencies to %s..." output_file);
let oc = open_out output_file in
Printf.fprintf oc "%s:\\\n%s\n%s:"
(String.concat "\\\n"
@ -240,7 +242,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
result))
results;
0
| Cli.OCaml ->
| Cli.OCaml | Cli.Python ->
Cli.debug_print "Compiling program into lambda calculus...";
let prgm = Lcalc.Compile_with_exceptions.translate_program prgm in
let prgm =
@ -254,19 +256,32 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
match source_file with
| FileName f -> f
| Contents _ ->
Errors.raise_error "The OCaml backend does not work if the input is not a file"
Errors.raise_error "This backend does not work if the input is not a file"
in
let output_file =
let output_file (extension : string) : string =
match output_file with
| Some f -> f
| None -> Filename.remove_extension source_file ^ ".ml"
| None -> Filename.remove_extension source_file ^ extension
in
Cli.debug_print (Printf.sprintf "Writing to %s..." output_file);
let oc = open_out output_file in
let fmt = Format.formatter_of_out_channel oc in
Cli.debug_print "Compiling program into OCaml...";
Lcalc.To_ocaml.format_program fmt prgm type_ordering;
close_out oc;
(match backend with
| Cli.OCaml ->
let output_file = output_file ".ml" in
Cli.debug_print (Printf.sprintf "Writing to %s..." output_file);
let oc = open_out output_file in
let fmt = Format.formatter_of_out_channel oc in
Cli.debug_print "Compiling program into OCaml...";
Lcalc.To_ocaml.format_program fmt prgm type_ordering;
close_out oc
| Cli.Python ->
let prgm = Scalc.Compile_from_lambda.translate_program prgm in
let output_file = output_file ".py" in
Cli.debug_print "Compiling program into Python...";
Cli.debug_print (Printf.sprintf "Writing to %s..." output_file);
let oc = open_out output_file in
let fmt = Format.formatter_of_out_channel oc in
Scalc.To_python.format_program fmt prgm type_ordering;
close_out oc
| _ -> assert false (* should not happen *));
0
| _ -> assert false
(* should not happen *))

2
compiler/dune
View File

@ -1,7 +1,7 @@
(library
(name driver)
(public_name catala.driver)
(libraries utils surface desugared literate dcalc lcalc runtime)
(libraries utils surface desugared literate dcalc lcalc scalc runtime)
(modules driver))
(library

2
compiler/lcalc/ast.ml
View File

@ -84,6 +84,8 @@ let make_let_in (x : Var.t) (tau : D.typ Pos.marked) (e1 : expr Pos.marked Bindl
(Pos.get_position (Bindlib.unbox e2)))
(Bindlib.box_list [ e1 ])
let handle_default = Var.make ("handle_default", Pos.no_pos)
type binder = (expr, expr Pos.marked) Bindlib.binder
type program = { decl_ctx : D.decl_ctx; scopes : (Var.t * expr Pos.marked) list }

2
compiler/lcalc/ast.mli
View File

@ -90,6 +90,8 @@ val make_let_in :
expr Pos.marked Bindlib.box ->
expr Pos.marked Bindlib.box
val handle_default : Var.t
type binder = (expr, expr Pos.marked) Bindlib.binder
type program = { decl_ctx : Dcalc.Ast.decl_ctx; scopes : (Var.t * expr Pos.marked) list }

73
compiler/lcalc/backends.ml 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) 2021 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.fr>
Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except
in compliance with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software distributed under the License
is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express
or implied. See the License for the specific language governing permissions and limitations under
the License. *)
let to_ascii (s : string) : string =
let out = ref "" in
CamomileLibraryDefault.Camomile.UTF8.iter
(fun c ->
let code = CamomileLibraryDefault.Camomile.UChar.uint_code c in
out :=
!out
^
match code with
| 0xc7 -> "C"
| 0xe7 -> "c"
| c when c >= 0xc0 && c <= 0xc6 -> "A"
| c when c >= 0xe0 && c <= 0xe6 -> "a"
| c when c >= 0xc8 && c <= 0xcb -> "E"
| c when c >= 0xe8 && c <= 0xeb -> "e"
| c when c >= 0xcc && c <= 0xcf -> "I"
| c when c >= 0xec && c <= 0xef -> "i"
| c when c >= 0xd2 && c <= 0xd6 -> "O"
| c when c >= 0xf2 && c <= 0xf6 -> "o"
| c when c >= 0xd9 && c <= 0xdc -> "U"
| c when c >= 0xf9 && c <= 0xfc -> "u"
| _ ->
if code > 128 then "_"
else String.make 1 (CamomileLibraryDefault.Camomile.UChar.char_of c))
s;
!out
let to_lowercase (s : string) : string =
let is_first = ref true in
let out = ref "" in
CamomileLibraryDefault.Camomile.UTF8.iter
(fun c ->
let is_uppercase = Dcalc.Print.is_uppercase c in
out :=
!out
^ (if is_uppercase && not !is_first then "_" else "")
^ String.lowercase_ascii (String.make 1 (CamomileLibraryDefault.Camomile.UChar.char_of c));
is_first := false)
s;
!out
let to_uppercase (s : string) : string =
let last_was_underscore = ref false in
let is_first = ref true in
let out = ref "" in
CamomileLibraryDefault.Camomile.UTF8.iter
(fun c ->
let is_underscore = c = CamomileLibraryDefault.Camomile.UChar.of_char '_' in
let c_string = String.make 1 (CamomileLibraryDefault.Camomile.UChar.char_of c) in
out :=
!out
^
if is_underscore then ""
else if !last_was_underscore || !is_first then String.uppercase_ascii c_string
else c_string;
last_was_underscore := is_underscore;
is_first := false)
s;
!out

23
compiler/lcalc/backends.mli Normal file
View File

@ -0,0 +1,23 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2021 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.fr>
Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except
in compliance with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software distributed under the License
is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express
or implied. See the License for the specific language governing permissions and limitations under
the License. *)
val to_ascii : string -> string
(** Removes all non-ASCII diacritics from a string by converting them to their base letter in the
Latin alphabet *)
val to_lowercase : string -> string
(** Converts CamlCase into snake_case *)
val to_uppercase : string -> string
(** Convertes snake_case into CamlCase *)

5
compiler/lcalc/compile_with_exceptions.ml
View File

@ -18,8 +18,6 @@ module A = Ast
type ctx = A.expr Pos.marked Bindlib.box D.VarMap.t
let handle_default pos = A.make_var (A.Var.make ("handle_default", pos), pos)
let translate_lit (l : D.lit) : A.expr =
match l with
| D.LBool l -> A.ELit (A.LBool l)
@ -42,7 +40,8 @@ let rec translate_default (ctx : ctx) (exceptions : D.expr Pos.marked list)
List.map (fun except -> thunk_expr (translate_expr ctx except) pos_default) exceptions
in
let exceptions =
A.make_app (handle_default pos_default)
A.make_app
(A.make_var (A.handle_default, pos_default))
[
Bindlib.box_apply
(fun exceptions -> (A.EArray exceptions, pos_default))

9
compiler/lcalc/lcalc.mld
View File

@ -2,7 +2,7 @@
This representation is the fifth in the compilation chain
(see {{: index.html#architecture} Architecture}). Its main difference
with the previous {{: Lcalc.html} default calculus} is the absence of the
with the previous {{: Dcalc.html} default calculus} is the absence of the
default term, which has been eliminated through diverse compilation schemes.
The module describing the abstract syntax tree is:
@ -22,11 +22,12 @@ Related modules:
default calculus using catchable exceptions. This compilation scheme has been
certified.
{1 OCaml backend}
{1 Backends}
Related modules:
{!modules: Lcalc.To_ocaml}
{!modules: Lcalc.To_ocaml Lcalc.To_python Lcalc.Backends}
The OCaml backend of the lambda calculus is merely a syntactic formatting,
since the core of the OCaml value language is effectively a lambda calculus.
since the core of the OCaml value language is effectively a lambda calculus.

42
compiler/lcalc/to_ocaml.ml
View File

@ -14,6 +14,7 @@
open Utils
open Ast
open Backends
module D = Dcalc.Ast
let format_lit (fmt : Format.formatter) (l : lit Pos.marked) : unit =
@ -94,47 +95,6 @@ let format_unop (fmt : Format.formatter) (op : Dcalc.Ast.unop Pos.marked) : unit
| GetMonth -> Format.fprintf fmt "%s" "month_number_of_date"
| GetYear -> Format.fprintf fmt "%s" "year_of_date"
let to_ascii (s : string) : string =
let out = ref "" in
CamomileLibraryDefault.Camomile.UTF8.iter
(fun c ->
let code = CamomileLibraryDefault.Camomile.UChar.uint_code c in
out :=
!out
^
match code with
| 0xc7 -> "C"
| 0xe7 -> "c"
| c when c >= 0xc0 && c <= 0xc6 -> "A"
| c when c >= 0xe0 && c <= 0xe6 -> "a"
| c when c >= 0xc8 && c <= 0xcb -> "E"
| c when c >= 0xe8 && c <= 0xeb -> "e"
| c when c >= 0xcc && c <= 0xcf -> "I"
| c when c >= 0xec && c <= 0xef -> "i"
| c when c >= 0xd2 && c <= 0xd6 -> "O"
| c when c >= 0xf2 && c <= 0xf6 -> "o"
| c when c >= 0xd9 && c <= 0xdc -> "U"
| c when c >= 0xf9 && c <= 0xfc -> "u"
| _ ->
if code > 128 then "_"
else String.make 1 (CamomileLibraryDefault.Camomile.UChar.char_of c))
s;
!out
let to_lowercase (s : string) : string =
let is_first = ref true in
let out = ref "" in
CamomileLibraryDefault.Camomile.UTF8.iter
(fun c ->
let is_uppercase = Dcalc.Print.is_uppercase c in
out :=
!out
^ (if is_uppercase && not !is_first then "_" else "")
^ String.lowercase_ascii (String.make 1 (CamomileLibraryDefault.Camomile.UChar.char_of c));
is_first := false)
s;
!out
let avoid_keywords (s : string) : string =
if
match s with

54
compiler/scalc/ast.ml Normal file
View File

@ -0,0 +1,54 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2021 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.fr>
Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except
in compliance with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software distributed under the License
is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express
or implied. See the License for the specific language governing permissions and limitations under
the License. *)
open Utils
module D = Dcalc.Ast
module L = Lcalc.Ast
module TopLevelName = Uid.Make (Uid.MarkedString) ()
module LocalName = Uid.Make (Uid.MarkedString) ()
type expr =
| EVar of LocalName.t
| EFunc of TopLevelName.t
| EStruct of expr Pos.marked list * D.StructName.t
| EStructFieldAccess of expr Pos.marked * D.StructFieldName.t * D.StructName.t
| EInj of expr Pos.marked * D.EnumConstructor.t * D.EnumName.t
| EArray of expr Pos.marked list
| ELit of L.lit
| EApp of expr Pos.marked * expr Pos.marked list
| EOp of Dcalc.Ast.operator
type stmt =
| SInnerFuncDef of LocalName.t Pos.marked * func
| SLocalDecl of LocalName.t Pos.marked * D.typ Pos.marked
| SLocalDef of LocalName.t Pos.marked * expr Pos.marked
| STryExcept of block * L.except * block
| SRaise of L.except
| SIfThenElse of expr Pos.marked * block * block
| SSwitch of
expr Pos.marked
* D.EnumName.t
* (block (* Statements corresponding to arm closure body*)
* (* Variable instantiated with enum payload *) LocalName.t)
list (** Each block corresponds to one case of the enum *)
| SReturn of expr
| SAssert of expr
and block = stmt Pos.marked list
and func = { func_params : (LocalName.t Pos.marked * D.typ Pos.marked) list; func_body : block }
type program = { decl_ctx : D.decl_ctx; scopes : (TopLevelName.t * func) list }

255
compiler/scalc/compile_from_lambda.ml Normal file
View File

@ -0,0 +1,255 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2021 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.fr>
Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except
in compliance with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software distributed under the License
is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express
or implied. See the License for the specific language governing permissions and limitations under
the License. *)
open Utils
module A = Ast
module L = Lcalc.Ast
module D = Dcalc.Ast
type ctxt = {
func_dict : A.TopLevelName.t L.VarMap.t;
decl_ctx : D.decl_ctx;
var_dict : A.LocalName.t L.VarMap.t;
inside_definition_of : A.LocalName.t option;
}
(* 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 : L.expr Pos.marked) : A.block * A.expr Pos.marked =
match Pos.unmark expr with
| L.EVar v ->
let local_var =
try A.EVar (L.VarMap.find (Pos.unmark v) ctxt.var_dict)
with Not_found -> A.EFunc (L.VarMap.find (Pos.unmark v) ctxt.func_dict)
in
([], (local_var, Pos.get_position v))
| L.ETuple (args, Some s_name) ->
let args_stmts, new_args =
List.fold_left
(fun (args_stmts, new_args) arg ->
let arg_stmts, new_arg = translate_expr ctxt arg in
(arg_stmts @ args_stmts, new_arg :: new_args))
([], []) args
in
let new_args = List.rev new_args in
let args_stmts = List.rev args_stmts in
(args_stmts, (A.EStruct (new_args, s_name), Pos.get_position expr))
| L.ETuple (_, None) -> failwith "Non-struct tuples cannot be compiled to scalc"
| L.ETupleAccess (e1, num_field, Some s_name, _) ->
let e1_stmts, new_e1 = translate_expr ctxt e1 in
let field_name =
fst (List.nth (D.StructMap.find s_name ctxt.decl_ctx.ctx_structs) num_field)
in
(e1_stmts, (A.EStructFieldAccess (new_e1, field_name, s_name), Pos.get_position expr))
| L.ETupleAccess (_, _, None, _) -> failwith "Non-struct tuples cannot be compiled to scalc"
| L.EInj (e1, num_cons, e_name, _) ->
let e1_stmts, new_e1 = translate_expr ctxt e1 in
let cons_name = fst (List.nth (D.EnumMap.find e_name ctxt.decl_ctx.ctx_enums) num_cons) in
(e1_stmts, (A.EInj (new_e1, cons_name, e_name), Pos.get_position expr))
| L.EApp (f, args) ->
let f_stmts, new_f = translate_expr ctxt f in
let args_stmts, new_args =
List.fold_left
(fun (args_stmts, new_args) arg ->
let arg_stmts, new_arg = translate_expr ctxt arg in
(arg_stmts @ args_stmts, new_arg :: new_args))
([], []) args
in
let new_args = List.rev new_args in
let args_stmts = List.rev args_stmts in
(f_stmts @ args_stmts, (A.EApp (new_f, new_args), Pos.get_position expr))
| L.EArray args ->
let args_stmts, new_args =
List.fold_left
(fun (args_stmts, new_args) arg ->
let arg_stmts, new_arg = translate_expr ctxt arg in
(arg_stmts @ args_stmts, new_arg :: new_args))
([], []) args
in
let new_args = List.rev new_args in
let args_stmts = List.rev args_stmts in
(args_stmts, (A.EArray new_args, Pos.get_position expr))
| L.EOp op -> ([], (A.EOp op, Pos.get_position expr))
| L.ELit l -> ([], (A.ELit l, Pos.get_position expr))
| _ ->
let tmp_var = A.LocalName.fresh ("local_var", Pos.get_position expr) in
let ctxt = { ctxt with inside_definition_of = Some tmp_var } in
let tmp_stmts = translate_statements ctxt expr in
( ( A.SLocalDecl ((tmp_var, Pos.get_position expr), (D.TAny, Pos.get_position expr)),
Pos.get_position expr )
:: tmp_stmts,
(A.EVar tmp_var, Pos.get_position expr) )
and translate_statements (ctxt : ctxt) (block_expr : L.expr Pos.marked) : A.block =
match Pos.unmark block_expr with
| L.EApp ((L.EAbs ((binder, _), [ (D.TLit D.TUnit, _) ]), _), [ (L.EAssert e, _) ]) ->
(* Assertions are always encapsulated in a unit-typed let binding *)
let _, body = Bindlib.unmbind binder in
let e_stmts, new_e = translate_expr ctxt e in
e_stmts
@ (A.SAssert (Pos.unmark new_e), Pos.get_position block_expr)
:: translate_statements ctxt body
| L.EApp ((L.EAbs ((binder, binder_pos), taus), eabs_pos), args) ->
(* This defines multiple local variables at the time *)
let vars, body = Bindlib.unmbind binder in
let vars_tau = List.map2 (fun x tau -> (x, tau)) (Array.to_list vars) taus in
let ctxt =
{
ctxt with
var_dict =
List.fold_left
(fun var_dict (x, _) ->
L.VarMap.add x (A.LocalName.fresh (Bindlib.name_of x, binder_pos)) var_dict)
ctxt.var_dict vars_tau;
}
in
let local_decls =
List.map
(fun (x, tau) ->
(A.SLocalDecl ((L.VarMap.find x ctxt.var_dict, binder_pos), tau), eabs_pos))
vars_tau
in
let vars_args =
List.map2
(fun (x, tau) arg -> ((L.VarMap.find x ctxt.var_dict, binder_pos), tau, arg))
vars_tau args
in
let def_blocks =
List.map
(fun (x, _tau, arg) ->
let ctxt = { ctxt with inside_definition_of = Some (Pos.unmark x) } in
let arg_stmts, new_arg = translate_expr ctxt arg in
arg_stmts @ [ (A.SLocalDef (x, new_arg), binder_pos) ])
vars_args
in
let rest_of_block = translate_statements ctxt body in
local_decls @ List.flatten def_blocks @ rest_of_block
| L.EAbs ((binder, binder_pos), taus) ->
let vars, body = Bindlib.unmbind binder in
let vars_tau = List.map2 (fun x tau -> (x, tau)) (Array.to_list vars) taus in
let closure_name =
match ctxt.inside_definition_of with
| None -> A.LocalName.fresh ("closure", Pos.get_position block_expr)
| Some x -> x
in
let ctxt =
{
ctxt with
var_dict =
List.fold_left
(fun var_dict (x, _) ->
L.VarMap.add x (A.LocalName.fresh (Bindlib.name_of x, binder_pos)) var_dict)
ctxt.var_dict vars_tau;
inside_definition_of = None;
}
in
let new_body = translate_statements ctxt body in
[
( A.SInnerFuncDef
( (closure_name, binder_pos),
{
func_params =
List.map
(fun (var, tau) -> ((L.VarMap.find var ctxt.var_dict, binder_pos), tau))
vars_tau;
func_body = new_body;
} ),
binder_pos );
]
| L.EMatch (e1, args, e_name) ->
let e1_stmts, new_e1 = translate_expr ctxt e1 in
let new_args =
List.fold_left
(fun new_args arg ->
match Pos.unmark arg with
| L.EAbs ((binder, pos_binder), _) ->
let vars, body = Bindlib.unmbind binder in
assert (Array.length vars = 1);
let var = vars.(0) in
let scalc_var = A.LocalName.fresh (Bindlib.name_of var, pos_binder) in
let ctxt = { ctxt with var_dict = L.VarMap.add var scalc_var ctxt.var_dict } in
let new_arg = translate_statements ctxt body in
(new_arg, scalc_var) :: new_args
| _ -> assert false
(* should not happen *))
[] args
in
let new_args = List.rev new_args in
e1_stmts @ [ (A.SSwitch (new_e1, e_name, new_args), Pos.get_position block_expr) ]
| L.EIfThenElse (cond, e_true, e_false) ->
let cond_stmts, s_cond = translate_expr ctxt cond in
let s_e_true = translate_statements ctxt e_true in
let s_e_false = translate_statements ctxt e_false in
cond_stmts @ [ (A.SIfThenElse (s_cond, s_e_true, s_e_false), Pos.get_position block_expr) ]
| L.ECatch (e_try, except, e_catch) ->
let s_e_try = translate_statements ctxt e_try in
let s_e_catch = translate_statements ctxt e_catch in
[ (A.STryExcept (s_e_try, except, s_e_catch), Pos.get_position block_expr) ]
| L.ERaise except -> [ (A.SRaise except, Pos.get_position block_expr) ]
| _ ->
let e_stmts, new_e = translate_expr ctxt block_expr in
e_stmts
@ [
( (match ctxt.inside_definition_of with
| None -> A.SReturn (Pos.unmark new_e)
| Some x -> A.SLocalDef (Pos.same_pos_as x new_e, new_e)),
Pos.get_position block_expr );
]
let translate_scope (decl_ctx : D.decl_ctx) (func_dict : A.TopLevelName.t L.VarMap.t)
(scope_expr : L.expr Pos.marked) : (A.LocalName.t Pos.marked * D.typ Pos.marked) list * A.block
=
match Pos.unmark scope_expr with
| L.EAbs ((binder, binder_pos), typs) ->
let vars, body = Bindlib.unmbind binder in
let var_dict =
Array.fold_left
(fun var_dict var ->
L.VarMap.add var (A.LocalName.fresh (Bindlib.name_of var, binder_pos)) var_dict)
L.VarMap.empty vars
in
let param_list =
List.map2
(fun var typ -> ((L.VarMap.find var var_dict, binder_pos), typ))
(Array.to_list vars) typs
in
let new_body =
translate_statements { decl_ctx; func_dict; var_dict; inside_definition_of = None } body
in
(param_list, new_body)
| _ -> assert false
(* should not happen *)
let translate_program (p : L.program) : A.program =
{
decl_ctx = p.L.decl_ctx;
scopes =
(let _, new_scopes =
List.fold_left
(fun (func_dict, new_scopes) (scope_name, scope_expr) ->
let new_scope_params, new_scope_body =
translate_scope p.decl_ctx func_dict scope_expr
in
let func_id = A.TopLevelName.fresh (Bindlib.name_of scope_name, Pos.no_pos) in
let func_dict = L.VarMap.add scope_name func_id func_dict in
( func_dict,
(func_id, { A.func_params = new_scope_params; A.func_body = new_scope_body })
:: new_scopes ))
( L.VarMap.singleton L.handle_default
(A.TopLevelName.fresh ("handle_default", Pos.no_pos)),
[] )
p.L.scopes
in
List.rev new_scopes);
}

8
compiler/scalc/dune Normal file
View File

@ -0,0 +1,8 @@
(library
(name scalc)
(public_name catala.scalc)
(libraries bindlib lcalc runtime))
(documentation
(package catala)
(mld_files scalc))

29
compiler/scalc/scalc.mld Normal file
View File

@ -0,0 +1,29 @@
{0 Statement calculus}
This representation is the sixth in the compilation chain
(see {{: index.html#architecture} Architecture}). Its main difference
with the previous {{: Lcalc.html} default calculus} is the switch to a
statement-based language. This representation does not assume any scoping
rules in the language, every local variable has a unique id.
The module describing the abstract syntax tree is:
{!modules: Dcalc.Ast}
{1 Compilation from lambda calculus }
Related modules:
{!modules: Scalc.Compile_from_lambda}
{!module: Scalc.Compile_from_lambda} Performs the classical translation
from an expression-based language to a statement-based language. Union types
are eliminated in favor of tagged unions.
{1 Backends}
Related modules:
{!modules: Lcalc.To_python}

414
compiler/scalc/to_python.ml Normal file
View File

@ -0,0 +1,414 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.fr>
Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except
in compliance with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software distributed under the License
is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express
or implied. See the License for the specific language governing permissions and limitations under
the License. *)
[@@@warning "-32-27"]
open Utils
open Ast
open Lcalc.Backends
module D = Dcalc.Ast
module L = Lcalc.Ast
let format_lit (fmt : Format.formatter) (l : L.lit Pos.marked) : unit =
match Pos.unmark l with
| LBool true -> Format.fprintf fmt "True"
| LBool false -> Format.fprintf fmt "False"
| LInt i -> Format.fprintf fmt "integer_of_string(\"%s\")" (Runtime.integer_to_string i)
| LUnit -> Format.fprintf fmt "Unit()"
| LRat i ->
Format.fprintf fmt "decimal_of_string(\"%a\")" Dcalc.Print.format_lit
(Pos.same_pos_as (Dcalc.Ast.LRat i) l)
| LMoney e ->
Format.fprintf fmt "money_of_cents_string(\"%s\")"
(Runtime.integer_to_string (Runtime.money_to_cents e))
| LDate d ->
Format.fprintf fmt "date_of_numbers(%d,%d,%d)"
(Runtime.integer_to_int (Runtime.year_of_date d))
(Runtime.integer_to_int (Runtime.month_number_of_date d))
(Runtime.integer_to_int (Runtime.day_of_month_of_date d))
| LDuration d ->
let years, months, days = Runtime.duration_to_years_months_days d in
Format.fprintf fmt "duration_of_numbers(%d,%d,%d)" years months days
let format_log_entry (fmt : Format.formatter) (entry : Dcalc.Ast.log_entry) : unit =
match entry with
| VarDef _ -> Format.fprintf fmt ":="
| BeginCall -> Format.fprintf fmt "→ "
| EndCall -> Format.fprintf fmt "%s" "← "
| PosRecordIfTrueBool -> Format.fprintf fmt "☛ "
let format_binop (fmt : Format.formatter) (op : Dcalc.Ast.binop Pos.marked) : unit =
match Pos.unmark op with
| Add _ -> Format.fprintf fmt "+"
| Sub _ -> Format.fprintf fmt "-"
| Mult _ -> Format.fprintf fmt "*"
| Div D.KInt -> Format.fprintf fmt "//"
| Div _ -> Format.fprintf fmt "/"
| And -> Format.fprintf fmt "and"
| Or -> Format.fprintf fmt "or"
| Eq -> Format.fprintf fmt "=="
| Neq | Xor -> Format.fprintf fmt "!="
| Lt _ -> Format.fprintf fmt "<"
| Lte _ -> Format.fprintf fmt "<="
| Gt _ -> Format.fprintf fmt ">"
| Gte _ -> Format.fprintf fmt ">="
| Map -> Format.fprintf fmt "list_map"
| Filter -> Format.fprintf fmt "list_filter"
let format_ternop (fmt : Format.formatter) (op : Dcalc.Ast.ternop Pos.marked) : unit =
match Pos.unmark op with Fold -> Format.fprintf fmt "list_fold_left"
let format_uid_list (fmt : Format.formatter) (uids : Uid.MarkedString.info list) : unit =
Format.fprintf fmt "[%a]"
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
(fun fmt info -> Format.fprintf fmt "\"%a\"" Utils.Uid.MarkedString.format_info info))
uids
let format_string_list (fmt : Format.formatter) (uids : string list) : unit =
Format.fprintf fmt "[%a]"
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
(fun fmt info -> Format.fprintf fmt "\"%s\"" info))
uids
let format_unop (fmt : Format.formatter) (op : Dcalc.Ast.unop Pos.marked) : unit =
match Pos.unmark op with
| Minus _ -> Format.fprintf fmt "-"
| Not -> Format.fprintf fmt "not"
| Log (entry, infos) -> assert false (* should not happen *)
| Length -> Format.fprintf fmt "%s" "list_length"
| IntToRat -> Format.fprintf fmt "%s" "decimal_of_integer"
| GetDay -> Format.fprintf fmt "%s" "day_of_month_of_date"
| GetMonth -> Format.fprintf fmt "%s" "month_number_of_date"
| GetYear -> Format.fprintf fmt "%s" "year_of_date"
let avoid_keywords (s : string) : string =
if
match s with
(* list taken from https://www.programiz.com/python-programming/keyword-list *)
| "False" | "None" | "True" | "and" | "as" | "assert" | "async" | "await" | "break" | "class"
| "continue" | "def" | "del" | "elif" | "else" | "except" | "finally" | "for" | "from"
| "global" | "if" | "import" | "in" | "is" | "lambda" | "nonlocal" | "not" | "or" | "pass"
| "raise" | "return" | "try" | "while" | "with" | "yield" ->
true
| _ -> false
then s ^ "_"
else s
let format_struct_name (fmt : Format.formatter) (v : Dcalc.Ast.StructName.t) : unit =
Format.fprintf fmt "%s"
(avoid_keywords
(to_uppercase (to_ascii (Format.asprintf "%a" Dcalc.Ast.StructName.format_t v))))
let format_struct_field_name (fmt : Format.formatter) (v : Dcalc.Ast.StructFieldName.t) : unit =
Format.fprintf fmt "%s"
(avoid_keywords (to_ascii (Format.asprintf "%a" Dcalc.Ast.StructFieldName.format_t v)))
let format_enum_name (fmt : Format.formatter) (v : Dcalc.Ast.EnumName.t) : unit =
Format.fprintf fmt "%s"
(avoid_keywords (to_uppercase (to_ascii (Format.asprintf "%a" Dcalc.Ast.EnumName.format_t v))))
let format_enum_cons_name (fmt : Format.formatter) (v : Dcalc.Ast.EnumConstructor.t) : unit =
Format.fprintf fmt "%s"
(avoid_keywords (to_ascii (Format.asprintf "%a" Dcalc.Ast.EnumConstructor.format_t v)))
let typ_needs_parens (e : Dcalc.Ast.typ Pos.marked) : bool =
match Pos.unmark e with TArrow _ | TArray _ -> true | _ -> false
let rec format_typ (fmt : Format.formatter) (typ : Dcalc.Ast.typ Pos.marked) : unit =
let format_typ = format_typ in
let format_typ_with_parens (fmt : Format.formatter) (t : Dcalc.Ast.typ Pos.marked) =
if typ_needs_parens t then Format.fprintf fmt "(%a)" format_typ t
else Format.fprintf fmt "%a" format_typ t
in
match Pos.unmark typ with
| TLit TUnit -> Format.fprintf fmt "Unit"
| TLit TMoney -> Format.fprintf fmt "Money"
| TLit TInt -> Format.fprintf fmt "Integer"
| TLit TRat -> Format.fprintf fmt "Decimal"
| TLit TDate -> Format.fprintf fmt "Date"
| TLit TDuration -> Format.fprintf fmt "Duration"
| TLit TBool -> Format.fprintf fmt "bool"
| TTuple (ts, None) ->
Format.fprintf fmt "Tuple[%a]"
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
(fun fmt t -> Format.fprintf fmt "%a" format_typ_with_parens t))
ts
| TTuple (_, Some s) -> Format.fprintf fmt "%a" format_struct_name s
| TEnum (_, e) -> Format.fprintf fmt "%a" format_enum_name e
| TArrow (t1, t2) ->
Format.fprintf fmt "Callable[[%a], %a]" format_typ_with_parens t1 format_typ_with_parens t2
| TArray t1 -> Format.fprintf fmt "List[%a]" format_typ_with_parens t1
| TAny -> Format.fprintf fmt "Any"
let format_name_cleaned (fmt : Format.formatter) (s : string) : unit =
let lowercase_name = to_lowercase (to_ascii s) in
let lowercase_name =
Re.Pcre.substitute ~rex:(Re.Pcre.regexp "\\.") ~subst:(fun _ -> "_dot_") lowercase_name
in
let lowercase_name = avoid_keywords (to_ascii lowercase_name) in
Format.fprintf fmt "%s" lowercase_name
let format_var (fmt : Format.formatter) (v : LocalName.t) : unit =
let v_str = Pos.unmark (LocalName.get_info v) in
if v_str = "_" then Format.fprintf fmt "_"
else Format.fprintf fmt "%a_%d" format_name_cleaned v_str (LocalName.hash v)
let format_toplevel_name (fmt : Format.formatter) (v : TopLevelName.t) : unit =
let v_str = Pos.unmark (TopLevelName.get_info v) in
format_name_cleaned fmt v_str
let needs_parens (e : expr Pos.marked) : bool =
match Pos.unmark e with ELit (LBool _ | LUnit) | EVar _ | EOp _ -> false | _ -> true
let format_exception (fmt : Format.formatter) (exc : L.except Pos.marked) : unit =
match Pos.unmark exc with
| ConflictError -> Format.fprintf fmt "ConflictError"
| EmptyError -> Format.fprintf fmt "EmptyError"
| Crash -> Format.fprintf fmt "Crash"
| NoValueProvided ->
let pos = Pos.get_position exc in
Format.fprintf fmt
"NoValueProvided(SourcePosition(filename=\"%s\",@ start_line=%d,@ start_column=%d,@ \
end_line=%d,@ end_column=%d,@ law_headings=%a))"
(Pos.get_file pos) (Pos.get_start_line pos) (Pos.get_start_column pos)
(Pos.get_end_line pos) (Pos.get_end_column pos) format_string_list (Pos.get_law_info pos)
let rec format_expression (ctx : Dcalc.Ast.decl_ctx) (fmt : Format.formatter) (e : expr Pos.marked)
: unit =
match Pos.unmark e with
| EVar v -> format_var fmt v
| EFunc f -> format_toplevel_name fmt f
| EStruct (es, s) ->
if List.length es = 0 then failwith "should not happen"
else
Format.fprintf fmt "%a(%a)" format_struct_name s
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
(fun fmt (e, struct_field) ->
Format.fprintf fmt "%a = %a" format_struct_field_name struct_field
(format_expression ctx) e))
(List.combine es (List.map fst (Dcalc.Ast.StructMap.find s ctx.ctx_structs)))
| EStructFieldAccess (e1, field, _) ->
Format.fprintf fmt "%a.%a" (format_expression ctx) e1 format_struct_field_name field
| EInj (e, cons, enum_name) ->
Format.fprintf fmt "%a(%a_Code.%a,@ %a)" format_enum_name enum_name format_enum_name enum_name
format_enum_cons_name cons (format_expression ctx) e
| EArray es ->
Format.fprintf fmt "[%a]"
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
(fun fmt e -> Format.fprintf fmt "%a" (format_expression ctx) e))
es
| ELit l -> Format.fprintf fmt "%a" format_lit (Pos.same_pos_as l e)
| EApp ((EOp (Binop ((Dcalc.Ast.Map | Dcalc.Ast.Filter) as op)), _), [ arg1; arg2 ]) ->
Format.fprintf fmt "%a(%a,@ %a)" format_binop (op, Pos.no_pos) (format_expression ctx) arg1
(format_expression ctx) arg2
| EApp ((EOp (Binop op), _), [ arg1; arg2 ]) ->
Format.fprintf fmt "(%a %a@ %a)" (format_expression ctx) arg1 format_binop (op, Pos.no_pos)
(format_expression ctx) arg2
| EApp ((EApp ((EOp (Unop (D.Log (D.BeginCall, info))), _), [ f ]), _), [ arg ])
when !Cli.trace_flag ->
Format.fprintf fmt "log_begin_call(%a,@ %a,@ %a)" format_uid_list info (format_expression ctx)
f (format_expression ctx) arg
| EApp ((EOp (Unop (D.Log (D.VarDef tau, info))), _), [ arg1 ]) when !Cli.trace_flag ->
Format.fprintf fmt "log_variable_definition(%a,@ %a)" format_uid_list info
(format_expression ctx) arg1
| EApp ((EOp (Unop (D.Log (D.PosRecordIfTrueBool, _))), pos), [ arg1 ]) when !Cli.trace_flag ->
Format.fprintf fmt
"log_decision_taken(SourcePosition(filename=\"%s\",@ start_line=%d,@ start_column=%d,@ \
end_line=%d, end_column=%d,@ law_headings=%a), %a)"
(Pos.get_file pos) (Pos.get_start_line pos) (Pos.get_start_column pos)
(Pos.get_end_line pos) (Pos.get_end_column pos) format_string_list (Pos.get_law_info pos)
(format_expression ctx) arg1
| EApp ((EOp (Unop (D.Log (D.EndCall, info))), _), [ arg1 ]) when !Cli.trace_flag ->
Format.fprintf fmt "log_end_call(%a,@ %a)" format_uid_list info (format_expression ctx) arg1
| EApp ((EOp (Unop (D.Log _)), _), [ arg1 ]) ->
Format.fprintf fmt "%a" (format_expression ctx) arg1
| EApp ((EOp (Unop ((Minus _ | Not) as op)), _), [ arg1 ]) ->
Format.fprintf fmt "%a %a" format_unop (op, Pos.no_pos) (format_expression ctx) arg1
| EApp ((EOp (Unop op), _), [ arg1 ]) ->
Format.fprintf fmt "%a(%a)" format_unop (op, Pos.no_pos) (format_expression ctx) arg1
| EApp (f, args) ->
Format.fprintf fmt "%a(%a)" (format_expression ctx) f
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
(format_expression ctx))
args
| EOp (Ternop op) -> Format.fprintf fmt "%a" format_ternop (op, Pos.no_pos)
| EOp (Binop op) -> Format.fprintf fmt "%a" format_binop (op, Pos.no_pos)
| EOp (Unop op) -> Format.fprintf fmt "%a" format_unop (op, Pos.no_pos)
let rec format_statement (ctx : Dcalc.Ast.decl_ctx) (fmt : Format.formatter) (s : stmt Pos.marked) :
unit =
match Pos.unmark s with
| SInnerFuncDef (name, { func_params; func_body }) ->
Format.fprintf fmt "@[<hov 4>def %a(%a):@\n%a@]" format_var (Pos.unmark name)
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
(fun fmt (var, typ) ->
Format.fprintf fmt "%a:%a" format_var (Pos.unmark var) format_typ typ))
func_params (format_block ctx) func_body
| SLocalDecl _ -> assert false (* We don't need to declare variables in Python *)
| SLocalDef (v, e) ->
Format.fprintf fmt "@[<hov 4>%a = %a@]" format_var (Pos.unmark v) (format_expression ctx) e
| STryExcept (try_b, except, catch_b) ->
Format.fprintf fmt "@[<hov 4>try:@\n%a@]@\n@[<hov 4>except %a:@\n%a@]" (format_block ctx)
try_b format_exception (except, Pos.no_pos) (format_block ctx) catch_b
| SRaise except ->
Format.fprintf fmt "@[<hov 4>raise %a@]" format_exception (except, Pos.get_position s)
| SIfThenElse (cond, b1, b2) ->
Format.fprintf fmt "@[<hov 4>if %a:@\n%a@]@\n@[<hov 4>else:@\n%a@]" (format_expression ctx)
cond (format_block ctx) b1 (format_block ctx) b2
| SSwitch (e1, e_name, cases) ->
let cases =
List.map2 (fun (x, y) (cons, _) -> (x, y, cons)) cases (D.EnumMap.find e_name ctx.ctx_enums)
in
let tmp_var = LocalName.fresh ("match_arg", Pos.no_pos) in
Format.fprintf fmt "%a = %a@\n@[<hov 4>if %a@]" format_var tmp_var (format_expression ctx) e1
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt "@]@\n@[<hov 4>elif ")
(fun fmt (case_block, payload_var, cons_name) ->
Format.fprintf fmt "%a.code == %a_Code.%a:@\n%a = %a.value@\n%a" format_var tmp_var
format_enum_name e_name format_enum_cons_name cons_name format_var payload_var
format_var tmp_var (format_block ctx) case_block))
cases
| SReturn e1 ->
Format.fprintf fmt "@[<hov 4>return %a@]" (format_expression ctx) (e1, Pos.get_position s)
| SAssert e1 ->
Format.fprintf fmt "@[<hov 4>assert %a@]" (format_expression ctx) (e1, Pos.get_position s)
and format_block (ctx : Dcalc.Ast.decl_ctx) (fmt : Format.formatter) (b : block) : unit =
Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
(format_statement ctx) fmt
(List.filter (fun s -> match Pos.unmark s with SLocalDecl _ -> false | _ -> true) b)
let format_ctx (type_ordering : Scopelang.Dependency.TVertex.t list) (fmt : Format.formatter)
(ctx : D.decl_ctx) : unit =
let format_struct_decl fmt (struct_name, struct_fields) =
if List.length struct_fields = 0 then failwith "no fields in the struct"
else
Format.fprintf fmt
"class %a:@\n\
\tdef __init__(self, %a) -> None:@\n\
%a@\n\
@\n\
\tdef __eq__(self, other: object) -> bool:@\n\
\t\tif isinstance(other, %a):@\n\
\t\t\treturn @[<hov>(%a)@]@\n\
\t\telse:@\n\
\t\t\treturn False@\n\
@\n\
\tdef __ne__(self, other: object) -> bool:@\n\
\t\treturn not (self == other)" format_struct_name struct_name
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
(fun _fmt (struct_field, struct_field_type) ->
Format.fprintf fmt "%a: %a" format_struct_field_name struct_field format_typ
struct_field_type))
struct_fields
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
(fun _fmt (struct_field, _) ->
Format.fprintf fmt "\t\tself.%a = %a" format_struct_field_name struct_field
format_struct_field_name struct_field))
struct_fields format_struct_name struct_name
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt " and@ ")
(fun _fmt (struct_field, _) ->
Format.fprintf fmt "self.%a == other.%a" format_struct_field_name struct_field
format_struct_field_name struct_field))
struct_fields
in
let format_enum_decl fmt (enum_name, enum_cons) =
if List.length enum_cons = 0 then failwith "no constructors in the enum"
else
Format.fprintf fmt
"@[<hov 4>class %a_Code(Enum):@\n\
%a@]@\n\
@\n\
class %a:@\n\
\tdef __init__(self, code: %a_Code, value: Any) -> None:@\n\
\t\tself.code = code@\n\
\t\tself.value = value@\n\
@\n\
@\n\
\tdef __eq__(self, other: object) -> bool:@\n\
\t\tif isinstance(other, %a):@\n\
\t\t\treturn self.code == other.code and self.value == other.value@\n\
\t\telse:@\n\
\t\t\treturn False@\n\
@\n\
@\n\
\tdef __ne__(self, other: object) -> bool:@\n\
\t\treturn not (self == other)" format_enum_name enum_name
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
(fun _fmt (i, enum_cons, enum_cons_type) ->
Format.fprintf fmt "%a = %d" format_enum_cons_name enum_cons i))
(List.mapi (fun i (x, y) -> (i, x, y)) enum_cons)
format_enum_name enum_name format_enum_name enum_name format_enum_name enum_name
in
let is_in_type_ordering s =
List.exists
(fun struct_or_enum ->
match struct_or_enum with
| Scopelang.Dependency.TVertex.Enum _ -> false
| Scopelang.Dependency.TVertex.Struct s' -> s = s')
type_ordering
in
let scope_structs =
List.map
(fun (s, _) -> Scopelang.Dependency.TVertex.Struct s)
(Dcalc.Ast.StructMap.bindings
(Dcalc.Ast.StructMap.filter (fun s _ -> not (is_in_type_ordering s)) ctx.ctx_structs))
in
List.iter
(fun struct_or_enum ->
match struct_or_enum with
| Scopelang.Dependency.TVertex.Struct s ->
Format.fprintf fmt "%a@\n@\n" format_struct_decl
(s, Dcalc.Ast.StructMap.find s ctx.Dcalc.Ast.ctx_structs)
| Scopelang.Dependency.TVertex.Enum e ->
Format.fprintf fmt "%a@\n@\n" format_enum_decl
(e, Dcalc.Ast.EnumMap.find e ctx.Dcalc.Ast.ctx_enums))
(type_ordering @ scope_structs)
let format_program (fmt : Format.formatter) (p : Ast.program)
(type_ordering : Scopelang.Dependency.TVertex.t list) : unit =
Cli.style_flag := false;
Format.fprintf fmt
"# This file has been generated by the Catala compiler, do not edit!\n\
@\n\
from .catala import *@\n\
from typing import Any, List, Callable, Tuple\n\
from enum import Enum\n\
@\n\
%a@\n\
@\n\
%a@?"
(format_ctx type_ordering) p.decl_ctx
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n@\n")
(fun fmt (name, { Ast.func_params; Ast.func_body }) ->
Format.fprintf fmt "@[<hov 4>def %a(%a):@\n%a@]" format_toplevel_name name
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
(fun fmt (var, typ) ->
Format.fprintf fmt "%a:%a" format_var (Pos.unmark var) format_typ typ))
func_params (format_block p.decl_ctx) func_body))
p.scopes

18
compiler/scalc/to_python.mli Normal file
View File

@ -0,0 +1,18 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2021 Inria, contributor: Denis Merigoux
<denis.merigoux@inria.fr>
Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except
in compliance with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software distributed under the License
is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express
or implied. See the License for the specific language governing permissions and limitations under
the License. *)
(** Formats a lambda calculus program into a valid Python program *)
val format_program : Format.formatter -> Ast.program -> Scopelang.Dependency.TVertex.t list -> unit
(** Usage [format_program fmt p type_dependencies_ordering] *)

2
compiler/utils/cli.ml
View File

@ -64,7 +64,7 @@ let backend =
& info [] ~docv:"BACKEND"
~doc:"Backend selection among: LaTeX, Makefile, Html, Interpret, OCaml, Dcalc, Scopelang")
type backend_option = Latex | Makefile | Html | Run | OCaml | Dcalc | Scopelang
type backend_option = Latex | Makefile | Html | Run | OCaml | Python | Dcalc | Scopelang
let language =
Arg.(

2
compiler/utils/cli.mli
View File

@ -49,7 +49,7 @@ val wrap_weaved_output : bool Cmdliner.Term.t
val backend : string Cmdliner.Term.t
type backend_option = Latex | Makefile | Html | Run | OCaml | Dcalc | Scopelang
type backend_option = Latex | Makefile | Html | Run | OCaml | Python | Dcalc | Scopelang
val language : string option Cmdliner.Term.t

7
examples/Makefile.common.mk
View File

@ -29,6 +29,13 @@ help : ../Makefile.common.mk
OCaml \
$<
#> <target_file>.py : Compiles the file to Python
%.py: %.catala_$(CATALA_LANG)
@$(CATALA) Makefile $<
$(CATALA) \
Python \
$<
#> <target_file>.tex : Weaves the file to LaTeX
%.tex: %.catala_$(CATALA_LANG)
@$(CATALA) Makefile $<

3
examples/allocations_familiales/.gitignore vendored
View File

@ -13,4 +13,5 @@ _minted*
*.pyg
*.d
*.new
*.ml
*.ml
*.py

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

@ -193,4 +193,27 @@ champ d'application Test9:
définition f.résidence égal à Guadeloupe
règle f.personne_charge_effective_permanente_est_parent rempli
assertion f.montant_versé = 0€
déclaration champ d'application Test10:
contexte f champ d'application InterfaceAllocationsFamiliales
champ d'application Test10:
définition f.enfants égal à [EnfantEntrée {
-- d_identifiant: 0
-- d_date_de_naissance: |2003-02-22|
-- d_rémuneration_mensuelle: 0€
-- d_prise_en_charge: EffectiveEtPermanente
-- d_a_déjà_ouvert_droit_aux_allocations_familiales: vrai
};EnfantEntrée {
-- d_identifiant: 1
-- d_date_de_naissance: |2013-09-30|
-- d_rémuneration_mensuelle: 300€
-- d_prise_en_charge: GardeAlternéePartageAllocations
-- d_a_déjà_ouvert_droit_aux_allocations_familiales: vrai
}]
définition f.ressources_ménage égal à 30000 €
définition f.date_courante égal à |2020-04-20|
définition f.résidence égal à Métropole
règle f.personne_charge_effective_permanente_est_parent rempli
assertion f.montant_versé = 99,37€
```

30
french_law/README.md Normal file
View File

@ -0,0 +1,30 @@
# French Law Libraries
This folder presents a working example of how Catala could be distributed and
deployed inside existing applications. Each sub-folder is specialized for
a particular programming language, and features a ready-to-use library of
all the French public algorithms coded up using Catala so far.
## General principles
Let us say you want to deploy a Catala program inside an application written
in programming language X. The Catala compiler will translate the source
Catala program into X, yielding a new `.x` source code file. This `.x` file
will export functions corresponding to the scopes of the original Catala
program. You can then reuse those exported functions in your application written
in X.
## OCaml
To see how to deploy Catala programs as an OCaml library, see
[the dedicated readme](ocaml/README.md).
## JS
To see how to deploy Catala programs as a JS library, see
[the dedicated readme](js/README.md).
## Python
To see how to deploy Catala programs as a Python library, see
[the dedicated readme](Python/README.md).

26
french_law/js/README.md
View File

@ -1,10 +1,26 @@
# The French Law Javascript Library
# Javascript French Law Library
This Javascript library contains some computations defined by French
legislative texts. The JS code is extracted from OCaml, which is itself
extracted from Catala code (https://catala-lang.org).
This folder contains a ready-to-use Javascript library featuring French public
algorithms coded up in Catala.
## Allocations familiales
## Generating the source files
The JS code is extracted from OCaml using
[`js_of_ocaml`](https://ocsigen.org/js_of_ocaml/). See the
[dedicated README](../ocaml/README.md) of the OCaml library for more precisions
about the OCaml code. The wrapping between OCaml and JS is done by the
`api_web.ml` module.
You can generate the `french_law.js` source JS module by invoking this command
from the root of the repository:
```
make build_french_law_library_js
```
## Available algorithms
### Allocations familiales
The function of the library is `computeAllocationsFamiliales`. This computation
returns the amount of _allocations familiales_ for one household described

50
french_law/ocaml/README.md Normal file
View File

@ -0,0 +1,50 @@
# OCaml French Law Library
This folder contains a ready-to-use OCaml library featuring French public
algorithms coded up in Catala.
## Organization
### Law source
The `law_source` folder contains the files generated by the Catala compiler.
These files are generated using the following rule from the top-level `Makefile`
of this repository:
```
make generate_french_law_library_ocaml
```
They can be compiled using
```
make build_french_law_library_ocaml
```
In particular, `law_source/unit_tests/run_tests.ml` provides an executable
that runs the unit tests coming from the source Catala examples, and that can
be launched with
```
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
manipulated by the Catala programs in OCaml and the operations available for them.
### Wrappers
Then, the `api.{ml, mli}` module provides a wrapper around the functions
exported in `law_source`. These wrappers mostly convert back and forth between
idiomatic OCaml types and the types expected by the Catala programs in OCaml.
`api.web.ml` is used for the JS library (see the [dedicated README](../js/README.md)).
Finally, `bench.ml` provides a simple benchmarking executable that runs the
computations of each algorithm a bunch of times with random inputs. You can run it
from the root of this repository with
```
make run_french_law_library_benchmark_ocaml
```

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

@ -21,4 +21,6 @@ let _ =
try_test "Allocations familiales #6" Tests_allocations_familiales.test6;
try_test "Allocations familiales #7" Tests_allocations_familiales.test7;
try_test "Allocations familiales #8" Tests_allocations_familiales.test8;
try_test "Allocations familiales #9" Tests_allocations_familiales.test9;
try_test "Allocations familiales #10" Tests_allocations_familiales.test10;
exit (if !failure then -1 else 0)

3
french_law/python/.gitignore vendored Normal file
View File

@ -0,0 +1,3 @@
env/
.mypy_cache/
**/__pycache__

13
french_law/python/Makefile Normal file
View File

@ -0,0 +1,13 @@
SOURCES=src/catala.py src/allocations_familiales.py main.py
dependencies:
pip install -r dependencies.txt
type:
mypy $(SOURCES)
format:
autopep8 --in-place $(SOURCES)
test:
python main.py

43
french_law/python/README.md Normal file
View File

@ -0,0 +1,43 @@
# Python French Law Library
This folder contains a ready-to-use Python library featuring French public
algorithms coded up in Catala.
The Python version expected to run the Python code is above 3.6. For the commands
noted below to run, you are expected to setup a virtual Python environment with
`virtualenv` by running the `setup_env.sh` script.
## Organization
### Law source
The `src/` folder contains the Python files generated by the Catala compiler.
To update them from the Catala sources, invoke this command from the root
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.
All theses Python files feature type annotations which can be checked against
using
```
make make type_french_law_library_python
```
### Wrappers
To use the algorithms in `src/`, you can take a look at the example provided in
`main.py`. It is very important to wrap all of the input parameters using
`src/catala.py` conversion functions.
You can benchmark the computation using
```
make run_french_law_library_benchmark_python
```

6
french_law/python/dependencies.txt Normal file
View File

@ -0,0 +1,6 @@
gmpy2
typing
mypy
python-dateutil
types-python-dateutil
autopep8

40
french_law/python/main.py Executable file
View File

@ -0,0 +1,40 @@
#!python3
from src.catala import date_of_numbers, Unit, integer_of_int, money_of_units_int, no_input, money_to_float
from src.allocations_familiales import interface_allocations_familiales, InterfaceAllocationsFamilialesIn, EnfantEntree, PriseEnCharge, PriseEnCharge_Code, Collectivite, Collectivite_Code
import timeit
def iteration():
out = interface_allocations_familiales(
InterfaceAllocationsFamilialesIn(
date_courante_in=lambda _: date_of_numbers(2020, 4, 20),
enfants_in=lambda _: [
EnfantEntree(d_identifiant=integer_of_int(0), d_remuneration_mensuelle=money_of_units_int(0),
d_date_de_naissance=date_of_numbers(2003, 2, 2),
d_prise_en_charge=PriseEnCharge(
PriseEnCharge_Code.EffectiveEtPermanente, Unit()),
d_a_deja_ouvert_droit_aux_allocations_familiales=True),
EnfantEntree(d_identifiant=integer_of_int(1), d_remuneration_mensuelle=money_of_units_int(300),
d_date_de_naissance=date_of_numbers(2013, 9, 30),
d_prise_en_charge=PriseEnCharge(
PriseEnCharge_Code.GardeAlterneePartageAllocations, Unit()),
d_a_deja_ouvert_droit_aux_allocations_familiales=True)
],
ressources_menage_in=lambda _: money_of_units_int(30000),
residence_in=lambda _: Collectivite(
Collectivite_Code.Metropole, Unit()),
personne_charge_effective_permanente_est_parent_in=lambda _: True,
personne_charge_effective_permanente_remplit_titre_I_in=lambda _: True,
enfants_a_charge_in=no_input(),
montant_verse_in=no_input()
))
money_given = money_to_float(out.montant_verse_out)
assert (money_given == 99.37)
iterations = 10000
if __name__ == '__main__':
print("Iterating {} iterations of the family benefits computation. Total time (s):".format(iterations))
print(timeit.timeit(iteration, number=iterations))

6
french_law/python/setup_env.sh Executable file
View File

@ -0,0 +1,6 @@
#! /usr/bin/env bash
cd "$(dirname "$0")"
virtualenv -p python3 env
source env/bin/activate
make dependencies

0
french_law/python/src/__init__.py Normal file
View File

3458
french_law/python/src/allocations_familiales.py Normal file
View File

File diff suppressed because it is too large Load Diff

526
french_law/python/src/catala.py Normal file
View File

@ -0,0 +1,526 @@
"""
.. module:: catala_runtime
:platform: Unix, Windows
:synopsis: The Python bindings for the functions used in the generated Catala code
:noindex:
.. moduleauthor:: Denis Merigoux <denis.merigoux@inria.fr>
"""
# This file should be in sync with compiler/runtime.{ml, mli} !
from gmpy2 import log2, mpz, mpq, mpfr, t_divmod # type: ignore
import datetime
import dateutil.relativedelta
from typing import NewType, List, Callable, Tuple, Optional, TypeVar, Iterable, Union
from functools import reduce
Alpha = TypeVar('Alpha')
Beta = TypeVar('Beta')
# ============
# Type classes
# ============
class Integer:
def __init__(self, value: Union[str, int]) -> None:
self.value = mpz(value)
def __add__(self, other: 'Integer') -> 'Integer':
return Integer(self.value + other.value)
def __sub__(self, other: 'Integer') -> 'Integer':
return Integer(self.value - other.value)
def __mul__(self, other: 'Integer') -> 'Integer':
return Integer(self.value * other.value)
def __truediv__(self, other: 'Integer') -> 'Integer':
return Integer(self.value // other.value)
def __neg__(self: 'Integer') -> 'Integer':
return Integer(- self.value)
def __lt__(self, other: 'Integer') -> bool:
return self.value < other.value
def __le__(self, other: 'Integer') -> bool:
return self.value <= other.value
def __gt__(self, other: 'Integer') -> bool:
return self.value > other.value
def __ge__(self, other: 'Integer') -> bool:
return self.value >= other.value
def __ne__(self, other: object) -> bool:
if isinstance(other, Integer):
return self.value != other.value
else:
return True
def __eq__(self, other: object) -> bool:
if isinstance(other, Integer):
return self.value == other.value
else:
return False
def __str__(self) -> str:
return self.value.__str__()
class Decimal:
def __init__(self, value: Union[str, int, float]) -> None:
self.value = mpq(value)
def __add__(self, other: 'Decimal') -> 'Decimal':
return Decimal(self.value + other.value)
def __sub__(self, other: 'Decimal') -> 'Decimal':
return Decimal(self.value - other.value)
def __mul__(self, other: 'Decimal') -> 'Decimal':
return Decimal(self.value * other.value)
def __truediv__(self, other: 'Decimal') -> 'Decimal':
return Decimal(self.value / other.value)
def __neg__(self: 'Decimal') -> 'Decimal':
return Decimal(- self.value)
def __lt__(self, other: 'Decimal') -> bool:
return self.value < other.value
def __le__(self, other: 'Decimal') -> bool:
return self.value <= other.value
def __gt__(self, other: 'Decimal') -> bool:
return self.value > other.value
def __ge__(self, other: 'Decimal') -> bool:
return self.value >= other.value
def __ne__(self, other: object) -> bool:
if isinstance(other, Decimal):
return self.value != other.value
else:
return True
def __eq__(self, other: object) -> bool:
if isinstance(other, Decimal):
return self.value == other.value
else:
return False
def __str__(self) -> str:
return self.value.__str__()
class Money:
def __init__(self, value: Integer) -> None:
self.value = value
def __add__(self, other: 'Money') -> 'Money':
return Money(self.value + other.value)
def __sub__(self, other: 'Money') -> 'Money':
return Money(self.value - other.value)
def __mul__(self, other: Decimal) -> 'Money':
cents = self.value.value
coeff = other.value
rat_result = self.value.value * other.value
out = Money(Integer(rat_result))
res, remainder = t_divmod(rat_result.numerator, rat_result.denominator)
if 2 * remainder >= rat_result.denominator:
return Money(Integer(res + 1))
else:
return Money(Integer(res))
def __truediv__(self, other: 'Money') -> Decimal:
return Decimal(mpq(self.value.value / other.value.value))
def __neg__(self: 'Money') -> 'Money':
return Money(- self.value)
def __lt__(self, other: 'Money') -> bool:
return self.value < other.value
def __le__(self, other: 'Money') -> bool:
return self.value <= other.value
def __gt__(self, other: 'Money') -> bool:
return self.value > other.value
def __ge__(self, other: 'Money') -> bool:
return self.value >= other.value
def __ne__(self, other: object) -> bool:
if isinstance(other, Money):
return self.value != other.value
else:
return True
def __eq__(self, other: object) -> bool:
if isinstance(other, Money):
return self.value == other.value
else:
return False
def __str__(self) -> str:
return "${:.2}".format(self.value.value / 100)
class Date:
def __init__(self, value: datetime.date) -> None:
self.value = value
def __add__(self, other: 'Duration') -> 'Date':
return Date(self.value + other.value)
def __sub__(self, other: 'Date') -> 'Duration':
return Duration(dateutil.relativedelta.relativedelta(self.value, other.value))
def __lt__(self, other: 'Date') -> bool:
return self.value < other.value
def __le__(self, other: 'Date') -> bool:
return self.value <= other.value
def __gt__(self, other: 'Date') -> bool:
return self.value > other.value
def __ge__(self, other: 'Date') -> bool:
return self.value >= other.value
def __ne__(self, other: object) -> bool:
if isinstance(other, Date):
return self.value != other.value
else:
return True
def __eq__(self, other: object) -> bool:
if isinstance(other, Date):
return self.value == other.value
else:
return False
class Duration:
def __init__(self, value: dateutil.relativedelta.relativedelta) -> None:
self.value = value
def __add__(self, other: 'Duration') -> 'Duration':
return Duration(self.value + other.value)
def __sub__(self, other: 'Duration') -> 'Duration':
return Duration(self.value - other.value)
def __neg__(self: 'Duration') -> 'Duration':
return Duration(- self.value)
def __lt__(self, other: 'Duration') -> bool:
x = self.value.normalized()
y = other.value.normalized()
if (x.years != 0 or y.years != 0 or x.months != 0 or y.months != 0):
raise Exception("Can only compare durations expressed in days")
else:
return x.days < y.days
def __le__(self, other: 'Duration') -> bool:
x = self.value.normalized()
y = other.value.normalized()
if (x.years != 0 or y.years != 0 or x.months != 0 or y.months != 0):
raise Exception("Can only compare durations expressed in days")
else:
return x.days <= y.days
def __gt__(self, other: 'Duration') -> bool:
x = self.value.normalized()
y = other.value.normalized()
if (x.years != 0 or y.years != 0 or x.months != 0 or y.months != 0):
raise Exception("Can only compare durations expressed in days")
else:
return x.days > y.days
def __ge__(self, other: 'Duration') -> bool:
x = self.value.normalized()
y = other.value.normalized()
if (x.years != 0 or y.years != 0 or x.months != 0 or y.months != 0):
raise Exception("Can only compare durations expressed in days")
else:
return x.days >= y.days
def __ne__(self, other: object) -> bool:
if isinstance(other, Duration):
return self.value != other.value
else:
return True
def __eq__(self, other: object) -> bool:
if isinstance(other, Duration):
return self.value == other.value
else:
return False
class Unit:
def __init__(self) -> None:
...
def __eq__(self, other: object) -> bool:
if isinstance(other, Unit):
return True
else:
return False
def __ne__(self, other: object) -> bool:
if isinstance(other, Unit):
return False
else:
return True
class SourcePosition:
def __init__(self,
filename: str,
start_line: int,
start_column: int,
end_line: int,
end_column: int,
law_headings: List[str]) -> None:
self.filename = filename
self.start_line = start_line
self.start_column = start_column
self.end_line = end_line
self.end_column = end_column
self.law_headings = law_headings
def __str__(self) -> str:
return "in file {}, from {}:{} to {}:{} ({})".format(
self.filename, self.start_line, self.start_column, self.end_line, self.end_column, ", ".join(self.law_headings))
# ==========
# Exceptions
# ==========
class EmptyError(Exception):
pass
class AssertionFailed(Exception):
pass
class ConflictError(Exception):
pass
class NoValueProvided(Exception):
def __init__(self, source_position: SourcePosition) -> None:
self.source_position = SourcePosition
# ============================
# Constructors and conversions
# ============================
# -----
# Money
# -----
def money_of_cents_string(v: str) -> Money:
return Money(Integer(v))
def money_of_units_int(v: int) -> Money:
return Money(Integer(v) * Integer(100))
def money_of_cents_integer(v: Integer) -> Money:
return Money(v)
def money_to_float(m: Money) -> float:
return float(mpfr(mpq(m.value.value, 100)))
def money_to_string(m: Money) -> str:
return str(money_to_float(m))
def money_to_cents(m: Money) -> Integer:
return m.value
# --------
# Decimals
# --------
def decimal_of_string(d: str) -> Decimal:
return Decimal(d)
def decimal_to_float(d: Decimal) -> float:
return float(mpfr(d.value))
def decimal_of_float(d: float) -> Decimal:
return Decimal(d)
def decimal_of_integer(d: Integer) -> Decimal:
return Decimal(d.value)
def decimal_to_string(precision: int, i: Decimal) -> str:
return "{1:.{0}}".format(precision, mpfr(i.value, precision * 10 // 2))
# --------
# Integers
# --------
def integer_of_string(s: str) -> Integer:
return Integer(s)
def integer_to_string(d: Integer) -> str:
return str(d.value)
def integer_of_int(d: int) -> Integer:
return Integer(d)
def integer_to_int(d: Integer) -> int:
return int(d.value)
def integer_exponentiation(i: Integer, e: int) -> Integer:
return i ** e # type: ignore
def integer_log2(i: Integer) -> int:
return int(log2(i.value))
# -----
# Dates
# -----
def day_of_month_of_date(d: Date) -> Integer:
return integer_of_int(d.value.day)
def month_number_of_date(d: Date) -> Integer:
return integer_of_int(d.value.month)
def year_of_date(d: Date) -> Integer:
return integer_of_int(d.value.year)
def date_to_string(d: Date) -> str:
return "{}".format(d.value)
def date_of_numbers(year: int, month: int, day: int) -> Date:
# The datetime.date does not take year=0 as an entry, we trick it into
# 1 in that case because year=0 cases don't care about the actual year
return Date(datetime.date(year if year != 0 else 1, month, day))
# ---------
# Durations
# ---------
def duration_of_numbers(years: int, months: int, days: int) -> Duration:
return Duration(dateutil.relativedelta.relativedelta(years=years, months=months, days=days))
def duration_to_years_months_days(d: Duration) -> Tuple[int, int, int]:
return (d.value.years, d.value.months, d.value.days) # type: ignore
def duration_to_string(s: Duration) -> str:
return "{}".format(s.value)
# -----
# Lists
# -----
def list_fold_left(f: Callable[[Alpha, Beta], Alpha], init: Alpha, l: List[Beta]) -> Alpha:
return reduce(f, l, init)
def list_filter(f: Callable[[Alpha], bool], l: List[Alpha]) -> List[Alpha]:
return [i for i in l if f(i)]
def list_map(f: Callable[[Alpha], Beta], l: List[Alpha]) -> List[Beta]:
return [f(i) for i in l]
def list_length(l: List[Alpha]) -> Integer:
return Integer(len(l))
# ========
# Defaults
# ========
def handle_default(
exceptions: List[Callable[[Unit], Alpha]],
just: Callable[[Unit], Alpha],
cons: Callable[[Unit], Alpha]
) -> Alpha:
acc: Optional[Alpha] = None
for exception in exceptions:
new_val: Optional[Alpha]
try:
new_val = exception(Unit())
except EmptyError:
new_val = None
if acc is None:
acc = new_val
elif not (acc is None) and new_val is None:
pass # acc stays the same
elif not (acc is None) and not (new_val is None):
raise ConflictError
if acc is None:
if just(Unit()):
return cons(Unit())
else:
raise EmptyError
else:
return acc
def no_input() -> Callable[[Unit], Alpha]:
def closure(_: Unit):
raise EmptyError
return closure
# =======
# Logging
# =======
def log_variable_definition(headings: List[str], value: Alpha) -> Alpha:
return value
def log_begin_call(headings: List[str], f: Callable[[Alpha], Beta], value: Alpha) -> Beta:
return f(value)
def log_end_call(headings: List[str], value: Alpha) -> Alpha:
return value
def log_decision_taken(pos: SourcePosition, value: bool) -> bool:
return value