CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-11-08 07:51:43 +03:00
Code Issues Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into allocations_logement

Browse Source
This commit is contained in:
Louis Gesbert 2022-05-12 15:22:17 +02:00
commit faa5b32638
18 changed files with 229 additions and 250 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
.git-blame-ignore-revs Normal file
View File

@ -0,0 +1,34 @@
# 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
3cdbfd03056434189fa2a63f5d93c8a2f0943771
257a304fb4276f538bef3a752f0e16d044009c7d
f25f8941beafd9be6b806d3965067a87234b544c
0161f313554c476d68d11ef8296e6076048d4ecd
7d81ac5e16b5162b477297e8663b4e7dcd36598b
9eec6a474cb3df064d8595f3b70b38d3d8332c3a
5b345b47828effa5a852cedc210dfb38add7d866
729fb7e55106fbb3e6d7a246c2eaa156a1f8d7cf
5bd66142a6b391185420fdd9815f5f06f7c64045
b9f46afcd7ba4bba504d12b3edf5f82e13ef5cad
b0829148c79d2114c1da7b3a0af4af1fc109d644
d776a10e5fedaf855e9ba8202f16e0842e631d32
9a718c6ced4cf47a612db074d5ebe80414306944
424b68a6a5b3df9ef717e2b5f5b8763031bc576f
f8dc1494f06a4bc82f5aa209b69991f400df537c
5c5bc77c875cf1febb10db25adfa7b342c686043
df4754b10b06cb1db4bdf18eb7b01d201f4f4fb2
a06dfbfaa51880de5d0e6d470a242d6ceb27c6b6
88eedbc0006c8936350754289ed867a6d7e29da4
536dde9834612094194e535f28976bfc31bf9ef9
fb281a0d99d66b06ca19e46c2a88ea9e8aa908cf
bba896c94909ad0f56ac9c7f9ef57f1b3cf4a516
b56299f3d37d8ff8e442a5aa0c440c3ceb06352f
1ef533126b6b3b6073714efcb8f62832f6f34fb1
71085ba3da9053c7cd9971c786d14d9245274f86
ece3525433e5e3c10c89cc67977cb1fc3c8635a3
e6c6ccbb0249f8df6148bd541c91343731cf87cc
f356712622d190059f8f3105e3b0c095c9d98a67
8005f14ad41daee5425dc345e2f34860f46a7f41
0dafd2c9f5c8020039b9771b0897ffd14a79414b

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

@ -21,6 +21,20 @@ jobs:
run: |
rm -rf french_law/python/env
./french_law/python/setup_env.sh
- name: Install dependencies
run: |
opam exec -- make dependencies
- name: Check promoted files
run: |
rm -f bad-promote
opam exec -- make check-promoted > promotion.out 2>&1 || touch bad-promote
- name: Make all
run: |
OCAMLRUNPARAM=b opam exec -- make dependencies all -B
OCAMLRUNPARAM=b opam exec -- make all
- name: Forward result from promotion check
run: |
if [ -e bad-promote ]; then
echo "[ERROR] Some promoted files were not up-to-date";
cat promotion.out;
exit 1
fi

12
CONTRIBUTING.md
View File

