diff --git a/src/lib/ast/analysis_semantic.ml b/src/lib/ast/analysis_semantic.ml index 3d2e463..f05f22f 100644 --- a/src/lib/ast/analysis_semantic.ml +++ b/src/lib/ast/analysis_semantic.ml @@ -91,6 +91,26 @@ module Semantic = struct | Core.VDecl _ | Core.TDecl _ | Core.Import _ | Core.CImport _ -> map) String_map.empty program.value.decls + let check_duplicate_function_definitions state (program : Core.program) = + let definitions = ref String_map.empty in + let check (fn : Core.function_decl) = + match fn.value.definition with + | None -> () + | Some _ -> + let name = fn.value.name.value in + if String_map.mem name !definitions then + add_diagnostic state Error fn.loc + (Printf.sprintf "duplicate function definition %s" name) + else definitions := String_map.add name () !definitions + in + List.iter + (fun (decl : Core.top_decl) -> + match decl.value with + | Core.FDecl fn -> check fn + | Core.Foreign foreign -> List.iter check foreign.value.decls + | Core.VDecl _ | Core.TDecl _ | Core.Import _ | Core.CImport _ -> ()) + program.value.decls + let duplicate_binding env name = match env with | [] -> false @@ -788,9 +808,6 @@ module Semantic = struct if not statement_context then add_diagnostic state Error expr.loc "mutation is statement-only and cannot be used as a value"; - if not (is_lvalue write.value.target) then - add_diagnostic state Error expr.loc - "mutation target must be assignable"; (match expr_annotation state write.value.target with | Some { resolved_type = Some resolved; _ } -> if not (resolved_is_pointerish resolved) then @@ -843,6 +860,7 @@ module Semantic = struct functions = collect_functions typed.program.program; } in + check_duplicate_function_definitions state typed.program.program; let env = [ initial_scope typed ] in List.iter (fun (decl : Core.top_decl) -> diff --git a/src/lib/ast/llvm_ir.ml b/src/lib/ast/llvm_ir.ml index 37ed54a..63142af 100644 --- a/src/lib/ast/llvm_ir.ml +++ b/src/lib/ast/llvm_ir.ml @@ -617,13 +617,60 @@ let create_string_literal t value = let zero = Llvm.const_int (i32_type t) 0 in Llvm.const_in_bounds_gep (Llvm.type_of init) global [| zero; zero |] +let constant_is_signed = function + | Analysis.ResolvedInt (Haven_token.Token.Signed, _) -> true + | _ -> false + +let constant_cast t value source target = + if Analysis.equal_resolved_type source target then Some value + else + match (source, target) with + | Analysis.ResolvedInt _, Analysis.ResolvedInt (_, bits) -> + Option.map + (fun constant -> + Llvm.const_of_int64 + (Llvm.integer_type t.context bits) + constant (constant_is_signed source)) + (Llvm.int64_of_const value) + | Analysis.ResolvedInt _, Analysis.ResolvedFloat -> + Option.map + (fun constant -> + Llvm.const_float (float_type t) (Int64.to_float constant)) + (Llvm.int64_of_const value) + | Analysis.ResolvedFloat, Analysis.ResolvedInt (_, bits) -> + Option.map + (fun constant -> + Llvm.const_of_int64 + (Llvm.integer_type t.context bits) + (Int64.of_float constant) (constant_is_signed target)) + (Llvm.float_of_const value) + | source, target + when Analysis.resolved_is_pointerish source + && Analysis.resolved_is_pointerish target -> + Some (Llvm.const_pointercast value (ptr_type t)) + | source, Analysis.ResolvedInt (_, bits) + when Analysis.resolved_is_pointerish source -> + Some + (Llvm.const_ptrtoint value + (Llvm.integer_type t.context bits)) + | Analysis.ResolvedInt _, target + when Analysis.resolved_is_pointerish target -> + Some (Llvm.const_inttoptr value (ptr_type t)) + | _ -> None + let rec constant_of_expr t (expr : Core.expression) = let resolved = expr_resolved_type t expr in match expr.value with | Core.Literal lit -> constant_of_literal t expr.loc resolved lit | Core.Nil when Analysis.resolved_is_pointerish resolved -> Some (Llvm.const_null (llvm_type_of_resolved t resolved)) - | Core.As cast -> constant_of_expr t cast.value.inner + | Core.As cast -> + Option.bind + (constant_of_expr t cast.value.inner) + (fun value -> + constant_cast t value + (expr_resolved_type t cast.value.inner) + resolved) | Core.SizeExpr inner -> let size = Llvm_target.DataLayout.abi_size @@ -1557,6 +1604,13 @@ and emit_enum_literal t (expr : Core.expression) (enum_lit : Core.enum_literal) | _ -> fail ~loc:expr.loc "enum literal requires enum type during LLVM lowering" and emit_binary t (expr : Core.expression) (binary : Core.binary) = + match binary.value.op with + | Core.LogicAnd | Core.LogicOr -> + emit_logical_binary t expr binary + | _ -> + emit_eager_binary t expr binary + +and emit_eager_binary t (expr : Core.expression) (binary : Core.binary) = let lhs = emit_expr t binary.value.left in let rhs = emit_expr t binary.value.right in let lhs_ty = expr_resolved_type t binary.value.left in @@ -1590,34 +1644,39 @@ and emit_binary t (expr : Core.expression) (binary : Core.binary) = | _ -> assert false in Llvm.build_fcmp pred lhs rhs "fcmp" t.builder - | ( Core.LogicAnd | Core.LogicOr ), _, _, Analysis.ResolvedInt (_, 1) -> - let lhs_bool = emit_to_bool t binary.value.left lhs in - let current_block = Llvm.insertion_block t.builder in - let fn_value = Llvm.block_parent current_block in - let rhs_block = Llvm.append_block t.context "logic.rhs" fn_value in - let end_block = Llvm.append_block t.context "logic.end" fn_value in - ignore - (Llvm.build_cond_br lhs_bool - (if binary.value.op = Core.LogicAnd then rhs_block else end_block) - (if binary.value.op = Core.LogicAnd then end_block else rhs_block) - t.builder); - Llvm.position_at_end rhs_block t.builder; - let rhs_value = emit_expr t binary.value.right in - let rhs_bool = emit_to_bool t binary.value.right rhs_value in - let rhs_block_final = Llvm.insertion_block t.builder in - ignore (Llvm.build_br end_block t.builder); - Llvm.position_at_end end_block t.builder; - let incoming = - if binary.value.op = Core.LogicAnd then - [ (Llvm.const_int (i1_type t) 0, current_block); (rhs_bool, rhs_block_final) ] - else - [ (Llvm.const_int (i1_type t) 1, current_block); (rhs_bool, rhs_block_final) ] - in - Llvm.build_phi incoming "logic.phi" t.builder | _, _, _, (Analysis.ResolvedVec _ | Analysis.ResolvedMatrix _) -> emit_vector_or_matrix_binary t expr binary lhs rhs lhs_ty rhs_ty result_ty | _ -> emit_nonfloat_binary t expr binary lhs rhs lhs_ty rhs_ty result_ty +and emit_logical_binary t (expr : Core.expression) (binary : Core.binary) = + let result_ty = expr_resolved_type t expr in + if not (Analysis.equal_resolved_type result_ty (Analysis.ResolvedInt (Unsigned, 1))) then + fail ~loc:expr.loc "logical operator lowering bug"; + let lhs = emit_expr t binary.value.left in + let lhs_bool = emit_to_bool t binary.value.left lhs in + let current_block = Llvm.insertion_block t.builder in + let fn_value = Llvm.block_parent current_block in + let rhs_block = Llvm.append_block t.context "logic.rhs" fn_value in + let end_block = Llvm.append_block t.context "logic.end" fn_value in + ignore + (Llvm.build_cond_br lhs_bool + (if binary.value.op = Core.LogicAnd then rhs_block else end_block) + (if binary.value.op = Core.LogicAnd then end_block else rhs_block) + t.builder); + Llvm.position_at_end rhs_block t.builder; + let rhs_value = emit_expr t binary.value.right in + let rhs_bool = emit_to_bool t binary.value.right rhs_value in + let rhs_block_final = Llvm.insertion_block t.builder in + ignore (Llvm.build_br end_block t.builder); + Llvm.position_at_end end_block t.builder; + let incoming = + if binary.value.op = Core.LogicAnd then + [ (Llvm.const_int (i1_type t) 0, current_block); (rhs_bool, rhs_block_final) ] + else + [ (Llvm.const_int (i1_type t) 1, current_block); (rhs_bool, rhs_block_final) ] + in + Llvm.build_phi incoming "logic.phi" t.builder + and emit_nonfloat_binary t (expr : Core.expression) binary lhs rhs lhs_ty rhs_ty result_ty = let cast_to_result lhs rhs = if Analysis.resolved_is_numeric result_ty then @@ -2285,7 +2344,8 @@ let declare_global_symbol t (decl : Core.var_decl) = (if decl.value.public 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 then Llvm.set_initializer (zero_constant t resolved) storage; + if decl.value.init_expr = None && not decl.value.public then + Llvm.set_initializer (zero_constant t resolved) storage; let symbol = Variable_symbol { storage; resolved_type = resolved; is_mutable = decl.value.is_mutable } @@ -2327,13 +2387,16 @@ let lower_global_initializer t (decl : Core.var_decl) = | Variable_symbol { storage; resolved_type; _ } -> ( match decl.value.init_expr with | None -> - Llvm.set_initializer (zero_constant t resolved_type) storage; - t.global_inits_rev <- { decl; storage } :: t.global_inits_rev + if not decl.value.public 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) | Some init -> ( match constant_of_expr t init with | Some constant -> Llvm.set_initializer constant storage | None -> + 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)) | Function_symbol _ -> fail "global %s unexpectedly resolved to function" decl.value.name.value diff --git a/src/lib/parser/grammar.mly b/src/lib/parser/grammar.mly index e4d3267..afa30c9 100644 --- a/src/lib/parser/grammar.mly +++ b/src/lib/parser/grammar.mly @@ -46,7 +46,7 @@ %left LT GT LE GE %left LSHIFT RSHIFT %left PLUS MINUS -%left MULITPLY DIVIDE MODULO +%left STAR SLASH PERCENT %nonassoc UMINUS BANG TILDE %start program @@ -210,9 +210,9 @@ expr: | l=expr WALRUS r=expr { mk_binary $startpos $endpos Mutate l r } | l=expr PLUS r=expr { mk_binary $startpos $endpos Add l r } | l=expr MINUS r=expr { mk_binary $startpos $endpos Subtract l r } - | l=expr STAR r=expr %prec MULITPLY { mk_binary $startpos $endpos Multiply l r } - | l=expr SLASH r=expr %prec DIVIDE { mk_binary $startpos $endpos Divide l r } - | l=expr PERCENT r=expr %prec MODULO { mk_binary $startpos $endpos Modulo l r } + | l=expr STAR r=expr { mk_binary $startpos $endpos Multiply l r } + | l=expr SLASH r=expr { mk_binary $startpos $endpos Divide l r } + | l=expr PERCENT r=expr { mk_binary $startpos $endpos Modulo l r } | l=expr AMP r=expr %prec BITWISE_AND { mk_binary $startpos $endpos BitwiseAnd l r } | l=expr CARET r=expr %prec BITWISE_XOR { mk_binary $startpos $endpos BitwiseXor l r } | l=expr PIPE r=expr %prec BITWISE_OR { mk_binary $startpos $endpos BitwiseOr l r } @@ -328,12 +328,12 @@ identifier: i=IDENT { mk_id i $startpos $endpos } ; haven_type: | t=type_primary { t } - | t=type_primary STAR { mk_loc $startpos $endpos (PointerType t) } - | t=type_primary CARET { + | t=haven_type STAR { mk_loc $startpos $endpos (PointerType t) } + | t=haven_type CARET { let ty : haven_type_desc = BoxType t in mk_loc $startpos $endpos ty } - | t=type_primary LBRACKET c=integer_literal RBRACKET { mk_loc $startpos $endpos (ArrayType (mk_loc $startpos $endpos { element = t; count = c })) } + | t=haven_type LBRACKET c=integer_literal RBRACKET { mk_loc $startpos $endpos (ArrayType (mk_loc $startpos $endpos { element = t; count = c })) } ; type_primary: diff --git a/src/test/test_llvm_ir.ml b/src/test/test_llvm_ir.ml index ddd9343..e1953e1 100644 --- a/src/test/test_llvm_ir.ml +++ b/src/test/test_llvm_ir.ml @@ -123,6 +123,38 @@ let run () = (string_contains ctor_ir "@llvm.global_ctors"); assert_true "non-constant globals should emit the init function" (string_contains ctor_ir "@__haven_global_init"); + assert_true "startup-initialized data must remain writable in LLVM" + (string_contains ctor_ir "@GLOBAL = internal global i32 0"); + + let external_ir = + emit_ir + "pub state i32 supplied_elsewhere;\npub fn read() -> i32 { supplied_elsewhere }" + in + assert_true "initializer-less public state should remain an external declaration" + (string_contains external_ir "@supplied_elsewhere = external global i32"); + assert_true "external declarations should not synthesize startup initialization" + (not (string_contains external_ir "@__haven_global_init")); + + let constant_cast_ir = + emit_ir + "data u32 ZERO = as(0);\npub fn main() -> u32 { ZERO }" + in + assert_true "constant casts should match the declared global type" + (string_contains constant_cast_ir "@ZERO = internal constant i32 0"); + + let short_circuit_ir = + emit_ir + {| +state i32 calls = 0; +impure fn rhs() -> i32 { + calls = calls + 1; + 1 +} +pub impure fn test() -> i1 { 0 && rhs() } +|} + in + assert_true "logical RHS should only be emitted in the conditional block" + (count_occurrences short_circuit_ir "call i32 @rhs()" = 1); let box_ir = emit_ir "pub fn forward(i32^ input) -> i32^ { defer unbox input; input }" in assert_true "box ownership should call box ref" diff --git a/src/test/test_parser.ml b/src/test/test_parser.ml index 1d9f40b..19c40ab 100644 --- a/src/test/test_parser.ml +++ b/src/test/test_parser.ml @@ -16,6 +16,12 @@ let run () = assert_parse_ok "specialization hole parameter types" "fn vadd(fvec? a, mat? b) { a }"; + assert_parse_ok "nested pointer type" + "pub fn follow(i8** cursor) -> i8* { load cursor }"; + + assert_parse_ok "composed pointer and array postfixes" + "pub fn first(i8*[2] values) -> i8* { values[0] }"; + assert_parse_ok "compile-time assert statement" "fn vadd(fvec? a, fvec? b) { @assert a.dim == b.dim, \"dims must match\"; a + b }"; @@ -93,6 +99,18 @@ extend Buffer with { assert_true "specialization function should keep omitted return type through core conversion" (specialized_fn.value.return_type = None); + let associativity_core = + parse_to_core "pub fn calculate() -> i32 { 15 * 100 / 400 }" + in + let calculate_fn = find_named_function "calculate" associativity_core in + (match Option.bind calculate_fn.value.definition (fun body -> body.value.result) with + | Some { value = Core.Binary divide; _ } + when divide.value.op = Core.Divide -> ( + match divide.value.left.value with + | Core.Binary multiply when multiply.value.op = Core.Multiply -> () + | _ -> failwith "expected multiplication to be the left operand of division") + | _ -> failwith "expected same-tier arithmetic operators to associate left"); + let assert_core = parse_to_core "fn vadd(fvec? a, fvec? b) { @assert a.dim == b.dim, \"dims must match\"; a + b }" diff --git a/src/test/test_rc.ml b/src/test/test_rc.ml index fb7e943..b1b96f2 100644 --- a/src/test/test_rc.ml +++ b/src/test/test_rc.ml @@ -18,7 +18,9 @@ let rc_cases = { name = "add"; expected_rc = 6 }; { name = "prec1"; expected_rc = 90 }; { name = "prec2"; expected_rc = 0 }; + { name = "associativity"; expected_rc = 3 }; { name = "shortcircuit"; expected_rc = 1 }; + { name = "cast_mutate"; expected_rc = 7 }; { name = "constant"; expected_rc = 0 }; { name = "struct"; expected_rc = 3 }; { name = "match"; expected_rc = 0 }; diff --git a/src/test/test_typing_semantics.ml b/src/test/test_typing_semantics.ml index 451b2f8..f5b7d31 100644 --- a/src/test/test_typing_semantics.ml +++ b/src/test/test_typing_semantics.ml @@ -1,6 +1,17 @@ open Test_support let run () = + let duplicate_function_pipeline = + parse_to_core + "fn duplicate() -> i32 { 1 }\nfn duplicate() -> i32 { 2 }\npub fn main() -> i32 { duplicate() }" + |> Analysis.Pipeline.run_core + in + assert_has_diagnostics "duplicate function definitions should fail semantic analysis" + duplicate_function_pipeline.semantic.diagnostics; + assert_any_diagnostic_message_contains "duplicate function definition wording" + "duplicate function definition duplicate" + duplicate_function_pipeline.semantic.diagnostics; + let bad_semantics = parse_to_core "pub fn main() -> void { break; }" |> Analysis.Pipeline.run_core in diff --git a/tests/inputs/associativity.hv b/tests/inputs/associativity.hv new file mode 100644 index 0000000..af6366e --- /dev/null +++ b/tests/inputs/associativity.hv @@ -0,0 +1,3 @@ +pub fn sut() -> i32 { + 15 * 100 / 400 +} diff --git a/tests/inputs/cast_mutate.hv b/tests/inputs/cast_mutate.hv new file mode 100644 index 0000000..1c92e5d --- /dev/null +++ b/tests/inputs/cast_mutate.hv @@ -0,0 +1,6 @@ +pub impure fn sut() -> i32 { + let mut i32 value = 0; + let i8* raw = as(ref value); + as(raw) := 7; + value +} diff --git a/tests/inputs/shortcircuit.hv b/tests/inputs/shortcircuit.hv index 569df7d..b2757ed 100644 --- a/tests/inputs/shortcircuit.hv +++ b/tests/inputs/shortcircuit.hv @@ -1,11 +1,18 @@ -pub fn and() -> i32 { - as(0 && (1 / 0)) +state i32 calls = 0; + +impure fn rhs() -> i32 { + calls = calls + 10; + 1 +} + +impure fn and() -> i32 { + as(0 && rhs()) } -pub fn or() -> i32 { - as(1 || (1 / 0)) +impure fn or() -> i32 { + as(1 || rhs()) } -pub fn sut() -> i32 { +pub impure fn sut() -> i32 { and() + or() -} \ No newline at end of file +}