Repository: fram-lang/dbl
Pull request #218: fix: allow positively recursive types
Author: login: dominik-muc
Created: 2025-04-04T19:46:28Z | Merged: 2025-04-08T16:44:59Z

I'm not sure it's the correct approach for checking positive recursion, please verify me.


Diff:
diff --git a/src/Lang/Core.mli b/src/Lang/Core.mli
index ed0cd6de..f5d7ed8e 100644
--- a/src/Lang/Core.mli
+++ b/src/Lang/Core.mli
@@ -95,7 +95,7 @@ type _ typ =
 
       The element of type [TData(tp, eff, ctors)] is a witness that type [tp]
       has constructors [ctors]. The effect [eff] is an effect of
-      pattern-matching: its pure for strictly positively recursive types,
+      pattern-matching: its pure for positively recursive types,
       and impure for other types (because it may lead to non-termination). *)
 
   | TApp     : ('k1 -> 'k2) typ * 'k1 typ -> 'k2 typ
@@ -141,8 +141,8 @@ type data_def =
       ctors : ctor_type list;
         (** List of constructors. *)
 
-      strictly_positive : bool
-        (** A flag indicating if the type is strictly positively recursive (in
+      positive : bool
+        (** A flag indicating if the type is positively recursive (in
           particular, not recursive at all) and therefore can be deconstructed
           without performing NTerm effect. *)
     }
diff --git a/src/Lang/CorePriv/Syntax.ml b/src/Lang/CorePriv/Syntax.ml
index 7ca2ff76..53a32f17 100644
--- a/src/Lang/CorePriv/Syntax.ml
+++ b/src/Lang/CorePriv/Syntax.ml
@@ -10,11 +10,11 @@ type var = Var.t
 
 type data_def =
   | DD_Data of
-    { tvar              : TVar.ex;
-      proof             : var;
-      args              : TVar.ex list;
-      ctors             : ctor_type list;
-      strictly_positive : bool
+    { tvar      : TVar.ex;
+      proof     : var;
+      args      : TVar.ex list;
+      ctors     : ctor_type list;
+      positive  : bool
     }
   | DD_Label of
     { tvar      : keffect tvar;
diff --git a/src/Lang/CorePriv/Type.ml b/src/Lang/CorePriv/Type.ml
index 02228c18..c5a33902 100644
--- a/src/Lang/CorePriv/Type.ml
+++ b/src/Lang/CorePriv/Type.ml
@@ -405,54 +405,85 @@ and subtype_in_scope scope (tp : ttype) =
     | _ -> None
     end
 
-(** Check if all types on non-strictly positive positions fits in given
+(** Check if all types on non-positive positions fits in given
   scope. *)
-let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
+let rec positive : type k. nonrec_scope:_ -> k typ -> bool =
   fun ~nonrec_scope tp ->
   match tp with
   | TVar _ | TEffPure -> true
-  | TGuard _ | TLabel _ | TData _ ->
+  | TLabel _ | TData _ ->
     begin match type_in_scope nonrec_scope tp with
     | Some _ -> true
     | None   -> false
     end
 
+  | TGuard (constraints, tp) ->
+    positive ~nonrec_scope tp &&
+    List.for_all
+      (fun (lhs, rhs) ->
+        positive ~nonrec_scope lhs &&
+        negative ~nonrec_scope rhs)
+      constraints
+
   | TEffJoin(eff1, eff2) ->
-    strictly_positive ~nonrec_scope eff1 &&
-    strictly_positive ~nonrec_scope eff2
+    positive ~nonrec_scope eff1 &&
+    positive ~nonrec_scope eff2
 
   | TArrow(tp1, tp2, eff) ->
-    begin match
-      type_in_scope nonrec_scope tp1,
-      strictly_positive ~nonrec_scope tp2,
-      strictly_positive ~nonrec_scope eff
-    with
-    | Some _, true, true -> true
-    | _ -> false
-    end
+    negative ~nonrec_scope tp1 &&
+    positive ~nonrec_scope tp2 &&
+    positive ~nonrec_scope eff
 
   | TForall(a, tp) ->
-    strictly_positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
+    positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
 
   | TApp(tp1, tp2) ->
     begin match
-      strictly_positive ~nonrec_scope tp1,
+      positive ~nonrec_scope tp1,
       type_in_scope nonrec_scope tp2
     with
     | true, Some _ -> true
     | _ -> false
     end
 
-(** Check if all types on non-strictly positive positions fits in given
+(** Check if all types on non-negative positions fits in given
+  scope. *)
+and negative : type k. nonrec_scope:_ -> k typ -> bool =
+  fun ~nonrec_scope tp ->
+  match tp with
+  | TEffPure -> true
+  | TVar _  | TLabel _ | TData _ | TApp _ | TEffJoin _ ->
+    begin match type_in_scope nonrec_scope tp with
+    | Some _ -> true
+    | None   -> false
+    end
+
+  | TGuard (constraints, tp) ->
+    negative ~nonrec_scope tp &&
+    List.for_all
+      (fun (lhs, rhs) ->
+        negative ~nonrec_scope lhs &&
+        positive ~nonrec_scope rhs)
+      constraints
+
+  | TArrow(tp1, tp2, eff) ->
+    positive ~nonrec_scope tp1 &&
+    negative ~nonrec_scope tp2 &&
+    negative ~nonrec_scope eff
+
+  | TForall(a, tp) ->
+    negative ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
+
+(** Check if all types on non-positive positions fits in given
   scope (for ADT constructors) *)
-let strictly_positive_ctor ~nonrec_scope ctor =
+let positive_ctor ~nonrec_scope ctor =
   let nonrec_scope = add_tvars_to_scope ctor.ctor_tvars nonrec_scope in
-  List.for_all (strictly_positive ~nonrec_scope) ctor.ctor_arg_types
+  List.for_all (positive ~nonrec_scope) ctor.ctor_arg_types
 
-(** Check if all types on non-strictly positive positions fits in given
+(** Check if all types on non-positive positions fits in given
   scope (for list of ADT constructors) *)
-let strictly_positive_ctors ~nonrec_scope ctors =
-  List.for_all (strictly_positive_ctor ~nonrec_scope) ctors
+let positive_ctors ~nonrec_scope ctors =
+  List.for_all (positive_ctor ~nonrec_scope) ctors
 
 type ex = Ex : 'k typ -> ex
 
diff --git a/src/Lang/CorePriv/WellTypedInvariant.ml b/src/Lang/CorePriv/WellTypedInvariant.ml
index 23cb03ee..245fa76c 100644
--- a/src/Lang/CorePriv/WellTypedInvariant.ml
+++ b/src/Lang/CorePriv/WellTypedInvariant.ml
@@ -285,23 +285,23 @@ let prepare_data_def env (dd : data_def) =
     (env, DD_Label { lbl with tvar = a })
 
 (** Compute the effect attached to the datatype (the effect of
-  pattern-matching). Types flagged as strictly positive have pure effect
+  pattern-matching). Types flagged as positive have pure effect
   of pattern-matching, but the function ensures that provided constructors
-  are strictly positive, i.e., all type variables on non-strictly-positive
+  are positive, i.e., all type variables on non-positive
   position fit in [nonrec_scope]. The [nonrec_scope] should be a scope of
   the definition not extended with types defined in the current recursive
   block.
 
-  If the type is not flagged as strictly positive, have always NTerm effect
+  If the type is not flagged as positive, have always NTerm effect
   attached, and no extra checks are performed. *)
-let adt_effect ~nonrec_scope strictly_positive args ctors =
-  if strictly_positive then
+let adt_effect ~nonrec_scope positive args ctors =
+  if positive then
     let nonrec_scope = Type.add_tvars_to_scope args nonrec_scope in
-    if Type.strictly_positive_ctors ~nonrec_scope ctors then
+    if Type.positive_ctors ~nonrec_scope ctors then
       TEffPure
     else
       InterpLib.InternalError.report
-        ~reason:"Type is not strictly positively recursive"
+        ~reason:"Type is not positively recursive"
         ()
   else
     Effect.nterm
@@ -321,7 +321,7 @@ let finalize_data_def ~nonrec_scope (env, dd_eff) dd =
   | DD_Data adt ->
     let (TVar.Ex a) = adt.tvar in
     let (xs, data_tp, ctors) = check_data env (TVar a) adt.args adt.ctors in
-    let eff = adt_effect ~nonrec_scope adt.strictly_positive xs ctors in
+    let eff = adt_effect ~nonrec_scope adt.positive xs ctors in
     let env =
       Env.add_irr_var env adt.proof
         (Type.t_foralls xs (TData(data_tp, eff, ctors))) in
diff --git a/src/Lang/Unif.mli b/src/Lang/Unif.mli
index 4f4d1529..e4f68aee 100644
--- a/src/Lang/Unif.mli
+++ b/src/Lang/Unif.mli
@@ -227,8 +227,8 @@ type data_def =
         (** List of constructors. *)
 
       eff    : effct
-        (** An effect indicating if the type is strictly positively recursive
-          (in particular, not recursive at all). Strictly positively recursive
+        (** An effect indicating if the type is positively recursive
+          (in particular, not recursive at all). Positively recursive
           types can be deconstructed in a pure way. *)
     }
 
diff --git a/src/ToCore/DataType.ml b/src/ToCore/DataType.ml
index e63b076b..833aca09 100644
--- a/src/ToCore/DataType.ml
+++ b/src/ToCore/DataType.ml
@@ -69,11 +69,11 @@ let finalize_data_def env (dd : data_def) =
     let (env, args) = Env.add_named_tvars env dd.args in
     let ctors = tr_ctor_decls env dd.ctors in
     T.DD_Data {
-      tvar              = dd.tvar;
-      proof             = dd.proof;
-      args              = args;
-      ctors             = ctors;
-      strictly_positive = dd.positive;
+      tvar      = dd.tvar;
+      proof     = dd.proof;
+      args      = args;
+      ctors     = ctors;
+      positive  = dd.positive;
     }
 
   | DD_Label dd ->
diff --git a/src/TypeInference/Module.mli b/src/TypeInference/Module.mli
index 28306225..3a2bbb16 100644
--- a/src/TypeInference/Module.mli
+++ b/src/TypeInference/Module.mli
@@ -28,7 +28,7 @@ type adt_info = {
 
   adt_effect : T.effct
     (** An effect of pattern-matching on this type. Generally it is [Pure]
-      for strictly poisitively recursive types. *)
+      for positively recursive types. *)
 }
 
 (** Information about type *)
diff --git a/test/ok/ok0129_positiveAdt.fram b/test/ok/ok0129_positiveAdt.fram
new file mode 100644
index 00000000..beb7ea36
--- /dev/null
+++ b/test/ok/ok0129_positiveAdt.fram
@@ -0,0 +1,2 @@
+data rec T = C of ((T -> Unit) -> Unit)
+let foo (C f) = f (fn (C g) => g (fn _ => ()))


Reviews:
user: login: ppolesiuk
body: Thanks for this PR. Unfortunately, the positivity checking in Core is not implemented correctly (and is bit inelegant). This should be fixed before merging. See comments below.
state: CHANGES_REQUESTED
author_association: MEMBER
submitted_at: 2025-04-05T08:10:18Z
user: login: dominik-muc
state: COMMENTED
author_association: MEMBER
submitted_at: 2025-04-05T19:27:13Z
user: login: ppolesiuk
state: COMMENTED
author_association: MEMBER
submitted_at: 2025-04-06T03:56:05Z
user: login: ppolesiuk
body: Now, it looks better, but still needs to be improved. As for now, functions `positive` and `negative` are equivalent, but they should be different. See comments below.
state: CHANGES_REQUESTED
author_association: MEMBER
submitted_at: 2025-04-07T15:55:04Z
user: login: ppolesiuk
body: I think, the `TGuard _` case in `negative` should be fixed. Also, code formatting might be improved.
state: CHANGES_REQUESTED
author_association: MEMBER
submitted_at: 2025-04-07T19:49:19Z
user: login: dominik-muc
state: COMMENTED
author_association: MEMBER
submitted_at: 2025-04-07T19:55:41Z
user: login: ppolesiuk
body: Looks good, only minor things regarding formatting might be improved. Thanks!
state: APPROVED
author_association: MEMBER
submitted_at: 2025-04-07T20:09:38Z
user: login: forell
body: The functions `positive` and `negative` look correct to me. Perhaps the test(s) could include more variety in the constructs used in types in order to be a bit more thorough.
state: APPROVED
author_association: MEMBER
submitted_at: 2025-04-08T11:55:40Z

Review comments:
diff_hunk: @@ -14,7 +14,7 @@ type data_def =
       proof             : var;
       args              : TVar.ex list;
       ctors             : ctor_type list;
-      strictly_positive : bool
+      positive : bool
path: src/Lang/CorePriv/Syntax.ml
user: login: ppolesiuk
body: Code formatting could be improved here. All colons above are aligned, so why to do it differently.
created_at: 2025-04-05T08:01:33Z
author_association: MEMBER
diff_hunk: @@ -418,41 +418,47 @@ let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
     end
 
   | TEffJoin(eff1, eff2) ->
-    strictly_positive ~nonrec_scope eff1 &&
-    strictly_positive ~nonrec_scope eff2
-
+    positive ~nonrec_scope eff1 &&
+    positive ~nonrec_scope eff2
+
+  | TArrow(TArrow (_, tp1, eff0), tp2, eff1) ->
path: src/Lang/CorePriv/Type.ml
user: login: ppolesiuk
body: Ugh... Onion is either nothing or an onion wrapped around a leaf. Most of operations on syntax should deconstruct at most one constructor at once. I think, we need two mutually recursive functions here: `positive` and `negative`.
created_at: 2025-04-05T08:04:55Z
author_association: MEMBER
diff_hunk: @@ -73,7 +73,7 @@ let finalize_data_def env (dd : data_def) =
       proof             = dd.proof;
       args              = args;
       ctors             = ctors;
-      strictly_positive = dd.positive;
+      positive = dd.positive;
path: src/ToCore/DataType.ml
user: login: ppolesiuk
body: Code formatting again...
created_at: 2025-04-05T08:06:33Z
author_association: MEMBER
diff_hunk: @@ -0,0 +1,2 @@
+data rec T = C of ((T -> Unit) -> Unit)
+let foo (C f) = f (fn (C g) => g (fn _ => ()))
path: test/ok/ok0129_positiveAdt.fram
user: login: ppolesiuk
body: We are not very strict about that (unfortunately), but this is not a valid Unix text file: it has no LF at the end.
created_at: 2025-04-05T08:08:02Z
author_association: MEMBER
diff_hunk: @@ -418,41 +418,47 @@ let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
     end
 
   | TEffJoin(eff1, eff2) ->
-    strictly_positive ~nonrec_scope eff1 &&
-    strictly_positive ~nonrec_scope eff2
-
+    positive ~nonrec_scope eff1 &&
+    positive ~nonrec_scope eff2
+
+  | TArrow(TArrow (_, tp1, eff0), tp2, eff1) ->
path: src/Lang/CorePriv/Type.ml
user: login: dominik-muc
body: I'm sorry, I don't follow. Isn't negative just *not positive*?
created_at: 2025-04-05T19:27:13Z
author_association: MEMBER
diff_hunk: @@ -418,41 +418,47 @@ let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
     end
 
   | TEffJoin(eff1, eff2) ->
-    strictly_positive ~nonrec_scope eff1 &&
-    strictly_positive ~nonrec_scope eff2
-
+    positive ~nonrec_scope eff1 &&
+    positive ~nonrec_scope eff2
+
+  | TArrow(TArrow (_, tp1, eff0), tp2, eff1) ->
path: src/Lang/CorePriv/Type.ml
user: login: ppolesiuk
body: No. For instance, parameter of application isn't on positive nor negative position. When some type is raised by subtyping, types/effects on positive positions can raised too, while types/effects on negative positions can be lowered.
created_at: 2025-04-06T03:56:05Z
author_association: MEMBER
diff_hunk: @@ -418,41 +418,69 @@ let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
     end
 
   | TEffJoin(eff1, eff2) ->
-    strictly_positive ~nonrec_scope eff1 &&
-    strictly_positive ~nonrec_scope eff2
-
+    positive ~nonrec_scope eff1 &&
+    positive ~nonrec_scope eff2
+    
   | TArrow(tp1, tp2, eff) ->
+    negative ~nonrec_scope tp1 &&
+    positive ~nonrec_scope tp2 &&
+    positive ~nonrec_scope eff
+
+  | TForall(a, tp) ->
+    positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
+
+  | TApp(tp1, tp2) ->
     begin match
-      type_in_scope nonrec_scope tp1,
-      strictly_positive ~nonrec_scope tp2,
-      strictly_positive ~nonrec_scope eff
+      positive ~nonrec_scope tp1,
+      type_in_scope nonrec_scope tp2
     with
-    | Some _, true, true -> true
+    | true, Some _ -> true
     | _ -> false
     end
 
+(** Check if all types on non-negative positions fits in given
+  scope. *)
+and negative : type k. nonrec_scope:_ -> k typ -> bool =
+  fun ~nonrec_scope tp ->
+  match tp with
+  | TVar _ | TEffPure -> true
path: src/Lang/CorePriv/Type.ml
user: login: ppolesiuk
body: The type variable is on positive, and therefore, on non-negative position, so we have to check if it fits in the given scope. It can be done the same way as constructs in the next line, i.e, `TLabel _ | TData _`.
created_at: 2025-04-07T15:20:10Z
author_association: MEMBER
diff_hunk: @@ -418,41 +418,69 @@ let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
     end
 
   | TEffJoin(eff1, eff2) ->
-    strictly_positive ~nonrec_scope eff1 &&
-    strictly_positive ~nonrec_scope eff2
-
+    positive ~nonrec_scope eff1 &&
+    positive ~nonrec_scope eff2
+    
   | TArrow(tp1, tp2, eff) ->
+    negative ~nonrec_scope tp1 &&
+    positive ~nonrec_scope tp2 &&
+    positive ~nonrec_scope eff
+
+  | TForall(a, tp) ->
+    positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
+
+  | TApp(tp1, tp2) ->
     begin match
-      type_in_scope nonrec_scope tp1,
-      strictly_positive ~nonrec_scope tp2,
-      strictly_positive ~nonrec_scope eff
+      positive ~nonrec_scope tp1,
+      type_in_scope nonrec_scope tp2
     with
-    | Some _, true, true -> true
+    | true, Some _ -> true
     | _ -> false
     end
 
+(** Check if all types on non-negative positions fits in given
+  scope. *)
+and negative : type k. nonrec_scope:_ -> k typ -> bool =
+  fun ~nonrec_scope tp ->
+  match tp with
+  | TVar _ | TEffPure -> true
+  | TGuard _ | TLabel _ | TData _ ->
+    begin match type_in_scope nonrec_scope tp with
+    | Some _ -> true
+    | None   -> false
+    end
+
+  | TEffJoin(eff1, eff2) ->
+    negative ~nonrec_scope eff1 &&
+    negative ~nonrec_scope eff2
path: src/Lang/CorePriv/Type.ml
user: login: ppolesiuk
body: All occurrences of variables in effects are positive, and therefor non-negative. This case can be merged with the previous one.
created_at: 2025-04-07T15:21:20Z
author_association: MEMBER
diff_hunk: @@ -418,41 +418,69 @@ let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
     end
 
   | TEffJoin(eff1, eff2) ->
-    strictly_positive ~nonrec_scope eff1 &&
-    strictly_positive ~nonrec_scope eff2
-
+    positive ~nonrec_scope eff1 &&
+    positive ~nonrec_scope eff2
+    
   | TArrow(tp1, tp2, eff) ->
+    negative ~nonrec_scope tp1 &&
+    positive ~nonrec_scope tp2 &&
+    positive ~nonrec_scope eff
+
+  | TForall(a, tp) ->
+    positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
+
+  | TApp(tp1, tp2) ->
     begin match
-      type_in_scope nonrec_scope tp1,
-      strictly_positive ~nonrec_scope tp2,
-      strictly_positive ~nonrec_scope eff
+      positive ~nonrec_scope tp1,
+      type_in_scope nonrec_scope tp2
     with
-    | Some _, true, true -> true
+    | true, Some _ -> true
     | _ -> false
     end
 
+(** Check if all types on non-negative positions fits in given
+  scope. *)
+and negative : type k. nonrec_scope:_ -> k typ -> bool =
+  fun ~nonrec_scope tp ->
+  match tp with
+  | TVar _ | TEffPure -> true
+  | TGuard _ | TLabel _ | TData _ ->
+    begin match type_in_scope nonrec_scope tp with
+    | Some _ -> true
+    | None   -> false
+    end
+
+  | TEffJoin(eff1, eff2) ->
+    negative ~nonrec_scope eff1 &&
+    negative ~nonrec_scope eff2
+    
+  | TArrow(tp1, tp2, eff) ->
+    positive ~nonrec_scope tp1 &&
+    negative ~nonrec_scope tp2 &&
+    negative ~nonrec_scope eff
+
   | TForall(a, tp) ->
-    strictly_positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
+    negative ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
 
   | TApp(tp1, tp2) ->
     begin match
-      strictly_positive ~nonrec_scope tp1,
+      negative ~nonrec_scope tp1,
path: src/Lang/CorePriv/Type.ml
user: login: ppolesiuk
body: The application case can be merged with the default (`TLabel _ | TData _`, etc.). All variables in the application are on non-negative positions.
created_at: 2025-04-07T15:34:12Z
author_association: MEMBER
diff_hunk: @@ -418,41 +418,69 @@ let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
     end
 
   | TEffJoin(eff1, eff2) ->
-    strictly_positive ~nonrec_scope eff1 &&
-    strictly_positive ~nonrec_scope eff2
-
+    positive ~nonrec_scope eff1 &&
+    positive ~nonrec_scope eff2
+    
   | TArrow(tp1, tp2, eff) ->
+    negative ~nonrec_scope tp1 &&
+    positive ~nonrec_scope tp2 &&
+    positive ~nonrec_scope eff
+
+  | TForall(a, tp) ->
+    positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
+
+  | TApp(tp1, tp2) ->
     begin match
-      type_in_scope nonrec_scope tp1,
-      strictly_positive ~nonrec_scope tp2,
-      strictly_positive ~nonrec_scope eff
+      positive ~nonrec_scope tp1,
+      type_in_scope nonrec_scope tp2
     with
-    | Some _, true, true -> true
+    | true, Some _ -> true
     | _ -> false
     end
 
+(** Check if all types on non-negative positions fits in given
+  scope. *)
+and negative : type k. nonrec_scope:_ -> k typ -> bool =
+  fun ~nonrec_scope tp ->
+  match tp with
+  | TVar _ | TEffPure -> true
+  | TGuard _ | TLabel _ | TData _ ->
path: src/Lang/CorePriv/Type.ml
user: login: ppolesiuk
body: We can do better with `TGuard` construct. Body of the guard is on the positive position. Same for the left-hand-side of constraints. Right-hand-side is on negative position. We can do the same in `positive` function.
created_at: 2025-04-07T15:38:57Z
author_association: MEMBER
diff_hunk: @@ -405,54 +405,79 @@ and subtype_in_scope scope (tp : ttype) =
     | _ -> None
     end
 
-(** Check if all types on non-strictly positive positions fits in given
+(** Check if all types on non-positive positions fits in given
   scope. *)
-let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
+let rec positive : type k. nonrec_scope:_ -> k typ -> bool =
   fun ~nonrec_scope tp ->
   match tp with
   | TVar _ | TEffPure -> true
-  | TGuard _ | TLabel _ | TData _ ->
+  | TLabel _ | TData _ ->
     begin match type_in_scope nonrec_scope tp with
     | Some _ -> true
     | None   -> false
     end
+  
+  | TGuard (constraints, tp) ->
+    positive ~nonrec_scope tp &&
+    List.for_all (fun (lhs, rhs) ->
+      positive ~nonrec_scope lhs &&
+      negative ~nonrec_scope rhs
+    )
+    constraints
path: src/Lang/CorePriv/Type.ml
user: login: ppolesiuk
body: Code formatting might be improved, to make it more similar to existing code base. The closing parenthesis should not be in a separate line. It might look like:
```
List.for_all
  (fun ... ->
    ...)
  constraints
```
or
```
constraints |> List.for_all
  (fun ... ->
    ...)
```
created_at: 2025-04-07T19:45:52Z
author_association: MEMBER
diff_hunk: @@ -405,54 +405,79 @@ and subtype_in_scope scope (tp : ttype) =
     | _ -> None
     end
 
-(** Check if all types on non-strictly positive positions fits in given
+(** Check if all types on non-positive positions fits in given
   scope. *)
-let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
+let rec positive : type k. nonrec_scope:_ -> k typ -> bool =
   fun ~nonrec_scope tp ->
   match tp with
   | TVar _ | TEffPure -> true
-  | TGuard _ | TLabel _ | TData _ ->
+  | TLabel _ | TData _ ->
     begin match type_in_scope nonrec_scope tp with
     | Some _ -> true
     | None   -> false
     end
+  
+  | TGuard (constraints, tp) ->
+    positive ~nonrec_scope tp &&
+    List.for_all (fun (lhs, rhs) ->
+      positive ~nonrec_scope lhs &&
+      negative ~nonrec_scope rhs
+    )
+    constraints
 
   | TEffJoin(eff1, eff2) ->
-    strictly_positive ~nonrec_scope eff1 &&
-    strictly_positive ~nonrec_scope eff2
-
+    positive ~nonrec_scope eff1 &&
+    positive ~nonrec_scope eff2
+    
   | TArrow(tp1, tp2, eff) ->
-    begin match
-      type_in_scope nonrec_scope tp1,
-      strictly_positive ~nonrec_scope tp2,
-      strictly_positive ~nonrec_scope eff
-    with
-    | Some _, true, true -> true
-    | _ -> false
-    end
+    negative ~nonrec_scope tp1 &&
+    positive ~nonrec_scope tp2 &&
+    positive ~nonrec_scope eff
 
   | TForall(a, tp) ->
-    strictly_positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
+    positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
 
   | TApp(tp1, tp2) ->
     begin match
-      strictly_positive ~nonrec_scope tp1,
+      positive ~nonrec_scope tp1,
       type_in_scope nonrec_scope tp2
     with
     | true, Some _ -> true
     | _ -> false
     end
 
-(** Check if all types on non-strictly positive positions fits in given
+(** Check if all types on non-negative positions fits in given
+  scope. *)
+and negative : type k. nonrec_scope:_ -> k typ -> bool =
+  fun ~nonrec_scope tp ->
+  match tp with
+  | TEffPure -> true
+  | TVar _  | TLabel _ | TData _ | TApp _ | TEffJoin _ ->
+    begin match type_in_scope nonrec_scope tp with
+    | Some _ -> true
+    | None   -> false
+    end
+
+  | TGuard _  -> positive ~nonrec_scope tp
path: src/Lang/CorePriv/Type.ml
user: login: ppolesiuk
body: It doesn't seem right... Something is negative when is positive?!
created_at: 2025-04-07T19:47:37Z
author_association: MEMBER
diff_hunk: @@ -405,54 +405,79 @@ and subtype_in_scope scope (tp : ttype) =
     | _ -> None
     end
 
-(** Check if all types on non-strictly positive positions fits in given
+(** Check if all types on non-positive positions fits in given
   scope. *)
-let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
+let rec positive : type k. nonrec_scope:_ -> k typ -> bool =
   fun ~nonrec_scope tp ->
   match tp with
   | TVar _ | TEffPure -> true
-  | TGuard _ | TLabel _ | TData _ ->
+  | TLabel _ | TData _ ->
     begin match type_in_scope nonrec_scope tp with
     | Some _ -> true
     | None   -> false
     end
+  
+  | TGuard (constraints, tp) ->
+    positive ~nonrec_scope tp &&
+    List.for_all (fun (lhs, rhs) ->
+      positive ~nonrec_scope lhs &&
+      negative ~nonrec_scope rhs
+    )
+    constraints
 
   | TEffJoin(eff1, eff2) ->
-    strictly_positive ~nonrec_scope eff1 &&
-    strictly_positive ~nonrec_scope eff2
-
+    positive ~nonrec_scope eff1 &&
+    positive ~nonrec_scope eff2
+    
   | TArrow(tp1, tp2, eff) ->
-    begin match
-      type_in_scope nonrec_scope tp1,
-      strictly_positive ~nonrec_scope tp2,
-      strictly_positive ~nonrec_scope eff
-    with
-    | Some _, true, true -> true
-    | _ -> false
-    end
+    negative ~nonrec_scope tp1 &&
+    positive ~nonrec_scope tp2 &&
+    positive ~nonrec_scope eff
 
   | TForall(a, tp) ->
-    strictly_positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
+    positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
 
   | TApp(tp1, tp2) ->
     begin match
-      strictly_positive ~nonrec_scope tp1,
+      positive ~nonrec_scope tp1,
       type_in_scope nonrec_scope tp2
     with
     | true, Some _ -> true
     | _ -> false
     end
 
-(** Check if all types on non-strictly positive positions fits in given
+(** Check if all types on non-negative positions fits in given
+  scope. *)
+and negative : type k. nonrec_scope:_ -> k typ -> bool =
+  fun ~nonrec_scope tp ->
+  match tp with
+  | TEffPure -> true
+  | TVar _  | TLabel _ | TData _ | TApp _ | TEffJoin _ ->
+    begin match type_in_scope nonrec_scope tp with
+    | Some _ -> true
+    | None   -> false
+    end
+
+  | TGuard _  -> positive ~nonrec_scope tp
path: src/Lang/CorePriv/Type.ml
user: login: dominik-muc
body: I misunderstood when you said "We can do the same in `positive` function."...
created_at: 2025-04-07T19:55:41Z
author_association: MEMBER
diff_hunk: @@ -405,54 +405,85 @@ and subtype_in_scope scope (tp : ttype) =
     | _ -> None
     end
 
-(** Check if all types on non-strictly positive positions fits in given
+(** Check if all types on non-positive positions fits in given
   scope. *)
-let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
+let rec positive : type k. nonrec_scope:_ -> k typ -> bool =
   fun ~nonrec_scope tp ->
   match tp with
   | TVar _ | TEffPure -> true
-  | TGuard _ | TLabel _ | TData _ ->
+  | TLabel _ | TData _ ->
     begin match type_in_scope nonrec_scope tp with
     | Some _ -> true
     | None   -> false
     end
+  
+  | TGuard (constraints, tp) ->
+    positive ~nonrec_scope tp &&
+    List.for_all
+      (fun (lhs, rhs) ->
+        positive ~nonrec_scope lhs &&
+        negative ~nonrec_scope rhs)
+    constraints
path: src/Lang/CorePriv/Type.ml
user: login: ppolesiuk
body: In this line, there is a parameter to function `List.for_all`. It should be indented, as other parameters, i.e, lambda. It should be:
```
List.for_all
  (fun (lhs, rhs) ->
    positive ~nonrec_scope lhs &&
    negative ~nonrec_scope rhs)
  constraints
```
created_at: 2025-04-07T20:05:07Z
author_association: MEMBER
diff_hunk: @@ -405,54 +405,85 @@ and subtype_in_scope scope (tp : ttype) =
     | _ -> None
     end
 
-(** Check if all types on non-strictly positive positions fits in given
+(** Check if all types on non-positive positions fits in given
   scope. *)
-let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
+let rec positive : type k. nonrec_scope:_ -> k typ -> bool =
   fun ~nonrec_scope tp ->
   match tp with
   | TVar _ | TEffPure -> true
-  | TGuard _ | TLabel _ | TData _ ->
+  | TLabel _ | TData _ ->
     begin match type_in_scope nonrec_scope tp with
     | Some _ -> true
     | None   -> false
     end
+  
+  | TGuard (constraints, tp) ->
+    positive ~nonrec_scope tp &&
+    List.for_all
+      (fun (lhs, rhs) ->
+        positive ~nonrec_scope lhs &&
+        negative ~nonrec_scope rhs)
+    constraints
 
   | TEffJoin(eff1, eff2) ->
-    strictly_positive ~nonrec_scope eff1 &&
-    strictly_positive ~nonrec_scope eff2
-
+    positive ~nonrec_scope eff1 &&
+    positive ~nonrec_scope eff2
+    
path: src/Lang/CorePriv/Type.ml
user: login: ppolesiuk
body: This spaces in the empty line might be removed.
created_at: 2025-04-07T20:06:09Z
author_association: MEMBER
diff_hunk: @@ -405,54 +405,85 @@ and subtype_in_scope scope (tp : ttype) =
     | _ -> None
     end
 
-(** Check if all types on non-strictly positive positions fits in given
+(** Check if all types on non-positive positions fits in given
   scope. *)
-let rec strictly_positive : type k. nonrec_scope:_ -> k typ -> bool =
+let rec positive : type k. nonrec_scope:_ -> k typ -> bool =
   fun ~nonrec_scope tp ->
   match tp with
   | TVar _ | TEffPure -> true
-  | TGuard _ | TLabel _ | TData _ ->
+  | TLabel _ | TData _ ->
     begin match type_in_scope nonrec_scope tp with
     | Some _ -> true
     | None   -> false
     end
+  
+  | TGuard (constraints, tp) ->
+    positive ~nonrec_scope tp &&
+    List.for_all
+      (fun (lhs, rhs) ->
+        positive ~nonrec_scope lhs &&
+        negative ~nonrec_scope rhs)
+    constraints
 
   | TEffJoin(eff1, eff2) ->
-    strictly_positive ~nonrec_scope eff1 &&
-    strictly_positive ~nonrec_scope eff2
-
+    positive ~nonrec_scope eff1 &&
+    positive ~nonrec_scope eff2
+    
   | TArrow(tp1, tp2, eff) ->
-    begin match
-      type_in_scope nonrec_scope tp1,
-      strictly_positive ~nonrec_scope tp2,
-      strictly_positive ~nonrec_scope eff
-    with
-    | Some _, true, true -> true
-    | _ -> false
-    end
+    negative ~nonrec_scope tp1 &&
+    positive ~nonrec_scope tp2 &&
+    positive ~nonrec_scope eff
 
   | TForall(a, tp) ->
-    strictly_positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
+    positive ~nonrec_scope:(TVar.Set.add a nonrec_scope) tp
 
   | TApp(tp1, tp2) ->
     begin match
-      strictly_positive ~nonrec_scope tp1,
+      positive ~nonrec_scope tp1,
       type_in_scope nonrec_scope tp2
     with
     | true, Some _ -> true
     | _ -> false
     end
 
-(** Check if all types on non-strictly positive positions fits in given
+(** Check if all types on non-negative positions fits in given
+  scope. *)
+and negative : type k. nonrec_scope:_ -> k typ -> bool =
+  fun ~nonrec_scope tp ->
+  match tp with
+  | TEffPure -> true
+  | TVar _  | TLabel _ | TData _ | TApp _ | TEffJoin _ ->
+    begin match type_in_scope nonrec_scope tp with
+    | Some _ -> true
+    | None   -> false
+    end
+
+  | TGuard (constraints, tp) ->
+    negative ~nonrec_scope tp &&
+    List.for_all
+      (fun (lhs, rhs) ->
+        negative ~nonrec_scope lhs &&
+        positive ~nonrec_scope rhs)
+    constraints
path: src/Lang/CorePriv/Type.ml
user: login: ppolesiuk
body: Same comment as in `positive` function, i.e., more indentation.
created_at: 2025-04-07T20:06:43Z
author_association: MEMBER

PR comments:
user: login: dominik-muc
created_at: 2025-04-07T11:27:55Z
body: Tests failed on opam setup... Can you re-run the CI?
author_association: MEMBER
user: login: ppolesiuk
created_at: 2025-04-07T20:11:42Z
body: @forell Could you review this PR? It touches important parts of the Core, so I want to make sure I didn't overlooked something.
author_association: MEMBER