@ -89,9 +89,6 @@ You can look at the
[online OCaml documentation](https://catala-lang.org/ocaml_docs/) for the
different modules' interfaces as well as high-level architecture documentation.
Please note that the `ocamlformat` version this project uses is `0.20.1`.
Using another version may cause spurious diffs to appear in your pull requests.
### Example: adding a builtin function
The language provides a limited number of builtin functions, which are sometimes
@ -160,3 +157,12 @@ To add support for a new language:
Feel free to open a pull request for discussion even if you couldn't go through
all these steps, the `lexer_xx.cppo.ml` file is the important part.
### Automatic formatting
Please ensure to submit commits formatted using the included `ocamlformat`
configuration. The `make build` target should ensure that.
In case the formatting rules or ocamlformat version changed remotely, you can
use [this script](https://gist.github.com/AltGr/2891a61f721c8fd85b1da71e10c691b6) to
reformat your branch patch by patch before rebasing.

36
Makefile
View File

@ -16,10 +16,10 @@ K := $(foreach exec,$(EXECUTABLES),\
Please install this executable for everything to work smoothly)))
dependencies-ocaml:
opam install . --deps-only --with-doc --with-test --yes
opam install . ./doc/catala-dev-dependencies.opam --deps-only --with-doc --with-test --yes
dependencies-ocaml-with-z3:
opam install . z3 --deps-only --with-doc --with-test --yes
opam install . ./doc/catala-dev-dependencies.opam z3 --deps-only --with-doc --with-test --yes
dependencies-js:
$(MAKE) -C $(FRENCH_LAW_JS_LIB_DIR) dependencies
@ -40,21 +40,13 @@ dependencies-with-z3: dependencies-ocaml-with-z3 dependencies-js init-submodules
COMPILER_DIR=compiler
BUILD_SYSTEM_DIR=build_system
format:
dune build @fmt --auto-promote 2> /dev/null | true
#> build_dev : Builds the Catala compiler, without formatting code
build_dev:
dune build @update-parser-messages --auto-promote | true
dune build $(COMPILER_DIR)/catala.exe
dune build $(BUILD_SYSTEM_DIR)/clerk.exe
build_dev: parser-messages
dune build $(COMPILER_DIR)/catala.exe $(BUILD_SYSTEM_DIR)/clerk.exe
#> build : Builds the Catala compiler
build:
dune build @update-parser-messages --auto-promote | true
@$(MAKE) --no-print-directory format
dune build $(COMPILER_DIR)/catala.exe
dune build $(BUILD_SYSTEM_DIR)/clerk.exe
build: parser-messages format
dune build $(COMPILER_DIR)/catala.exe $(BUILD_SYSTEM_DIR)/clerk.exe
#> js_build : Builds the Web-compatible JS versions of the Catala compiler
js_build:
@ -69,6 +61,20 @@ doc:
install:
dune build @install
##########################################
# Rules related to promoted files
##########################################
check-promoted:
dune build @update-parser-messages @fmt
compiler/surface/parser.messages: compiler/surface/tokens.mly compiler/surface/parser.mly
dune build @update-parser-messages --auto-promote || true
parser-messages: compiler/surface/parser.messages
format:
dune build @fmt --auto-promote >/dev/null || true
##########################################
# Syntax highlighting rules
##########################################
@ -334,4 +340,4 @@ help_catala:
##########################################
.PHONY: inspect clean all literate_examples english allocations_familiales pygments \
install build_dev build doc format dependencies dependencies-ocaml \
catala.html help
catala.html help parser-messages

9
build_system/clerk_driver.ml
View File

