From bb82204659be7a3c07106f8d351fefcee553c2aa Mon Sep 17 00:00:00 2001
From: Patrycja Balik <root@pbalik.com>
Date: Sat, 20 Jul 2024 08:13:55 +0200
Subject: [PATCH] Fix visibility of module patterns (#140)

Fixes #138.
---
 src/DblParser/Desugar.ml                | 2 +-
 src/Lang/Surface.ml                     | 2 +-
 src/TypeInference/Pattern.ml            | 4 ++--
 test/ok/ok0110_publicModulePattern.fram | 6 ++++++
 4 files changed, 10 insertions(+), 4 deletions(-)
 create mode 100644 test/ok/ok0110_publicModulePattern.fram

diff --git a/src/DblParser/Desugar.ml b/src/DblParser/Desugar.ml
index 8eecc3d..0605e6e 100644
--- a/src/DblParser/Desugar.ml
+++ b/src/DblParser/Desugar.ml
@@ -316,7 +316,7 @@ let rec tr_pattern ~public (p : Raw.expr) =
     let ps = List.map (tr_pattern ~public) ps in
     begin match flds with
     | [ { data = FldModule name; _ } ] ->
-      make (PCtor(cpath, CNModule name, ps))
+      make (PCtor(cpath, CNModule(public, name), ps))
     | _ ->
       let (targs, iargs) = map_inst_like (tr_named_pattern ~public) flds in
       make (PCtor(cpath, CNParams(targs, iargs), ps))
diff --git a/src/Lang/Surface.ml b/src/Lang/Surface.ml
index 41144fd..d01f0d6 100644
--- a/src/Lang/Surface.ml
+++ b/src/Lang/Surface.ml
@@ -159,7 +159,7 @@ and pattern_data =
 and ctor_pattern_named =
   | CNParams of named_type_arg list * named_pattern list
     (** Named type parameters and named patterns of a constructor *)
-  | CNModule of module_name
+  | CNModule of is_public * module_name
     (** Bind all named parameters under the specified module name *)
 
 (** Pattern for named parameter *)
diff --git a/src/TypeInference/Pattern.ml b/src/TypeInference/Pattern.ml
index 2a2a2a9..7de73db 100644
--- a/src/TypeInference/Pattern.ml
+++ b/src/TypeInference/Pattern.ml
@@ -201,13 +201,13 @@ let rec check_ctor_named ~pos ~env ~scope
     let (env, bn1, ps1) =
       check_ctor_named_args ~pos ~env ~scope nps ctor_named in
     (env, scope, sub2, tvars, ps1, bn1)
-  | S.CNModule modname ->
+  | S.CNModule(public, modname) ->
     (* TODO: This may seem inconsistent with the other case as implicits aren't
        introduced to the current namespace, just the provided module name. *)
     let env = Env.enter_module env in
     let (env, tvars, ps1, sub2) =
       open_named ~pos ~public:true env ctor.ctor_targs ctor.ctor_named in
-    let env = Env.leave_module env ~public:false modname in
+    let env = Env.leave_module env ~public modname in
     (env, Env.scope env, sub2, tvars, ps1, T.Name.Map.empty)
 
 and check_ctor_named_args ~pos ~env ~scope nps named =
diff --git a/test/ok/ok0110_publicModulePattern.fram b/test/ok/ok0110_publicModulePattern.fram
new file mode 100644
index 0000000..c01f13d
--- /dev/null
+++ b/test/ok/ok0110_publicModulePattern.fram
@@ -0,0 +1,6 @@
+module M
+  data T = C of { x : Int }
+  pub let C { module N } = C { x = 42 }
+end
+
+let x = M.N.x