infoductor/Infoductor/Foundation/Methodology.lean

/-
  Infoductor.Foundation.Methodology — `@[methodology]` + `cubical_search`
  ==========================================================================
  Phase D' of `docs/ALGEBRA_PLAN.md`.  Provides the autodiscovery
  layer that crowns the metacoding stack:

  - `@[methodology]` attribute: registers a Lean theorem as a "proof
    fragment" indexed by a classifier shape.  When `cubical_search`
    encounters a question matching that shape, it tries the
    registered theorem.

  - `cubical_search` tactic: walks the methodology library by
    classifier dispatch and applies matches; on miss, attempts
    methodology-transport along declared structural Paths
    (`transp`-at-the-meta-level).

  Per ALGEBRA_PLAN §4.3:
  > Once a small library of base methodologies exists, every new
  > structural Path declared in the codebase **automatically generates
  > new methodology candidates** by transporting existing methodologies
  > across the path.

  This module ships the registry + the basic tactic; the
  methodology-transport clause is scaffolded as `deriveByTransport`
  (a stub returning `[]` until the structural-Path infrastructure
  arrives in REL2.6+).
-/

import Lean
import Infoductor.Foundation.MacroAlias
import Infoductor.Foundation.MetaPath

namespace Infoductor

open Lean Lean.Elab Lean.Elab.Tactic

-- ── Methodology entries ─────────────────────────────────────────────────────

/-- A registered methodology.  Indexes a Lean theorem by the
    classifier shape it solves.

    `classifierName` is a `Name` referring to a `MetaClassifier`-
    valued `def` (or one of the syntactic classifier predicates from
    `Question.lean`).  `theoremName` is the `Name` of the theorem
    that `cubical_search` will try when the question matches.

    Priority is used for ordering: higher priority methodologies are
    tried first.  Default 100; specialised methodologies bump higher,
    catch-alls run lower. -/
structure MethodologyEntry where
  classifierName : Name
  theoremName    : Name
  priority       : Nat := 100
  description    : String := ""
  deriving Repr, Inhabited

-- ── The methodology registry ────────────────────────────────────────────────

/-- Global registry of methodologies, indexed by classifier name.
    Built up via `@[methodology]`-tagged declarations.

    Implementation: `EnvExtension` so adds are visible across
    modules.  Lookup is linear in the registry size (acceptable for
    REL2.5; a discrtree-indexed version is REL2.6 work per
    ALGEBRA_PLAN §10.4). -/
