2021-01-28 02:28:28 +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:
|
|
|
|
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. *)
|
|
|
|
|
2022-11-21 12:46:17 +03:00
|
|
|
open Catala_utils
|
2022-08-12 18:59:49 +03:00
|
|
|
open Shared_ast
|
2021-01-28 02:28:28 +03:00
|
|
|
module D = Dcalc.Ast
|
|
|
|
module A = Ast
|
|
|
|
|
2023-01-23 14:19:36 +03:00
|
|
|
type 'm ctx = unit
|
2023-02-15 14:40:15 +03:00
|
|
|
(** This translation no longer needs a context at the moment, but we keep
|
|
|
|
passing the argument through the functions in case the need arises with
|
|
|
|
further evolutions. *)
|
2021-01-28 02:28:28 +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
|
|
|
let thunk_expr (type m) (e : m A.expr boxed) : m A.expr boxed =
|
2022-07-28 11:36:36 +03:00
|
|
|
let dummy_var = Var.make "_" in
|
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 pos = Expr.pos e in
|
2022-09-12 18:03:44 +03:00
|
|
|
let arg_t = Marked.mark pos (TLit TUnit) in
|
|
|
|
Expr.make_abs [| dummy_var |] e [arg_t] pos
|
2021-01-28 20:30:01 +03:00
|
|
|
|
2023-01-23 14:19:36 +03:00
|
|
|
let translate_var : 'm D.expr Var.t -> 'm A.expr Var.t = Var.translate
|
|
|
|
|
2021-01-28 02:28:28 +03:00
|
|
|
let rec translate_default
|
2022-06-23 15:06:11 +03:00
|
|
|
(ctx : 'm ctx)
|
2022-08-25 17:35:08 +03:00
|
|
|
(exceptions : 'm D.expr list)
|
|
|
|
(just : 'm D.expr)
|
|
|
|
(cons : 'm D.expr)
|
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
|
|
|
(mark_default : 'm mark) : 'm A.expr boxed =
|
2021-01-28 20:30:01 +03:00
|
|
|
let exceptions =
|
2022-09-12 18:03:44 +03:00
|
|
|
List.map (fun except -> thunk_expr (translate_expr ctx except)) exceptions
|
2021-01-28 20:30:01 +03:00
|
|
|
in
|
2022-10-04 15:21:04 +03:00
|
|
|
let pos = Expr.mark_pos mark_default in
|
2021-01-28 02:28:28 +03:00
|
|
|
let exceptions =
|
2022-08-22 19:53:30 +03:00
|
|
|
Expr.make_app
|
2023-03-28 11:07:01 +03:00
|
|
|
(Expr.eop Op.HandleDefault
|
|
|
|
[TAny, pos; TAny, pos; TAny, pos]
|
|
|
|
(Expr.no_mark mark_default))
|
2021-01-28 02:28:28 +03:00
|
|
|
[
|
2022-08-12 23:42:39 +03:00
|
|
|
Expr.earray exceptions mark_default;
|
2022-09-12 18:03:44 +03:00
|
|
|
thunk_expr (translate_expr ctx just);
|
|
|
|
thunk_expr (translate_expr ctx cons);
|
2021-01-28 02:28:28 +03:00
|
|
|
]
|
2022-10-04 15:21:04 +03:00
|
|
|
pos
|
2021-01-28 02:28:28 +03:00
|
|
|
in
|
|
|
|
exceptions
|
|
|
|
|
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
|
|
|
and translate_expr (ctx : 'm ctx) (e : 'm D.expr) : 'm A.expr boxed =
|
2022-11-17 19:13:35 +03:00
|
|
|
let m = Marked.get_mark e in
|
2022-05-30 12:20:48 +03:00
|
|
|
match Marked.unmark e with
|
2023-01-23 14:19:36 +03:00
|
|
|
| EVar v -> Expr.make_var (translate_var v) m
|
2022-11-17 19:13:35 +03:00
|
|
|
| EStruct { name; fields } ->
|
2022-11-21 12:12:45 +03:00
|
|
|
Expr.estruct name (StructField.Map.map (translate_expr ctx) fields) m
|
2022-11-17 19:13:35 +03:00
|
|
|
| EStructAccess { name; e; field } ->
|
|
|
|
Expr.estructaccess (translate_expr ctx e) field name m
|
2023-01-10 13:50:37 +03:00
|
|
|
| ETuple es -> Expr.etuple (List.map (translate_expr ctx) es) m
|
|
|
|
| ETupleAccess { e; index; size } ->
|
|
|
|
Expr.etupleaccess (translate_expr ctx e) index size m
|
2022-11-17 19:13:35 +03:00
|
|
|
| EInj { name; e; cons } -> Expr.einj (translate_expr ctx e) cons name m
|
|
|
|
| EMatch { name; e; cases } ->
|
|
|
|
Expr.ematch (translate_expr ctx e) name
|
2022-11-21 12:12:45 +03:00
|
|
|
(EnumConstructor.Map.map (translate_expr ctx) cases)
|
2022-11-17 19:13:35 +03:00
|
|
|
m
|
|
|
|
| EArray es -> Expr.earray (List.map (translate_expr ctx) es) m
|
2022-08-25 13:09:51 +03:00
|
|
|
| ELit
|
|
|
|
((LBool _ | LInt _ | LRat _ | LMoney _ | LUnit | LDate _ | LDuration _) as
|
|
|
|
l) ->
|
2022-11-17 19:13:35 +03:00
|
|
|
Expr.elit l m
|
|
|
|
| ELit LEmptyError -> Expr.eraise EmptyError m
|
2023-01-20 20:18:53 +03:00
|
|
|
| EOp { op; tys } -> Expr.eop (Operator.translate None op) tys m
|
2022-11-17 19:13:35 +03:00
|
|
|
| EIfThenElse { cond; etrue; efalse } ->
|
|
|
|
Expr.eifthenelse (translate_expr ctx cond) (translate_expr ctx etrue)
|
|
|
|
(translate_expr ctx efalse)
|
|
|
|
m
|
|
|
|
| EAssert e1 -> Expr.eassert (translate_expr ctx e1) m
|
|
|
|
| EErrorOnEmpty arg ->
|
2022-08-12 23:42:39 +03:00
|
|
|
Expr.ecatch (translate_expr ctx arg) EmptyError
|
2022-11-17 19:13:35 +03:00
|
|
|
(Expr.eraise NoValueProvided m)
|
|
|
|
m
|
|
|
|
| EApp { f; args } ->
|
|
|
|
Expr.eapp (translate_expr ctx f)
|
2022-04-25 19:00:08 +03:00
|
|
|
(List.map (translate_expr ctx) args)
|
2022-05-30 12:20:48 +03:00
|
|
|
(Marked.get_mark e)
|
2022-11-17 19:13:35 +03:00
|
|
|
| EAbs { binder; tys } ->
|
2021-01-28 02:28:28 +03:00
|
|
|
let vars, body = Bindlib.unmbind binder in
|
|
|
|
let new_body = translate_expr ctx body in
|
2023-01-23 14:19:36 +03:00
|
|
|
let new_binder = Expr.bind (Array.map translate_var vars) new_body in
|
2022-11-17 19:13:35 +03:00
|
|
|
Expr.eabs new_binder tys (Marked.get_mark e)
|
|
|
|
| EDefault { excepts = [exn]; just; cons } when !Cli.optimize_flag ->
|
|
|
|
(* FIXME: bad place to rely on a global flag *)
|
2022-08-12 23:42:39 +03:00
|
|
|
Expr.ecatch (translate_expr ctx exn) EmptyError
|
|
|
|
(Expr.eifthenelse (translate_expr ctx just) (translate_expr ctx cons)
|
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
|
|
|
(Expr.eraise EmptyError (Marked.get_mark e))
|
2022-05-30 12:20:48 +03:00
|
|
|
(Marked.get_mark e))
|
|
|
|
(Marked.get_mark e)
|
2022-11-17 19:13:35 +03:00
|
|
|
| EDefault { excepts; just; cons } ->
|
|
|
|
translate_default ctx excepts just cons (Marked.get_mark e)
|
2021-01-28 02:28:28 +03:00
|
|
|
|
2022-04-25 19:00:08 +03:00
|
|
|
let rec translate_scope_lets
|
2022-08-12 23:42:39 +03:00
|
|
|
(decl_ctx : decl_ctx)
|
2022-06-23 15:06:11 +03:00
|
|
|
(ctx : 'm ctx)
|
2022-08-25 20:46:13 +03:00
|
|
|
(scope_lets : 'm D.expr scope_body_expr) :
|
|
|
|
'm A.expr scope_body_expr Bindlib.box =
|
2022-04-25 19:00:08 +03:00
|
|
|
match scope_lets with
|
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
|
|
|
| Result e ->
|
2022-10-21 16:33:05 +03:00
|
|
|
Bindlib.box_apply (fun e -> Result e) (Expr.Box.lift (translate_expr ctx e))
|
2022-04-25 19:00:08 +03:00
|
|
|
| ScopeLet scope_let ->
|
2023-01-23 14:19:36 +03:00
|
|
|
let scope_let_var, scope_let_next =
|
2022-04-25 19:00:08 +03:00
|
|
|
Bindlib.unbind scope_let.scope_let_next
|
|
|
|
in
|
|
|
|
let new_scope_let_expr = translate_expr ctx scope_let.scope_let_expr in
|
2023-01-23 14:19:36 +03:00
|
|
|
let new_scope_next = translate_scope_lets decl_ctx ctx scope_let_next in
|
|
|
|
let new_scope_next =
|
|
|
|
Bindlib.bind_var (translate_var scope_let_var) new_scope_next
|
|
|
|
in
|
2022-04-25 19:00:08 +03:00
|
|
|
Bindlib.box_apply2
|
|
|
|
(fun new_scope_next new_scope_let_expr ->
|
2022-08-12 23:42:39 +03:00
|
|
|
ScopeLet
|
2022-04-25 19:00:08 +03:00
|
|
|
{
|
2022-08-12 23:42:39 +03:00
|
|
|
scope_let_typ = scope_let.scope_let_typ;
|
|
|
|
scope_let_kind = scope_let.scope_let_kind;
|
|
|
|
scope_let_pos = scope_let.scope_let_pos;
|
2022-04-25 19:00:08 +03:00
|
|
|
scope_let_next = new_scope_next;
|
|
|
|
scope_let_expr = new_scope_let_expr;
|
|
|
|
})
|
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
|
|
|
new_scope_next
|
2022-10-21 16:33:05 +03:00
|
|
|
(Expr.Box.lift new_scope_let_expr)
|
2022-04-25 19:00:08 +03:00
|
|
|
|
2023-02-13 17:00:23 +03:00
|
|
|
let translate_items
|
2022-08-12 23:42:39 +03:00
|
|
|
(decl_ctx : decl_ctx)
|
2022-06-23 15:06:11 +03:00
|
|
|
(ctx : 'm ctx)
|
2023-01-23 14:19:36 +03:00
|
|
|
(scopes : 'm D.expr code_item_list) : 'm A.expr code_item_list Bindlib.box =
|
|
|
|
Scope.map_ctx
|
|
|
|
~f:
|
|
|
|
(fun ctx -> function
|
|
|
|
| Topdef (name, ty, e) ->
|
|
|
|
( ctx,
|
|
|
|
Bindlib.box_apply
|
|
|
|
(fun e -> Topdef (name, ty, e))
|
|
|
|
(Expr.Box.lift (translate_expr ctx e)) )
|
|
|
|
| ScopeDef (name, body) ->
|
|
|
|
let scope_input_var, body_expr =
|
|
|
|
Bindlib.unbind body.scope_body_expr
|
|
|
|
in
|
|
|
|
let new_scope_body_expr =
|
|
|
|
translate_scope_lets decl_ctx ctx body_expr
|
|
|
|
in
|
|
|
|
let new_body =
|
|
|
|
Bindlib.bind_var (translate_var scope_input_var) new_scope_body_expr
|
|
|
|
in
|
|
|
|
( ctx,
|
|
|
|
Bindlib.box_apply
|
|
|
|
(fun scope_body_expr ->
|
|
|
|
ScopeDef (name, { body with scope_body_expr }))
|
|
|
|
new_body ))
|
|
|
|
~varf:translate_var ctx scopes
|
2022-04-02 15:51:11 +03:00
|
|
|
|
2022-06-23 15:06:11 +03:00
|
|
|
let translate_program (prgm : 'm D.program) : 'm A.program =
|
2021-01-28 15:58:59 +03:00
|
|
|
{
|
2023-02-13 17:00:23 +03:00
|
|
|
code_items =
|
|
|
|
Bindlib.unbox (translate_items prgm.decl_ctx () prgm.code_items);
|
2021-01-29 13:42:19 +03:00
|
|
|
decl_ctx = prgm.decl_ctx;
|
2021-01-28 15:58:59 +03:00
|
|
|
}
|