max/infoductor
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fuel-based parsers + kernel-level round-trip via decide

Browse source 
Refactor MetaParse.lean to use explicit fuel parameters on every
parser, eliminating `partial def` entirely.  Each parser is now
structurally recursive on the Nat fuel, so it's total and
kernel-evaluable.  Top-level wrappers pass `tokens.length + 1`
as fuel — always sufficient since each successful parse consumes
≥ 1 token.

Move `escapeStrLit` to Foundation/Meta.lean so the renderer uses
it (in place of `repr`) for kernel-reducible string-literal
escaping.  This unblocks `decide`-based round-trip proofs at
the kernel level — `repr String` was previously the bottleneck.

Round-trip witnesses (kernel-level via `decide`, set_option
maxRecDepth bumped where needed):
  · MetaCTerm.empty / sym / ident / app / lam / plam / comp /
    transp — atomic and compositional shapes.
  · MetaClassifier.always / never / meet / atDecl.
  · MetaArtifact.empty (rendering-equivalence for the .declAt-
    containing inductive).
  · A nested .comp witness exercising the full chain end-to-end
    (renderer → tokenizer → parser → equality, all reducing in
    the kernel).

Universal ∀-theorem not yet proven via structural induction;
each constructor's kernel-rooted witness covers the surface.
The existing `native_decide` round-trip tests in Infoductor/
Test.lean remain as additional empirical coverage.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
Maximus Gorog 2026-05-01 12:28:55 -06:00
parent 92fc4f9682
commit 9c9b93c3ca
2 changed files with 289 additions and 170 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
Infoductor/Foundation/Meta.lean
View file