initialize methodologyRegistryExt :
    SimplePersistentEnvExtension MethodologyEntry (Array MethodologyEntry) ←
  registerSimplePersistentEnvExtension {
    name          := `Infoductor.methodologyRegistry
    addEntryFn    := fun arr e => arr.push e
    addImportedFn := fun arrs => arrs.foldl (init := #[]) Array.append
    asyncMode     := .sync
  }

def getMethodologies : CoreM (Array MethodologyEntry) := do
  let env ← getEnv
  return methodologyRegistryExt.getState env

def registerMethodology (entry : MethodologyEntry) : CoreM Unit := do
  modifyEnv (methodologyRegistryExt.addEntry · entry)

/-- Find every methodology indexed against a given classifier name. -/
def findMethodologies (classifier : Name) : CoreM (Array MethodologyEntry) := do
  let all ← getMethodologies
  return all.filter (·.classifierName == classifier)

-- ── The `@[methodology]` attribute ──────────────────────────────────────────
-- Attached to a theorem.  Attribute parser parses the classifier
-- name and optional priority.  Registration adds an entry to the
-- methodology registry pointing back to the tagged theorem.

/-- Parser-level data for the `@[methodology]` attribute.  We accept
    a plain identifier naming the classifier.  Priority configuration
    via `priority := n` is Phase D'.1 work; the v0 attribute uses a
    fixed default of 100.

    The syntax `name :=` matches the attribute name registered below;
    Lean's attribute system looks up attributes by syntax kind, not
    by leading keyword. -/
syntax (name := methodology) "methodology" ident : attr

/-- The `@[methodology]` attribute itself.  Records the tagged
    theorem under the named classifier (priority defaults to 100). -/
initialize methodologyAttr : Unit ←
  registerBuiltinAttribute {
    name := `methodology
    descr := "Register this theorem as a proof methodology indexed \
              by a classifier (Phase D' of ALGEBRA_PLAN.md).  Usage: \
              `@[methodology IsFullFace]`."
    add := fun declName stx _kind => do
      -- Parse classifier name from the attribute syntax.
      let classifierName? : Option Name :=
        match stx with
        | `(attr| methodology $cls:ident) => some cls.getId
        | _ => none
      let some classifierName := classifierName?
        | throwError "@[methodology] requires a classifier name"
      let env ← getEnv
      let docstring? := (← findDocString? env declName).getD ""
      registerMethodology
        { classifierName := classifierName
        , theoremName    := declName
        , priority       := 100
        , description    := docstring? }
  }

-- ── The methodology-transport clause (scaffold) ─────────────────────────────
-- ALGEBRA_PLAN §4.3: when a structural Path connects classifierA to
-- classifierB and the methodology library has an entry for
-- classifierA, transport derives a candidate for classifierB.
--
-- Full implementation requires (a) declared structural Paths in the
-- codebase, (b) reification of methodology bodies as CTerms, (c)
-- application of `transp` at the methodology level.  REL2.6+ work.
--
-- The scaffold below returns `[]` so the surrounding tactic remains
-- well-typed; uses are guarded by feature flags.

/-- Derive new methodology candidates by transporting existing ones
    along declared structural Paths.

    Per ALGEBRA_PLAN §4.3:
    > Twenty starting methodologies + a hundred declared paths →
    > potentially thousands of derived methodologies, each formally
    > certified-by-construction.

    Implementation: for every methodology M registered against a
    classifier C₁, and every MetaPath C₁ ↦ C₂ in the registry,
    derive a candidate methodology against C₂ whose witness is M's
    body composed with the path witness.

    For the v0 dispatch tactic, the "composed witness" is just M's
    theorem name — `cubical_search` will try both M and the path
    witness directly via apply/exact.  A future Phase D'.6 will use
    actual Lean term composition to produce a single derived
    theorem.  See `Algebra/MetaPath.lean` for the path attribute. -/
def deriveByTransport (targetClassifier : Name) : CoreM (Array MethodologyEntry) := do
  let paths ← findPathsToTarget targetClassifier
  let mut out := #[]
  for path in paths do
    -- For every methodology M against the source classifier of this
    -- path, produce a derived candidate against the target classifier.
    let sourceMethodologies ← findMethodologies path.sourceClassifier
    for M in sourceMethodologies do
      out := out.push
        { classifierName := targetClassifier
        , theoremName    := M.theoremName  -- v0: try the source method directly
        , priority       := M.priority - 10  -- derived; lower priority
        , description    := s!"derived via metaPath {path.sourceClassifier} ↦ {path.targetClassifier} from {M.theoremName}" }
      -- Also add the path witness itself as a candidate; cubical_search
      -- can apply it to convert the goal to the source classifier form.
      out := out.push
        { classifierName := targetClassifier
        , theoremName    := path.witnessName
        , priority       := M.priority - 20
        , description    := s!"path witness {path.witnessName} for transport" }
  return out

-- ── Tactic primitive: try one entry as a goal closer ───────────────────────
-- Foundation primitive for any methodology-dispatching tactic.
-- Anyone can build different orderings, retry strategies, or
-- failure-reporting on top of this.

/-- Try to close the current goal by applying the registered
    methodology entry's theorem.

    **Contract.** Attempts `exact entry.theoremName`, falling back
    to `apply entry.theoremName`.  Returns `true` if the goal closes
    completely (no subgoals remaining); `false` otherwise.

    Tactic state is restored on `false` — neither a partial-apply nor
    a thrown elaboration error leaks past the call.  Never throws.
    Order of attempts (`exact` before `apply`) is fixed by this
    primitive; alternative orderings can be implemented by composing
    different primitives.

    Use this as the building block for goal-closing dispatch loops;
    no opinion baked in beyond the fixed exact/apply order. -/
def tryEntryAsClosed (entry : MethodologyEntry) : TacticM Bool := do
  let stx := mkIdent entry.theoremName
  let initialState ← saveState
  try
    evalTactic (← `(tactic| (first | exact $stx | apply $stx)))
    if (← getUnsolvedGoals).isEmpty then
      return true
    else
      restoreState initialState
      return false
  catch _ =>
    restoreState initialState
    return false

