diff --git a/build_system/clerk_driver.ml b/build_system/clerk_driver.ml index da51f3cb..5b8da955 100644 --- a/build_system/clerk_driver.ml +++ b/build_system/clerk_driver.ml @@ -747,7 +747,7 @@ let test_cmd = [ Nj.binding Var.post_test [ - "test_reset() { if ! diff -q $$1 $$2; then cp -f $$2 $$1; \ + "test_reset() { if ! diff -q $$1 $$2 >/dev/null; then cp -f $$2 $$1; \ fi; }"; ";"; "test_reset"; diff --git a/compiler/desugared/from_surface.ml b/compiler/desugared/from_surface.ml index a9bb6907..e230cb58 100644 --- a/compiler/desugared/from_surface.ml +++ b/compiler/desugared/from_surface.ml @@ -474,7 +474,8 @@ let rec translate_expr (* This type will be resolved in Scopelang.Desambiguation *) let fn = Expr.make_abs [| v |] (rec_helper ~local_vars e2) [tau] pos in Expr.eapp fn [rec_helper e1] emark - | StructLit ((([], s_name), _), fields) -> + | StructLit (((path, s_name), _), fields) -> + let ctxt = Name_resolution.module_ctx ctxt path in let s_uid = match Ident.Map.find_opt (Mark.remove s_name) ctxt.typedefs with | Some (Name_resolution.TStruct s_uid) -> s_uid @@ -515,8 +516,6 @@ let rec translate_expr expected_s_fields; Expr.estruct ~name:s_uid ~fields:s_fields emark - | StructLit (((_, _s_name), _), _fields) -> - Message.raise_spanned_error pos "Qualified paths are not supported yet" | EnumInject (((path, (constructor, pos_constructor)), _), payload) -> ( let get_possible_c_uids ctxt = try Ident.Map.find constructor ctxt.Name_resolution.constructor_idmap @@ -1425,6 +1424,7 @@ let init_scope_defs (** Main function of this module *) let translate_program (ctxt : Name_resolution.context) (surface : S.program) : Ast.program = + let top_ctx = ctxt in let desugared = let get_program_scopes ctxt = ScopeName.Map.mapi @@ -1455,7 +1455,7 @@ let translate_program (ctxt : Name_resolution.context) (surface : S.program) : { Ast.scope_vars; scope_sub_scopes; - scope_defs = init_scope_defs ctxt s_context.var_idmap; + scope_defs = init_scope_defs top_ctx s_context.var_idmap; scope_assertions = Ast.AssertionName.Map.empty; scope_meta_assertions = []; scope_options = []; diff --git a/compiler/desugared/linting.ml b/compiler/desugared/linting.ml index 1c3b6d68..41e45683 100644 --- a/compiler/desugared/linting.ml +++ b/compiler/desugared/linting.ml @@ -112,9 +112,10 @@ let detect_unused_struct_fields (p : program) : unit = let rec structs_fields_used_expr e struct_fields_used = match Mark.remove e with | EDStructAccess { name_opt = Some name; e = e_struct; field } -> + let ctx = Program.module_ctx p.program_ctx (StructName.path name) in let field = StructName.Map.find name - (Ident.Map.find field p.program_ctx.ctx_struct_fields) + (Ident.Map.find field ctx.ctx_struct_fields) in StructField.Set.add field (structs_fields_used_expr e_struct struct_fields_used) diff --git a/compiler/scopelang/from_desugared.ml b/compiler/scopelang/from_desugared.ml index 722261f7..ae2acd00 100644 --- a/compiler/scopelang/from_desugared.ml +++ b/compiler/scopelang/from_desugared.ml @@ -105,9 +105,10 @@ let rec translate_expr (ctx : ctx) (e : D.expr) : untyped Ast.expr boxed = | EDStructAccess { e; field; name_opt = Some name } -> let e' = translate_expr ctx e in let field = + let decl_ctx = Program.module_ctx ctx.decl_ctx (StructName.path name) in try StructName.Map.find name - (Ident.Map.find field ctx.decl_ctx.ctx_struct_fields) + (Ident.Map.find field decl_ctx.ctx_struct_fields) with StructName.Map.Not_found _ | Ident.Map.Not_found _ -> (* Should not happen after disambiguation *) Message.raise_spanned_error (Expr.mark_pos m) diff --git a/compiler/shared_ast/typing.ml b/compiler/shared_ast/typing.ml index ab821589..49d0ef8d 100644 --- a/compiler/shared_ast/typing.ml +++ b/compiler/shared_ast/typing.ml @@ -533,6 +533,7 @@ and typecheck_expr_top_down : A.StructName.format name in let field = + let ctx = Program.module_ctx ctx (A.StructName.path name) in let candidate_structs = try A.Ident.Map.find field ctx.ctx_struct_fields with A.Ident.Map.Not_found _ -> diff --git a/tests/test_modules/good/mod_def.catala_en b/tests/test_modules/good/mod_def.catala_en index 5fba6c5b..5b8936d1 100644 --- a/tests/test_modules/good/mod_def.catala_en +++ b/tests/test_modules/good/mod_def.catala_en @@ -8,6 +8,10 @@ declaration enumeration Enum1: -- No -- Maybe +declaration structure Str1: + data fld1 content Enum1 + data fld2 content integer + declaration scope S: output sr content money output e1 content Enum1 diff --git a/tests/test_modules/good/mod_middle.catala_en b/tests/test_modules/good/mod_middle.catala_en index 2c9ac730..9ed920e0 100644 --- a/tests/test_modules/good/mod_middle.catala_en +++ b/tests/test_modules/good/mod_middle.catala_en @@ -6,15 +6,16 @@ declaration scope S: input x content integer output o1 content Mod_def.S - # context -- this should work output o2 content money + # context -- this should work + output o3 content money ``` ```catala scope S: definition o1 equals output of Mod_def.S -# definition o2 equals o1.Mod_def.S.sr * 2 -- this should work ? - definition o2 equals $44 * (decimal of x) + definition o2 equals o1.Mod_def.S.sr * 2. + o1.sr / 2. + definition o3 equals $44 * (decimal of x) ``` ```catala-test-inline diff --git a/tests/test_modules/good/mod_use.catala_en b/tests/test_modules/good/mod_use.catala_en index 53ce372e..a5bd15d2 100644 --- a/tests/test_modules/good/mod_use.catala_en +++ b/tests/test_modules/good/mod_use.catala_en @@ -16,6 +16,7 @@ scope T2: definition o2 equals t1.e1 definition o3 equals t1.sr definition o4 equals Mod_def.half of 10 + assertion (Mod_def.Str1 { -- fld1: No -- fld2: 1 }).Mod_def.Str1.fld1 = No assertion o1 = Mod_def.Enum1.No assertion o2 = Mod_def.Enum1.Maybe assertion o3 = $1000 diff --git a/tests/test_modules/good/mod_use2.catala_en b/tests/test_modules/good/mod_use2.catala_en index 1f1dafaf..3920042f 100644 --- a/tests/test_modules/good/mod_use2.catala_en +++ b/tests/test_modules/good/mod_use2.catala_en @@ -6,20 +6,25 @@ declaration scope T: # input i content Enum1 output o1 content Mod_def.S output o2 content money + output o3 content money scope T: definition t1.x equals 3 definition o1 equals t1.o1 definition o2 equals t1.o2 + definition o3 equals t1.o3 ``` ```catala-test-inline $ catala interpret -s T [RESULT] Computation successful! Results: [RESULT] o1 = Mod_def.S { -- sr: $1,000.00 -- e1: Maybe () } -[RESULT] o2 = $132.00 +[RESULT] o2 = $2,500.00 +[RESULT] o3 = $132.00 ``` +The following tests multiple inclusion of the same module (Mod_def is used through Mod_middle here, and also directly by mod_use.catala_en included below) + > Include: mod_use.catala_en ```catala-test-inline diff --git a/tests/test_modules/good/output/mod_def.ml b/tests/test_modules/good/output/mod_def.ml index 96e8de31..2249b54e 100644 --- a/tests/test_modules/good/output/mod_def.ml +++ b/tests/test_modules/good/output/mod_def.ml @@ -16,6 +16,10 @@ module S = struct type t = {sr: money; e1: Enum1.t} end +module Str1 = struct + type t = {fld1: Enum1.t; fld2: integer} +end + module S_in = struct type t = unit end @@ -32,8 +36,8 @@ let s (s_in: S_in.t) : S.t = (fun (_: unit) -> money_of_cents_string "100000")) with EmptyError -> (raise (NoValueProvided - {filename = "tests/test_modules/good/mod_def.catala_en"; start_line=12; - start_column=10; end_line=12; end_column=12; + {filename = "tests/test_modules/good/mod_def.catala_en"; start_line=16; + start_column=10; end_line=16; end_column=12; law_headings=["Test modules + inclusions 1"]})) in let e1_: Enum1.t = try @@ -43,8 +47,8 @@ let s (s_in: S_in.t) : S.t = (fun (_: unit) -> true) (fun (_: unit) -> Enum1.Maybe ())) with EmptyError -> (raise (NoValueProvided - {filename = "tests/test_modules/good/mod_def.catala_en"; start_line=13; - start_column=10; end_line=13; end_column=12; + {filename = "tests/test_modules/good/mod_def.catala_en"; start_line=17; + start_column=10; end_line=17; end_column=12; law_headings=["Test modules + inclusions 1"]})) in {S.sr = sr_; S.e1 = e1_}