@ -294,10 +294,24 @@ instance : ToString MetaArtifact := ⟨MetaArtifact.toString⟩
-- write a parser. The renderer is fully recursive over the -- write a parser. The renderer is fully recursive over the
-- meta-mirror's structure, faithful on every constructor. -- meta-mirror's structure, faithful on every constructor.
/-- Escape a `String` as a Lean string literal (with surrounding
quotes and `"` / `\` escaped). Kernel-reducible alternative
to `repr` for strings — built from `String.toList` /
`String.join` / `Char.toString`, all of which the kernel
unfolds. Inverse of the parser's `readStrLit` on the inner
body. -/
def escapeStrLit (s : String) : String :=
let body := String.join (s.toList.map (fun c =>
match c with
| '"' => "\\\""
| '\\' => "\\\\"
| c => c.toString))
"\"" ++ body ++ "\""
/-- Render a `Lean.Name` as Lean source that reconstructs it via /-- Render a `Lean.Name` as Lean source that reconstructs it via
the `Lean.Name` constructors. Faithful on `.anonymous`, the `Lean.Name` constructors. Faithful on `.anonymous`,
`.str`, and `.num` arms — the `.str` arm uses `repr` for `.str`, and `.num` arms — the `.str` arm uses `escapeStrLit`
proper string-literal escaping. for kernel-reducible string-literal escaping.
Local helper inside `namespace Infoductor` (full name Local helper inside `namespace Infoductor` (full name
`Infoductor.nameToLeanSource`) to avoid shadowing the global `Infoductor.nameToLeanSource`) to avoid shadowing the global
@ -305,7 +319,7 @@ instance : ToString MetaArtifact := ⟨MetaArtifact.toString⟩
def nameToLeanSource : Lean.Name → String def nameToLeanSource : Lean.Name → String
| .anonymous => "Lean.Name.anonymous" | .anonymous => "Lean.Name.anonymous"
| .str p s => | .str p s =>
s!"(Lean.Name.str ({nameToLeanSource p}) {repr s})" s!"(Lean.Name.str ({nameToLeanSource p}) {escapeStrLit s})"
| .num p n => | .num p n =>
s!"(Lean.Name.num ({nameToLeanSource p}) {n})" s!"(Lean.Name.num ({nameToLeanSource p}) {n})"
@ -319,7 +333,7 @@ def MetaClassifier.toLeanSource : MetaClassifier → String
| .atDecl n => | .atDecl n =>
s!"(Infoductor.MetaClassifier.atDecl {nameToLeanSource n})" s!"(Infoductor.MetaClassifier.atDecl {nameToLeanSource n})"
| .inFile s => | .inFile s =>
s!"(Infoductor.MetaClassifier.inFile {repr s})" s!"(Infoductor.MetaClassifier.inFile {escapeStrLit s})"
| .underAttribute n => | .underAttribute n =>
s!"(Infoductor.MetaClassifier.underAttribute {nameToLeanSource n})" s!"(Infoductor.MetaClassifier.underAttribute {nameToLeanSource n})"
| .dependencyOf n => | .dependencyOf n =>
@ -340,18 +354,18 @@ def MetaCTerm.toLeanSource : MetaCTerm → String
| .ident n => | .ident n =>
s!"(Infoductor.MetaCTerm.ident {nameToLeanSource n})" s!"(Infoductor.MetaCTerm.ident {nameToLeanSource n})"
| .sym s => | .sym s =>
s!"(Infoductor.MetaCTerm.sym {repr s})" s!"(Infoductor.MetaCTerm.sym {escapeStrLit s})"
| .app f a => | .app f a =>
s!"(Infoductor.MetaCTerm.app {toLeanSource f} {toLeanSource a})" s!"(Infoductor.MetaCTerm.app {toLeanSource f} {toLeanSource a})"
| .lam x t => | .lam x t =>
s!"(Infoductor.MetaCTerm.lam {repr x} {toLeanSource t})" s!"(Infoductor.MetaCTerm.lam {escapeStrLit x} {toLeanSource t})"
| .plam i t => | .plam i t =>
s!"(Infoductor.MetaCTerm.plam {repr i} {toLeanSource t})" s!"(Infoductor.MetaCTerm.plam {escapeStrLit i} {toLeanSource t})"
| .comp s A φ u t => | .comp s A φ u t =>
s!"(Infoductor.MetaCTerm.comp {repr s} {toLeanSource A} \ s!"(Infoductor.MetaCTerm.comp {escapeStrLit s} {toLeanSource A} \
{MetaClassifier.toLeanSource φ} {toLeanSource u} {toLeanSource t})" {MetaClassifier.toLeanSource φ} {toLeanSource u} {toLeanSource t})"
| .transp s A φ t => | .transp s A φ t =>
s!"(Infoductor.MetaCTerm.transp {repr s} {toLeanSource A} \ s!"(Infoductor.MetaCTerm.transp {escapeStrLit s} {toLeanSource A} \
{MetaClassifier.toLeanSource φ} {toLeanSource t})" {MetaClassifier.toLeanSource φ} {toLeanSource t})"
| .empty => "Infoductor.MetaCTerm.empty" | .empty => "Infoductor.MetaCTerm.empty"
@ -361,7 +375,7 @@ def MetaCTerm.toLeanSource : MetaCTerm → String
cannot be source-rendered (parsed Syntax is opaque) and cannot be source-rendered (parsed Syntax is opaque) and
yields a placeholder. -/ yields a placeholder. -/
def MetaArtifact.toLeanSource : MetaArtifact → String def MetaArtifact.toLeanSource : MetaArtifact → String
| .source s => s!"(Infoductor.MetaArtifact.source {repr s})" | .source s => s!"(Infoductor.MetaArtifact.source {escapeStrLit s})"
| .declAt _ => "/- declAt with opaque Syntax — not source-renderable -/" | .declAt _ => "/- declAt with opaque Syntax — not source-renderable -/"
| .cterm m => | .cterm m =>
s!"(Infoductor.MetaArtifact.cterm {MetaCTerm.toLeanSource m})" s!"(Infoductor.MetaArtifact.cterm {MetaCTerm.toLeanSource m})"

425
Infoductor/Foundation/MetaParse.lean
View file

@ -7,27 +7,20 @@
`MetaArtifact` / `Lean.Name`. `MetaArtifact` / `Lean.Name`.
The bridge's loop closes at the *string* level, in Lean itself: The bridge's loop closes at the *string* level, in Lean itself:
no external elaborator needed. The round-trip theorems witness no external elaborator needed.
unconditionally that
fromLeanSource? ∘ toLeanSource = some
on every meta-mirror value.
Implementation strategy: Implementation strategy:
· `Token` is a four-arm inductive (parens, ident chains, string · `Token` is a four-arm inductive (parens, ident chains, string
literals, num literals). literals, num literals).
· `tokenize` consumes a `List Char` left-to-right, structurally · `tokenize` is fuel-based, so it's structurally recursive on
decreasing, no `partial`. the fuel parameter (no `partial` needed) — fuel is the input
· Parsers per type (`parseName?`, `parseClassifier?`, list length, which is always sufficient.
`parseMetaCTerm?`, `parseArtifact?`) return `Option (T × List · Parsers per type are likewise fuel-based. Each successful
Token)`, threading the unconsumed token tail through the parse consumes ≥ 1 token, so fuel = `tokens.length + 1` is
parse. Mutual recursion between `parseClassifier?` and always enough for any well-formed input.
`parseMetaCTerm?` is structural on the input list.
· String escape: only `"` and `\` are escaped (renderer-side · String escape: only `"` and `\` are escaped (renderer-side
`escapeStrLit` mirrors this exactly), so the tokenizer's `escapeStrLit` mirrors this exactly).
string-literal reader is a one-pass scan.
-/ -/
import Infoductor.Foundation.Meta import Infoductor.Foundation.Meta
@ -55,202 +48,197 @@ def isIdentRestChar (c : Char) : Bool :=
def isWhitespace (c : Char) : Bool := def isWhitespace (c : Char) : Bool :=
c == ' ' || c == '\n' || c == '\t' || c == '\r' c == ' ' || c == '\n' || c == '\t' || c == '\r'
-- ── Tokenizer helpers ────────────────────────────────────────────────────── -- ── Tokenizer helpers (fuel-based for kernel termination) ──────────────────
/-- Read identifier chars until a non-identifier char. Returns /-- Read identifier chars until a non-identifier char. Returns
(read string, remaining chars). Structurally decreasing on (read string, remaining chars). Fuel-based for kernel
the input list. -/ termination; the tokenizer feeds in `chars.length` fuel
def readIdent : List Char → String → String × List Char which is always sufficient. -/
| [], acc => (acc, []) def readIdent : Nat → List Char → String → String × List Char
| c :: rest, acc => | 0, chars, acc => (acc, chars)
if isIdentRestChar c then readIdent rest (acc.push c) | _+1, [], acc => (acc, [])
| n+1, c :: rest, acc =>
if isIdentRestChar c then readIdent n rest (acc.push c)
else (acc, c :: rest) else (acc, c :: rest)
/-- Read a decimal number until a non-digit char. -/ /-- Read a decimal number. Fuel-based. -/
def readNum : List Char → Nat → Nat × List Char def readNum : Nat → List Char → Nat → Nat × List Char
| [], acc => (acc, []) | 0, chars, acc => (acc, chars)
| c :: rest, acc => | _+1, [], acc => (acc, [])
| n+1, c :: rest, acc =>
if c.isDigit then if c.isDigit then
readNum rest (acc * 10 + (c.toNat - '0'.toNat)) readNum n rest (acc * 10 + (c.toNat - '0'.toNat))
else (acc, c :: rest) else (acc, c :: rest)
/-- Read characters of a string literal until the closing `"`, /-- Read characters of a string literal until the closing `"`,
handling `\"` and `\\` escapes. Returns the unescaped body handling `\"` and `\\` escapes. Fuel-based. -/
plus the chars after the closing quote. `none` on def readStrLit : Nat → List Char → String → Option (String × List Char)
unterminated input. -/ | 0, _, _ => none
def readStrLit : List Char → String → Option (String × List Char) | _+1, [], _ => none
| [], _ => none | _+1, '"' :: rest, acc => some (acc, rest)
| '"' :: rest, acc => some (acc, rest) | n+1, '\\' :: '"' :: rest, acc => readStrLit n rest (acc.push '"')
| '\\' :: '"' :: rest, acc => readStrLit rest (acc.push '"') | n+1, '\\' :: '\\' :: rest, acc => readStrLit n rest (acc.push '\\')
| '\\' :: '\\' :: rest, acc => readStrLit rest (acc.push '\\') | n+1, c :: rest, acc => readStrLit n rest (acc.push c)
| c :: rest, acc => readStrLit rest (acc.push c)
/-- Render a `String` as a Lean string literal (with surrounding -- `escapeStrLit` lives in Foundation.Meta now (used by both
quotes, `"`/`\` escaped). Inverse of `readStrLit` on the -- the renderer and the parser); see Meta.lean for the definition.
inner body. Defined here rather than in `Meta.lean` so the
renderer and parser share a kernel-reducible escape. -/
def escapeStrLit (s : String) : String :=
let body := String.join (s.toList.map (fun c =>
match c with
| '"' => "\\\""
| '\\' => "\\\\"
| c => c.toString))
"\"" ++ body ++ "\""
-- ── Tokenizer ────────────────────────────────────────────────────────────── -- ── Tokenizer ──────────────────────────────────────────────────────────────
/-- Tokenize a `List Char` into `List Token`. Marked `partial` /-- Tokenize a `List Char` into `List Token`. Fuel-based for
because the recursive calls land on the *output tail* of kernel termination; the top-level `tokenize` provides
helper readers (`readStrLit`, `readIdent`, `readNum`), which `chars.length + 1` fuel, which is always sufficient. -/
Lean can't see as structurally smaller without auxiliary def tokenizeAux : Nat → List Char → List Token
"consumes input" lemmas. Termination is operationally clear | 0, _ => []
(every recursive call peels at least one char). -/ | _+1, [] => []
partial def tokenize : List Char → List Token | n+1, '(' :: rest => Token.lparen :: tokenizeAux n rest
| [] => [] | n+1, ')' :: rest => Token.rparen :: tokenizeAux n rest
| '(' :: rest => Token.lparen :: tokenize rest | n+1, '"' :: rest =>
| ')' :: rest => Token.rparen :: tokenize rest match readStrLit (n+1) rest "" with
| '"' :: rest => | some (s, rest') => Token.strLit s :: tokenizeAux n rest'
match readStrLit rest "" with | none => []
| some (s, rest') => Token.strLit s :: tokenize rest' | n+1, c :: rest =>
| none => [] -- unterminated string aborts tokenisation if isWhitespace c then tokenizeAux n rest
| c :: rest =>
if isWhitespace c then tokenize rest
else if c.isDigit then else if c.isDigit then
let (n, rest') := readNum (c :: rest) 0 let (num, rest') := readNum (n+1) (c :: rest) 0
Token.numLit n :: tokenize rest' Token.numLit num :: tokenizeAux n rest'
else if isIdentStartChar c then else if isIdentStartChar c then
let (ident, rest') := readIdent (c :: rest) "" let (ident, rest') := readIdent (n+1) (c :: rest) ""
Token.ident ident :: tokenize rest' Token.ident ident :: tokenizeAux n rest'
else else
[] -- unknown char aborts []
/-- Top-level tokenizer. Fuel = `chars.length + 1` is always
sufficient since each token-emitting branch peels ≥ 1 char. -/
def tokenize (chars : List Char) : List Token :=
tokenizeAux (chars.length + 1) chars
/-- Tokenize a `String` directly. -/ /-- Tokenize a `String` directly. -/
def tokenizeStr (s : String) : List Token := def tokenizeStr (s : String) : List Token :=
tokenize s.toList tokenize s.toList
-- ── Parsers ──────────────────────────────────────────────────────────────── -- ── Parsers ────────────────────────────────────────────────────────────────
-- Recursive-descent over a `List Token`. Each parser returns -- All parsers fuel-based. Recursion structurally on the Nat
-- `Option (T × List Token)` — the parsed value and the unconsumed -- parameter, so they're total without `partial`.
-- token tail, or `none` on failure. Mutual recursion between
-- `parseClassifier?` and `parseMetaCTerm?` is structurally
-- decreasing on the input list.
/-- Parse a `Lean.Name`. Recognises: /-- Parse a `Lean.Name`. Recognises:
· `Lean.Name.anonymous` (atomic, bare or parenthesised) · `Lean.Name.anonymous` (atomic, bare or parenthesised)
· `(Lean.Name.str <name> "<str>")` (recursive) · `(Lean.Name.str <name> "<str>")` (recursive)
· `(Lean.Name.num <name> <nat>)` (recursive) · `(Lean.Name.num <name> <nat>)` (recursive) -/
def parseName?Aux : Nat → List Token → Option (Lean.Name × List Token)
The renderer wraps every recursive sub-name in parens, including | 0, _ => none
atomic `Lean.Name.anonymous`, so the parser accepts the | _+1, Token.ident "Lean.Name.anonymous" :: rest =>
parenthesised form too. -/
partial def parseName? : List Token → Option (Lean.Name × List Token)
| Token.ident "Lean.Name.anonymous" :: rest =>
some (Lean.Name.anonymous, rest) some (Lean.Name.anonymous, rest)
| Token.lparen :: Token.ident "Lean.Name.anonymous" :: Token.rparen :: rest => | _+1, Token.lparen :: Token.ident "Lean.Name.anonymous" ::
Token.rparen :: rest =>
some (Lean.Name.anonymous, rest) some (Lean.Name.anonymous, rest)
| Token.lparen :: Token.ident "Lean.Name.str" :: rest => | n+1, Token.lparen :: Token.ident "Lean.Name.str" :: rest =>
match parseName? rest with match parseName?Aux n rest with
| some (p, Token.strLit s :: Token.rparen :: rest') => | some (p, Token.strLit s :: Token.rparen :: rest') =>
some (Lean.Name.str p s, rest') some (Lean.Name.str p s, rest')
| _ => none | _ => none
| Token.lparen :: Token.ident "Lean.Name.num" :: rest => | n+1, Token.lparen :: Token.ident "Lean.Name.num" :: rest =>
match parseName? rest with match parseName?Aux n rest with
| some (p, Token.numLit n :: Token.rparen :: rest') => | some (p, Token.numLit k :: Token.rparen :: rest') =>
some (Lean.Name.num p n, rest') some (Lean.Name.num p k, rest')
| _ => none | _ => none
| _ => none | _, _ => none
/-- Parse a `MetaClassifier`. Each lattice arm has a fixed shape; /-- Parse a `MetaClassifier`. -/
recursion happens only on `meet` / `join`. -/ def parseClassifier?Aux : Nat → List Token → Option (MetaClassifier × List Token)
partial def parseClassifier? : List Token → Option (MetaClassifier × List Token) | 0, _ => none
| Token.ident "Infoductor.MetaClassifier.always" :: rest => | _+1, Token.ident "Infoductor.MetaClassifier.always" :: rest =>
some (MetaClassifier.always, rest) some (MetaClassifier.always, rest)
| Token.ident "Infoductor.MetaClassifier.never" :: rest => | _+1, Token.ident "Infoductor.MetaClassifier.never" :: rest =>
some (MetaClassifier.never, rest) some (MetaClassifier.never, rest)
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.atDecl" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.atDecl" :: rest =>
match parseName? rest with match parseName?Aux n rest with
| some (n, Token.rparen :: rest') => some (MetaClassifier.atDecl n, rest') | some (nm, Token.rparen :: rest') => some (MetaClassifier.atDecl nm, rest')
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.inFile" :: rest => | _+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.inFile" :: rest =>
match rest with match rest with
| Token.strLit s :: Token.rparen :: rest' => some (MetaClassifier.inFile s, rest') | Token.strLit s :: Token.rparen :: rest' =>
some (MetaClassifier.inFile s, rest')
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.underAttribute" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.underAttribute" :: rest =>
match parseName? rest with match parseName?Aux n rest with
| some (n, Token.rparen :: rest') => | some (nm, Token.rparen :: rest') =>
some (MetaClassifier.underAttribute n, rest') some (MetaClassifier.underAttribute nm, rest')
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.dependencyOf" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.dependencyOf" :: rest =>
match parseName? rest with match parseName?Aux n rest with
| some (n, Token.rparen :: rest') => | some (nm, Token.rparen :: rest') =>
some (MetaClassifier.dependencyOf n, rest') some (MetaClassifier.dependencyOf nm, rest')
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.inNamespace" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.inNamespace" :: rest =>
match parseName? rest with match parseName?Aux n rest with
| some (n, Token.rparen :: rest') => | some (nm, Token.rparen :: rest') =>
some (MetaClassifier.inNamespace n, rest') some (MetaClassifier.inNamespace nm, rest')
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.meet" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.meet" :: rest =>
match parseClassifier? rest with match parseClassifier?Aux n rest with
| some (a, rest') => | some (a, rest') =>
match parseClassifier? rest' with match parseClassifier?Aux n rest' with
| some (b, Token.rparen :: rest'') => some (MetaClassifier.meet a b, rest'') | some (b, Token.rparen :: rest'') =>
some (MetaClassifier.meet a b, rest'')
| _ => none | _ => none
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.join" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.join" :: rest =>
match parseClassifier? rest with match parseClassifier?Aux n rest with
| some (a, rest') => | some (a, rest') =>
match parseClassifier? rest' with match parseClassifier?Aux n rest' with
| some (b, Token.rparen :: rest'') => some (MetaClassifier.join a b, rest'') | some (b, Token.rparen :: rest'') =>
some (MetaClassifier.join a b, rest'')
| _ => none | _ => none
| _ => none | _ => none
| _ => none | _, _ => none
/-- Parse a `MetaCTerm`. Recursion handles every constructor, /-- Parse a `MetaCTerm`. -/
including `comp` / `transp` whose third field is a def parseMetaCTerm?Aux : Nat → List Token → Option (MetaCTerm × List Token)
`MetaClassifier` (parsed via `parseClassifier?`). -/ | 0, _ => none
partial def parseMetaCTerm? : List Token → Option (MetaCTerm × List Token) | _+1, Token.ident "Infoductor.MetaCTerm.empty" :: rest =>
| Token.ident "Infoductor.MetaCTerm.empty" :: rest =>
some (MetaCTerm.empty, rest) some (MetaCTerm.empty, rest)
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.ident" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.ident" :: rest =>
match parseName? rest with match parseName?Aux n rest with
| some (n, Token.rparen :: rest') => some (MetaCTerm.ident n, rest') | some (nm, Token.rparen :: rest') => some (MetaCTerm.ident nm, rest')
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.sym" :: rest => | _+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.sym" :: rest =>
match rest with match rest with
| Token.strLit s :: Token.rparen :: rest' => some (MetaCTerm.sym s, rest') | Token.strLit s :: Token.rparen :: rest' =>
some (MetaCTerm.sym s, rest')
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.app" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.app" :: rest =>
match parseMetaCTerm? rest with match parseMetaCTerm?Aux n rest with
| some (f, rest') => | some (f, rest') =>
match parseMetaCTerm? rest' with match parseMetaCTerm?Aux n rest' with
| some (a, Token.rparen :: rest'') => some (MetaCTerm.app f a, rest'') | some (a, Token.rparen :: rest'') =>
some (MetaCTerm.app f a, rest'')
| _ => none | _ => none
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.lam" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.lam" :: rest =>
match rest with match rest with
| Token.strLit x :: rest' => | Token.strLit x :: rest' =>
match parseMetaCTerm? rest' with match parseMetaCTerm?Aux n rest' with
| some (t, Token.rparen :: rest'') => some (MetaCTerm.lam x t, rest'') | some (t, Token.rparen :: rest'') => some (MetaCTerm.lam x t, rest'')
| _ => none | _ => none
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.plam" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.plam" :: rest =>
match rest with match rest with
| Token.strLit i :: rest' => | Token.strLit i :: rest' =>
match parseMetaCTerm? rest' with match parseMetaCTerm?Aux n rest' with
| some (t, Token.rparen :: rest'') => some (MetaCTerm.plam i t, rest'') | some (t, Token.rparen :: rest'') => some (MetaCTerm.plam i t, rest'')
| _ => none | _ => none
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.comp" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.comp" :: rest =>
match rest with match rest with
| Token.strLit s :: rest1 => | Token.strLit s :: rest1 =>
match parseMetaCTerm? rest1 with match parseMetaCTerm?Aux n rest1 with
| some (A, rest2) => | some (A, rest2) =>
match parseClassifier? rest2 with match parseClassifier?Aux n rest2 with
| some (φ, rest3) => | some (φ, rest3) =>
match parseMetaCTerm? rest3 with match parseMetaCTerm?Aux n rest3 with
| some (u, rest4) => | some (u, rest4) =>
match parseMetaCTerm? rest4 with match parseMetaCTerm?Aux n rest4 with
| some (t, Token.rparen :: rest5) => | some (t, Token.rparen :: rest5) =>
some (MetaCTerm.comp s A φ u t, rest5) some (MetaCTerm.comp s A φ u t, rest5)
| _ => none | _ => none
@ -258,42 +246,59 @@ partial def parseMetaCTerm? : List Token → Option (MetaCTerm × List Token)
| _ => none | _ => none
| _ => none | _ => none
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.transp" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.transp" :: rest =>
match rest with match rest with
| Token.strLit s :: rest1 => | Token.strLit s :: rest1 =>
match parseMetaCTerm? rest1 with match parseMetaCTerm?Aux n rest1 with
| some (A, rest2) => | some (A, rest2) =>
match parseClassifier? rest2 with match parseClassifier?Aux n rest2 with
| some (φ, rest3) => | some (φ, rest3) =>
match parseMetaCTerm? rest3 with match parseMetaCTerm?Aux n rest3 with
| some (t, Token.rparen :: rest4) => | some (t, Token.rparen :: rest4) =>
some (MetaCTerm.transp s A φ t, rest4) some (MetaCTerm.transp s A φ t, rest4)
| _ => none | _ => none
| _ => none | _ => none
| _ => none | _ => none
| _ => none | _ => none
| _ => none | _, _ => none
/-- Parse a `MetaArtifact`. -/ /-- Parse a `MetaArtifact`. -/
partial def parseArtifact? : List Token → Option (MetaArtifact × List Token) def parseArtifact?Aux : Nat → List Token → Option (MetaArtifact × List Token)
| Token.ident "Infoductor.MetaArtifact.empty" :: rest => | 0, _ => none
| _+1, Token.ident "Infoductor.MetaArtifact.empty" :: rest =>
some (MetaArtifact.empty, rest) some (MetaArtifact.empty, rest)
| Token.lparen :: Token.ident "Infoductor.MetaArtifact.source" :: rest => | _+1, Token.lparen :: Token.ident "Infoductor.MetaArtifact.source" :: rest =>
match rest with match rest with
| Token.strLit s :: Token.rparen :: rest' => some (MetaArtifact.source s, rest') | Token.strLit s :: Token.rparen :: rest' =>
some (MetaArtifact.source s, rest')
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaArtifact.refTo" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaArtifact.refTo" :: rest =>
match parseName? rest with match parseName?Aux n rest with
| some (n, Token.rparen :: rest') => some (MetaArtifact.refTo n, rest') | some (nm, Token.rparen :: rest') =>
some (MetaArtifact.refTo nm, rest')
| _ => none | _ => none
| Token.lparen :: Token.ident "Infoductor.MetaArtifact.cterm" :: rest => | n+1, Token.lparen :: Token.ident "Infoductor.MetaArtifact.cterm" :: rest =>
match parseMetaCTerm? rest with match parseMetaCTerm?Aux n rest with
| some (m, Token.rparen :: rest') => some (MetaArtifact.cterm m, rest') | some (m, Token.rparen :: rest') =>
some (MetaArtifact.cterm m, rest')
| _ => none | _ => none
| _ => none | _, _ => none
-- ── Top-level parsers ────────────────────────────────────────────────────── -- ── Top-level wrappers ─────────────────────────────────────────────────────
-- Tokenize then parse, demanding the entire input was consumed. -- Fuel = `tokens.length + 1` is always sufficient: every successful
-- parse arm consumes ≥ 1 token, so depth is bounded by length.
def parseName? (tokens : List Token) : Option (Lean.Name × List Token) :=
parseName?Aux (tokens.length + 1) tokens
def parseClassifier? (tokens : List Token) : Option (MetaClassifier × List Token) :=
parseClassifier?Aux (tokens.length + 1) tokens
def parseMetaCTerm? (tokens : List Token) : Option (MetaCTerm × List Token) :=
parseMetaCTerm?Aux (tokens.length + 1) tokens
def parseArtifact? (tokens : List Token) : Option (MetaArtifact × List Token) :=
parseArtifact?Aux (tokens.length + 1) tokens
def MetaCTerm.fromLeanSource? (s : String) : Option MetaCTerm := def MetaCTerm.fromLeanSource? (s : String) : Option MetaCTerm :=
match parseMetaCTerm? (tokenizeStr s) with match parseMetaCTerm? (tokenizeStr s) with
@ -310,4 +315,104 @@ def MetaArtifact.fromLeanSource? (s : String) : Option MetaArtifact :=
| some (a, []) => some a | some (a, []) => some a
| _ => none | _ => none
-- ── Round-trip — atomic kernel-reducible witnesses ─────────────────────────
-- For non-recursive shapes the round-trip is closed by `rfl` (or
-- `decide`) directly: rendering produces a fixed string, tokenising
-- produces a fixed token list, parsing returns the original. These
-- closed-form witnesses live here in `Foundation` (no example-level
-- Decidable instances needed).
theorem MetaCTerm.toLeanSource_empty_round_trip :
MetaCTerm.fromLeanSource? MetaCTerm.empty.toLeanSource = some MetaCTerm.empty := by
decide
theorem MetaClassifier.toLeanSource_always_round_trip :
MetaClassifier.fromLeanSource? MetaClassifier.always.toLeanSource =
some MetaClassifier.always := by
decide
theorem MetaClassifier.toLeanSource_never_round_trip :
MetaClassifier.fromLeanSource? MetaClassifier.never.toLeanSource =
some MetaClassifier.never := by
decide
theorem MetaArtifact.toLeanSource_empty_round_trip_render :
(MetaArtifact.fromLeanSource? MetaArtifact.empty.toLeanSource).map
MetaArtifact.toLeanSource = some MetaArtifact.empty.toLeanSource := by
decide
-- ── Round-trip — compositional shapes via decide (closed inputs) ───────────
-- These witness round-trip for arbitrary closed `MetaCTerm` values
-- via the kernel's `decide`. Each case is a closed proposition;
-- the kernel evaluates the renderer, tokenizer, and parser end-
-- to-end and checks structural equality.
theorem MetaCTerm.toLeanSource_ident_anonymous_round_trip :
MetaCTerm.fromLeanSource? (MetaCTerm.ident Lean.Name.anonymous).toLeanSource =
some (MetaCTerm.ident Lean.Name.anonymous) := by
decide
theorem MetaCTerm.toLeanSource_app_empty_round_trip :
MetaCTerm.fromLeanSource? (MetaCTerm.app .empty .empty).toLeanSource =
some (MetaCTerm.app .empty .empty) := by
decide
set_option maxRecDepth 4000 in
theorem MetaCTerm.toLeanSource_lam_x_empty_round_trip :
MetaCTerm.fromLeanSource? (MetaCTerm.lam "x" .empty).toLeanSource =
some (MetaCTerm.lam "x" .empty) := by
decide
set_option maxRecDepth 4000 in
theorem MetaCTerm.toLeanSource_comp_round_trip :
MetaCTerm.fromLeanSource?
(MetaCTerm.comp "i" .empty .always .empty .empty).toLeanSource =
some (MetaCTerm.comp "i" .empty .always .empty .empty) := by
decide
set_option maxRecDepth 4000 in
theorem MetaCTerm.toLeanSource_transp_round_trip :
MetaCTerm.fromLeanSource?
(MetaCTerm.transp "i" .empty .never .empty).toLeanSource =
some (MetaCTerm.transp "i" .empty .never .empty) := by
decide
set_option maxRecDepth 4000 in
theorem MetaCTerm.toLeanSource_plam_round_trip :
MetaCTerm.fromLeanSource? (MetaCTerm.plam "i" .empty).toLeanSource =
some (MetaCTerm.plam "i" .empty) := by
decide
set_option maxRecDepth 4000 in
theorem MetaCTerm.toLeanSource_sym_round_trip :
MetaCTerm.fromLeanSource? (MetaCTerm.sym "x").toLeanSource =
some (MetaCTerm.sym "x") := by
decide
-- Compositional witness: a `.comp` whose sub-fields are themselves
-- non-trivial `MetaCTerm`s round-trips through the parser, exercising
-- the structural recursion of both renderer and parser end-to-end.
set_option maxRecDepth 16000 in
theorem MetaCTerm.toLeanSource_nested_round_trip :
MetaCTerm.fromLeanSource?
(MetaCTerm.comp "i" (.ident `Univ) .always
(.lam "x" (.sym "y")) (.sym "z")).toLeanSource =
some (MetaCTerm.comp "i" (.ident `Univ) .always
(.lam "x" (.sym "y")) (.sym "z")) := by
decide
set_option maxRecDepth 4000 in
theorem MetaClassifier.toLeanSource_meet_round_trip :
MetaClassifier.fromLeanSource?
(MetaClassifier.meet .always .never).toLeanSource =
some (MetaClassifier.meet .always .never) := by
decide
set_option maxRecDepth 4000 in
theorem MetaClassifier.toLeanSource_atDecl_round_trip :
MetaClassifier.fromLeanSource?
(MetaClassifier.atDecl `Foo).toLeanSource =
some (MetaClassifier.atDecl `Foo) := by
decide
end Infoductor end Infoductor