@ -134,8 +134,8 @@ let info =
"Please file bug reports at https://github.com/CatalaLang/catala/issues";
]
in
let exits = Term.default_exits @ [Term.exit_info ~doc:"on error." 1] in
Term.info "clerk" ~version ~doc ~exits ~man
let exits = Cmd.Exit.defaults @ [Cmd.Exit.info ~doc:"on error." 1] in
Cmd.info "clerk" ~version ~doc ~exits ~man
(**{1 Testing}*)
@ -795,7 +795,4 @@ let driver
Cli.error_print "The command \"%s\" is unknown to clerk." command;
1
let main () =
match Cmdliner.Term.eval (clerk_t driver, info) with
| `Ok 0 -> Cmdliner.Term.exit (`Ok 0)
| _ -> Cmdliner.Term.exit (`Error `Term)
let main () = exit (Cmdliner.Cmd.eval' (Cmdliner.Cmd.v info (clerk_t driver)))

133
build_system/ninja_utils.mli
View File

@ -1,29 +1,32 @@
(* This file is part of the Catala build system, a specification language for tax and social
benefits computation rules. Copyright (C) 2020 Inria, contributor: Emile Rolley
<emile.rolley@tuta.io>
(* This file is part of the Catala build system, a specification language for
tax and social benefits computation rules. Copyright (C) 2020 Inria,
contributor: Emile Rolley <emile.rolley@tuta.io>
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
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
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
License for the specific language governing permissions and limitations under
the License. *)
(** This library contains the implementations of utility functions used to generate {{:
https://ninja-build.org}Ninja} build files in OCaml with almost no dependencies -- it only
depends on {{: https://v3.ocaml.org/p/re/1.10.3/doc/Re/index.html}Re}. It's currently developed
to be used by {{: {https://github.com/CatalaLang/catala/tree/master/build_system}Clerk}, the {{:
https://catala-lang.org}Catala} build system. Therefore, the library {b supports only very basic
features} required by Clerk. *)
(** {2 What (** This library contains the implementations of utility functions
used to generate {{:https://ninja-build.org} Ninja} build files in OCaml
with almost no dependencies -- it only depends on
{{:https://v3.ocaml.org/p/re/1.10.3/doc/Re/index.html} Re}. It's currently
developed to be used by
{{:https://github.com/CatalaLang/catala/tree/master/build_system} Clerk},
the {{:https://catala-lang.org} Catala} build system. Therefore, the library
{b supports only very basic features} required by Clerk. *) is Ninja?} *)
(** {2 What is Ninja?} *)
(** {{:https://ninja-build.org} Ninja} is a low-level build system. It's designed to have its input
files ({i build.ninja}) generated by a higher-level build system, and to run builds as fast as
possible by supporting native cross-platform (Windows and Unix) parallel builds.
(** {{:https://ninja-build.org} Ninja} is a low-level build system. It's
designed to have its input files ({i build.ninja}) generated by a
higher-level build system, and to run builds as fast as possible by
supporting native cross-platform (Windows and Unix) parallel builds.
See the {{:https://ninja-build.org/manual.html} manual} for more details. *)
@ -31,24 +34,25 @@
(** Helper module to build ninja expressions. *)
module Expr : sig
(** Represents a ninja expression. Which could be either a literal, a {{:
https://ninja-build.org/manual.html#_variables}variable references} ($_) or
a sequence of sub-expressions.
(** Represents a ninja expression. Which could be either a literal, a
{{:https://ninja-build.org/manual.html#_variables} variable references}
($_) or a sequence of sub-expressions.
{b Note:} for now, there are no visible differences between an [Expr.Seq]
and a list of {!type: Expr.t}, indeed, in both cases, one space is added
between each expression -- resp. sub-expression. The difference only comes from the semantic:
an [Expr.Seq] is {b a unique} Ninja expression. *)
{b Note:} for now, there are no visible differences between an [Expr.Seq]
and a list of {!type: Expr.t}, indeed, in both cases, one space is added
between each expression -- resp. sub-expression. The difference only comes
from the semantic: an [Expr.Seq] is {b a unique} Ninja expression. *)
type t =
| Lit of string
(* Literal string. *)
| Var of string
(* Variable reference. *)
| Seq of t list
(* Sequence of sub-expressions. *)
(* Sequence of sub-expressions. *)
val format : Format.formatter -> t -> unit
(** [format fmt exp] outputs in [fmt] the string representation of the ninja expression [exp]. *)
(** [format fmt exp] outputs in [fmt] the string representation of the ninja
expression [exp]. *)
val format_list : Format.formatter -> t list -> unit
(** [format fmt ls] outputs in [fmt] the string representation of a list [ls]
@ -57,30 +61,31 @@ end
(** {1 Ninja rules} *)
(** Helper module to build {{:https://ninja-build.org/manual.html#_rules}ninja rules}. *)
(** Helper module to build {{:https://ninja-build.org/manual.html#_rules} ninja
rules}. *)
module Rule : sig
type t = {
name : string;
command : Expr.t;
description : Expr.t option;
}
type t = { name : string; command : Expr.t; description : Expr.t option }
(** Represents the minimal ninja rule representation for Clerk:
{[
rule <name>
command = <command>
[description = <description>]
rule <name>
command = <command>
[description = <description>]
]} *)
val make : string -> command:Expr.t -> description:Expr.t -> t
(** [make name ~command ~description] returns the corresponding ninja {!type: Rule.t}. *)
(** [make name ~command ~description] returns the corresponding ninja {!type:
Rule.t}. *)
val format : Format.formatter -> t -> unit
(** [format fmt rule] outputs in [fmt] the string representation of the ninja [rule]. *)
(** [format fmt rule] outputs in [fmt] the string representation of the ninja
[rule]. *)
end
(** {1 Ninja builds} *)
(** Helper module to build ninja {{: https://ninja-build.org/manual.html#_build_statements}build statements}. *)
(** Helper module to build ninja
{{:https://ninja-build.org/manual.html#_build_statements} build statements}. *)
module Build : sig
type t = {
outputs : Expr.t list;
@ -89,49 +94,63 @@ module Build : sig
vars : (string * Expr.t) list;
}
(** Represents the minimal ninja build statement representation for Clerk:
{[
build <outputs>: <rule> [<inputs>]
[<vars>]
build <outputs>: <rule> [<inputs>]
[<vars>]
]}*)
val make : outputs:Expr.t list -> rule:string -> t
(** [make ~outputs ~rule] returns the corresponding ninja {!type: Build.t} with no {!field: inputs}
or {!field: vars}. *)
(** [make ~outputs ~rule] returns the corresponding ninja {!type: Build.t}
with no {!field: inputs} or {!field: vars}. *)
val make_with_vars : outputs:Expr.t list -> rule:string -> vars:(string * Expr.t) list -> t
(** [make_with_vars ~outputs ~rule ~vars] returns the corresponding ninja {!type: Build.t} with no {!field: inputs}. *)
val make_with_vars :
outputs:Expr.t list -> rule:string -> vars:(string * Expr.t) list -> t
(** [make_with_vars ~outputs ~rule ~vars] returns the corresponding ninja
{!type: Build.t} with no {!field: inputs}. *)
val make_with_inputs : outputs:Expr.t list -> rule:string -> inputs:Expr.t list -> t
(** [make_with_vars ~outputs ~rule ~inputs] returns the corresponding ninja {!type: Build.t} with no {!field: vars}. *)
val make_with_inputs :
outputs:Expr.t list -> rule:string -> inputs:Expr.t list -> t
(** [make_with_vars ~outputs ~rule ~inputs] returns the corresponding ninja
{!type: Build.t} with no {!field: vars}. *)
val make_with_vars_and_inputs :
outputs:Expr.t list -> rule:string -> inputs:Expr.t list -> vars:(string * Expr.t) list -> t
(** [make_with_vars ~outputs ~rule ~inputs ~vars] returns the corresponding ninja {!type: Build.t}. *)
outputs:Expr.t list ->
rule:string ->
inputs:Expr.t list ->
vars:(string * Expr.t) list ->
t
(** [make_with_vars ~outputs ~rule ~inputs ~vars] returns the corresponding
ninja {!type: Build.t}. *)
val empty : t
(** [empty] is the minimal ninja {!type: Build.t} with ["empty"] as {!field: outputs} and ["phony"] as {!field: rule}. *)
(** [empty] is the minimal ninja {!type: Build.t} with ["empty"] as {!field:
outputs} and ["phony"] as {!field: rule}. *)
val unpath : ?sep:string -> string -> string
(** [unpath ~sep path] replaces all [/] occurences with [sep] in [path] to avoid ninja writing the
corresponding file and use it as sub command. By default, [sep] is set to ["-"]. *)
(** [unpath ~sep path] replaces all [/] occurences with [sep] in [path] to
avoid ninja writing the corresponding file and use it as sub command. By
default, [sep] is set to ["-"]. *)
val format : Format.formatter -> t -> unit
(** [format fmt build] outputs in [fmt] the string representation of the ninja [build]. *)
(** [format fmt build] outputs in [fmt] the string representation of the ninja
[build]. *)
end
(** {1 Maps} *)
module RuleMap : Map.S with type key = String.t
module BuildMap : Map.S with type key = String.t
(** {1 Ninja} *)
type ninja = { rules : Rule.t RuleMap.t; builds : Build.t BuildMap.t }
(** Represents the minimal ninja architecture (list of rule and build statements) needed for clerk. *)
(** Represents the minimal ninja architecture (list of rule and build
statements) needed for clerk. *)
val empty : ninja
(** [empty] returns the empty empty ninja structure. *)
val format : Format.formatter -> ninja -> unit
(** [format fmt build] outputs in [fmt] the string representation of all [ninja.rules] and [ninja.builds]. *)
(** [format fmt build] outputs in [fmt] the string representation of all
[ninja.rules] and [ninja.builds]. *)

3
catala.opam
View File

@ -1,4 +1,3 @@
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
version: "0.6.0"
synopsis:
@ -26,7 +25,7 @@ depends: [
"menhirLib" {>= "20200211"}
"unionFind" {>= "20200320"}
"bindlib" {>= "5.0.1"}
"cmdliner" {= "1.0.4"}
"cmdliner" {>= "1.1.0"}
"re" {>= "1.9.0"}
"zarith" {>= "1.12"}
"zarith_stubs_js" {>= "v0.14.1"}

4
clerk.opam
View File

@ -1,4 +1,3 @@
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
version: "0.6.0"
synopsis:
@ -13,7 +12,7 @@ bug-reports: "https://github.com/CatalaLang/catala/issues"
depends: [
"dune" {>= "2.8"}
"ocaml" {>= "4.11.0"}
"cmdliner" {= "1.0.4"}
"cmdliner" {>= "1.1.0"}
"re" {>= "1.9.0"}
"ANSITerminal" {>= "0.8.2"}
"alcotest" {with-test & >= "1.5.0"}
@ -36,3 +35,4 @@ build: [
]
]
dev-repo: "git+https://github.com/CatalaLang/catala.git"
depexts: ["ninja-build"] {os-family = "debian"}

7
compiler/driver.ml
View File

@ -407,8 +407,7 @@ let driver source_file (options : Cli.options) : int =
let main () =
let return_code =
Cmdliner.Term.eval (Cli.catala_t (fun f -> driver (FileName f)), Cli.info)
Cmdliner.Cmd.eval'
(Cmdliner.Cmd.v Cli.info (Cli.catala_t (fun f -> driver (FileName f))))
in
match return_code with
| `Ok 0 -> Cmdliner.Term.exit (`Ok 0)
| _ -> Cmdliner.Term.exit (`Error `Term)
exit return_code

82
compiler/lcalc/ast.ml
View File

@ -53,15 +53,13 @@ type expr =
type program = { decl_ctx : Dcalc.Ast.decl_ctx; scopes : expr Dcalc.Ast.scopes }
let evar (v : expr Bindlib.var) (pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box_apply (fun v' -> (v', pos)) (Bindlib.box_var v)
Bindlib.box_apply (fun v' -> v', pos) (Bindlib.box_var v)
let etuple
(args : expr Pos.marked Bindlib.box list)
(s : Dcalc.Ast.StructName.t option)
(pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box_apply
(fun args -> (ETuple (args, s), pos))
(Bindlib.box_list args)
Bindlib.box_apply (fun args -> ETuple (args, s), pos) (Bindlib.box_list args)
let etupleaccess
(e1 : expr Pos.marked Bindlib.box)
@ -69,7 +67,7 @@ let etupleaccess
(s : Dcalc.Ast.StructName.t option)
(typs : Dcalc.Ast.typ Pos.marked list)
(pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box_apply (fun e1 -> (ETupleAccess (e1, i, s, typs), pos)) e1
Bindlib.box_apply (fun e1 -> ETupleAccess (e1, i, s, typs), pos) e1
let einj
(e1 : expr Pos.marked Bindlib.box)
@ -77,7 +75,7 @@ let einj
(e_name : Dcalc.Ast.EnumName.t)
(typs : Dcalc.Ast.typ Pos.marked list)
(pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box_apply (fun e1 -> (EInj (e1, i, e_name, typs), pos)) e1
Bindlib.box_apply (fun e1 -> EInj (e1, i, e_name, typs), pos) e1
let ematch
(arg : expr Pos.marked Bindlib.box)
@ -85,12 +83,12 @@ let ematch
(e_name : Dcalc.Ast.EnumName.t)
(pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box_apply2
(fun arg arms -> (EMatch (arg, arms, e_name), pos))
(fun arg arms -> EMatch (arg, arms, e_name), pos)
arg (Bindlib.box_list arms)
let earray (args : expr Pos.marked Bindlib.box list) (pos : Pos.t) :
expr Pos.marked Bindlib.box =
Bindlib.box_apply (fun args -> (EArray args, pos)) (Bindlib.box_list args)
Bindlib.box_apply (fun args -> EArray args, pos) (Bindlib.box_list args)
let elit (l : lit) (pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box (ELit l, pos)
@ -101,7 +99,7 @@ let eabs
(typs : Dcalc.Ast.typ Pos.marked list)
(pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box_apply
(fun binder -> (EAbs ((binder, pos_binder), typs), pos))
(fun binder -> EAbs ((binder, pos_binder), typs), pos)
binder
let eapp
@ -109,12 +107,12 @@ let eapp
(args : expr Pos.marked Bindlib.box list)
(pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box_apply2
(fun e1 args -> (EApp (e1, args), pos))
(fun e1 args -> EApp (e1, args), pos)
e1 (Bindlib.box_list args)
let eassert (e1 : expr Pos.marked Bindlib.box) (pos : Pos.t) :
expr Pos.marked Bindlib.box =
Bindlib.box_apply (fun e1 -> (EAssert e1, pos)) e1
Bindlib.box_apply (fun e1 -> EAssert e1, pos) e1
let eop (op : Dcalc.Ast.operator) (pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box (EOp op, pos)
@ -127,14 +125,14 @@ let ecatch
(exn : except)
(e2 : expr Pos.marked Bindlib.box)
(pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box_apply2 (fun e1 e2 -> (ECatch (e1, exn, e2), pos)) e1 e2
Bindlib.box_apply2 (fun e1 e2 -> ECatch (e1, exn, e2), pos) e1 e2
let eifthenelse
(e1 : expr Pos.marked Bindlib.box)
(e2 : expr Pos.marked Bindlib.box)
(e3 : expr Pos.marked Bindlib.box)
(pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box_apply3 (fun e1 e2 e3 -> (EIfThenElse (e1, e2, e3), pos)) e1 e2 e3
Bindlib.box_apply3 (fun e1 e2 e3 -> EIfThenElse (e1, e2, e3), pos) e1 e2 e3
module Var = struct
type t = expr Bindlib.var
@ -159,27 +157,27 @@ let map_expr
match Pos.unmark e with
| EVar (v, _pos) -> evar v (Pos.get_position e)
| EApp (e1, args) ->
eapp (f ctx e1) (List.map (f ctx) args) (Pos.get_position e)
eapp (f ctx e1) (List.map (f ctx) args) (Pos.get_position e)
| EAbs ((binder, binder_pos), typs) ->
eabs
(Bindlib.box_mbinder (f ctx) binder)
binder_pos typs (Pos.get_position e)
eabs
(Bindlib.box_mbinder (f ctx) binder)
binder_pos typs (Pos.get_position e)
| ETuple (args, s) -> etuple (List.map (f ctx) args) s (Pos.get_position e)
| ETupleAccess (e1, n, s_name, typs) ->
etupleaccess ((f ctx) e1) n s_name typs (Pos.get_position e)
etupleaccess ((f ctx) e1) n s_name typs (Pos.get_position e)
| EInj (e1, i, e_name, typs) ->
einj ((f ctx) e1) i e_name typs (Pos.get_position e)
einj ((f ctx) e1) i e_name typs (Pos.get_position e)
| EMatch (arg, arms, e_name) ->
ematch ((f ctx) arg) (List.map (f ctx) arms) e_name (Pos.get_position e)
ematch ((f ctx) arg) (List.map (f ctx) arms) e_name (Pos.get_position e)
| EArray args -> earray (List.map (f ctx) args) (Pos.get_position e)
| ELit l -> elit l (Pos.get_position e)
| EAssert e1 -> eassert ((f ctx) e1) (Pos.get_position e)
| EOp op -> Bindlib.box (EOp op, Pos.get_position e)
| ERaise exn -> eraise exn (Pos.get_position e)
| EIfThenElse (e1, e2, e3) ->
eifthenelse ((f ctx) e1) ((f ctx) e2) ((f ctx) e3) (Pos.get_position e)
eifthenelse ((f ctx) e1) ((f ctx) e2) ((f ctx) e3) (Pos.get_position e)
| ECatch (e1, exn, e2) ->
ecatch (f ctx e1) exn (f ctx e2) (Pos.get_position e)
ecatch (f ctx e1) exn (f ctx e2) (Pos.get_position e)
(** See [Bindlib.box_term] documentation for why we are doing that. *)
let box_expr (e : expr Pos.marked) : expr Pos.marked Bindlib.box =
@ -187,7 +185,7 @@ let box_expr (e : expr Pos.marked) : expr Pos.marked Bindlib.box =
id_t () e
let make_var ((x, pos) : Var.t Pos.marked) : expr Pos.marked Bindlib.box =
Bindlib.box_apply (fun x -> (x, pos)) (Bindlib.box_var x)
Bindlib.box_apply (fun x -> x, pos) (Bindlib.box_var x)
let make_abs
(xs : vars)
@ -196,14 +194,14 @@ let make_abs
(taus : D.typ Pos.marked list)
(pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box_apply
(fun b -> (EAbs ((b, pos_binder), taus), pos))
(fun b -> EAbs ((b, pos_binder), taus), pos)
(Bindlib.bind_mvar xs e)
let make_app
(e : expr Pos.marked Bindlib.box)
(u : expr Pos.marked Bindlib.box list)
(pos : Pos.t) : expr Pos.marked Bindlib.box =
Bindlib.box_apply2 (fun e u -> (EApp (e, u), pos)) e (Bindlib.box_list u)
Bindlib.box_apply2 (fun e u -> EApp (e, u), pos) e (Bindlib.box_list u)
let make_let_in
(x : Var.t)
@ -211,7 +209,7 @@ let make_let_in
(e1 : expr Pos.marked Bindlib.box)
(e2 : expr Pos.marked Bindlib.box)
(pos : Pos.t) : expr Pos.marked Bindlib.box =
make_app (make_abs (Array.of_list [ x ]) e2 pos [ tau ] pos) [ e1 ] pos
make_app (make_abs (Array.of_list [x]) e2 pos [tau] pos) [e1] pos
let make_multiple_let_in
(xs : Var.t array)
@ -232,26 +230,21 @@ let some_constr : D.EnumConstructor.t =
D.EnumConstructor.fresh ("ESome", Pos.no_pos)
let option_enum_config : (D.EnumConstructor.t * D.typ Pos.marked) list =
[
(none_constr, (D.TLit D.TUnit, Pos.no_pos));
(some_constr, (D.TAny, Pos.no_pos));
]
[none_constr, (D.TLit D.TUnit, Pos.no_pos); some_constr, (D.TAny, Pos.no_pos)]
let make_none (pos : Pos.t) : expr Pos.marked Bindlib.box =
let mark : 'a -> 'a Pos.marked = Pos.mark pos in
Bindlib.box @@ mark
@@ EInj
( mark @@ ELit LUnit,
0,
option_enum,
[ (D.TLit D.TUnit, pos); (D.TAny, pos) ] )
(mark @@ ELit LUnit, 0, option_enum, [D.TLit D.TUnit, pos; D.TAny, pos])
let make_some (e : expr Pos.marked Bindlib.box) : expr Pos.marked Bindlib.box =
let pos = Pos.get_position @@ Bindlib.unbox e in
let mark : 'a -> 'a Pos.marked = Pos.mark pos in
let+ e = e [@ocamlformat "disable"] in
mark @@ EInj (e, 1, option_enum, [ (D.TLit D.TUnit, pos); (D.TAny, pos) ])
begin[@ocamlformat "disable"]
let+ e = e in
mark @@ EInj (e, 1, option_enum, [ (D.TLit D.TUnit, pos); (D.TAny, pos) ])
end
(** [make_matchopt_with_abs_arms arg e_none e_some] build an expression
[match arg with |None -> e_none | Some -> e_some] and requires e_some and
@ -262,11 +255,12 @@ let make_matchopt_with_abs_arms
(e_some : expr Pos.marked Bindlib.box) : expr Pos.marked Bindlib.box =
let pos = Pos.get_position @@ Bindlib.unbox arg in
let mark : 'a -> 'a Pos.marked = Pos.mark pos in
let+ arg = arg
and+ e_none = e_none
and+ e_some = e_some [@ocamlformat "disable"] in
mark @@ EMatch (arg, [ e_none; e_some ], option_enum)
begin[@ocamlformat "disable"]
let+ arg = arg
and+ e_none = e_none
and+ e_some = e_some in
mark @@ EMatch (arg, [ e_none; e_some ], option_enum)
end
(** [make_matchopt pos v tau arg e_none e_some] builds an expression
[match arg with | None () -> e_none | Some v -> e_some]. It binds v to
@ -282,8 +276,8 @@ let make_matchopt
let x = Var.make ("_", pos) in
make_matchopt_with_abs_arms arg
(make_abs (Array.of_list [ x ]) e_none pos [ (D.TLit D.TUnit, pos) ] pos)
(make_abs (Array.of_list [ v ]) e_some pos [ tau ] pos)
(make_abs (Array.of_list [x]) e_none pos [D.TLit D.TUnit, pos] pos)
(make_abs (Array.of_list [v]) e_some pos [tau] pos)
let handle_default = Var.make ("handle_default", Pos.no_pos)
let handle_default_opt = Var.make ("handle_default_opt", Pos.no_pos)

3
compiler/lcalc/print.ml
View File

@ -29,7 +29,8 @@ let begins_with_uppercase (s : string) : bool =
let first_letter = CamomileLibraryDefault.Camomile.UTF8.get s 0 in
is_uppercase first_letter
(** @note: (EmileRolley) seems to be factorizable with Dcalc.Print.format_lit. *)
(** {b Note:} (EmileRolley) seems to be factorizable with
Dcalc.Print.format_lit. *)
let format_lit (fmt : Format.formatter) (l : lit Pos.marked) : unit =
match Pos.unmark l with
| LBool b -> Dcalc.Print.format_lit_style fmt (string_of_bool b)

1
compiler/surface/.ocamlformat-ignore Normal file
View File

@ -0,0 +1 @@
*.cppo.ml

4
compiler/utils/cli.ml
View File

@ -314,8 +314,8 @@ let info =
"Please file bug reports at https://github.com/CatalaLang/catala/issues";
]
in
let exits = Term.default_exits @ [Term.exit_info ~doc:"on error." 1] in
Term.info "catala" ~version ~doc ~exits ~man
let exits = Cmd.Exit.defaults @ [Cmd.Exit.info ~doc:"on error." 1] in
Cmd.info "catala" ~version ~doc ~exits ~man
(**{1 Terminal formatting}*)

2
compiler/utils/cli.mli
View File

@ -101,7 +101,7 @@ val catala_t : (string -> options -> 'a) -> 'a Cmdliner.Term.t
val set_option_globals : options -> unit
val version : string
val info : Cmdliner.Term.info
val info : Cmdliner.Cmd.info
(**{1 Terminal formatting}*)

20
doc/catala-dev-dependencies.opam Normal file
View File

@ -0,0 +1,20 @@
opam-version: "2.0"
version: "0.6.0"
synopsis: "Virtual package listing the requirements for a complete Catala dev environment"
maintainer: ["contact@catala-lang.org"]
authors: [
"Denis Merigoux"
"Nicolas Chataing"
"Emile Rolley"
"Louis Gesbert"
"Aymeric Fromherz"
"Alain Delaët-Tixeuil"
]
license: "Apache-2.0"
homepage: "https://github.com/CatalaLang/catala"
bug-reports: "https://github.com/CatalaLang/catala/issues"
depends: [
"ocamlformat" {= "0.21.0"}
"obelisk"
"conf-npm"
]

111
dune-project
View File

@ -4,7 +4,7 @@
(version 0.6.0)
(generate_opam_files true)
(generate_opam_files false)
(formatting)
@ -27,113 +27,4 @@
(license Apache-2.0)
(package
(name catala)
(synopsis
"Compiler and library for the literate programming language for tax code specification")
(description
"Catala is a domain-specific language for deriving faithful-by-construction algorithms from legislative texts. See https://catala-lang.org for more information")
(depends
(ocaml
(>= 4.11.0))
(ANSITerminal
(>= 0.8.2))
(sedlex
(>= 2.4))
(menhir
(>= 20200211))
(menhirLib
(>= 20200211))
(unionFind
(>= 20200320))
(bindlib
(>= 5.0.1))
(cmdliner
(= 1.0.4))
(re
(>= 1.9.0))
(zarith
(>= 1.12))
(zarith_stubs_js
(>= v0.14.1))
(ocamlgraph
(>= 1.8.8))
(calendar
(>= 2.04))
(visitors
(>= 20200210))
(benchmark
(>= 1.6))
(js_of_ocaml-ppx
(>= 3.8.0))
(camomile
(>= 1.0.2))
(cppo
(>= 1))
(obelisk :dev)
(alcotest
(and
:with-test
(>= 1.5.0)))
(ocamlformat
(and
:dev
(= 0.20.1))))
(depopts
z3)
(conflicts
(z3 (< 4.8.11))))
(package
(name french_law)
(authors "Denis Merigoux")
(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")
(depends
(ocaml
(>= 4.11.0))
(catala
(= :version))
(conf-npm :dev)))
(package
(name clerk)
(authors "Emile Rolley" "Denis Merigoux")
(synopsis
"Build system for Catala, a specification language for tax and social benefits computation rules")
(description
"Clerk is a build system for Catala, a specification language for tax and social benefits computation rules, see https://catala-lang.org")
(depends
(ocaml
(>= 4.11.0))
(cmdliner
(= 1.0.4))
(re
(>= 1.9.0))
(ANSITerminal
(>= 0.8.2))
(alcotest
(and
:with-test
(>= 1.5.0)))
(catala
(= :version))
(ninja_utils
(= :version))))
(package
(name ninja_utils)
(authors "Emile Rolley")
(synopsis
"A collection of utility functions used to generate Ninja build files")
(description
"This library contains the implementations of utility functions used to generate Ninja build files -- see https://ninja-build.org. It's currently used by the Catala build system (see https://github.com/CatalaLang/catala/tree/master/build_system)")
(depends
(ocaml
(>= 4.11.0))
(re
(>= 1.10.3))))
(using menhir 2.1)

1
french_law.opam
View File

@ -1,4 +1,3 @@
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
version: "0.6.0"
synopsis: "A collection of algorithms and computations defined by French law"

1
ninja_utils.opam
View File

@ -1,4 +1,3 @@
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
version: "0.6.0"
synopsis: