Fixes related to environments and lookups

compiler/desugared/disambiguate.ml

@@ -62,12 +62,14 @@ let scope ctx env scope =
   { scope with scope_defs; scope_assertions }
 
 let program prg =
+  (* Caution: this environment building code is very similar to that in
+     scopelang/ast.ml. Any edits should probably be reflected. *)
   let base_typing_env prg =
+    let env = Typing.Env.empty prg.program_ctx in
     let env =
       TopdefName.Map.fold
         (fun name (_e, ty) env -> Typing.Env.add_toplevel_var name ty env)
-        prg.program_topdefs
-        (Typing.Env.empty prg.program_ctx)
+        prg.program_topdefs env
     in
     let env =
       ScopeName.Map.fold

compiler/desugared/name_resolution.ml

@@ -524,6 +524,18 @@ let process_enum_decl (ctxt : context) (edecl : Surface.Ast.enum_decl) : context
       })
     ctxt edecl.enum_decl_cases
 
+let process_topdef ctxt def =
+  let uid =
+    Ident.Map.find (Mark.remove def.Surface.Ast.topdef_name) ctxt.topdefs
+  in
+  {
+    ctxt with
+    topdef_types =
+      TopdefName.Map.add uid
+        (process_type ctxt def.Surface.Ast.topdef_type)
+        ctxt.topdef_types;
+  }
+
 (** Process an item declaration *)
 let process_item_decl
     (scope : ScopeName.t)
@@ -698,14 +710,7 @@ let process_name_item (ctxt : context) (item : Surface.Ast.code_item Mark.pos) :
           "toplevel definition")
       (Ident.Map.find_opt name ctxt.topdefs);
     let uid = TopdefName.fresh ctxt.path def.topdef_name in
-    {
-      ctxt with
-      topdefs = Ident.Map.add name uid ctxt.topdefs;
-      topdef_types =
-        TopdefName.Map.add uid
-          (process_type ctxt def.topdef_type)
-          ctxt.topdef_types;
-    }
+    { ctxt with topdefs = Ident.Map.add name uid ctxt.topdefs }
 
 (** Process a code item that is a declaration *)
 let process_decl_item (ctxt : context) (item : Surface.Ast.code_item Mark.pos) :
@@ -715,7 +720,7 @@ let process_decl_item (ctxt : context) (item : Surface.Ast.code_item Mark.pos) :
   | StructDecl sdecl -> process_struct_decl ctxt sdecl
   | EnumDecl edecl -> process_enum_decl ctxt edecl
   | ScopeUse _ -> ctxt
-  | Topdef _ -> ctxt
+  | Topdef def -> process_topdef ctxt def
 
 (** Process a code block *)
 let process_code_block

compiler/scopelang/ast.ml

