From e00f6ad307db94dcc548d1cfcf1acb3f8e5c9101 Mon Sep 17 00:00:00 2001 From: Matthew Iselin Date: Sun, 9 Aug 2026 19:32:13 -0700 Subject: [PATCH] Add module visibility syntax spike --- docs/haven.ebnf | 5 +++- docs/haven.lark | 6 ++-- docs/language.md | 27 +++++++++++++++-- docs/syntax.md | 33 +++++++++++++++++++-- src/bin/lsp/code_lenses.ml | 5 +++- src/bin/lsp/document_symbols.ml | 9 ++++-- src/bin/lsp/symbol_resolution.ml | 21 ++++++++++---- src/lib/ast/convert.ml | 50 +++++++++++++++++++++++++++----- src/lib/ast/core_ast.ml | 5 ++-- src/lib/ast/imports.ml | 7 ++++- src/lib/ast/llvm_ir.ml | 12 ++++---- src/lib/ast/pretty.ml | 23 ++++++++++----- src/lib/ast/surface_ast.ml | 5 ++-- src/lib/cst/cst.ml | 18 ++++++++++-- src/lib/cst/emit.ml | 34 ++++++++++++++++------ src/lib/cst/locate.ml | 4 +++ src/lib/cst/pretty.ml | 23 ++++++++++----- src/lib/dune | 2 +- src/lib/parser/grammar.mly | 31 +++++++++++++++----- src/lib/parser/parser.ml | 2 ++ src/lib/visibility.ml | 8 +++++ src/test/test_llvm_ir.ml | 6 ++-- src/test/test_parser.ml | 47 ++++++++++++++++++++++++++++++ src/test/test_purity.ml | 2 +- 24 files changed, 313 insertions(+), 72 deletions(-) create mode 100644 src/lib/visibility.ml diff --git a/docs/haven.ebnf b/docs/haven.ebnf index ea2714a..cf766c9 100644 --- a/docs/haven.ebnf +++ b/docs/haven.ebnf @@ -5,6 +5,7 @@ module ::= top_decl+ top_decl ::= import | cimport | foreign_block + | visibility_block | fn_decl | tydecl | extend_decl @@ -35,7 +36,7 @@ params ::= param (',' param)* (',' '*')? | '*' param ::= type IDENT -tydecl ::= 'type' IDENT ( '=' type_body )? ';' +tydecl ::= visibility? 'type' IDENT ( '=' type_body )? ';' type_body ::= type | struct_decl | enum_decl @@ -59,7 +60,9 @@ global_data ::= 'data' global_binding global_state ::= 'state' global_binding global_binding ::= type IDENT ( '=' expr )? +visibility_block ::= visibility '{' top_decl* '}' visibility ::= 'pub' + | 'pub' '(' 'module' ')' mutability ::= 'mut' block ::= '{' stmt* expr? '}' diff --git a/docs/haven.lark b/docs/haven.lark index 3539c03..e388a18 100644 --- a/docs/haven.lark +++ b/docs/haven.lark @@ -5,6 +5,7 @@ module: top_decl+ top_decl: import | cimport | foreign_block + | visibility_block | fn_decl | tydecl | global_decl @@ -34,7 +35,7 @@ params: param ("," param)* ("," "*")? | "*" param: type IDENT -tydecl: "type" IDENT ("=" type_body)? ";" +tydecl: visibility? "type" IDENT ("=" type_body)? ";" type_body: type | struct_decl | enum_decl @@ -52,7 +53,8 @@ global_data: "data" global_binding global_state: "state" global_binding global_binding: type IDENT ("=" expr)? -visibility: "pub" +visibility_block: visibility "{" top_decl* "}" +visibility: "pub" | "pub" "(" "module" ")" mutability: "mut" block: "{" stmt* expr? "}" diff --git a/docs/language.md b/docs/language.md index e2ec7a0..6cbd6a3 100644 --- a/docs/language.md +++ b/docs/language.md @@ -327,6 +327,27 @@ control the mutability of the stored value. In the example above, `:=` would be ## Declarations +### Visibility + +Top-level declarations are file-visible by default. Use `pub(module)` for declarations shared by files in the same module, and `pub` for declarations visible outside the module. + +```haven +fn file_helper() -> i32 { 1 } +pub(module) fn module_helper() -> i32 { 2 } +pub fn public_helper() -> i32 { 3 } +``` + +Visibility blocks are shorthand for applying the same visibility to each declaration in the block: + +```haven +pub(module) { + fn first_helper() -> i32 { 1 } + fn second_helper() -> i32 { 2 } +} +``` + +An explicit declaration modifier overrides the surrounding block. Visibility blocks do not introduce a lexical scope. + ### Import Declarations #### Haven Imports @@ -445,11 +466,11 @@ Variables at function scope must be initialized. Functions can be forward-declared without a body. ``` -[pub] [impure] fn () -> ; -[pub] [impure] fn () -> { } +[visibility] [impure] fn () -> ; +[visibility] [impure] fn () -> { } ``` -Specifying `pub` on declarations that have no definitions will create an external reference to the function. +Specifying external `pub` on declarations that have no definitions will create an external reference to the function. A `pub(module)` declaration without a definition remains module-visible and is not exported at linker scope. Specifying `impure` on declarations will mark the function as impure, which means it is allowed to read and write memory. diff --git a/docs/syntax.md b/docs/syntax.md index 40af872..85a9155 100644 --- a/docs/syntax.md +++ b/docs/syntax.md @@ -26,6 +26,7 @@ referenced by: top_decl ::= import | cimport | foreign_block + | visibility_block | fn_decl | tydecl | extend_decl @@ -48,6 +49,17 @@ referenced by: * top_decl +**visibility_block:** + +``` +visibility_block + ::= visibility '{' top_decl* '}' +``` + +referenced by: + +* top_decl + **extend_decl:** ``` @@ -156,7 +168,7 @@ referenced by: ``` fn_header - ::= 'pub'? fn_purity 'fn' IDENT '(' params? ')' return_type? + ::= visibility? fn_purity 'fn' IDENT '(' params? ')' return_type? ``` referenced by: @@ -249,7 +261,7 @@ referenced by: ![tydecl](diagram/tydecl.svg) ``` -tydecl ::= 'type' IDENT ( '=' type_body )? ';' +tydecl ::= visibility? 'type' IDENT ( '=' type_body )? ';' ``` referenced by: @@ -379,13 +391,28 @@ referenced by: ``` global_decl - ::= 'pub'? ( global_data | global_state ) ';' + ::= visibility? ( global_data | global_state ) ';' ``` referenced by: * top_decl +**visibility:** + +``` +visibility + ::= 'pub' + | 'pub' '(' 'module' ')' +``` + +referenced by: + +* fn_header +* tydecl +* global_decl +* visibility_block + **global_data:** ![global_data](diagram/global_data.svg) diff --git a/src/bin/lsp/code_lenses.ml b/src/bin/lsp/code_lenses.ml index 5114147..29010dd 100644 --- a/src/bin/lsp/code_lenses.ml +++ b/src/bin/lsp/code_lenses.ml @@ -17,7 +17,10 @@ let function_lenses (pipeline : Analysis.Pipeline.result) (fn : Core.function_de (fun title -> title) [ Some (if fn.value.impure then "impure" else "pure"); - if fn.value.public then Some "public" else None; + (match fn.value.visibility with + | Haven_core.Visibility.File -> None + | Module -> Some "module" + | External -> Some "public"); Option.map (fun (intrinsic : Core.intrinsic) -> "intrinsic " ^ intrinsic.value.name.value) diff --git a/src/bin/lsp/document_symbols.ml b/src/bin/lsp/document_symbols.ml index 1c60198..67f840f 100644 --- a/src/bin/lsp/document_symbols.ml +++ b/src/bin/lsp/document_symbols.ml @@ -19,7 +19,10 @@ let function_detail (fn : Cst.function_decl) = (List.filter (fun part -> not (String.equal part "")) [ - if fn.value.public then "pub" else ""; + (match fn.value.visibility with + | Haven_core.Visibility.File -> "" + | Module -> "pub(module)" + | External -> "pub"); if fn.value.impure then "impure" else ""; "fn"; ]) @@ -122,8 +125,10 @@ let type_symbol (decl : Cst.type_decl) = ~selection_range:(Lsp_helpers.loc_to_range decl.value.name.loc) () let symbols_for_program (parsed : Cst.parsed_program) = - let top_decl_symbols (decl : Cst.top_decl) = + let rec top_decl_symbols (decl : Cst.top_decl) = match decl.value with + | Cst.VisibilityBlock block -> + List.concat_map top_decl_symbols block.value.decls | Cst.FDecl fn -> [ function_symbol fn ] | Cst.VDecl var_decl -> diff --git a/src/bin/lsp/symbol_resolution.ml b/src/bin/lsp/symbol_resolution.ml index d19060e..260c89c 100644 --- a/src/bin/lsp/symbol_resolution.ml +++ b/src/bin/lsp/symbol_resolution.ml @@ -123,7 +123,10 @@ let function_signature (fn : Core.function_decl) = (List.filter (fun part -> not (String.equal part "")) [ - if fn.value.public then "pub" else ""; + (match fn.value.visibility with + | Haven_core.Visibility.File -> "" + | Module -> "pub(module)" + | External -> "pub"); if fn.value.impure then "impure" else ""; "fn"; ]) @@ -136,7 +139,7 @@ let function_signature (fn : Core.function_decl) = Printf.sprintf "%s %s(%s)%s" prefix fn.value.name.value (String.concat ", " params) return_suffix -let function_signature_with_types ~name ~public ~impure ~vararg ~params +let function_signature_with_types ~name ~visibility ~impure ~vararg ~params ~return_type = let params = let params = @@ -151,7 +154,12 @@ let function_signature_with_types ~name ~public ~impure ~vararg ~params String.concat " " (List.filter (fun part -> not (String.equal part "")) - [ if public then "pub" else ""; if impure then "impure" else ""; "fn" ]) + [ (match visibility with + | Haven_core.Visibility.File -> "" + | Module -> "pub(module)" + | External -> "pub"); + if impure then "impure" else ""; + "fn" ]) in let return_suffix = match return_type with @@ -216,7 +224,10 @@ let binding_contents typing (binding : Core.let_stmt) = let global_contents (decl : Core.var_decl) = hover_block (Printf.sprintf "global%s%s %s: %s" - (if decl.value.public then " pub" else "") + (match decl.value.visibility with + | Haven_core.Visibility.File -> "" + | Module -> " pub(module)" + | External -> " pub") (if decl.value.is_mutable then " mut" else "") decl.value.name.value (format_core_type decl.value.ty)) @@ -429,7 +440,7 @@ and specialized_call_hover state (expr : Core.expression) (call : Core.call) = | Some params -> let specialized = function_signature_with_types ~name:fn.value.name.value - ~public:fn.value.public ~impure:fn.value.impure + ~visibility:fn.value.visibility ~impure:fn.value.impure ~vararg:fn.value.vararg ~params ~return_type: (Option.map diff --git a/src/lib/ast/convert.ml b/src/lib/ast/convert.ml index cca4364..81ac66a 100644 --- a/src/lib/ast/convert.ml +++ b/src/lib/ast/convert.ml @@ -103,7 +103,39 @@ let validate_surface_function_decl (fn : Surface.function_decl) = fn.value.name.value (string_of_loc fn.loc)) let rec cst_program_to_surface (program : Cst.program) : Surface.program = - let decls = List.map cst_top_decl_to_surface program.value.decls in + let rec expand_decl ~default_visibility (decl : Cst.top_decl) = + match decl.value with + | Cst.VisibilityBlock block -> + List.concat_map + (expand_decl ~default_visibility:block.value.visibility) + block.value.decls + | Cst.FDecl fn -> + let fn = + if fn.value.visibility = Visibility.File then + { fn with value = { fn.value with visibility = default_visibility } } + else fn + in + [ cst_top_decl_to_surface { decl with value = Cst.FDecl fn } ] + | Cst.TDecl ty -> + let ty = + if ty.value.visibility = Visibility.File then + { ty with value = { ty.value with visibility = default_visibility } } + else ty + in + [ cst_top_decl_to_surface { decl with value = Cst.TDecl ty } ] + | Cst.VDecl var -> + let var = + if var.value.visibility = Visibility.File then + { var with value = { var.value with visibility = default_visibility } } + else var + in + [ cst_top_decl_to_surface { decl with value = Cst.VDecl var } ] + | Cst.Import _ | Cst.CImport _ | Cst.Foreign _ | Cst.Extend _ -> + [ cst_top_decl_to_surface decl ] + in + let decls = + List.concat_map (expand_decl ~default_visibility:Visibility.File) program.value.decls + in mk_surface program.loc { Surface.decls } and cst_top_decl_to_surface (decl : Cst.top_decl) : Surface.top_decl = @@ -112,6 +144,8 @@ and cst_top_decl_to_surface (decl : Cst.top_decl) : Surface.top_decl = | Cst.FDecl fn -> Surface.FDecl (cst_function_decl_to_surface fn) | Cst.TDecl ty -> Surface.TDecl (cst_type_decl_to_surface ty) | Cst.VDecl v -> Surface.VDecl (cst_var_decl_to_surface v) + | Cst.VisibilityBlock _ -> + failwith "visibility blocks must be expanded before surface conversion" | Cst.Import i -> Surface.Import { value = i.value; loc = i.loc } | Cst.CImport i -> Surface.CImport { value = i.value; loc = i.loc } | Cst.Foreign f -> Surface.Foreign (cst_foreign_to_surface f) @@ -122,7 +156,7 @@ and cst_top_decl_to_surface (decl : Cst.top_decl) : Surface.top_decl = and cst_function_decl_to_surface (fn : Cst.function_decl) : Surface.function_decl = let value = { - Surface.public = fn.value.public; + Surface.visibility = fn.value.visibility; impure = fn.value.impure; name = cst_identifier_to_surface fn.value.name; definition = Option.map cst_block_to_surface fn.value.definition; @@ -167,7 +201,7 @@ and cst_var_decl_to_surface (decl : Cst.var_decl) : Surface.var_decl = let value = { Surface.name = cst_identifier_to_surface decl.value.name; - public = decl.value.public; + Surface.visibility = decl.value.visibility; is_mutable = decl.value.is_mutable; ty = cst_type_to_surface decl.value.ty; init_expr = Option.map cst_expr_to_surface decl.value.init_expr; @@ -216,6 +250,7 @@ and cst_type_decl_to_surface (decl : Cst.type_decl) : Surface.type_decl = let value = { Surface.name = cst_identifier_to_surface decl.value.name; + Surface.visibility = decl.value.visibility; data = cst_type_decl_data_to_surface decl.value.data; construct = None; destruct = None; @@ -797,7 +832,7 @@ let synthesize_surface_lifecycle_fn let self_ty = mk_surface_pointer_type loc target_ty in mk_surface loc { - Surface.public = false; + Surface.visibility = Visibility.File; impure = true; name = mk_surface_ident loc (lifecycle_function_name target kind); definition = Some body; @@ -938,7 +973,7 @@ and surface_top_decl_to_core st (decl : Surface.top_decl) : Core.top_decl = and surface_function_decl_to_core st (fn : Surface.function_decl) : Core.function_decl = let value = { - Core.public = fn.value.public; + Core.visibility = fn.value.visibility; impure = fn.value.impure; name = surface_identifier_to_core fn.value.name; definition = @@ -978,7 +1013,7 @@ and surface_var_decl_to_core st (decl : Surface.var_decl) : Core.var_decl = mk_core decl.loc { Core.name = surface_identifier_to_core decl.value.name; - public = decl.value.public; + Core.visibility = decl.value.visibility; is_mutable = decl.value.is_mutable; ty = surface_type_to_core decl.value.ty; init_expr = Option.map (surface_expr_to_core st) decl.value.init_expr; @@ -988,6 +1023,7 @@ and surface_type_decl_to_core st (decl : Surface.type_decl) : Core.type_decl = mk_core decl.loc { Core.name = surface_identifier_to_core decl.value.name; + visibility = decl.value.visibility; data = surface_type_decl_data_to_core st decl.value.data; construct = Option.map (surface_function_decl_to_core st) decl.value.construct; destruct = Option.map (surface_function_decl_to_core st) decl.value.destruct; @@ -1046,7 +1082,7 @@ and surface_foreign_to_core st (foreign : Surface.foreign) : Core.foreign = value = { fn.value with - public = true; + Surface.visibility = Visibility.External; impure = true; }; } diff --git a/src/lib/ast/core_ast.ml b/src/lib/ast/core_ast.ml index c148cae..21677d7 100644 --- a/src/lib/ast/core_ast.ml +++ b/src/lib/ast/core_ast.ml @@ -71,7 +71,7 @@ and top_decl_desc = and top_decl = top_decl_desc node and function_decl_desc = { - public : bool; + visibility : Visibility.t; impure : bool; name : identifier; definition : block option; @@ -85,7 +85,7 @@ and function_decl = function_decl_desc node and var_decl_desc = { name : identifier; - public : bool; + visibility : Visibility.t; is_mutable : bool; ty : haven_type; init_expr : expression option; @@ -94,6 +94,7 @@ and var_decl_desc = { and var_decl = var_decl_desc node and type_decl_desc = { name : identifier; + visibility : Visibility.t; data : type_decl_data; construct : function_decl option; destruct : function_decl option; diff --git a/src/lib/ast/imports.ml b/src/lib/ast/imports.ml index b442bb3..794bc7d 100644 --- a/src/lib/ast/imports.ml +++ b/src/lib/ast/imports.ml @@ -94,7 +94,12 @@ and expand_top_decl state ~current_file (decl : Cst.top_decl) : Cst.top_decl lis expand_import state ~current_file import_path.value import_path.loc | Cst.CImport import_path -> expand_cimport state ~current_file import_path.value import_path.loc - | Cst.Foreign _ | Cst.FDecl _ | Cst.TDecl _ | Cst.VDecl _ | Cst.Extend _ -> + | Cst.Foreign _ + | Cst.FDecl _ + | Cst.TDecl _ + | Cst.VDecl _ + | Cst.VisibilityBlock _ + | Cst.Extend _ -> [ decl ] and expand_import state ~current_file import_path loc = diff --git a/src/lib/ast/llvm_ir.ml b/src/lib/ast/llvm_ir.ml index d7cec08..b588992 100644 --- a/src/lib/ast/llvm_ir.ml +++ b/src/lib/ast/llvm_ir.ml @@ -2318,7 +2318,8 @@ let declare_function_symbol t (fn : Core.function_decl) = | None -> let fn_value = Llvm.declare_function fn.value.name.value fn_ty t.llmodule in Llvm.set_linkage - (if fn.value.public then Llvm.Linkage.External else Llvm.Linkage.Internal) + (if Visibility.is_external fn.value.visibility then Llvm.Linkage.External + else Llvm.Linkage.Internal) fn_value; Llvm.set_function_call_conv Llvm.CallConv.c fn_value; fn_value @@ -2343,10 +2344,11 @@ let declare_global_symbol t (decl : Core.var_decl) = Llvm.declare_global (llvm_type_of_resolved t resolved) decl.value.name.value t.llmodule in Llvm.set_linkage - (if decl.value.public then Llvm.Linkage.External else Llvm.Linkage.Internal) + (if Visibility.is_external decl.value.visibility then Llvm.Linkage.External + else Llvm.Linkage.Internal) storage; Llvm.set_global_constant (not decl.value.is_mutable) storage; - if decl.value.init_expr = None && not decl.value.public then + if decl.value.init_expr = None && not (Visibility.is_external decl.value.visibility) then Llvm.set_initializer (zero_constant t resolved) storage; let symbol = Variable_symbol @@ -2389,7 +2391,7 @@ let lower_global_initializer t (decl : Core.var_decl) = | Variable_symbol { storage; resolved_type; _ } -> ( match decl.value.init_expr with | None -> - if not decl.value.public then ( + if not (Visibility.is_external decl.value.visibility) then ( Llvm.set_global_constant false storage; Llvm.set_initializer (zero_constant t resolved_type) storage; t.global_inits_rev <- { decl; storage } :: t.global_inits_rev) @@ -2426,7 +2428,7 @@ let emit_global_ctor t = { value = { - public = false; + visibility = Visibility.File; impure = true; name = { value = "__haven_global_init"; loc = dummy_loc }; definition = None; diff --git a/src/lib/ast/pretty.ml b/src/lib/ast/pretty.ml index 0b70d9a..5428b01 100644 --- a/src/lib/ast/pretty.ml +++ b/src/lib/ast/pretty.ml @@ -1,4 +1,5 @@ open Format +open Haven_core open Haven_token.Token module Surface = Surface_ast @@ -225,8 +226,9 @@ let pp_surface_param fmt (param : Surface.param) = let rec pp_surface_function fmt (fn : Surface.function_decl) = fprintf fmt - "@[Function(@,pub=%a,@ impure=%a,@ name=%a,@ params=%a,@ return=%a,@ intrinsic=%a,@ body=%a@,)@]" - pp_print_bool fn.value.public pp_print_bool fn.value.impure + "@[Function(@,visibility=%a,@ impure=%a,@ name=%a,@ params=%a,@ return=%a,@ intrinsic=%a,@ body=%a@,)@]" + (fun fmt visibility -> fprintf fmt "%s" (Visibility.to_string visibility)) + fn.value.visibility pp_print_bool fn.value.impure pp_surface_identifier fn.value.name (pp_print_list ~pp_sep pp_surface_param) fn.value.params.value.params @@ -243,8 +245,10 @@ and pp_surface_intrinsic fmt (intr : Surface.intrinsic) = intr.value.types let pp_surface_var_decl fmt (decl : Surface.var_decl) = - fprintf fmt "Var(%a, pub=%a, mutable=%a, ty=%a, init=%a)" - pp_surface_identifier decl.value.name pp_print_bool decl.value.public + fprintf fmt "Var(%a, visibility=%a, mutable=%a, ty=%a, init=%a)" + pp_surface_identifier decl.value.name + (fun fmt visibility -> fprintf fmt "%s" (Visibility.to_string visibility)) + decl.value.visibility pp_print_bool decl.value.is_mutable pp_surface_type decl.value.ty (pp_print_option pp_surface_expression) decl.value.init_expr @@ -482,8 +486,9 @@ let pp_core_param fmt (param : Core.param) = let rec pp_core_function fmt (fn : Core.function_decl) = fprintf fmt - "@[Function(@,pub=%a,@ impure=%a,@ name=%a,@ params=%a,@ return=%a,@ intrinsic=%a,@ body=%a@,)@]" - pp_print_bool fn.value.public pp_print_bool fn.value.impure + "@[Function(@,visibility=%a,@ impure=%a,@ name=%a,@ params=%a,@ return=%a,@ intrinsic=%a,@ body=%a@,)@]" + (fun fmt visibility -> fprintf fmt "%s" (Visibility.to_string visibility)) + fn.value.visibility pp_print_bool fn.value.impure pp_core_identifier fn.value.name (pp_print_list ~pp_sep pp_core_param) fn.value.params.value.params @@ -500,8 +505,10 @@ and pp_core_intrinsic fmt (intr : Core.intrinsic) = intr.value.types let pp_core_var_decl fmt (decl : Core.var_decl) = - fprintf fmt "Var(%a, pub=%a, mutable=%a, ty=%a, init=%a)" - pp_core_identifier decl.value.name pp_print_bool decl.value.public + fprintf fmt "Var(%a, visibility=%a, mutable=%a, ty=%a, init=%a)" + pp_core_identifier decl.value.name + (fun fmt visibility -> fprintf fmt "%s" (Visibility.to_string visibility)) + decl.value.visibility pp_print_bool decl.value.is_mutable pp_core_type decl.value.ty (pp_print_option pp_core_expression) decl.value.init_expr diff --git a/src/lib/ast/surface_ast.ml b/src/lib/ast/surface_ast.ml index 723395d..2e49268 100644 --- a/src/lib/ast/surface_ast.ml +++ b/src/lib/ast/surface_ast.ml @@ -74,7 +74,7 @@ and top_decl_desc = and top_decl = top_decl_desc node and function_decl_desc = { - public : bool; + visibility : Visibility.t; impure : bool; name : identifier; definition : block option; @@ -88,7 +88,7 @@ and function_decl = function_decl_desc node and var_decl_desc = { name : identifier; - public : bool; + visibility : Visibility.t; is_mutable : bool; ty : haven_type; init_expr : expression option; @@ -97,6 +97,7 @@ and var_decl_desc = { and var_decl = var_decl_desc node and type_decl_desc = { name : identifier; + visibility : Visibility.t; data : type_decl_data; construct : function_decl option; destruct : function_decl option; diff --git a/src/lib/cst/cst.ml b/src/lib/cst/cst.ml index 0822723..3934174 100644 --- a/src/lib/cst/cst.ml +++ b/src/lib/cst/cst.ml @@ -121,6 +121,7 @@ and top_decl_desc = | FDecl of function_decl | TDecl of type_decl | VDecl of var_decl + | VisibilityBlock of visibility_block | Import of string node | CImport of string node | Foreign of foreign @@ -128,8 +129,15 @@ and top_decl_desc = and top_decl = top_decl_desc node +and visibility_block_desc = { + visibility : Visibility.t; + decls : top_decl list; +} + +and visibility_block = visibility_block_desc node + and function_decl_desc = { - public : bool; + visibility : Visibility.t; impure : bool; name : identifier; definition : block option; @@ -143,14 +151,18 @@ and function_decl = function_decl_desc node and var_decl_desc = { name : identifier; - public : bool; + visibility : Visibility.t; is_mutable : bool; ty : haven_type; init_expr : expression option; } and var_decl = var_decl_desc node -and type_decl_desc = { name : identifier; data : type_decl_data } +and type_decl_desc = { + name : identifier; + visibility : Visibility.t; + data : type_decl_data; +} and type_decl = type_decl_desc node and type_extend_desc = { target : identifier; items : extend_item list } diff --git a/src/lib/cst/emit.ml b/src/lib/cst/emit.ml index 7267744..7edc5d3 100644 --- a/src/lib/cst/emit.ml +++ b/src/lib/cst/emit.ml @@ -78,6 +78,11 @@ let flush_inline_on_line ~line queue fmt = let emit_identifier fmt (id : identifier) = fprintf fmt "%s" id.value let emit_string_lit fmt (s : string node) = fprintf fmt "%S" s.value +let emit_visibility fmt = function + | Visibility.File -> () + | Visibility.Module -> fprintf fmt "pub(module) " + | Visibility.External -> fprintf fmt "pub " + let binary_op_string = function | Add -> "+" | Subtract -> "-" @@ -523,8 +528,8 @@ let emit_intrinsic fmt (i : intrinsic) = let emit_fdecl ~comments fmt (decl : function_decl) = let decl = unwrap decl in - fprintf fmt "%s%sfn %s(" - (if decl.public then "pub " else "") + fprintf fmt "%a%sfn %s(" + emit_visibility decl.visibility (if decl.impure then "impure " else "") decl.name.value; emit_params fmt decl.params; @@ -547,8 +552,8 @@ let emit_fdecl_list ~comments fmt decls = let emit_var_decl ~comments fmt (decl : var_decl) = let decl = unwrap decl in - fprintf fmt "%s%s %a %a" - (if decl.public then "pub " else "") + fprintf fmt "%a%s %a %a" + emit_visibility decl.visibility (if decl.is_mutable then "state" else "data") emit_type decl.ty emit_identifier decl.name; (pp_print_option (fun fmt expr -> @@ -595,13 +600,13 @@ let emit_enum_decl fmt (d : enum_decl) = let emit_type_decl fmt (ty : type_decl) = let ty = unwrap ty in match ty.data with - | TypeDeclForward -> fprintf fmt "type %a;" emit_identifier ty.name + | TypeDeclForward -> fprintf fmt "%atype %a;" emit_visibility ty.visibility emit_identifier ty.name | TypeDeclAlias t -> - fprintf fmt "type %a = %a;" emit_identifier ty.name emit_type t + fprintf fmt "%atype %a = %a;" emit_visibility ty.visibility emit_identifier ty.name emit_type t | TypeDeclStruct s -> - fprintf fmt "type %a = %a;" emit_identifier ty.name emit_struct_decl s + fprintf fmt "%atype %a = %a;" emit_visibility ty.visibility emit_identifier ty.name emit_struct_decl s | TypeDeclEnum e -> - fprintf fmt "type %a = %a;" emit_identifier ty.name emit_enum_decl e + fprintf fmt "%atype %a = %a;" emit_visibility ty.visibility emit_identifier ty.name emit_enum_decl e let emit_extend_item ~comments fmt (item : extend_item) = emit_comments ~comments ~indent:1 ~loc:item.loc ~kind:`Leading fmt; @@ -639,7 +644,7 @@ let emit_foreign ~comments fmt (f : foreign) = f.decls; fprintf fmt "\n}" -let emit_decl ~comments fmt decl = +let rec emit_decl ~comments fmt decl = emit_comments ~comments ~indent:0 ~loc:decl.loc ~kind:`Leading fmt; let needs_separate_trailing = match decl.value with @@ -652,12 +657,23 @@ let emit_decl ~comments fmt decl = | TDecl t -> emit_type_decl fmt t | Extend e -> emit_type_extend ~comments fmt e | VDecl v -> emit_var_decl ~comments fmt v + | VisibilityBlock block -> emit_visibility_block ~comments fmt block | Import i -> fprintf fmt "import %a;" emit_string_lit i | CImport i -> fprintf fmt "cimport %a;" emit_string_lit i | Foreign f -> emit_foreign ~comments fmt f); emit_comments ~comments ~indent:0 ~loc:decl.loc ~kind:`Trailing ~separate:needs_separate_trailing fmt +and emit_visibility_block ~comments fmt (block : visibility_block) = + let block = unwrap block in + fprintf fmt "%a{\n" emit_visibility block.visibility; + List.iteri + (fun index decl -> + emit_decl ~comments fmt decl; + if index < List.length block.decls - 1 then fprintf fmt "\n\n") + block.decls; + fprintf fmt "\n}" + let is_import decl = match decl.value with Import _ | CImport _ -> true | _ -> false diff --git a/src/lib/cst/locate.ml b/src/lib/cst/locate.ml index 6fb84b8..32b4f6f 100644 --- a/src/lib/cst/locate.ml +++ b/src/lib/cst/locate.ml @@ -4,6 +4,7 @@ open Haven_core type any_node = | Program of program | TopDecl of top_decl + | VisibilityBlock of visibility_block | FunctionDecl of function_decl | VarDecl of var_decl | TypeDecl of type_decl @@ -50,6 +51,7 @@ type any_node = let location_of = function | Program p -> p.loc | TopDecl t -> t.loc + | VisibilityBlock b -> b.loc | FunctionDecl f -> f.loc | VarDecl v -> v.loc | TypeDecl t -> t.loc @@ -321,6 +323,8 @@ and walk_function_decl predicate acc fn = and walk_top_decl predicate acc decl = let acc = add_if predicate (TopDecl decl) acc in match decl.value with + | VisibilityBlock block -> + List.fold_left (walk_top_decl predicate) acc block.value.decls | FDecl f -> walk_function_decl predicate acc f | VDecl v -> walk_var_decl predicate acc v | TDecl t -> walk_type_decl predicate acc t diff --git a/src/lib/cst/pretty.ml b/src/lib/cst/pretty.ml index 23e4931..2cbd347 100644 --- a/src/lib/cst/pretty.ml +++ b/src/lib/cst/pretty.ml @@ -1,11 +1,14 @@ open Format open Cst +open Haven_core open Haven_token.Token let unwrap (n : _ Cst.node) = n.value let pp_identifier fmt (id : identifier) = fprintf fmt "%s" id.value let pp_string_lit fmt (s : string node) = fprintf fmt "%S" s.value +let pp_visibility fmt visibility = fprintf fmt "%s" (Visibility.to_string visibility) + let pp_unary_op fmt op = match op with | Not -> fprintf fmt "!" @@ -249,11 +252,11 @@ let pp_fdecl fmt (decl : function_decl) = let decl = unwrap decl in fprintf fmt "@[Function(@,\ - pub=%a@,\ + visibility=%a@,\ impure=%a@,\ name=%s,@ params=%a,@ vararg=%a,@ intrinsic=%a,@ body=%a@,\ )@]" - pp_print_bool decl.public pp_print_bool decl.impure decl.name.value + pp_visibility decl.visibility pp_print_bool decl.impure decl.name.value pp_param_list decl.params pp_print_bool decl.vararg (pp_print_option pp_intrinsic) decl.intrinsic (pp_print_option pp_block) decl.definition @@ -267,8 +270,8 @@ let pp_fdecl_list fmt decls = let pp_var_decl fmt (decl : var_decl) = let decl = unwrap decl in fprintf fmt - "@[Variable(@,name=%s,@ pub=%a,@ mutable=%a,@ ty=%a,@ init=%a@,)@]" - decl.name.value pp_print_bool decl.public pp_print_bool decl.is_mutable + "@[Variable(@,name=%s,@ visibility=%a,@ mutable=%a,@ ty=%a,@ init=%a@,)@]" + decl.name.value pp_visibility decl.visibility pp_print_bool decl.is_mutable pp_type decl.ty (pp_print_option pp_expression) decl.init_expr @@ -305,8 +308,8 @@ let pp_type_decl_data fmt tyd = let pp_type_decl fmt (ty : type_decl) = let ty = unwrap ty in - fprintf fmt "@[TypeDecl(@,%a,@ %a@,)@]" pp_identifier ty.name - pp_type_decl_data ty.data + fprintf fmt "@[TypeDecl(@,visibility=%a,@ %a,@ %a@,)@]" + pp_visibility ty.visibility pp_identifier ty.name pp_type_decl_data ty.data let pp_lifecycle_construct fmt (decl : lifecycle_construct) = fprintf fmt "Construct(params=[%a], body=%a)" @@ -324,10 +327,11 @@ let pp_type_extend fmt (ext : type_extend) = (pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt ",@ ") pp_extend_item) ext.items -let pp_decl fmt decl = +let rec pp_decl fmt decl = match decl.value with | FDecl d -> fprintf fmt "@[FDecl(@,%a@,)@]" pp_fdecl d | TDecl t -> pp_type_decl fmt t + | VisibilityBlock b -> pp_visibility_block fmt b | Extend e -> pp_type_extend fmt e | VDecl v -> pp_var_decl fmt v | Import i -> fprintf fmt "Import(%s)" i.value @@ -337,6 +341,11 @@ let pp_decl fmt decl = fprintf fmt "@[Foreign(@,%s,@ decls=%a@,)@]" f.lib.value pp_fdecl_list f.decls +and pp_visibility_block fmt (block : visibility_block) = + fprintf fmt "Block(visibility=%a, decls=[%a])" pp_visibility block.value.visibility + (pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt ",@ ") pp_decl) + block.value.decls + let pp_program fmt (program : program) = Format.pp_set_margin fmt 100; Format.pp_set_max_indent fmt 80; diff --git a/src/lib/dune b/src/lib/dune index 8db5cdc..dedaf95 100644 --- a/src/lib/dune +++ b/src/lib/dune @@ -10,4 +10,4 @@ (library (name haven_core) (public_name haven.core) - (modules loc)) + (modules loc visibility)) diff --git a/src/lib/parser/grammar.mly b/src/lib/parser/grammar.mly index 1d255e5..22ffbeb 100644 --- a/src/lib/parser/grammar.mly +++ b/src/lib/parser/grammar.mly @@ -1,4 +1,5 @@ %{ + open Haven_core.Visibility open Haven_cst.Cst let mk_loc start_pos end_pos value = with_location ~start_pos ~end_pos value @@ -31,7 +32,7 @@ %token EOF (* Main keywords *) -%token PUB FN MUT IF ELSE LET WHILE UNTIL BREAK CONTINUE MATCH AS ITER +%token PUB MODULE FN MUT IF ELSE LET WHILE UNTIL BREAK CONTINUE MATCH AS ITER %token LOAD RET STRUCT TYPE NIL ZERO DEFER IMPURE ENUM IMPORT CIMPORT SIZE %token BOX UNBOX INTRINSIC FOREIGN DATA STATE VEC MAT FUNCTION %token VAFUNCTION CELL REF EXTEND WITH CONSTRUCT DESTRUCT @@ -60,6 +61,7 @@ program: decls=top_decl+ EOF { mk_loc $startpos $endpos { decls } } ; (** TOP-LEVEL CONSTRUCTS **) top_decl: + | b=visibility_block { mk_loc $startpos $endpos (VisibilityBlock b) } | d=fn_definition { mk_loc $startpos $endpos (FDecl d) } | d=fn_forward_decl { mk_loc $startpos $endpos (FDecl d) } | i=import_decl { mk_loc $startpos $endpos (Import i) } @@ -70,6 +72,11 @@ top_decl: | v=global_decl { mk_loc $startpos $endpos (VDecl v) } ; +visibility_block: + v=visibility LBRACE ds=top_decl* RBRACE + { mk_loc $startpos $endpos { visibility = v; decls = ds } } + ; + import_decl: IMPORT i=STRING_LIT SEMICOLON { mk_id i $startpos(i) $endpos(i) } ; cimport_decl: CIMPORT i=STRING_LIT SEMICOLON { mk_id i $startpos(i) $endpos(i) } ; @@ -89,8 +96,8 @@ fn_forward_decl: ; fn_header: - pub=boption(PUB) impure=boption(IMPURE) FN name=identifier LPAREN p=params RPAREN rt=return_type? - { mk_loc $startpos $endpos { public = pub; impure = impure; name; definition = None; intrinsic = None; params = p; return_type = rt; vararg = p.value.vararg } } + visibility=visibility_opt impure=boption(IMPURE) FN name=identifier LPAREN p=params RPAREN rt=return_type? + { mk_loc $startpos $endpos { visibility; impure; name; definition = None; intrinsic = None; params = p; return_type = rt; vararg = p.value.vararg } } ; return_type: ARROW t=haven_type { t } ; @@ -117,8 +124,8 @@ vararg_params: param: t=haven_type n=identifier { mk_loc $startpos $endpos { name = n; ty = t } } ; type_decl: - | TYPE i=identifier EQUAL t=type_defn SEMICOLON { mk_loc $startpos $endpos { name = i; data = t } } - | TYPE i=identifier SEMICOLON { mk_loc $startpos $endpos { name = i; data = TypeDeclForward } } + | visibility=visibility_opt TYPE i=identifier EQUAL t=type_defn SEMICOLON { mk_loc $startpos $endpos { name = i; visibility; data = t } } + | visibility=visibility_opt TYPE i=identifier SEMICOLON { mk_loc $startpos $endpos { name = i; visibility; data = TypeDeclForward } } ; extend_decl: EXTEND i=identifier WITH LBRACE items=list(extend_item) RBRACE @@ -152,14 +159,24 @@ enum_generics: g=delimited(LT, separated_list(COMMA, identifier), GT) { g } ; enum_variant: i=identifier t=option(enum_wrapped_type) { mk_loc $startpos $endpos { name = i; inner_tys = Option.value ~default:[] t }} ; enum_wrapped_type: LPAREN ts=separated_nonempty_list(COMMA, haven_type) RPAREN { ts } ; -global_decl: p=boption(PUB) d=global_decl_inner SEMICOLON { mk_loc $startpos $endpos { d.value with public = p } } ; +global_decl: visibility=visibility_opt d=global_decl_inner SEMICOLON { mk_loc $startpos $endpos { d.value with visibility } } ; global_decl_inner: | DATA b=global_decl_binding { b } | STATE b=global_decl_binding { mk_loc $startpos $endpos { b.value with is_mutable = true } } ; global_decl_binding: t=haven_type n=identifier e=option(bind_expr) { - mk_loc $startpos $endpos { name = n; public = false; is_mutable = false; ty = t; init_expr = e } + mk_loc $startpos $endpos { name = n; visibility = File; is_mutable = false; ty = t; init_expr = e } } ; + +visibility_opt: + | v=visibility { v } + | { File } + ; + +visibility: + | PUB LPAREN MODULE RPAREN { Module } + | PUB { External } + ; bind_expr: | EQUAL i=init { mk_expr $startpos(i) $endpos(i) (Initializer i) } | EQUAL e=expr { e } diff --git a/src/lib/parser/parser.ml b/src/lib/parser/parser.ml index bb5b431..a10bdc5 100644 --- a/src/lib/parser/parser.ml +++ b/src/lib/parser/parser.ml @@ -23,6 +23,7 @@ let keywords = ("match", Grammar.MATCH); ("as", Grammar.AS); ("pub", Grammar.PUB); + ("module", Grammar.MODULE); ("mut", Grammar.MUT); ("fn", Grammar.FN); ("iter", Grammar.ITER); @@ -180,6 +181,7 @@ let token_to_string = function | Grammar.FLOAT_TYPE -> "float" | Grammar.STR_TYPE -> "str" | Grammar.PUB -> "pub" + | Grammar.MODULE -> "module" | Grammar.FN -> "fn" | Grammar.IMPURE -> "impure" | Grammar.MUT -> "mut" diff --git a/src/lib/visibility.ml b/src/lib/visibility.ml new file mode 100644 index 0000000..b6f0ded --- /dev/null +++ b/src/lib/visibility.ml @@ -0,0 +1,8 @@ +type t = File | Module | External + +let to_string = function + | File -> "file" + | Module -> "module" + | External -> "external" + +let is_external = function External -> true | File | Module -> false diff --git a/src/test/test_llvm_ir.ml b/src/test/test_llvm_ir.ml index b147260..9a5dea4 100644 --- a/src/test/test_llvm_ir.ml +++ b/src/test/test_llvm_ir.ml @@ -76,7 +76,8 @@ let fn_decl ?(public = false) ?(impure = false) ?(definition = None) ?(params = ?(return_type = Some ty_void) name = node { - Core.public = public; + Core.visibility = + if public then Haven_core.Visibility.External else Haven_core.Visibility.File; impure; name = ident name; definition; @@ -363,6 +364,7 @@ pub impure fn main() -> i32 { (node { Core.name = ident "Buffer"; + visibility = Haven_core.Visibility.File; data = Core.TypeDeclStruct (node @@ -382,7 +384,7 @@ pub impure fn main() -> i32 { node { Core.name = ident "GLOBAL_BUFFER"; - public = false; + Core.visibility = Haven_core.Visibility.File; is_mutable = false; ty = ty_buffer; init_expr = None; diff --git a/src/test/test_parser.ml b/src/test/test_parser.ml index 8f5d2b1..a972e7e 100644 --- a/src/test/test_parser.ml +++ b/src/test/test_parser.ml @@ -40,6 +40,53 @@ let run () = assert_parse_ok "aggregate zero initializer" "pub state i32[4] values = zero;"; + let visibility_core = + parse_to_core + {| +fn file_helper() -> i32 { 0 } +pub(module) fn module_helper() -> i32 { 1 } +pub fn public_helper() -> i32 { 2 } + +pub(module) { + fn grouped_helper() -> i32 { 3 } + pub fn grouped_public_helper() -> i32 { 4 } + type Shared = i32; + state i32 cache; +} +|} + in + let assert_function_visibility name expected = + let fn_decl = find_named_function name visibility_core in + assert_true + (Printf.sprintf "%s should have %s visibility" name + (Haven_core.Visibility.to_string expected)) + (fn_decl.value.visibility = expected) + in + assert_function_visibility "file_helper" Haven_core.Visibility.File; + assert_function_visibility "module_helper" Haven_core.Visibility.Module; + assert_function_visibility "public_helper" Haven_core.Visibility.External; + assert_function_visibility "grouped_helper" Haven_core.Visibility.Module; + assert_function_visibility "grouped_public_helper" Haven_core.Visibility.External; + let find_decl name = + List.find + (fun (decl : Core.top_decl) -> + match decl.value with + | Core.TDecl ty -> String.equal ty.value.name.value name + | Core.VDecl var -> String.equal var.value.name.value name + | _ -> false) + visibility_core.program.value.decls + in + (match (find_decl "Shared").value with + | Core.TDecl ty -> + assert_true "grouped type should have module visibility" + (ty.value.visibility = Haven_core.Visibility.Module) + | _ -> failwith "expected grouped type declaration"); + (match (find_decl "cache").value with + | Core.VDecl var -> + assert_true "grouped state should have module visibility" + (var.value.visibility = Haven_core.Visibility.Module) + | _ -> failwith "expected grouped state declaration"); + assert_parse_ok "extend lifecycle block" {| type Buffer = struct { diff --git a/src/test/test_purity.ml b/src/test/test_purity.ml index 2306bdf..7db41f8 100644 --- a/src/test/test_purity.ml +++ b/src/test/test_purity.ml @@ -16,7 +16,7 @@ pub fn main() -> i32 { in let puts_decl = find_named_function "puts" foreign_pipeline.core in assert_true "foreign declarations should be marked public" - puts_decl.value.public; + (puts_decl.value.visibility = Haven_core.Visibility.External); assert_true "foreign declarations should be marked impure" puts_decl.value.impure; assert_has_diagnostics "calling foreign from a pure function should fail purity"