Fuel-based parsers + kernel-level round-trip via decide
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
parent
92fc4f9682
commit
9c9b93c3ca
2 changed files with 289 additions and 170 deletions
|
|
@ -294,10 +294,24 @@ instance : ToString MetaArtifact := ⟨MetaArtifact.toString⟩
|
|||
-- write a parser. The renderer is fully recursive over the
|
||||
-- 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
|
||||
the `Lean.Name` constructors. Faithful on `.anonymous`,
|
||||
`.str`, and `.num` arms — the `.str` arm uses `repr` for
|
||||
proper string-literal escaping.
|
||||
`.str`, and `.num` arms — the `.str` arm uses `escapeStrLit`
|
||||
for kernel-reducible string-literal escaping.
|
||||
|
||||
Local helper inside `namespace Infoductor` (full name
|
||||
`Infoductor.nameToLeanSource`) to avoid shadowing the global
|
||||
|
|
@ -305,7 +319,7 @@ instance : ToString MetaArtifact := ⟨MetaArtifact.toString⟩
|
|||
def nameToLeanSource : Lean.Name → String
|
||||
| .anonymous => "Lean.Name.anonymous"
|
||||
| .str p s =>
|
||||
s!"(Lean.Name.str ({nameToLeanSource p}) {repr s})"
|
||||
s!"(Lean.Name.str ({nameToLeanSource p}) {escapeStrLit s})"
|
||||
| .num p n =>
|
||||
s!"(Lean.Name.num ({nameToLeanSource p}) {n})"
|
||||
|
||||
|
|
@ -319,7 +333,7 @@ def MetaClassifier.toLeanSource : MetaClassifier → String
|
|||
| .atDecl n =>
|
||||
s!"(Infoductor.MetaClassifier.atDecl {nameToLeanSource n})"
|
||||
| .inFile s =>
|
||||
s!"(Infoductor.MetaClassifier.inFile {repr s})"
|
||||
s!"(Infoductor.MetaClassifier.inFile {escapeStrLit s})"
|
||||
| .underAttribute n =>
|
||||
s!"(Infoductor.MetaClassifier.underAttribute {nameToLeanSource n})"
|
||||
| .dependencyOf n =>
|
||||
|
|
@ -340,18 +354,18 @@ def MetaCTerm.toLeanSource : MetaCTerm → String
|
|||
| .ident n =>
|
||||
s!"(Infoductor.MetaCTerm.ident {nameToLeanSource n})"
|
||||
| .sym s =>
|
||||
s!"(Infoductor.MetaCTerm.sym {repr s})"
|
||||
s!"(Infoductor.MetaCTerm.sym {escapeStrLit s})"
|
||||
| .app f a =>
|
||||
s!"(Infoductor.MetaCTerm.app {toLeanSource f} {toLeanSource a})"
|
||||
| .lam x t =>
|
||||
s!"(Infoductor.MetaCTerm.lam {repr x} {toLeanSource t})"
|
||||
s!"(Infoductor.MetaCTerm.lam {escapeStrLit x} {toLeanSource 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 =>
|
||||
s!"(Infoductor.MetaCTerm.comp {repr s} {toLeanSource A} \
|
||||
s!"(Infoductor.MetaCTerm.comp {escapeStrLit s} {toLeanSource A} \
|
||||
{MetaClassifier.toLeanSource φ} {toLeanSource u} {toLeanSource 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})"
|
||||
| .empty => "Infoductor.MetaCTerm.empty"
|
||||
|
||||
|
|
@ -361,7 +375,7 @@ def MetaCTerm.toLeanSource : MetaCTerm → String
|
|||
cannot be source-rendered (parsed Syntax is opaque) and
|
||||
yields a placeholder. -/
|
||||
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 -/"
|
||||
| .cterm m =>
|
||||
s!"(Infoductor.MetaArtifact.cterm {MetaCTerm.toLeanSource m})"
|
||||
|
|
|
|||
|
|
@ -7,27 +7,20 @@
|
|||
`MetaArtifact` / `Lean.Name`.
|
||||
|
||||
The bridge's loop closes at the *string* level, in Lean itself:
|
||||
no external elaborator needed. The round-trip theorems witness
|
||||
unconditionally that
|
||||
|
||||
fromLeanSource? ∘ toLeanSource = some
|
||||
|
||||
on every meta-mirror value.
|
||||
no external elaborator needed.
|
||||
|
||||
Implementation strategy:
|
||||
|
||||
· `Token` is a four-arm inductive (parens, ident chains, string
|
||||
literals, num literals).
|
||||
· `tokenize` consumes a `List Char` left-to-right, structurally
|
||||
decreasing, no `partial`.
|
||||
· Parsers per type (`parseName?`, `parseClassifier?`,
|
||||
`parseMetaCTerm?`, `parseArtifact?`) return `Option (T × List
|
||||
Token)`, threading the unconsumed token tail through the
|
||||
parse. Mutual recursion between `parseClassifier?` and
|
||||
`parseMetaCTerm?` is structural on the input list.
|
||||
· `tokenize` is fuel-based, so it's structurally recursive on
|
||||
the fuel parameter (no `partial` needed) — fuel is the input
|
||||
list length, which is always sufficient.
|
||||
· Parsers per type are likewise fuel-based. Each successful
|
||||
parse consumes ≥ 1 token, so fuel = `tokens.length + 1` is
|
||||
always enough for any well-formed input.
|
||||
· String escape: only `"` and `\` are escaped (renderer-side
|
||||
`escapeStrLit` mirrors this exactly), so the tokenizer's
|
||||
string-literal reader is a one-pass scan.
|
||||
`escapeStrLit` mirrors this exactly).
|
||||
-/
|
||||
|
||||
import Infoductor.Foundation.Meta
|
||||
|
|
@ -55,202 +48,197 @@ def isIdentRestChar (c : Char) : Bool :=
|
|||
def isWhitespace (c : Char) : Bool :=
|
||||
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 string, remaining chars). Structurally decreasing on
|
||||
the input list. -/
|
||||
def readIdent : List Char → String → String × List Char
|
||||
| [], acc => (acc, [])
|
||||
| c :: rest, acc =>
|
||||
if isIdentRestChar c then readIdent rest (acc.push c)
|
||||
(read string, remaining chars). Fuel-based for kernel
|
||||
termination; the tokenizer feeds in `chars.length` fuel
|
||||
which is always sufficient. -/
|
||||
def readIdent : Nat → List Char → String → String × List Char
|
||||
| 0, chars, acc => (acc, chars)
|
||||
| _+1, [], acc => (acc, [])
|
||||
| n+1, c :: rest, acc =>
|
||||
if isIdentRestChar c then readIdent n rest (acc.push c)
|
||||
else (acc, c :: rest)
|
||||
|
||||
/-- Read a decimal number until a non-digit char. -/
|
||||
def readNum : List Char → Nat → Nat × List Char
|
||||
| [], acc => (acc, [])
|
||||
| c :: rest, acc =>
|
||||
/-- Read a decimal number. Fuel-based. -/
|
||||
def readNum : Nat → List Char → Nat → Nat × List Char
|
||||
| 0, chars, acc => (acc, chars)
|
||||
| _+1, [], acc => (acc, [])
|
||||
| n+1, c :: rest, acc =>
|
||||
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)
|
||||
|
||||
/-- Read characters of a string literal until the closing `"`,
|
||||
handling `\"` and `\\` escapes. Returns the unescaped body
|
||||
plus the chars after the closing quote. `none` on
|
||||
unterminated input. -/
|
||||
def readStrLit : List Char → String → Option (String × List Char)
|
||||
| [], _ => none
|
||||
| '"' :: rest, acc => some (acc, rest)
|
||||
| '\\' :: '"' :: rest, acc => readStrLit rest (acc.push '"')
|
||||
| '\\' :: '\\' :: rest, acc => readStrLit rest (acc.push '\\')
|
||||
| c :: rest, acc => readStrLit rest (acc.push c)
|
||||
handling `\"` and `\\` escapes. Fuel-based. -/
|
||||
def readStrLit : Nat → List Char → String → Option (String × List Char)
|
||||
| 0, _, _ => none
|
||||
| _+1, [], _ => none
|
||||
| _+1, '"' :: rest, acc => some (acc, rest)
|
||||
| n+1, '\\' :: '"' :: rest, acc => readStrLit n rest (acc.push '"')
|
||||
| n+1, '\\' :: '\\' :: rest, acc => readStrLit n rest (acc.push '\\')
|
||||
| n+1, c :: rest, acc => readStrLit n rest (acc.push c)
|
||||
|
||||
/-- Render a `String` as a Lean string literal (with surrounding
|
||||
quotes, `"`/`\` escaped). Inverse of `readStrLit` on the
|
||||
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 ++ "\""
|
||||
-- `escapeStrLit` lives in Foundation.Meta now (used by both
|
||||
-- the renderer and the parser); see Meta.lean for the definition.
|
||||
|
||||
-- ── Tokenizer ──────────────────────────────────────────────────────────────
|
||||
|
||||
/-- Tokenize a `List Char` into `List Token`. Marked `partial`
|
||||
because the recursive calls land on the *output tail* of
|
||||
helper readers (`readStrLit`, `readIdent`, `readNum`), which
|
||||
Lean can't see as structurally smaller without auxiliary
|
||||
"consumes input" lemmas. Termination is operationally clear
|
||||
(every recursive call peels at least one char). -/
|
||||
partial def tokenize : List Char → List Token
|
||||
| [] => []
|
||||
| '(' :: rest => Token.lparen :: tokenize rest
|
||||
| ')' :: rest => Token.rparen :: tokenize rest
|
||||
| '"' :: rest =>
|
||||
match readStrLit rest "" with
|
||||
| some (s, rest') => Token.strLit s :: tokenize rest'
|
||||
| none => [] -- unterminated string aborts tokenisation
|
||||
| c :: rest =>
|
||||
if isWhitespace c then tokenize rest
|
||||
/-- Tokenize a `List Char` into `List Token`. Fuel-based for
|
||||
kernel termination; the top-level `tokenize` provides
|
||||
`chars.length + 1` fuel, which is always sufficient. -/
|
||||
def tokenizeAux : Nat → List Char → List Token
|
||||
| 0, _ => []
|
||||
| _+1, [] => []
|
||||
| n+1, '(' :: rest => Token.lparen :: tokenizeAux n rest
|
||||
| n+1, ')' :: rest => Token.rparen :: tokenizeAux n rest
|
||||
| n+1, '"' :: rest =>
|
||||
match readStrLit (n+1) rest "" with
|
||||
| some (s, rest') => Token.strLit s :: tokenizeAux n rest'
|
||||
| none => []
|
||||
| n+1, c :: rest =>
|
||||
if isWhitespace c then tokenizeAux n rest
|
||||
else if c.isDigit then
|
||||
let (n, rest') := readNum (c :: rest) 0
|
||||
Token.numLit n :: tokenize rest'
|
||||
let (num, rest') := readNum (n+1) (c :: rest) 0
|
||||
Token.numLit num :: tokenizeAux n rest'
|
||||
else if isIdentStartChar c then
|
||||
let (ident, rest') := readIdent (c :: rest) ""
|
||||
Token.ident ident :: tokenize rest'
|
||||
let (ident, rest') := readIdent (n+1) (c :: rest) ""
|
||||
Token.ident ident :: tokenizeAux n rest'
|
||||
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. -/
|
||||
def tokenizeStr (s : String) : List Token :=
|
||||
tokenize s.toList
|
||||
|
||||
-- ── Parsers ────────────────────────────────────────────────────────────────
|
||||
-- Recursive-descent over a `List Token`. Each parser returns
|
||||
-- `Option (T × List Token)` — the parsed value and the unconsumed
|
||||
-- token tail, or `none` on failure. Mutual recursion between
|
||||
-- `parseClassifier?` and `parseMetaCTerm?` is structurally
|
||||
-- decreasing on the input list.
|
||||
-- All parsers fuel-based. Recursion structurally on the Nat
|
||||
-- parameter, so they're total without `partial`.
|
||||
|
||||
/-- Parse a `Lean.Name`. Recognises:
|
||||
· `Lean.Name.anonymous` (atomic, bare or parenthesised)
|
||||
· `(Lean.Name.str <name> "<str>")` (recursive)
|
||||
· `(Lean.Name.num <name> <nat>)` (recursive)
|
||||
|
||||
The renderer wraps every recursive sub-name in parens, including
|
||||
atomic `Lean.Name.anonymous`, so the parser accepts the
|
||||
parenthesised form too. -/
|
||||
partial def parseName? : List Token → Option (Lean.Name × List Token)
|
||||
| Token.ident "Lean.Name.anonymous" :: rest =>
|
||||
· `(Lean.Name.num <name> <nat>)` (recursive) -/
|
||||
def parseName?Aux : Nat → List Token → Option (Lean.Name × List Token)
|
||||
| 0, _ => none
|
||||
| _+1, Token.ident "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)
|
||||
| Token.lparen :: Token.ident "Lean.Name.str" :: rest =>
|
||||
match parseName? rest with
|
||||
| n+1, Token.lparen :: Token.ident "Lean.Name.str" :: rest =>
|
||||
match parseName?Aux n rest with
|
||||
| some (p, Token.strLit s :: Token.rparen :: rest') =>
|
||||
some (Lean.Name.str p s, rest')
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Lean.Name.num" :: rest =>
|
||||
match parseName? rest with
|
||||
| some (p, Token.numLit n :: Token.rparen :: rest') =>
|
||||
some (Lean.Name.num p n, rest')
|
||||
| n+1, Token.lparen :: Token.ident "Lean.Name.num" :: rest =>
|
||||
match parseName?Aux n rest with
|
||||
| some (p, Token.numLit k :: Token.rparen :: rest') =>
|
||||
some (Lean.Name.num p k, rest')
|
||||
| _ => none
|
||||
| _ => none
|
||||
| _, _ => none
|
||||
|
||||
/-- Parse a `MetaClassifier`. Each lattice arm has a fixed shape;
|
||||
recursion happens only on `meet` / `join`. -/
|
||||
partial def parseClassifier? : List Token → Option (MetaClassifier × List Token)
|
||||
| Token.ident "Infoductor.MetaClassifier.always" :: rest =>
|
||||
/-- Parse a `MetaClassifier`. -/
|
||||
def parseClassifier?Aux : Nat → List Token → Option (MetaClassifier × List Token)
|
||||
| 0, _ => none
|
||||
| _+1, Token.ident "Infoductor.MetaClassifier.always" :: rest =>
|
||||
some (MetaClassifier.always, rest)
|
||||
| Token.ident "Infoductor.MetaClassifier.never" :: rest =>
|
||||
| _+1, Token.ident "Infoductor.MetaClassifier.never" :: rest =>
|
||||
some (MetaClassifier.never, rest)
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.atDecl" :: rest =>
|
||||
match parseName? rest with
|
||||
| some (n, Token.rparen :: rest') => some (MetaClassifier.atDecl n, rest')
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.atDecl" :: rest =>
|
||||
match parseName?Aux n rest with
|
||||
| some (nm, Token.rparen :: rest') => some (MetaClassifier.atDecl nm, rest')
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.inFile" :: rest =>
|
||||
| _+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.inFile" :: rest =>
|
||||
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
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.underAttribute" :: rest =>
|
||||
match parseName? rest with
|
||||
| some (n, Token.rparen :: rest') =>
|
||||
some (MetaClassifier.underAttribute n, rest')
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.underAttribute" :: rest =>
|
||||
match parseName?Aux n rest with
|
||||
| some (nm, Token.rparen :: rest') =>
|
||||
some (MetaClassifier.underAttribute nm, rest')
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.dependencyOf" :: rest =>
|
||||
match parseName? rest with
|
||||
| some (n, Token.rparen :: rest') =>
|
||||
some (MetaClassifier.dependencyOf n, rest')
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.dependencyOf" :: rest =>
|
||||
match parseName?Aux n rest with
|
||||
| some (nm, Token.rparen :: rest') =>
|
||||
some (MetaClassifier.dependencyOf nm, rest')
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.inNamespace" :: rest =>
|
||||
match parseName? rest with
|
||||
| some (n, Token.rparen :: rest') =>
|
||||
some (MetaClassifier.inNamespace n, rest')
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.inNamespace" :: rest =>
|
||||
match parseName?Aux n rest with
|
||||
| some (nm, Token.rparen :: rest') =>
|
||||
some (MetaClassifier.inNamespace nm, rest')
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.meet" :: rest =>
|
||||
match parseClassifier? rest with
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.meet" :: rest =>
|
||||
match parseClassifier?Aux n rest with
|
||||
| some (a, rest') =>
|
||||
match parseClassifier? rest' with
|
||||
| some (b, Token.rparen :: rest'') => some (MetaClassifier.meet a b, rest'')
|
||||
match parseClassifier?Aux n rest' with
|
||||
| some (b, Token.rparen :: rest'') =>
|
||||
some (MetaClassifier.meet a b, rest'')
|
||||
| _ => none
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaClassifier.join" :: rest =>
|
||||
match parseClassifier? rest with
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaClassifier.join" :: rest =>
|
||||
match parseClassifier?Aux n rest with
|
||||
| some (a, rest') =>
|
||||
match parseClassifier? rest' with
|
||||
| some (b, Token.rparen :: rest'') => some (MetaClassifier.join a b, rest'')
|
||||
match parseClassifier?Aux n rest' with
|
||||
| some (b, Token.rparen :: rest'') =>
|
||||
some (MetaClassifier.join a b, rest'')
|
||||
| _ => none
|
||||
| _ => none
|
||||
| _ => none
|
||||
| _, _ => none
|
||||
|
||||
/-- Parse a `MetaCTerm`. Recursion handles every constructor,
|
||||
including `comp` / `transp` whose third field is a
|
||||
`MetaClassifier` (parsed via `parseClassifier?`). -/
|
||||
partial def parseMetaCTerm? : List Token → Option (MetaCTerm × List Token)
|
||||
| Token.ident "Infoductor.MetaCTerm.empty" :: rest =>
|
||||
/-- Parse a `MetaCTerm`. -/
|
||||
def parseMetaCTerm?Aux : Nat → List Token → Option (MetaCTerm × List Token)
|
||||
| 0, _ => none
|
||||
| _+1, Token.ident "Infoductor.MetaCTerm.empty" :: rest =>
|
||||
some (MetaCTerm.empty, rest)
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.ident" :: rest =>
|
||||
match parseName? rest with
|
||||
| some (n, Token.rparen :: rest') => some (MetaCTerm.ident n, rest')
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.ident" :: rest =>
|
||||
match parseName?Aux n rest with
|
||||
| some (nm, Token.rparen :: rest') => some (MetaCTerm.ident nm, rest')
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.sym" :: rest =>
|
||||
| _+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.sym" :: rest =>
|
||||
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
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.app" :: rest =>
|
||||
match parseMetaCTerm? rest with
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.app" :: rest =>
|
||||
match parseMetaCTerm?Aux n rest with
|
||||
| some (f, rest') =>
|
||||
match parseMetaCTerm? rest' with
|
||||
| some (a, Token.rparen :: rest'') => some (MetaCTerm.app f a, rest'')
|
||||
match parseMetaCTerm?Aux n rest' with
|
||||
| some (a, Token.rparen :: rest'') =>
|
||||
some (MetaCTerm.app f a, rest'')
|
||||
| _ => none
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.lam" :: rest =>
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.lam" :: rest =>
|
||||
match rest with
|
||||
| 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'')
|
||||
| _ => none
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.plam" :: rest =>
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.plam" :: rest =>
|
||||
match rest with
|
||||
| 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'')
|
||||
| _ => none
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.comp" :: rest =>
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.comp" :: rest =>
|
||||
match rest with
|
||||
| Token.strLit s :: rest1 =>
|
||||
match parseMetaCTerm? rest1 with
|
||||
match parseMetaCTerm?Aux n rest1 with
|
||||
| some (A, rest2) =>
|
||||
match parseClassifier? rest2 with
|
||||
match parseClassifier?Aux n rest2 with
|
||||
| some (φ, rest3) =>
|
||||
match parseMetaCTerm? rest3 with
|
||||
match parseMetaCTerm?Aux n rest3 with
|
||||
| some (u, rest4) =>
|
||||
match parseMetaCTerm? rest4 with
|
||||
match parseMetaCTerm?Aux n rest4 with
|
||||
| some (t, Token.rparen :: rest5) =>
|
||||
some (MetaCTerm.comp s A φ u t, rest5)
|
||||
| _ => none
|
||||
|
|
@ -258,42 +246,59 @@ partial def parseMetaCTerm? : List Token → Option (MetaCTerm × List Token)
|
|||
| _ => none
|
||||
| _ => none
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaCTerm.transp" :: rest =>
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaCTerm.transp" :: rest =>
|
||||
match rest with
|
||||
| Token.strLit s :: rest1 =>
|
||||
match parseMetaCTerm? rest1 with
|
||||
match parseMetaCTerm?Aux n rest1 with
|
||||
| some (A, rest2) =>
|
||||
match parseClassifier? rest2 with
|
||||
match parseClassifier?Aux n rest2 with
|
||||
| some (φ, rest3) =>
|
||||
match parseMetaCTerm? rest3 with
|
||||
match parseMetaCTerm?Aux n rest3 with
|
||||
| some (t, Token.rparen :: rest4) =>
|
||||
some (MetaCTerm.transp s A φ t, rest4)
|
||||
| _ => none
|
||||
| _ => none
|
||||
| _ => none
|
||||
| _ => none
|
||||
| _ => none
|
||||
| _, _ => none
|
||||
|
||||
/-- Parse a `MetaArtifact`. -/
|
||||
partial def parseArtifact? : List Token → Option (MetaArtifact × List Token)
|
||||
| Token.ident "Infoductor.MetaArtifact.empty" :: rest =>
|
||||
def parseArtifact?Aux : Nat → List Token → Option (MetaArtifact × List Token)
|
||||
| 0, _ => none
|
||||
| _+1, Token.ident "Infoductor.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
|
||||
| Token.strLit s :: Token.rparen :: rest' => some (MetaArtifact.source s, rest')
|
||||
| Token.strLit s :: Token.rparen :: rest' =>
|
||||
some (MetaArtifact.source s, rest')
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaArtifact.refTo" :: rest =>
|
||||
match parseName? rest with
|
||||
| some (n, Token.rparen :: rest') => some (MetaArtifact.refTo n, rest')
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaArtifact.refTo" :: rest =>
|
||||
match parseName?Aux n rest with
|
||||
| some (nm, Token.rparen :: rest') =>
|
||||
some (MetaArtifact.refTo nm, rest')
|
||||
| _ => none
|
||||
| Token.lparen :: Token.ident "Infoductor.MetaArtifact.cterm" :: rest =>
|
||||
match parseMetaCTerm? rest with
|
||||
| some (m, Token.rparen :: rest') => some (MetaArtifact.cterm m, rest')
|
||||
| n+1, Token.lparen :: Token.ident "Infoductor.MetaArtifact.cterm" :: rest =>
|
||||
match parseMetaCTerm?Aux n rest with
|
||||
| some (m, Token.rparen :: rest') =>
|
||||
some (MetaArtifact.cterm m, rest')
|
||||
| _ => none
|
||||
| _ => none
|
||||
| _, _ => none
|
||||
|
||||
-- ── Top-level parsers ──────────────────────────────────────────────────────
|
||||
-- Tokenize then parse, demanding the entire input was consumed.
|
||||
-- ── Top-level wrappers ─────────────────────────────────────────────────────
|
||||
-- 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 :=
|
||||
match parseMetaCTerm? (tokenizeStr s) with
|
||||
|
|
@ -310,4 +315,104 @@ def MetaArtifact.fromLeanSource? (s : String) : Option MetaArtifact :=
|
|||
| some (a, []) => some a
|
||||
| _ => 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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue