From 9cecf5587a82440d88e0460de3c4c9fabe8ac39a Mon Sep 17 00:00:00 2001 From: Denis Merigoux Date: Fri, 22 Sep 2023 17:50:19 +0200 Subject: [PATCH] Register surface syntax languge in program troughout the compilation chain --- compiler/dcalc/from_scopelang.ml | 6 +++++- compiler/desugared/ast.ml | 1 + compiler/desugared/ast.mli | 1 + compiler/desugared/from_surface.ml | 1 + compiler/lcalc/closure_conversion.ml | 2 +- compiler/lcalc/compile_without_exceptions.ml | 2 +- compiler/scopelang/ast.ml | 1 + compiler/scopelang/ast.mli | 1 + compiler/scopelang/from_desugared.ml | 2 ++ compiler/shared_ast/definitions.ml | 6 +++++- compiler/shared_ast/program.ml | 8 ++++---- compiler/shared_ast/typing.ml | 1 + compiler/surface/ast.ml | 1 + compiler/surface/parser_driver.ml | 5 +++++ 14 files changed, 30 insertions(+), 8 deletions(-) diff --git a/compiler/dcalc/from_scopelang.ml b/compiler/dcalc/from_scopelang.ml index 106e668f..4e5c2a91 100644 --- a/compiler/dcalc/from_scopelang.ml +++ b/compiler/dcalc/from_scopelang.ml @@ -1254,4 +1254,8 @@ let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program = ctx ) in let items, ctx = translate_defs top_ctx defs_ordering in - { code_items = Bindlib.unbox items; decl_ctx = ctx.decl_ctx } + { + code_items = Bindlib.unbox items; + decl_ctx = ctx.decl_ctx; + lang = prgm.program_lang; + } diff --git a/compiler/desugared/ast.ml b/compiler/desugared/ast.ml index 1dfa6b0f..23b92fbe 100644 --- a/compiler/desugared/ast.ml +++ b/compiler/desugared/ast.ml @@ -233,6 +233,7 @@ type program = { program_topdefs : (expr option * typ) TopdefName.Map.t; program_ctx : decl_ctx; program_modules : program ModuleName.Map.t; + program_lang : Cli.backend_lang; } let rec locations_used e : LocationSet.t = diff --git a/compiler/desugared/ast.mli b/compiler/desugared/ast.mli index bde89f85..47ccd8c9 100644 --- a/compiler/desugared/ast.mli +++ b/compiler/desugared/ast.mli @@ -117,6 +117,7 @@ type program = { program_topdefs : (expr option * typ) TopdefName.Map.t; program_ctx : decl_ctx; program_modules : program ModuleName.Map.t; + program_lang : Cli.backend_lang; } (** {1 Helpers} *) diff --git a/compiler/desugared/from_surface.ml b/compiler/desugared/from_surface.ml index 7f420e6b..6d748f00 100644 --- a/compiler/desugared/from_surface.ml +++ b/compiler/desugared/from_surface.ml @@ -1468,6 +1468,7 @@ let translate_program (ctxt : Name_resolution.context) (surface : S.program) : ModuleName.Map.map make_ctx ctxt.Name_resolution.modules in { + Ast.program_lang = surface.program_lang; Ast.program_ctx = { (* After name resolution, type definitions (structs and enums) are diff --git a/compiler/lcalc/closure_conversion.ml b/compiler/lcalc/closure_conversion.ml index 918d6ff0..066f2b1a 100644 --- a/compiler/lcalc/closure_conversion.ml +++ b/compiler/lcalc/closure_conversion.ml @@ -356,7 +356,7 @@ let transform_closures_program (p : 'm program) : 'm program Bindlib.box = in Bindlib.box_apply (fun new_code_items -> - { code_items = new_code_items; decl_ctx = new_decl_ctx }) + { code_items = new_code_items; decl_ctx = new_decl_ctx; lang = p.lang }) new_code_items (** {1 Hoisting closures}*) diff --git a/compiler/lcalc/compile_without_exceptions.ml b/compiler/lcalc/compile_without_exceptions.ml index 7af28c30..7bcceccc 100644 --- a/compiler/lcalc/compile_without_exceptions.ml +++ b/compiler/lcalc/compile_without_exceptions.ml @@ -769,4 +769,4 @@ let translate_program (prgm : typed D.program) : untyped A.program = (* program is closed here. *) let code_items = Bindlib.unbox code_items in - Program.untype { decl_ctx; code_items } + Program.untype { decl_ctx; code_items; lang = prgm.lang } diff --git a/compiler/scopelang/ast.ml b/compiler/scopelang/ast.ml index 5d0edf16..c9a8c5c2 100644 --- a/compiler/scopelang/ast.ml +++ b/compiler/scopelang/ast.ml @@ -55,6 +55,7 @@ type 'm program = { program_topdefs : ('m expr * typ) TopdefName.Map.t; program_modules : nil program ModuleName.Map.t; program_ctx : decl_ctx; + program_lang : Cli.backend_lang; } let type_rule decl_ctx env = function diff --git a/compiler/scopelang/ast.mli b/compiler/scopelang/ast.mli index 3628946f..cba64b46 100644 --- a/compiler/scopelang/ast.mli +++ b/compiler/scopelang/ast.mli @@ -51,6 +51,7 @@ type 'm program = { expressions. They won't contain any rules or topdefs, but will still have the scope signatures needed to respect the call convention *) program_ctx : decl_ctx; + program_lang : Cli.backend_lang; } val type_program : 'm program -> typed program diff --git a/compiler/scopelang/from_desugared.ml b/compiler/scopelang/from_desugared.ml index 57713e3e..1d4fad26 100644 --- a/compiler/scopelang/from_desugared.ml +++ b/compiler/scopelang/from_desugared.ml @@ -831,6 +831,7 @@ let translate_program process_modules (ModuleName.Map.find modname program_ctx.ctx_modules) m_desugared; + Ast.program_lang = desugared.program_lang; }) desugared.D.program_modules in @@ -855,4 +856,5 @@ let translate_program Ast.program_scopes; Ast.program_ctx; Ast.program_modules; + Ast.program_lang = desugared.program_lang; } diff --git a/compiler/shared_ast/definitions.ml b/compiler/shared_ast/definitions.ml index 78d0405a..5a4c514c 100644 --- a/compiler/shared_ast/definitions.ml +++ b/compiler/shared_ast/definitions.ml @@ -666,4 +666,8 @@ type decl_ctx = { ctx_modules : decl_ctx ModuleName.Map.t; } -type 'e program = { decl_ctx : decl_ctx; code_items : 'e code_item_list } +type 'e program = { + decl_ctx : decl_ctx; + code_items : 'e code_item_list; + lang : Cli.backend_lang; +} diff --git a/compiler/shared_ast/program.ml b/compiler/shared_ast/program.ml index b0c3ec6f..0f1d0ecc 100644 --- a/compiler/shared_ast/program.ml +++ b/compiler/shared_ast/program.ml @@ -17,15 +17,15 @@ open Definitions -let map_exprs ~f ~varf { code_items; decl_ctx } = +let map_exprs ~f ~varf { code_items; decl_ctx; lang } = Bindlib.box_apply - (fun code_items -> { code_items; decl_ctx }) + (fun code_items -> { code_items; decl_ctx; lang }) (Scope.map_exprs ~f ~varf code_items) -let fold_left_exprs ~f ~init { code_items; decl_ctx = _ } = +let fold_left_exprs ~f ~init { code_items; _ } = Scope.fold_left ~f:(fun acc e _ -> f acc e) ~init code_items -let fold_right_exprs ~f ~init { code_items; decl_ctx = _ } = +let fold_right_exprs ~f ~init { code_items; _ } = Scope.fold_right ~f:(fun e _ acc -> f e acc) ~init code_items let empty_ctx = diff --git a/compiler/shared_ast/typing.ml b/compiler/shared_ast/typing.ml index 00985041..0ede62df 100644 --- a/compiler/shared_ast/typing.ml +++ b/compiler/shared_ast/typing.ml @@ -1041,6 +1041,7 @@ let program ~leave_unresolved prg = prg.A.code_items in { + A.lang = prg.lang; A.code_items = Bindlib.unbox code_items; decl_ctx = { diff --git a/compiler/surface/ast.ml b/compiler/surface/ast.ml index e98fc962..7fd7a35f 100644 --- a/compiler/surface/ast.ml +++ b/compiler/surface/ast.ml @@ -318,6 +318,7 @@ and program = { program_items : law_structure list; program_source_files : (string[@opaque]) list; program_modules : (uident * interface) list; + program_lang : Cli.backend_lang; [@opaque] } and source_file = law_structure list diff --git a/compiler/surface/parser_driver.ml b/compiler/surface/parser_driver.ml index 538f4684..58fdf93e 100644 --- a/compiler/surface/parser_driver.ml +++ b/compiler/surface/parser_driver.ml @@ -232,6 +232,7 @@ let rec parse_source_file program_items = program.Ast.program_items; program_source_files = source_file_name :: program.Ast.program_source_files; program_modules = []; + program_lang = language; } (** Expands the include directives in a parsing result, thus parsing new source @@ -254,12 +255,14 @@ and expand_includes acc.Ast.program_items @ includ_program.program_items; Ast.program_modules = acc.Ast.program_modules @ includ_program.program_modules; + Ast.program_lang = language; } | Ast.LawHeading (heading, commands') -> let { Ast.program_items = commands'; Ast.program_source_files = new_sources; Ast.program_modules = new_modules; + Ast.program_lang = _; } = expand_includes source_file commands' language in @@ -268,12 +271,14 @@ and expand_includes Ast.program_items = acc.Ast.program_items @ [Ast.LawHeading (heading, commands')]; Ast.program_modules = acc.Ast.program_modules @ new_modules; + Ast.program_lang = language; } | i -> { acc with Ast.program_items = acc.Ast.program_items @ [i] }) { Ast.program_source_files = []; Ast.program_items = []; Ast.program_modules = []; + Ast.program_lang = language; } commands