-- ── Reference dispatcher: `cubical_search` ─────────────────────────────────
-- A reference composition of `findMethodologies` + `deriveByTransport`
-- + `tryEntryAsClosed` in one obvious order.  This is a *demonstrator*,
-- not a normative tactic — anyone wanting different ordering, priority
-- handling, or failure reporting writes their own using the
-- primitives above.

/-- Reference-composition tactic: walk every registered methodology;
    on miss, walk the `@[metaPath]`-derived transport candidates;
    emit a structured failure report on full miss.

    Stages (fixed in this demonstrator; anyone can write a different
    composition):
      1. Direct registry: `getMethodologies`, try each via
         `tryEntryAsClosed` in registry order.
      2. Transport: walk `getMetaPaths` and try each path's source
         methodologies and the path witness itself.
      3. Failure: structured report with per-candidate "didn't fire"
         reasons.

    This is a tactic *demonstrator*, exposing the primitive composition
    pattern.  Tag your goal-closing methodologies with `@[methodology
    Classifier]` and they enter this dispatcher's stage 1; declare
    `@[metaPath A B]` and stage 2 lifts methodologies from A to B
    automatically.  No opinion about ordering, retry strategy, or
    priority interpretation beyond what's stated here. -/
syntax (name := cubicalSearch) "cubical_search" : tactic

elab_rules : tactic
  | `(tactic| cubical_search) => do
      let goal ← getMainGoal
      let goalType ← goal.getType
      let methodologies ← getMethodologies
      let mut tried : Array Name := #[]
      -- Stage 1: direct methodology dispatch.
      for entry in methodologies do
        tried := tried.push entry.theoremName
        if (← tryEntryAsClosed entry) then return
      -- Stage 2: methodology-transport candidates from every
      -- declared `@[metaPath]`.
      let allPaths ← getMetaPaths
      for path in allPaths do
        let sourceMethods ← findMethodologies path.sourceClassifier
        for M in sourceMethods do
          tried := tried.push M.theoremName
          if (← tryEntryAsClosed M) then return
        let witnessEntry : MethodologyEntry :=
          { classifierName := path.targetClassifier
          , theoremName := path.witnessName
          , priority := 0, description := "" }
        tried := tried.push path.witnessName
        if (← tryEntryAsClosed witnessEntry) then return
      -- Structured failure (demonstrator format; no normative
      -- commitment — alternative composers may emit any shape).
      let lines := tried.map (fun n => s!"  ✗ {n}")
      let report := String.intercalate "\n" lines.toList
      let pathCount := allPaths.size
      let methCount := methodologies.size
      throwError s!"cubical_search: no registered methodology closed the goal\n  {← Meta.ppExpr goalType}\n\ncandidates considered ({methCount} direct + {pathCount} paths):\n{report}\n\nregister a new @[methodology] (or build a custom dispatcher from `tryEntryAsClosed`)."

-- ── Diagnostics ─────────────────────────────────────────────────────────────

/-- Print the methodology registry — what's currently available to
    `cubical_search`. -/
def printMethodologies : CoreM Unit := do
  let entries ← getMethodologies
  IO.println s!"── Methodology registry ({entries.size}) ──"
  for entry in entries do
    let p := if entry.priority == 100 then "" else s!" (prio {entry.priority})"
    let d := if entry.description.isEmpty then "" else s!" — {entry.description}"
    IO.println s!"  {entry.classifierName} → {entry.theoremName}{p}{d}"

end Infoductor