fix(effects): pin v1 effect-row registry + reject unknown names (#196)

Root cause of #59: lower_effect_expr accepted ANY string as an effect
(silent ESingleton name), so every contributor invented their own and
migrated /{IO} code did not unify with stdlib /io.

PR-1 (additive + aliases, per owner decision):
- effect.ml: canonical v1 registry — IO/Async/Partial/Throws/Mut,
  reserved Random/Time/Net, legacy aliases io->IO/state->Mut/exn->Throws.
- typecheck: declared_effects on context (populated by
  register_effect_decl); lower_effect_expr canonicalizes via the
  registry and rejects names that are neither v1/reserved/alias nor a
  user-declared  — new UnknownEffect type_error with an
  actionable message, raised via Effect_validation_error and caught at
  the check_program boundary.
- stdlib/effects.affine untouched (legacy names still compile via
  aliases — verified).

Gate: dune build clean; dune test --force 253/253, zero regression
(incl. AOT effects smoke). Verified: /IO /Async accepted, /io
canonicalizes, /Zonk rejected.

Follow-up (tracked, not in scope): braced /{IO} return-position row
syntax from the migration-stance doc is a separate grammar item.

Refs #59

Co-authored-by: Claude Opus 4.7 (1M context) <noreply@anthropic.com>

Author: hyperpolymath

lib/effect.ml

@@ -120,3 +120,31 @@ let string_of_eff (e : eff) : string =
       end
   in
   aux (normalize_eff e)
+
+(** {1 Effect-row v1 canonical registry (issue #59)}
+
+    Pins the v1 effect-name list so migration can begin without every
+    contributor inventing their own names.  This is effect *tracking*
+    only — handler design remains out of scope (see
+    [docs/guides/effects-migration-stance.adoc]). *)
+
+(** Canonical v1 effect names.  [Throws] is written [Throws[E]] at use
+    sites; the type parameter is carried syntactically but not yet
+    threaded (tracking-only v1). *)
+let v1_effects = [ "IO"; "Async"; "Partial"; "Throws"; "Mut" ]
+
+(** Reserved for v1.x — recognised so the names are not repurposed, not
+    yet wired into the stdlib. *)
+let reserved_effects = [ "Random"; "Time"; "Net" ]
+
+(** Legacy lowercase stdlib effects → canonical v1.  Kept as aliases so
+    [stdlib/effects.affine] and existing code compile unchanged
+    (additive migration; a rename sweep is a later, separate change). *)
+let legacy_aliases = [ ("io", "IO"); ("state", "Mut"); ("exn", "Throws") ]
+
+(** Canonical registry name for a source effect name, or [None] if it is
+    neither a v1/reserved name nor a legacy alias.  Callers additionally
+    accept user-declared effects (`effect <name>;`). *)
+let canonical_effect_name (s : string) : string option =
+  if List.mem s v1_effects || List.mem s reserved_effects then Some s
+  else List.assoc_opt s legacy_aliases

lib/effect.mli

@@ -26,3 +26,18 @@ val normalize_eff : eff -> eff
 
 (** Pretty print effect *)
 val string_of_eff : eff -> string
+
+(** {1 Effect-row v1 canonical registry (issue #59)} *)
+
+(** Canonical v1 effect names. *)
+val v1_effects : string list
+
+(** Reserved-for-v1.x effect names. *)
+val reserved_effects : string list
+
+(** Legacy lowercase stdlib effect → canonical v1 name. *)
+val legacy_aliases : (string * string) list
+
+(** Canonical registry name for a source effect name, or [None] if
+    unknown to the registry (caller also accepts declared effects). *)
+val canonical_effect_name : string -> string option

lib/typecheck.ml

@@ -103,6 +103,9 @@ type type_error =
   | BranchTypeMismatch of { then_ty : ty; else_ty : ty }
   | QuantityError of Quantity.quantity_error * Span.t
       (** QTT quantity violation detected after type checking. *)
+  | UnknownEffect of string
+      (** Effect name not in the v1 registry, not a legacy alias, and
+          not a user-declared effect (issue #59). *)
 
 (** Format a type error for human consumption. *)
 let show_type_error = function
@@ -132,9 +135,22 @@ let show_type_error = function
       (ty_to_string then_ty) (ty_to_string else_ty)
   | QuantityError (qerr, _span) ->
     Printf.sprintf "Quantity error: %s" (Quantity.format_quantity_error qerr)
+  | UnknownEffect name ->
+    Printf.sprintf
+      "Unknown effect '%s'. Use a v1 effect (%s), a reserved name (%s), \
+       or declare it with `effect %s;`."
+      name
+      (String.concat ", " Effect.v1_effects)
+      (String.concat ", " Effect.reserved_effects)
+      name
 
 let format_type_error = show_type_error
 
+(** Raised by [lower_effect_expr] for an unknown effect name; caught at
+    the [check_program] boundary and converted to [UnknownEffect]
+    (lowering is not in the result monad). *)
+exception Effect_validation_error of string
+
 (** {1 Context} *)
 
 (** Type checking context.
@@ -157,6 +173,9 @@ type context = {
   (** The current effect context — unified with declared effects *)
   trait_registry : Trait.trait_registry;
   (** Trait registry — stores trait definitions and impls for dispatch *)
+  declared_effects : (string, unit) Hashtbl.t;
+  (** User-declared effect names (`effect <name>;`). Consulted by
+      [lower_effect_expr] alongside the v1 registry (issue #59). *)
 }
 
 type 'a result = ('a, type_error) Result.t
@@ -186,6 +205,7 @@ let create_context (symbols : Symbol.t) : context =
     level = 0;
     current_eff = fresh_effvar 0;
     trait_registry = Trait.create_registry ();
+    declared_effects = Hashtbl.create 16;
   }
 
 (** Enter a deeper let-level. *)
@@ -418,14 +438,21 @@ let rec lower_type_expr (ctx : context) (te : type_expr) : ty =
     fresh_tyvar ctx.level
 
 and lower_effect_expr (ctx : context) (ee : effect_expr) : eff =
+  (* Resolve a source effect name to a canonical singleton (issue #59):
+     Pure → pure; v1/reserved/legacy-alias → canonical registry name;
+     user-declared (`effect <name>;`) → kept as written; anything else
+     is rejected so contributors cannot silently invent effect names. *)
+  let resolve (name : string) : eff =
+    if name = "Pure" then EPure
+    else match Effect.canonical_effect_name name with
+      | Some canonical -> ESingleton canonical
+      | None ->
+        if Hashtbl.mem ctx.declared_effects name then ESingleton name
+        else raise (Effect_validation_error name)
+  in
   match ee with
-  | EffVar { name; _ } ->
-    begin match name with
-      | "Pure" -> EPure
-      | _ -> ESingleton name
-    end
-  | EffCon ({ name; _ }, _args) ->
-    ESingleton name
+  | EffVar { name; _ } -> resolve name
+  | EffCon ({ name; _ }, _args) -> resolve name
   | EffUnion (e1, e2) ->
     EUnion [lower_effect_expr ctx e1; lower_effect_expr ctx e2]
 
@@ -1565,6 +1592,7 @@ let register_type_decl (ctx : context) (td : type_decl) : unit result =
 
 (** Register an effect declaration. *)
 let register_effect_decl (ctx : context) (ed : effect_decl) : unit result =
+  Hashtbl.replace ctx.declared_effects ed.ed_name.name ();
   List.iter (fun (op : effect_op_decl) ->
     let param_tys = List.map (fun (p : param) ->
       lower_type_expr ctx p.p_ty
@@ -1671,6 +1699,7 @@ let check_decl (ctx : context) (decl : top_level) : (unit, type_error) Result.t
 let check_program ?(import_types : (string, scheme) Hashtbl.t option)
     (symbols : Symbol.t) (prog : Ast.program)
     : (context, type_error) Result.t =
+  try
   let ctx = create_context symbols in
   register_builtins ctx;
   Option.iter (fun tbl ->
@@ -1717,3 +1746,4 @@ let check_program ?(import_types : (string, scheme) Hashtbl.t option)
       Error (QuantityError (qerr, span))
     end
   | Error e -> Error e
+  with Effect_validation_error name -> Error (UnknownEffect name)