From d8c120bf97d1f58489dbf51e62314d5ed42e231a Mon Sep 17 00:00:00 2001
From: Denis Merigoux <denis.merigoux@gmail.com>
Date: Fri, 4 Feb 2022 14:34:25 +0100
Subject: [PATCH] Propagate visibility down, missing handling in scope_to_dcalc

---
 compiler/desugared/desugared_to_scope.ml             |  5 +++--
 compiler/scopelang/ast.ml                            |  6 +++---
 compiler/scopelang/ast.mli                           | 12 ++++++------
 compiler/scopelang/print.ml                          |  6 ++++--
 compiler/scopelang/scope_to_dcalc.ml                 |  8 ++------
 .../good/output/test_bool.catala_en.Scopelang        |  2 +-
 6 files changed, 19 insertions(+), 20 deletions(-)

diff --git a/compiler/desugared/desugared_to_scope.ml b/compiler/desugared/desugared_to_scope.ml
index 426e70f8..64662a46 100644
--- a/compiler/desugared/desugared_to_scope.ml
+++ b/compiler/desugared/desugared_to_scope.ml
@@ -269,8 +269,9 @@ let translate_scope (scope : Ast.scope) : Scopelang.Ast.scope_decl =
   let scope_sig =
     Scopelang.Ast.ScopeVarSet.fold
       (fun var acc ->
-        let typ = (Ast.ScopeDefMap.find (Ast.ScopeDef.Var var) scope.scope_defs).scope_def_typ in
-        Scopelang.Ast.ScopeVarMap.add var typ acc)
+        let scope_def = Ast.ScopeDefMap.find (Ast.ScopeDef.Var var) scope.scope_defs in
+        let typ = scope_def.scope_def_typ in
+        Scopelang.Ast.ScopeVarMap.add var (typ, scope_def.scope_def_visibility) acc)
       scope.scope_vars Scopelang.Ast.ScopeVarMap.empty
   in
   {
diff --git a/compiler/scopelang/ast.ml b/compiler/scopelang/ast.ml
index cee7619f..2c5cb6d7 100644
--- a/compiler/scopelang/ast.ml
+++ b/compiler/scopelang/ast.ml
@@ -118,16 +118,16 @@ let rec locations_used (e : expr Pos.marked) : LocationSet.t =
       List.fold_left (fun acc e' -> LocationSet.union acc (locations_used e')) LocationSet.empty es
   | ErrorOnEmpty e' -> locations_used e'
 
+type visibility = { visibility_output : bool; visibility_input : bool }
+
 type rule =
   | Definition of location Pos.marked * typ Pos.marked * expr Pos.marked
   | Assertion of expr Pos.marked
   | Call of ScopeName.t * SubScopeName.t
 
-type visibility = { visibility_output : bool; visibility_input : bool }
-
 type scope_decl = {
   scope_decl_name : ScopeName.t;
-  scope_sig : typ Pos.marked ScopeVarMap.t;
+  scope_sig : (typ Pos.marked * visibility) ScopeVarMap.t;
   scope_decl_rules : rule list;
 }
 
diff --git a/compiler/scopelang/ast.mli b/compiler/scopelang/ast.mli
index 5bb5b532..725330e8 100644
--- a/compiler/scopelang/ast.mli
+++ b/compiler/scopelang/ast.mli
@@ -84,19 +84,19 @@ type expr =
 
 val locations_used : expr Pos.marked -> LocationSet.t
 
-type rule =
-  | Definition of location Pos.marked * typ Pos.marked * expr Pos.marked
-  | Assertion of expr Pos.marked
-  | Call of ScopeName.t * SubScopeName.t
-
 type visibility = {
   visibility_output : bool;  (** True if present in the scope's output *)
   visibility_input : bool;  (** True if present in the scope's input (reentrant) *)
 }
 
+type rule =
+  | Definition of location Pos.marked * typ Pos.marked * expr Pos.marked
+  | Assertion of expr Pos.marked
+  | Call of ScopeName.t * SubScopeName.t
+
 type scope_decl = {
   scope_decl_name : ScopeName.t;
-  scope_sig : typ Pos.marked ScopeVarMap.t;
+  scope_sig : (typ Pos.marked * visibility) ScopeVarMap.t;
   scope_decl_rules : rule list;
 }
 
diff --git a/compiler/scopelang/print.ml b/compiler/scopelang/print.ml
index a2b588b4..6fc30360 100644
--- a/compiler/scopelang/print.ml
+++ b/compiler/scopelang/print.ml
@@ -147,8 +147,10 @@ let format_scope (fmt : Format.formatter) ((name, decl) : ScopeName.t * scope_de
     ScopeName.format_t name
     (Format.pp_print_list
        ~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ")
-       (fun fmt (scope_var, typ) ->
-         Format.fprintf fmt "(%a: %a)" ScopeVar.format_t scope_var format_typ typ))
+       (fun fmt (scope_var, (typ, vis)) ->
+         Format.fprintf fmt "(%a: %a%s%s)" ScopeVar.format_t scope_var format_typ typ
+           (if vis.visibility_input then "|input" else "")
+           (if vis.visibility_output then "|output" else "")))
     (ScopeVarMap.bindings decl.scope_sig)
     (Format.pp_print_list
        ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@\n")
diff --git a/compiler/scopelang/scope_to_dcalc.ml b/compiler/scopelang/scope_to_dcalc.ml
index d31ae7a2..00076c49 100644
--- a/compiler/scopelang/scope_to_dcalc.ml
+++ b/compiler/scopelang/scope_to_dcalc.ml
@@ -644,16 +644,12 @@ let translate_program (prgm : Ast.program) : Dcalc.Ast.program * Dependency.TVer
         {
           scope_sig_local_vars =
             List.map
-              (fun (scope_var, tau) ->
+              (fun (scope_var, (tau, vis)) ->
                 let tau = translate_typ (ctx_for_typ_translation scope_name) tau in
                 {
                   scope_var_name = scope_var;
                   scope_var_typ = Pos.unmark tau;
-                  scope_var_visibility =
-                    {
-                      visibility_input = true;
-                      visibility_output = true (* TODO: change with info from desugared *);
-                    };
+                  scope_var_visibility = vis;
                 })
               (Ast.ScopeVarMap.bindings scope.scope_sig);
           scope_sig_scope_var = scope_dvar;
diff --git a/tests/test_bool/good/output/test_bool.catala_en.Scopelang b/tests/test_bool/good/output/test_bool.catala_en.Scopelang
index 40f2f4b3..faa95a21 100644
--- a/tests/test_bool/good/output/test_bool.catala_en.Scopelang
+++ b/tests/test_bool/good/output/test_bool.catala_en.Scopelang
@@ -1,4 +1,4 @@
-let scope TestBool (foo: bool) (bar: integer) =
+let scope TestBool (foo: bool|input|output) (bar: integer|input|output) =
   let bar : integer =
     reentrant or by default
       ⟨⟨true ⊢ ⟨⟨true ⊢ 1⟩ | false ⊢ ∅ ⟩⟩ |