2020-06-22 17:16:55 +03:00
|
|
|
(* This file is part of the Catala compiler, a specification language for tax
|
|
|
|
and social benefits computation rules. Copyright (C) 2020 Inria, contributor:
|
|
|
|
Nicolas Chataing <nicolas.chataing@ens.fr>
|
|
|
|
|
|
|
|
Licensed under the Apache License, Version 2.0 (the "License"); you may not
|
|
|
|
use this file except in compliance with the License. You may obtain a copy of
|
|
|
|
the License at
|
|
|
|
|
|
|
|
http://www.apache.org/licenses/LICENSE-2.0
|
|
|
|
|
|
|
|
Unless required by applicable law or agreed to in writing, software
|
|
|
|
distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
|
|
|
|
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
|
|
|
|
License for the specific language governing permissions and limitations under
|
|
|
|
the License. *)
|
|
|
|
|
2020-12-14 19:00:42 +03:00
|
|
|
(** Abstract syntax tree of the desugared representation *)
|
|
|
|
|
2022-11-21 12:46:17 +03:00
|
|
|
open Catala_utils
|
2022-08-12 23:42:39 +03:00
|
|
|
open Shared_ast
|
2020-11-23 14:20:38 +03:00
|
|
|
|
2020-12-14 19:00:42 +03:00
|
|
|
(** {1 Names, Maps and Keys} *)
|
|
|
|
|
2020-11-23 14:20:38 +03:00
|
|
|
(** Inside a scope, a definition can refer either to a scope def, or a subscope
|
|
|
|
def *)
|
|
|
|
module ScopeDef = struct
|
|
|
|
type t =
|
2022-02-28 19:19:06 +03:00
|
|
|
| Var of ScopeVar.t * StateName.t option
|
2022-09-20 15:04:07 +03:00
|
|
|
| SubScopeVar of SubScopeName.t * ScopeVar.t * Pos.t
|
2022-02-28 19:19:06 +03:00
|
|
|
(** In this case, the [ScopeVar.t] lives inside the context of the
|
|
|
|
subscope's original declaration *)
|
2020-11-23 14:20:38 +03:00
|
|
|
|
|
|
|
let compare x y =
|
|
|
|
match x, y with
|
2023-03-05 14:10:04 +03:00
|
|
|
| Var (x, stx), Var (y, sty) -> (
|
|
|
|
match ScopeVar.compare x y with
|
|
|
|
| 0 -> Option.compare StateName.compare stx sty
|
|
|
|
| n -> n)
|
|
|
|
| SubScopeVar (x', x, _), SubScopeVar (y', y, _) -> (
|
|
|
|
match SubScopeName.compare x' y' with 0 -> ScopeVar.compare x y | n -> n)
|
2023-03-03 21:20:45 +03:00
|
|
|
| Var _, _ -> -1
|
|
|
|
| _, Var _ -> 1
|
2020-11-23 14:20:38 +03:00
|
|
|
|
2020-12-18 17:59:15 +03:00
|
|
|
let get_position x =
|
|
|
|
match x with
|
2022-05-30 12:20:48 +03:00
|
|
|
| Var (x, None) -> Marked.get_mark (ScopeVar.get_info x)
|
|
|
|
| Var (_, Some sx) -> Marked.get_mark (StateName.get_info sx)
|
2022-09-20 15:04:07 +03:00
|
|
|
| SubScopeVar (_, _, pos) -> pos
|
2020-12-18 17:59:15 +03:00
|
|
|
|
2020-11-25 13:53:56 +03:00
|
|
|
let format_t fmt x =
|
2020-11-23 14:20:38 +03:00
|
|
|
match x with
|
2022-02-28 19:19:06 +03:00
|
|
|
| Var (v, None) -> ScopeVar.format_t fmt v
|
|
|
|
| Var (v, Some sv) ->
|
|
|
|
Format.fprintf fmt "%a.%a" ScopeVar.format_t v StateName.format_t sv
|
2022-09-20 15:04:07 +03:00
|
|
|
| SubScopeVar (s, v, _) ->
|
2022-08-17 18:14:29 +03:00
|
|
|
Format.fprintf fmt "%a.%a" SubScopeName.format_t s ScopeVar.format_t v
|
2020-11-23 14:20:38 +03:00
|
|
|
|
2020-11-23 18:12:45 +03:00
|
|
|
let hash x =
|
|
|
|
match x with
|
2022-02-28 19:19:06 +03:00
|
|
|
| Var (v, None) -> ScopeVar.hash v
|
|
|
|
| Var (v, Some sv) -> Int.logxor (ScopeVar.hash v) (StateName.hash sv)
|
2022-09-20 15:04:07 +03:00
|
|
|
| SubScopeVar (w, v, _) ->
|
|
|
|
Int.logxor (SubScopeName.hash w) (ScopeVar.hash v)
|
2020-11-23 14:20:38 +03:00
|
|
|
end
|
|
|
|
|
2020-12-14 19:00:42 +03:00
|
|
|
module ScopeDefMap : Map.S with type key = ScopeDef.t = Map.Make (ScopeDef)
|
|
|
|
module ScopeDefSet : Set.S with type elt = ScopeDef.t = Set.Make (ScopeDef)
|
|
|
|
|
|
|
|
(** {1 AST} *)
|
2020-06-22 17:16:55 +03:00
|
|
|
|
2022-08-25 17:08:08 +03:00
|
|
|
type location = desugared glocation
|
2022-02-28 19:19:06 +03:00
|
|
|
|
2022-05-30 12:20:48 +03:00
|
|
|
module LocationSet : Set.S with type elt = location Marked.pos =
|
2022-02-28 19:19:06 +03:00
|
|
|
Set.Make (struct
|
2022-05-30 12:20:48 +03:00
|
|
|
type t = location Marked.pos
|
2022-02-28 19:19:06 +03:00
|
|
|
|
2022-08-25 17:08:08 +03:00
|
|
|
let compare = Expr.compare_location
|
2022-02-28 19:19:06 +03:00
|
|
|
end)
|
|
|
|
|
2022-08-26 16:21:47 +03:00
|
|
|
type expr = (desugared, untyped mark) gexpr
|
2022-05-25 15:41:04 +03:00
|
|
|
|
2022-08-25 17:08:08 +03:00
|
|
|
module ExprMap = Map.Make (struct
|
2022-08-25 17:35:08 +03:00
|
|
|
type t = expr
|
2022-02-28 20:34:32 +03:00
|
|
|
|
2022-08-25 17:08:08 +03:00
|
|
|
let compare = Expr.compare
|
|
|
|
end)
|
2022-02-28 20:34:32 +03:00
|
|
|
|
2022-11-07 15:50:28 +03:00
|
|
|
type io_input = NoInput | OnlyInput | Reentrant
|
|
|
|
type io = { io_output : bool Marked.pos; io_input : io_input Marked.pos }
|
|
|
|
|
2022-07-13 16:00:57 +03:00
|
|
|
type exception_situation =
|
|
|
|
| BaseCase
|
|
|
|
| ExceptionToLabel of LabelName.t Marked.pos
|
|
|
|
| ExceptionToRule of RuleName.t Marked.pos
|
|
|
|
|
|
|
|
type label_situation = ExplicitlyLabeled of LabelName.t Marked.pos | Unlabeled
|
|
|
|
|
2020-11-25 12:10:27 +03:00
|
|
|
type rule = {
|
2022-01-04 20:19:15 +03:00
|
|
|
rule_id : RuleName.t;
|
Swap boxing and annotations in expressions
This was the only reasonable solution I found to the issue raised
[here](https://github.com/CatalaLang/catala/pull/334#discussion_r987175884).
This was a pretty tedious rewrite, but it should now ensure we are doing things
correctly. As a bonus, the "smart" expression constructors are now used
everywhere to build expressions (so another refactoring like this one should be
much easier) and this makes the code overall feel more
straightforward (`Bindlib.box_apply` or `let+` no longer need to be visible!)
---
Basically, we were using values of type `gexpr box = naked_gexpr marked box`
throughout when (re-)building expressions. This was done 99% of the time by
using `Bindlib.box_apply add_mark naked_e` right after building `naked_e`. In
lots of places, we needed to recover the annotation of this expression later on,
typically to build its parent term (to inherit the position, or build the type).
Since it wasn't always possible to wrap these uses within `box_apply` (esp. as
bindlib boxes aren't a monad), here and there we had to call `Bindlib.unbox`,
just to recover the position or type. This had the very unpleasant effect of
forcing the resolution of the whole box (including applying any stored closures)
to reach the top-level annotation which isn't even dependant on specific
variable bindings. Then, generally, throwing away the result.
Therefore, the change proposed here transforms
- `naked_gexpr marked Bindlib.box` into
- `naked_gexpr Bindlib.box marked` (aliased to `boxed_gexpr` or `gexpr boxed` for
convenience)
This means only
1. not fitting the mark into the box right away when building, and
2. accessing the top-level mark directly without unboxing
The functions for building terms from module `Shared_ast.Expr` could be changed
easily. But then they needed to be consistently used throughout, without
manually building terms through `Bindlib.apply_box` -- which covers most of the
changes in this patch.
`Expr.Box.inj` is provided to swap back to a box, before binding for example.
Additionally, this gives a 40% speedup on `make -C examples pass_all_tests`,
which hints at the amount of unnecessary work we were doing --'
2022-10-06 20:13:45 +03:00
|
|
|
rule_just : expr boxed;
|
|
|
|
rule_cons : expr boxed;
|
2023-02-28 16:40:05 +03:00
|
|
|
rule_parameter : (expr Var.t Marked.pos * typ) list Marked.pos option;
|
2022-07-13 16:00:57 +03:00
|
|
|
rule_exception : exception_situation;
|
|
|
|
rule_label : label_situation;
|
2020-11-25 12:10:27 +03:00
|
|
|
}
|
2020-06-22 17:16:55 +03:00
|
|
|
|
2022-05-25 15:41:04 +03:00
|
|
|
module Rule = struct
|
|
|
|
type t = rule
|
|
|
|
|
|
|
|
(** Structural equality (otherwise, you should just compare the [rule_id]
|
|
|
|
fields) *)
|
|
|
|
let compare r1 r2 =
|
|
|
|
match r1.rule_parameter, r2.rule_parameter with
|
|
|
|
| None, None -> (
|
Swap boxing and annotations in expressions
This was the only reasonable solution I found to the issue raised
[here](https://github.com/CatalaLang/catala/pull/334#discussion_r987175884).
This was a pretty tedious rewrite, but it should now ensure we are doing things
correctly. As a bonus, the "smart" expression constructors are now used
everywhere to build expressions (so another refactoring like this one should be
much easier) and this makes the code overall feel more
straightforward (`Bindlib.box_apply` or `let+` no longer need to be visible!)
---
Basically, we were using values of type `gexpr box = naked_gexpr marked box`
throughout when (re-)building expressions. This was done 99% of the time by
using `Bindlib.box_apply add_mark naked_e` right after building `naked_e`. In
lots of places, we needed to recover the annotation of this expression later on,
typically to build its parent term (to inherit the position, or build the type).
Since it wasn't always possible to wrap these uses within `box_apply` (esp. as
bindlib boxes aren't a monad), here and there we had to call `Bindlib.unbox`,
just to recover the position or type. This had the very unpleasant effect of
forcing the resolution of the whole box (including applying any stored closures)
to reach the top-level annotation which isn't even dependant on specific
variable bindings. Then, generally, throwing away the result.
Therefore, the change proposed here transforms
- `naked_gexpr marked Bindlib.box` into
- `naked_gexpr Bindlib.box marked` (aliased to `boxed_gexpr` or `gexpr boxed` for
convenience)
This means only
1. not fitting the mark into the box right away when building, and
2. accessing the top-level mark directly without unboxing
The functions for building terms from module `Shared_ast.Expr` could be changed
easily. But then they needed to be consistently used throughout, without
manually building terms through `Bindlib.apply_box` -- which covers most of the
changes in this patch.
`Expr.Box.inj` is provided to swap back to a box, before binding for example.
Additionally, this gives a 40% speedup on `make -C examples pass_all_tests`,
which hints at the amount of unnecessary work we were doing --'
2022-10-06 20:13:45 +03:00
|
|
|
let j1 = Expr.unbox r1.rule_just in
|
|
|
|
let j2 = Expr.unbox r2.rule_just in
|
2022-05-25 15:41:04 +03:00
|
|
|
match Expr.compare j1 j2 with
|
|
|
|
| 0 ->
|
Swap boxing and annotations in expressions
This was the only reasonable solution I found to the issue raised
[here](https://github.com/CatalaLang/catala/pull/334#discussion_r987175884).
This was a pretty tedious rewrite, but it should now ensure we are doing things
correctly. As a bonus, the "smart" expression constructors are now used
everywhere to build expressions (so another refactoring like this one should be
much easier) and this makes the code overall feel more
straightforward (`Bindlib.box_apply` or `let+` no longer need to be visible!)
---
Basically, we were using values of type `gexpr box = naked_gexpr marked box`
throughout when (re-)building expressions. This was done 99% of the time by
using `Bindlib.box_apply add_mark naked_e` right after building `naked_e`. In
lots of places, we needed to recover the annotation of this expression later on,
typically to build its parent term (to inherit the position, or build the type).
Since it wasn't always possible to wrap these uses within `box_apply` (esp. as
bindlib boxes aren't a monad), here and there we had to call `Bindlib.unbox`,
just to recover the position or type. This had the very unpleasant effect of
forcing the resolution of the whole box (including applying any stored closures)
to reach the top-level annotation which isn't even dependant on specific
variable bindings. Then, generally, throwing away the result.
Therefore, the change proposed here transforms
- `naked_gexpr marked Bindlib.box` into
- `naked_gexpr Bindlib.box marked` (aliased to `boxed_gexpr` or `gexpr boxed` for
convenience)
This means only
1. not fitting the mark into the box right away when building, and
2. accessing the top-level mark directly without unboxing
The functions for building terms from module `Shared_ast.Expr` could be changed
easily. But then they needed to be consistently used throughout, without
manually building terms through `Bindlib.apply_box` -- which covers most of the
changes in this patch.
`Expr.Box.inj` is provided to swap back to a box, before binding for example.
Additionally, this gives a 40% speedup on `make -C examples pass_all_tests`,
which hints at the amount of unnecessary work we were doing --'
2022-10-06 20:13:45 +03:00
|
|
|
let c1 = Expr.unbox r1.rule_cons in
|
|
|
|
let c2 = Expr.unbox r2.rule_cons in
|
2022-05-25 15:41:04 +03:00
|
|
|
Expr.compare c1 c2
|
|
|
|
| n -> n)
|
2023-02-28 16:40:05 +03:00
|
|
|
| Some (l1, _), Some (l2, _) ->
|
|
|
|
ListLabels.compare l1 l2 ~cmp:(fun ((v1, _), t1) ((v2, _), t2) ->
|
2023-02-20 19:21:44 +03:00
|
|
|
match Type.compare t1 t2 with
|
|
|
|
| 0 -> (
|
|
|
|
let open Bindlib in
|
|
|
|
let b1 = unbox (bind_var v1 (Expr.Box.lift r1.rule_just)) in
|
|
|
|
let b2 = unbox (bind_var v2 (Expr.Box.lift r2.rule_just)) in
|
|
|
|
let _, j1, j2 = unbind2 b1 b2 in
|
|
|
|
match Expr.compare j1 j2 with
|
|
|
|
| 0 ->
|
|
|
|
let b1 = unbox (bind_var v1 (Expr.Box.lift r1.rule_cons)) in
|
|
|
|
let b2 = unbox (bind_var v2 (Expr.Box.lift r2.rule_cons)) in
|
|
|
|
let _, c1, c2 = unbind2 b1 b2 in
|
|
|
|
Expr.compare c1 c2
|
|
|
|
| n -> n)
|
|
|
|
| n -> n)
|
2022-05-25 15:41:04 +03:00
|
|
|
| None, Some _ -> -1
|
|
|
|
| Some _, None -> 1
|
|
|
|
end
|
|
|
|
|
2023-02-27 11:50:42 +03:00
|
|
|
let empty_rule
|
|
|
|
(pos : Pos.t)
|
2023-02-28 16:40:05 +03:00
|
|
|
(parameters : (Uid.MarkedString.info * typ) list Marked.pos option) : rule =
|
2020-11-25 12:10:27 +03:00
|
|
|
{
|
Swap boxing and annotations in expressions
This was the only reasonable solution I found to the issue raised
[here](https://github.com/CatalaLang/catala/pull/334#discussion_r987175884).
This was a pretty tedious rewrite, but it should now ensure we are doing things
correctly. As a bonus, the "smart" expression constructors are now used
everywhere to build expressions (so another refactoring like this one should be
much easier) and this makes the code overall feel more
straightforward (`Bindlib.box_apply` or `let+` no longer need to be visible!)
---
Basically, we were using values of type `gexpr box = naked_gexpr marked box`
throughout when (re-)building expressions. This was done 99% of the time by
using `Bindlib.box_apply add_mark naked_e` right after building `naked_e`. In
lots of places, we needed to recover the annotation of this expression later on,
typically to build its parent term (to inherit the position, or build the type).
Since it wasn't always possible to wrap these uses within `box_apply` (esp. as
bindlib boxes aren't a monad), here and there we had to call `Bindlib.unbox`,
just to recover the position or type. This had the very unpleasant effect of
forcing the resolution of the whole box (including applying any stored closures)
to reach the top-level annotation which isn't even dependant on specific
variable bindings. Then, generally, throwing away the result.
Therefore, the change proposed here transforms
- `naked_gexpr marked Bindlib.box` into
- `naked_gexpr Bindlib.box marked` (aliased to `boxed_gexpr` or `gexpr boxed` for
convenience)
This means only
1. not fitting the mark into the box right away when building, and
2. accessing the top-level mark directly without unboxing
The functions for building terms from module `Shared_ast.Expr` could be changed
easily. But then they needed to be consistently used throughout, without
manually building terms through `Bindlib.apply_box` -- which covers most of the
changes in this patch.
`Expr.Box.inj` is provided to swap back to a box, before binding for example.
Additionally, this gives a 40% speedup on `make -C examples pass_all_tests`,
which hints at the amount of unnecessary work we were doing --'
2022-10-06 20:13:45 +03:00
|
|
|
rule_just = Expr.box (ELit (LBool false), Untyped { pos });
|
|
|
|
rule_cons = Expr.box (ELit LEmptyError, Untyped { pos });
|
2022-01-04 20:19:15 +03:00
|
|
|
rule_parameter =
|
2023-02-27 11:50:42 +03:00
|
|
|
Option.map
|
2023-02-28 16:40:05 +03:00
|
|
|
(Marked.map_under_mark
|
|
|
|
(List.map (fun (lbl, typ) -> Marked.map_under_mark Var.make lbl, typ)))
|
2023-02-27 11:50:42 +03:00
|
|
|
parameters;
|
2022-07-13 16:00:57 +03:00
|
|
|
rule_exception = BaseCase;
|
2022-01-04 20:19:15 +03:00
|
|
|
rule_id = RuleName.fresh ("empty", pos);
|
2022-07-13 16:00:57 +03:00
|
|
|
rule_label = Unlabeled;
|
2020-11-25 12:10:27 +03:00
|
|
|
}
|
2020-08-10 00:01:42 +03:00
|
|
|
|
2023-02-27 11:50:42 +03:00
|
|
|
let always_false_rule
|
|
|
|
(pos : Pos.t)
|
2023-02-28 16:40:05 +03:00
|
|
|
(parameters : (Uid.MarkedString.info * typ) list Marked.pos option) : rule =
|
2020-12-31 02:28:26 +03:00
|
|
|
{
|
Swap boxing and annotations in expressions
This was the only reasonable solution I found to the issue raised
[here](https://github.com/CatalaLang/catala/pull/334#discussion_r987175884).
This was a pretty tedious rewrite, but it should now ensure we are doing things
correctly. As a bonus, the "smart" expression constructors are now used
everywhere to build expressions (so another refactoring like this one should be
much easier) and this makes the code overall feel more
straightforward (`Bindlib.box_apply` or `let+` no longer need to be visible!)
---
Basically, we were using values of type `gexpr box = naked_gexpr marked box`
throughout when (re-)building expressions. This was done 99% of the time by
using `Bindlib.box_apply add_mark naked_e` right after building `naked_e`. In
lots of places, we needed to recover the annotation of this expression later on,
typically to build its parent term (to inherit the position, or build the type).
Since it wasn't always possible to wrap these uses within `box_apply` (esp. as
bindlib boxes aren't a monad), here and there we had to call `Bindlib.unbox`,
just to recover the position or type. This had the very unpleasant effect of
forcing the resolution of the whole box (including applying any stored closures)
to reach the top-level annotation which isn't even dependant on specific
variable bindings. Then, generally, throwing away the result.
Therefore, the change proposed here transforms
- `naked_gexpr marked Bindlib.box` into
- `naked_gexpr Bindlib.box marked` (aliased to `boxed_gexpr` or `gexpr boxed` for
convenience)
This means only
1. not fitting the mark into the box right away when building, and
2. accessing the top-level mark directly without unboxing
The functions for building terms from module `Shared_ast.Expr` could be changed
easily. But then they needed to be consistently used throughout, without
manually building terms through `Bindlib.apply_box` -- which covers most of the
changes in this patch.
`Expr.Box.inj` is provided to swap back to a box, before binding for example.
Additionally, this gives a 40% speedup on `make -C examples pass_all_tests`,
which hints at the amount of unnecessary work we were doing --'
2022-10-06 20:13:45 +03:00
|
|
|
rule_just = Expr.box (ELit (LBool true), Untyped { pos });
|
|
|
|
rule_cons = Expr.box (ELit (LBool false), Untyped { pos });
|
2022-01-04 20:19:15 +03:00
|
|
|
rule_parameter =
|
2023-02-27 11:50:42 +03:00
|
|
|
Option.map
|
2023-02-28 16:40:05 +03:00
|
|
|
(Marked.map_under_mark
|
|
|
|
(List.map (fun (lbl, typ) -> Marked.map_under_mark Var.make lbl, typ)))
|
2023-02-27 11:50:42 +03:00
|
|
|
parameters;
|
2022-07-13 16:00:57 +03:00
|
|
|
rule_exception = BaseCase;
|
2022-01-04 20:19:15 +03:00
|
|
|
rule_id = RuleName.fresh ("always_false", pos);
|
2022-07-13 16:00:57 +03:00
|
|
|
rule_label = Unlabeled;
|
2020-12-31 02:28:26 +03:00
|
|
|
}
|
|
|
|
|
Swap boxing and annotations in expressions
This was the only reasonable solution I found to the issue raised
[here](https://github.com/CatalaLang/catala/pull/334#discussion_r987175884).
This was a pretty tedious rewrite, but it should now ensure we are doing things
correctly. As a bonus, the "smart" expression constructors are now used
everywhere to build expressions (so another refactoring like this one should be
much easier) and this makes the code overall feel more
straightforward (`Bindlib.box_apply` or `let+` no longer need to be visible!)
---
Basically, we were using values of type `gexpr box = naked_gexpr marked box`
throughout when (re-)building expressions. This was done 99% of the time by
using `Bindlib.box_apply add_mark naked_e` right after building `naked_e`. In
lots of places, we needed to recover the annotation of this expression later on,
typically to build its parent term (to inherit the position, or build the type).
Since it wasn't always possible to wrap these uses within `box_apply` (esp. as
bindlib boxes aren't a monad), here and there we had to call `Bindlib.unbox`,
just to recover the position or type. This had the very unpleasant effect of
forcing the resolution of the whole box (including applying any stored closures)
to reach the top-level annotation which isn't even dependant on specific
variable bindings. Then, generally, throwing away the result.
Therefore, the change proposed here transforms
- `naked_gexpr marked Bindlib.box` into
- `naked_gexpr Bindlib.box marked` (aliased to `boxed_gexpr` or `gexpr boxed` for
convenience)
This means only
1. not fitting the mark into the box right away when building, and
2. accessing the top-level mark directly without unboxing
The functions for building terms from module `Shared_ast.Expr` could be changed
easily. But then they needed to be consistently used throughout, without
manually building terms through `Bindlib.apply_box` -- which covers most of the
changes in this patch.
`Expr.Box.inj` is provided to swap back to a box, before binding for example.
Additionally, this gives a 40% speedup on `make -C examples pass_all_tests`,
which hints at the amount of unnecessary work we were doing --'
2022-10-06 20:13:45 +03:00
|
|
|
type assertion = expr boxed
|
2020-06-22 17:16:55 +03:00
|
|
|
type variation_typ = Increasing | Decreasing
|
|
|
|
type reference_typ = Decree | Law
|
2023-01-20 20:18:53 +03:00
|
|
|
type catala_option = DateRounding of variation_typ
|
2020-06-22 17:16:55 +03:00
|
|
|
|
|
|
|
type meta_assertion =
|
2022-05-30 12:20:48 +03:00
|
|
|
| FixedBy of reference_typ Marked.pos
|
|
|
|
| VariesWith of unit * variation_typ Marked.pos option
|
2020-06-22 17:16:55 +03:00
|
|
|
|
2022-01-04 20:19:15 +03:00
|
|
|
type scope_def = {
|
2022-11-21 12:12:45 +03:00
|
|
|
scope_def_rules : rule RuleName.Map.t;
|
2022-08-25 18:29:00 +03:00
|
|
|
scope_def_typ : typ;
|
2023-02-28 16:40:05 +03:00
|
|
|
scope_def_parameters : (Uid.MarkedString.info * typ) list Marked.pos option;
|
2022-01-04 20:19:15 +03:00
|
|
|
scope_def_is_condition : bool;
|
2022-11-07 15:50:28 +03:00
|
|
|
scope_def_io : io;
|
2022-01-04 20:19:15 +03:00
|
|
|
}
|
|
|
|
|
2022-02-28 19:19:06 +03:00
|
|
|
type var_or_states = WholeVar | States of StateName.t list
|
|
|
|
|
2020-06-22 17:16:55 +03:00
|
|
|
type scope = {
|
2022-11-21 12:12:45 +03:00
|
|
|
scope_vars : var_or_states ScopeVar.Map.t;
|
|
|
|
scope_sub_scopes : ScopeName.t SubScopeName.Map.t;
|
2022-08-12 23:42:39 +03:00
|
|
|
scope_uid : ScopeName.t;
|
2022-01-04 20:19:15 +03:00
|
|
|
scope_defs : scope_def ScopeDefMap.t;
|
2020-06-22 17:16:55 +03:00
|
|
|
scope_assertions : assertion list;
|
2023-03-16 20:51:01 +03:00
|
|
|
scope_options : catala_option Marked.pos list;
|
2020-09-13 01:33:56 +03:00
|
|
|
scope_meta_assertions : meta_assertion list;
|
2020-06-22 17:16:55 +03:00
|
|
|
}
|
|
|
|
|
2022-11-21 12:12:45 +03:00
|
|
|
type program = {
|
|
|
|
program_scopes : scope ScopeName.Map.t;
|
2023-02-13 17:00:23 +03:00
|
|
|
program_topdefs : (expr * typ) TopdefName.Map.t;
|
2022-11-21 12:12:45 +03:00
|
|
|
program_ctx : decl_ctx;
|
|
|
|
}
|
2020-11-25 13:53:56 +03:00
|
|
|
|
2022-10-10 16:15:36 +03:00
|
|
|
let rec locations_used e : LocationSet.t =
|
|
|
|
match e with
|
|
|
|
| ELocation l, m -> LocationSet.singleton (l, Expr.mark_pos m)
|
2022-11-17 19:13:35 +03:00
|
|
|
| EAbs { binder; _ }, _ ->
|
2022-02-28 19:19:06 +03:00
|
|
|
let _, body = Bindlib.unmbind binder in
|
|
|
|
locations_used body
|
2022-10-10 16:15:36 +03:00
|
|
|
| e ->
|
|
|
|
Expr.shallow_fold
|
|
|
|
(fun e -> LocationSet.union (locations_used e))
|
|
|
|
e LocationSet.empty
|
2022-02-28 19:19:06 +03:00
|
|
|
|
2022-11-21 12:12:45 +03:00
|
|
|
let free_variables (def : rule RuleName.Map.t) : Pos.t ScopeDefMap.t =
|
2022-02-28 19:19:06 +03:00
|
|
|
let add_locs (acc : Pos.t ScopeDefMap.t) (locs : LocationSet.t) :
|
|
|
|
Pos.t ScopeDefMap.t =
|
|
|
|
LocationSet.fold
|
2020-12-03 23:02:28 +03:00
|
|
|
(fun (loc, loc_pos) acc ->
|
2023-01-23 14:19:36 +03:00
|
|
|
let usage =
|
|
|
|
match loc with
|
|
|
|
| DesugaredScopeVar (v, st) ->
|
|
|
|
Some (ScopeDef.Var (Marked.unmark v, st))
|
2022-02-28 19:19:06 +03:00
|
|
|
| SubScopeVar (_, sub_index, sub_var) ->
|
2023-01-23 14:19:36 +03:00
|
|
|
Some
|
|
|
|
(ScopeDef.SubScopeVar
|
|
|
|
( Marked.unmark sub_index,
|
|
|
|
Marked.unmark sub_var,
|
|
|
|
Marked.get_mark sub_index ))
|
2023-02-13 17:00:23 +03:00
|
|
|
| ToplevelVar _ -> None
|
2023-01-23 14:19:36 +03:00
|
|
|
in
|
|
|
|
match usage with Some u -> ScopeDefMap.add u loc_pos acc | None -> acc)
|
2020-12-03 23:02:28 +03:00
|
|
|
locs acc
|
2020-11-25 13:53:56 +03:00
|
|
|
in
|
2022-11-21 12:12:45 +03:00
|
|
|
RuleName.Map.fold
|
2020-11-25 16:35:26 +03:00
|
|
|
(fun _ rule acc ->
|
2020-11-27 18:27:10 +03:00
|
|
|
let locs =
|
2022-02-28 19:19:06 +03:00
|
|
|
LocationSet.union
|
Swap boxing and annotations in expressions
This was the only reasonable solution I found to the issue raised
[here](https://github.com/CatalaLang/catala/pull/334#discussion_r987175884).
This was a pretty tedious rewrite, but it should now ensure we are doing things
correctly. As a bonus, the "smart" expression constructors are now used
everywhere to build expressions (so another refactoring like this one should be
much easier) and this makes the code overall feel more
straightforward (`Bindlib.box_apply` or `let+` no longer need to be visible!)
---
Basically, we were using values of type `gexpr box = naked_gexpr marked box`
throughout when (re-)building expressions. This was done 99% of the time by
using `Bindlib.box_apply add_mark naked_e` right after building `naked_e`. In
lots of places, we needed to recover the annotation of this expression later on,
typically to build its parent term (to inherit the position, or build the type).
Since it wasn't always possible to wrap these uses within `box_apply` (esp. as
bindlib boxes aren't a monad), here and there we had to call `Bindlib.unbox`,
just to recover the position or type. This had the very unpleasant effect of
forcing the resolution of the whole box (including applying any stored closures)
to reach the top-level annotation which isn't even dependant on specific
variable bindings. Then, generally, throwing away the result.
Therefore, the change proposed here transforms
- `naked_gexpr marked Bindlib.box` into
- `naked_gexpr Bindlib.box marked` (aliased to `boxed_gexpr` or `gexpr boxed` for
convenience)
This means only
1. not fitting the mark into the box right away when building, and
2. accessing the top-level mark directly without unboxing
The functions for building terms from module `Shared_ast.Expr` could be changed
easily. But then they needed to be consistently used throughout, without
manually building terms through `Bindlib.apply_box` -- which covers most of the
changes in this patch.
`Expr.Box.inj` is provided to swap back to a box, before binding for example.
Additionally, this gives a 40% speedup on `make -C examples pass_all_tests`,
which hints at the amount of unnecessary work we were doing --'
2022-10-06 20:13:45 +03:00
|
|
|
(locations_used (Expr.unbox rule.rule_just))
|
|
|
|
(locations_used (Expr.unbox rule.rule_cons))
|
2020-11-27 18:27:10 +03:00
|
|
|
in
|
2020-11-25 13:53:56 +03:00
|
|
|
add_locs acc locs)
|
2020-11-27 13:37:21 +03:00
|
|
|
def ScopeDefMap.empty
|