2022-08-16 18:09:26 +03:00
|
|
|
(* This file is part of the Catala compiler, a specification language for tax
|
|
|
|
and social benefits computation rules. Copyright (C) 2020-2022 Inria,
|
|
|
|
contributor: Denis Merigoux <denis.merigoux@inria.fr>, Alain Delaët-Tixeuil
|
|
|
|
<alain.delaet--tixeuil@inria.fr>, Louis Gesbert <louis.gesbert@inria.fr>
|
|
|
|
|
|
|
|
Licensed under the Apache License, Version 2.0 (the "License"); you may not
|
|
|
|
use this file except in compliance with the License. You may obtain a copy of
|
|
|
|
the License at
|
|
|
|
|
|
|
|
http://www.apache.org/licenses/LICENSE-2.0
|
|
|
|
|
|
|
|
Unless required by applicable law or agreed to in writing, software
|
|
|
|
distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
|
|
|
|
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
|
|
|
|
License for the specific language governing permissions and limitations under
|
|
|
|
the License. *)
|
|
|
|
|
2022-08-22 19:53:30 +03:00
|
|
|
open Definitions
|
|
|
|
|
2024-02-09 18:48:02 +03:00
|
|
|
let map_decl_ctx ~f ctx =
|
|
|
|
{
|
|
|
|
ctx with
|
|
|
|
ctx_enums = EnumName.Map.map (EnumConstructor.Map.map f) ctx.ctx_enums;
|
|
|
|
ctx_structs = StructName.Map.map (StructField.Map.map f) ctx.ctx_structs;
|
|
|
|
ctx_topdefs = TopdefName.Map.map f ctx.ctx_topdefs;
|
|
|
|
}
|
|
|
|
|
|
|
|
let map_exprs ?typ ~f ~varf { code_items; decl_ctx; lang; module_name } =
|
|
|
|
let boxed_prg =
|
|
|
|
Bindlib.box_apply
|
|
|
|
(fun code_items ->
|
|
|
|
let decl_ctx =
|
|
|
|
match typ with None -> decl_ctx | Some f -> map_decl_ctx ~f decl_ctx
|
|
|
|
in
|
|
|
|
{ code_items; decl_ctx; lang; module_name })
|
|
|
|
(Scope.map_exprs ?typ ~f ~varf code_items)
|
|
|
|
in
|
Implement safe renaming of idents for backend printing
Previously we had some heuristics in the backends trying to achieve this with a
lot of holes ; this should be much more solid, relying on `Bindlib` to do the
correct renamings.
**Note1**: it's not plugged into the backends other than OCaml at the moment.
**Note2**: the related, obsolete heuristics haven't been cleaned out yet
**Note3**: we conservatively suppose a single namespace at the moment. This is
required for e.g. Python, but it forces vars named like struct fields to be
renamed, which is more verbose in e.g. OCaml. The renaming engine could be
improved to support different namespaces, with a way to select how to route the
different kinds of identifiers into them.
Similarly, customisation for what needs to be uppercase or lowercase is not
available yet.
**Note4**: besides excluding keywords, we should also be careful to exclude (or
namespace):
- the idents used in the runtime (e.g. `o_add_int_int`)
- the dynamically generated idents (e.g. `embed_*`)
**Note5**: module names themselves aren't handled yet. The reason is that they
must be discoverable by the user, and even need to match the filenames, etc. In
other words, imagine that `Mod` is a keyword in the target language. You can't
rename a module called `Mod` to `Mod1` without knowing the whole module context,
because that would destroy the mapping for a module already called `Mod1`.
A reliable solution would be to translate all module names to e.g.
`CatalaModule_*`, which we can assume will never conflict with any built-in, and
forbid idents starting with that prefix. We may also want to restrict their
names to ASCII ? Currently we use a projection, but what if I have two modules
called `Là` and `La` ?
2024-08-05 18:08:36 +03:00
|
|
|
Expr.Box.assert_closed boxed_prg;
|
2024-02-09 18:48:02 +03:00
|
|
|
Bindlib.unbox boxed_prg
|
|
|
|
|
|
|
|
let fold_left ~f ~init { code_items; _ } =
|
|
|
|
fst @@ BoundList.fold_left ~f:(fun acc e _ -> f acc e) ~init code_items
|
2022-08-22 19:53:30 +03:00
|
|
|
|
2024-02-09 18:48:02 +03:00
|
|
|
let fold_exprs ~f ~init prg = Scope.fold_exprs ~f ~init prg.code_items
|
2023-03-30 19:52:29 +03:00
|
|
|
|
2024-02-09 18:48:02 +03:00
|
|
|
let fold_right ~f ~init { code_items; _ } =
|
|
|
|
BoundList.fold_right
|
|
|
|
~f:(fun e _ acc -> f e acc)
|
Implement safe renaming of idents for backend printing
Previously we had some heuristics in the backends trying to achieve this with a
lot of holes ; this should be much more solid, relying on `Bindlib` to do the
correct renamings.
**Note1**: it's not plugged into the backends other than OCaml at the moment.
**Note2**: the related, obsolete heuristics haven't been cleaned out yet
**Note3**: we conservatively suppose a single namespace at the moment. This is
required for e.g. Python, but it forces vars named like struct fields to be
renamed, which is more verbose in e.g. OCaml. The renaming engine could be
improved to support different namespaces, with a way to select how to route the
different kinds of identifiers into them.
Similarly, customisation for what needs to be uppercase or lowercase is not
available yet.
**Note4**: besides excluding keywords, we should also be careful to exclude (or
namespace):
- the idents used in the runtime (e.g. `o_add_int_int`)
- the dynamically generated idents (e.g. `embed_*`)
**Note5**: module names themselves aren't handled yet. The reason is that they
must be discoverable by the user, and even need to match the filenames, etc. In
other words, imagine that `Mod` is a keyword in the target language. You can't
rename a module called `Mod` to `Mod1` without knowing the whole module context,
because that would destroy the mapping for a module already called `Mod1`.
A reliable solution would be to translate all module names to e.g.
`CatalaModule_*`, which we can assume will never conflict with any built-in, and
forbid idents starting with that prefix. We may also want to restrict their
names to ASCII ? Currently we use a projection, but what if I have two modules
called `Là` and `La` ?
2024-08-05 18:08:36 +03:00
|
|
|
~init:(fun _vlist -> init)
|
2024-02-09 18:48:02 +03:00
|
|
|
code_items
|
2023-03-30 19:52:29 +03:00
|
|
|
|
2023-04-19 19:26:50 +03:00
|
|
|
let empty_ctx =
|
|
|
|
{
|
|
|
|
ctx_enums = EnumName.Map.empty;
|
|
|
|
ctx_structs = StructName.Map.empty;
|
|
|
|
ctx_scopes = ScopeName.Map.empty;
|
2023-08-10 17:52:39 +03:00
|
|
|
ctx_topdefs = TopdefName.Map.empty;
|
2023-11-20 18:01:06 +03:00
|
|
|
ctx_struct_fields = Ident.Map.empty;
|
|
|
|
ctx_enum_constrs = Ident.Map.empty;
|
|
|
|
ctx_scope_index = Ident.Map.empty;
|
2024-05-27 12:26:14 +03:00
|
|
|
ctx_modules = ModuleName.Map.empty;
|
2023-04-19 19:26:50 +03:00
|
|
|
}
|
|
|
|
|
2023-02-13 17:00:23 +03:00
|
|
|
let get_scope_body { code_items; _ } scope =
|
2022-11-17 19:13:35 +03:00
|
|
|
match
|
2024-02-09 18:48:02 +03:00
|
|
|
BoundList.fold_left ~init:None
|
2023-01-23 14:19:36 +03:00
|
|
|
~f:(fun acc item _ ->
|
|
|
|
match item with
|
|
|
|
| ScopeDef (name, body) when ScopeName.equal scope name -> Some body
|
|
|
|
| _ -> acc)
|
2023-02-13 17:00:23 +03:00
|
|
|
code_items
|
2022-11-17 19:13:35 +03:00
|
|
|
with
|
2024-02-09 18:48:02 +03:00
|
|
|
| None, _ -> raise Not_found
|
|
|
|
| Some body, _ -> body
|
2022-11-17 19:13:35 +03:00
|
|
|
|
2023-05-17 17:15:00 +03:00
|
|
|
let untype : 'm. ('a, 'm) gexpr program -> ('a, untyped) gexpr program =
|
2024-02-09 18:48:02 +03:00
|
|
|
fun prg -> map_exprs ~f:Expr.untype ~varf:Var.translate prg
|
2022-08-17 12:49:16 +03:00
|
|
|
|
2024-02-09 18:48:02 +03:00
|
|
|
let find_scope name =
|
|
|
|
BoundList.find ~f:(function
|
|
|
|
| ScopeDef (n, body) when ScopeName.equal name n -> Some body
|
|
|
|
| _ -> None)
|
2023-03-17 13:34:52 +03:00
|
|
|
|
2022-08-17 12:49:16 +03:00
|
|
|
let to_expr p main_scope =
|
2024-02-09 18:48:02 +03:00
|
|
|
let res = Scope.unfold p.decl_ctx p.code_items main_scope in
|
2023-04-14 15:18:28 +03:00
|
|
|
Expr.Box.assert_closed (Expr.Box.lift res);
|
2023-03-17 19:20:35 +03:00
|
|
|
res
|
2024-02-22 14:14:25 +03:00
|
|
|
|
|
|
|
let modules_to_list (mt : module_tree) =
|
2024-05-27 12:26:14 +03:00
|
|
|
let rec aux acc mtree =
|
2024-02-22 14:14:25 +03:00
|
|
|
ModuleName.Map.fold
|
2024-05-27 12:26:14 +03:00
|
|
|
(fun mname mnode acc ->
|
2024-05-24 15:26:44 +03:00
|
|
|
if List.exists (fun (m, _) -> ModuleName.equal m mname) acc then acc
|
2024-05-27 12:26:14 +03:00
|
|
|
else (mname, mnode.intf_id) :: aux acc mnode.deps)
|
2024-02-22 14:14:25 +03:00
|
|
|
mtree acc
|
|
|
|
in
|
|
|
|
List.rev (aux [] mt)
|