@@ -70,21 +70,23 @@ let type_rule decl_ctx env = function
     Call (sc_name, ssc_name, Typed { pos; ty = Mark.add pos TAny })
 
 let type_program (prg : 'm program) : typed program =
+  (* Caution: this environment building code is very similar to that in
+     desugared/disambiguate.ml. Any edits should probably be reflected. *)
   let base_typing_env prg =
-    let typing_env = Typing.Env.empty prg.program_ctx in
-    let typing_env =
+    let env = Typing.Env.empty prg.program_ctx in
+    let env =
       TopdefName.Map.fold
-        (fun name (_, ty) -> Typing.Env.add_toplevel_var name ty)
-        prg.program_topdefs typing_env
+        (fun name ty env -> Typing.Env.add_toplevel_var name ty env)
+        prg.program_ctx.ctx_topdefs env
     in
-    let typing_env =
+    let env =
       ScopeName.Map.fold
-        (fun scope_name scope_decl ->
+        (fun scope_name scope_decl env ->
           let vars = ScopeVar.Map.map fst (Mark.remove scope_decl).scope_sig in
-          Typing.Env.add_scope scope_name ~vars)
-        prg.program_scopes typing_env
+          Typing.Env.add_scope scope_name ~vars env)
+        prg.program_scopes env
     in
-    typing_env
+    env
   in
   let rec build_typing_env prg =
     ModuleName.Map.fold
@@ -92,7 +94,7 @@ let type_program (prg : 'm program) : typed program =
         Typing.Env.add_module modname ~module_env:(build_typing_env prg))
       prg.program_modules (base_typing_env prg)
   in
-  let typing_env =
+  let env =
     ModuleName.Map.fold
       (fun modname prg ->
         Typing.Env.add_module modname ~module_env:(build_typing_env prg))
@@ -102,22 +104,21 @@ let type_program (prg : 'm program) : typed program =
     TopdefName.Map.map
       (fun (expr, typ) ->
         ( Expr.unbox
-            (Typing.expr prg.program_ctx ~leave_unresolved:false ~env:typing_env
-               ~typ expr),
+            (Typing.expr prg.program_ctx ~leave_unresolved:false ~env ~typ expr),
           typ ))
       prg.program_topdefs
   in
   let program_scopes =
     ScopeName.Map.map
       (Mark.map (fun scope_decl ->
-           let typing_env =
+           let env =
              ScopeVar.Map.fold
                (fun svar (typ, _) env -> Typing.Env.add_scope_var svar typ env)
-               scope_decl.scope_sig typing_env
+               scope_decl.scope_sig env
            in
            let scope_decl_rules =
              List.map
-               (type_rule prg.program_ctx typing_env)
+               (type_rule prg.program_ctx env)
                scope_decl.scope_decl_rules
            in
            { scope_decl with scope_decl_rules }))

compiler/scopelang/dependency.ml

@@ -83,9 +83,11 @@ let rec expr_used_defs e =
   in
   match e with
   | ELocation (ToplevelVar { name = v, pos }), _ ->
-    VMap.singleton (Topdef v) pos
+    if TopdefName.path v <> [] then VMap.empty
+    else VMap.singleton (Topdef v) pos
   | (EScopeCall { scope; _ }, m) as e ->
-    VMap.add (Scope scope) (Expr.mark_pos m) (recurse_subterms e)
+    if ScopeName.path scope <> [] then VMap.empty
+    else VMap.add (Scope scope) (Expr.mark_pos m) (recurse_subterms e)
   | EAbs { binder; _ }, _ ->
     let _, body = Bindlib.unmbind binder in
     expr_used_defs body

compiler/scopelang/from_desugared.ml

@@ -826,7 +826,7 @@ let translate_program
             ScopeName.Map.map
               (translate_scope_interface ctx)
               m_desugared.D.program_scopes;
-          program_ctx;
+          program_ctx = ModuleName.Map.find modname program_ctx.ctx_modules;
           program_modules =
             process_modules
               (ModuleName.Map.find modname program_ctx.ctx_modules)

compiler/shared_ast/typing.ml

@@ -315,7 +315,7 @@ module Env = struct
     modules : 'e t A.ModuleName.Map.t;
   }
 
-  let rec empty (decl_ctx : A.decl_ctx) =
+  let empty (decl_ctx : A.decl_ctx) =
     (* We fill the environment initially with the structs and enums
        declarations *)
     {
@@ -331,7 +331,7 @@ module Env = struct
       scope_vars = A.ScopeVar.Map.empty;
       scopes = A.ScopeName.Map.empty;
       toplevel_vars = A.TopdefName.Map.empty;
-      modules = A.ModuleName.Map.map empty decl_ctx.A.ctx_modules;
+      modules = A.ModuleName.Map.empty;
     }
 
   let get t v = Var.Map.find_opt v t.vars
@@ -368,6 +368,26 @@ module Env = struct
         (A.ScopeName.Map.find scope_name t.scopes)
     in
     { t with scope_vars }
+
+  let rec dump ppf env =
+    let pp_sep = Format.pp_print_space in
+    Format.pp_open_vbox ppf 0;
+    (* Format.fprintf ppf "structs: @[<hov>%a@]@,"
+     *   (A.StructName.Map.format_keys ~pp_sep) env.structs;
+     * Format.fprintf ppf "enums: @[<hov>%a@]@,"
+     *   (A.EnumName.Map.format_keys ~pp_sep) env.enums;
+     * Format.fprintf ppf "vars: @[<hov>%a@]@,"
+     *   (Var.Map.format_keys ~pp_sep) env.vars; *)
+    Format.fprintf ppf "scopes: @[<hov>%a@]@,"
+      (A.ScopeName.Map.format_keys ~pp_sep)
+      env.scopes;
+    Format.fprintf ppf "topdefs: @[<hov>%a@]@,"
+      (A.TopdefName.Map.format_keys ~pp_sep)
+      env.toplevel_vars;
+    Format.fprintf ppf "@[<hv 2>modules:@ %a@]"
+      (A.ModuleName.Map.format dump)
+      env.modules;
+    Format.pp_close_box ppf ()
 end
 
 let add_pos e ty = Mark.add (Expr.pos e) ty

compiler/shared_ast/typing.mli

@@ -31,6 +31,9 @@ module Env : sig
   val add_module : ModuleName.t -> module_env:'e t -> 'e t -> 'e t
   val module_env : Uid.Path.t -> 'e t -> 'e t
   val open_scope : ScopeName.t -> 'e t -> 'e t
+
+  val dump : Format.formatter -> 'e t -> unit
+  (** For debug purposes *)
 end
 
 (** In the following functions, the [~leave_unresolved] labeled parameter

compiler/shared_ast/var.ml

@@ -109,6 +109,7 @@ module Map = struct
   let fold f m acc = fold (fun v x acc -> f (get v) x acc) m acc
   let keys m = keys m |> List.map get
   let values m = values m
+  let format_keys ?pp_sep m = format_keys ?pp_sep m
 
   (* Add more as needed *)
 end

compiler/shared_ast/var.mli

@@ -76,4 +76,10 @@ module Map : sig
   val fold : ('e var -> 'x -> 'acc -> 'acc) -> ('e, 'x) t -> 'acc -> 'acc
   val keys : ('e, 'x) t -> 'e var list
   val values : ('e, 'x) t -> 'x list
+
+  val format_keys :
+    ?pp_sep:(Format.formatter -> unit -> unit) ->
+    Format.formatter ->
+    ('e, 'x) t ->
+    unit
 end

tests/test_modules/good/mod_def.catala_en

@@ -9,6 +9,10 @@ declaration enumeration Enum1:
 declaration scope S:
   output sr content money
   output e1 content Enum1
+
+declaration half content decimal
+  depends on x content integer
+  equals x / 2
 ```
 
 ```catala

tests/test_modules/good/mod_use.catala_en

@@ -7,20 +7,71 @@ declaration scope T2:
   output o1 content Mod_def.Enum1
   output o2 content Mod_def.Enum1
   output o3 content money
+  output o4 content decimal
 
 scope T2:
   definition o1 equals Mod_def.Enum1.No
   definition o2 equals t1.e1
   definition o3 equals t1.sr
+  definition o4 equals Mod_def.half of 10
   assertion o1 = Mod_def.Enum1.No
   assertion o2 = Mod_def.Enum1.Maybe
   assertion o3 = $1000
+  assertion o4 = 5.0
 ```
 
 ```catala-test-inline
-$ catala interpret -s T2 --disable_warnings --use mod_def.catala_en
-[RESULT] Computation successful! Results:
-[RESULT] o1 = No ()
-[RESULT] o2 = Maybe ()
-[RESULT] o3 = $1,000.00
+$ catala interpret -s T2 --disable_warnings --use mod_def.catala_en --debug
+[DEBUG] Loading shared modules...
+[DEBUG] Collecting rules...
+[DEBUG] Reading files...
+[DEBUG] Parsing mod_use.catala_en
+[DEBUG] Parsing mod_def.catala_en
+[DEBUG] Name resolution...
+[DEBUG] Desugaring...
+[DEBUG] Disambiguating...
+[DEBUG] Linting...
+[DEBUG] Typechecking...
+[ERROR]
+Reference to Mod_def.half not found
+
+┌─⯈ mod_use.catala_en:16.24-16.36:
+└──┐
+16 │   definition o4 equals Mod_def.half of 10
+   │                        ‾‾‾‾‾‾‾‾‾‾‾‾
+   └─ Test modules + inclusions 2
+Raised at Catala_utils__Message.raise_spanned_error.(fun).continuation in file "compiler/catala_utils/message.ml", line 232, characters 4-183
+Called from Shared_ast__Typing.typecheck_expr_top_down in file "compiler/shared_ast/typing.ml", line 437, characters 8-97
+Called from Shared_ast__Typing.typecheck_expr_top_down in file "compiler/shared_ast/typing.ml", line 810, characters 14-73
+Called from Shared_ast__Typing.typecheck_expr_top_down in file "compiler/shared_ast/typing.ml", line 841, characters 16-74
+Called from Shared_ast__Typing.wrap_expr.(fun) in file "compiler/shared_ast/typing.ml", line 895, characters 32-37
+Called from Shared_ast__Typing.wrap in file "compiler/shared_ast/typing.ml", line 886, characters 6-9
+Called from Shared_ast__Typing.expr in file "compiler/shared_ast/typing.ml", line 926, characters 4-48
+Called from Scopelang__Ast.type_rule in file "compiler/scopelang/ast.ml", line 62, characters 16-75
+Called from Stdlib__List.map in file "list.ml", line 92, characters 20-23
+Called from Stdlib__List.map in file "list.ml", line 92, characters 32-39
+Called from Scopelang__Ast.type_program.(fun) in file "compiler/scopelang/ast.ml", line 119, characters 13-118
+Called from Catala_utils__Mark.map in file "compiler/catala_utils/mark.ml", line 25, characters 19-22
+Called from Stdlib__Map.Make.map in file "map.ml", line 304, characters 19-22
+Called from Scopelang__Ast.type_program in file "compiler/scopelang/ast.ml", line 111, characters 4-498
+Called from Driver.Passes.dcalc in file "compiler/driver.ml", line 114, characters 14-44
+Called from Driver.Commands.interpret_dcalc in file "compiler/driver.ml", line 574, characters 6-68
+Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 24, characters 19-24
+Called from Cmdliner_eval.run_parser in file "cmdliner_eval.ml", line 34, characters 37-44
+Called from Cmdliner_eval.eval_value in file "cmdliner_eval.ml", line 202, characters 14-39
+Called from Driver.main in file "compiler/driver.ml", line 890, characters 8-49
+#return code 123#
+```
+
+```catala-test-inline
+$ catala ocaml --disable_warnings --use mod_def.catala_en
+[ERROR]
+Reference to Mod_def.half not found
+
+┌─⯈ mod_use.catala_en:16.24-16.36:
+└──┐
+16 │   definition o4 equals Mod_def.half of 10
+   │                        ‾‾‾‾‾‾‾‾‾‾‾‾
+   └─ Test modules + inclusions 2
+#return code 123#
 ```