From 9f65d441461c5d0ec2731917840007edfee0a92f Mon Sep 17 00:00:00 2001 From: shah Date: Tue, 27 Oct 2026 01:30:18 -0500 Subject: [PATCH 01/18] Add XML safe subset parser and printer, with proved round trip --- .gitignore | 1 + Main.lean | 87 +++ Proofs.lean | 1 + Proofs/RoundTrip.lean | 1636 +++++++++++++++++++++++++++++++++++++++++ README.md | 72 +- SPEC.md | 224 ++++++ Xml.lean | 2 + Xml/Parse.lean | 423 +++++++++++ Xml/Value.lean | 271 +++++++ lake-manifest.json | 6 + lakefile.toml | 13 + lean-toolchain | 1 + tests/TEST-RESULTS.md | 20 + tests/run_tests.py | 745 +++++++++++++++++++ 14 files changed, 3484 insertions(+), 18 deletions(-) create mode 100644 Main.lean create mode 100644 Proofs.lean create mode 100644 Proofs/RoundTrip.lean create mode 100644 SPEC.md create mode 100644 Xml.lean create mode 100644 Xml/Parse.lean create mode 100644 Xml/Value.lean create mode 100644 lake-manifest.json create mode 100644 lakefile.toml create mode 100644 lean-toolchain create mode 100644 tests/TEST-RESULTS.md create mode 100644 tests/run_tests.py diff --git a/.gitignore b/.gitignore index 01f8cdb..ae73679 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,2 @@ .lake/ +__pycache__/ diff --git a/Main.lean b/Main.lean new file mode 100644 index 0000000..d8bfd04 --- /dev/null +++ b/Main.lean @@ -0,0 +1,87 @@ +/- + Command line front end, used by the tests. + + Reads one request per line and prints one answer per line. A + request is an operation and its input as comma-separated decimal + character codes. + + parse 60,97,62,120,60,47,97,62 prints ok:60,97,62,120,60,47,97,62 + parse 60,97,47,62 prints ok:60,97,47,62 + parse 120 prints none + + The one operation is `parse`. Its input is the character codes of + an XML text in the safe subset. Its answer is `ok:` and the + character codes of the canonical print of the parsed document, + or `none` when the text is rejected. + + A request is an operation, then optionally one space and its + numbers; with no numbers after the space, the input is empty. A + malformed request prints `error`: any other line, an unknown + operation, a number that is not plain decimal digits, or a + character code that is not a Unicode scalar value. A line may end + in LF or CR LF; nothing else around a request is ignored. + + The parsing and printing here call `Xml.parse` and `Xml.print` + directly. The line handling is covered by the tests, not by a + proof. +-/ + +import Xml + +open Xml + +/-- A number in plain decimal digits. Longer numbers than any + character code are refused before they are converted, since + that takes time quadratic in their length. -/ +def number (t : String) : Option Nat := + let ds := t.toList + if ds.isEmpty || !ds.all Char.isDigit || (ds.dropWhile (· = '0')).length > 7 then none + else t.toNat? + +/-- The comma-separated numbers in `s`. -/ +def numbers (s : String) : Option (List Nat) := + if s.isEmpty then some [] else (s.splitOn ",").mapM number + +def toChars (ns : List Nat) : Option (List Char) := + ns.mapM fun n => if n.isValidChar then some (Char.ofNat n) else none + +def showCodes (cs : List Char) : String := + ",".intercalate (cs.map fun c => toString c.toNat) + +/-- The answer to one request, or `none` when the request is + malformed. -/ +def answer (op : String) (ns : List Nat) : Option String := + match op with + | "parse" => + match toChars ns with + | none => none + | some cs => + match parse cs with + | some d => some ("ok:" ++ showCodes (print d)) + | none => some "none" + | _ => none + +/-- The answer to one line: an operation, then optionally one space + and its numbers. -/ +def request (line : String) : Option String := + match line.splitOn " " with + | [op] => answer op [] + | [op, arg] => numbers arg >>= answer op + | _ => none + +/-- The line without its line ending: LF, or CR LF. -/ +def chomp (line : String) : String := + let cs := line.toList + if cs.getLast? = some '\n' then + let cs := cs.dropLast + String.ofList (if cs.getLast? = some '\r' then cs.dropLast else cs) + else line + +def main : IO Unit := do + let stdin ← IO.getStdin + let stdout ← IO.getStdout + repeat + let line ← stdin.getLine + if line.isEmpty then break + let line := chomp line + stdout.putStrLn ((request line).getD "error") diff --git a/Proofs.lean b/Proofs.lean new file mode 100644 index 0000000..1a31d95 --- /dev/null +++ b/Proofs.lean @@ -0,0 +1 @@ +import Proofs.RoundTrip diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean new file mode 100644 index 0000000..377c90b --- /dev/null +++ b/Proofs/RoundTrip.lean @@ -0,0 +1,1636 @@ +/- + The round trip proof: for every well formed document, parsing + its printed form gives the document back. + + The statement proved here is `parse_print`. A matching statement + in a spec file still has to be added by a reviewer, so this file + builds on its own, in the same shape as the proofs of the other + slices. + + The proof goes layer by layer: references, text runs, attribute + values, character data, names, comment bodies, processing + instruction data, attributes, then elements and content together + by a strong induction on the length of the printed form, then + the prolog and epilog lists, and at last the document. +-/ + +import Xml + +namespace Xml.Proofs + +open Xml + +set_option maxRecDepth 10000 + +/-! ## Small facts -/ + +theorem isWs_of_ne {c : Char} (h1 : c ≠ ' ') (h2 : c ≠ '\t') + (h3 : c ≠ '\n') (h4 : c ≠ '\r') : isWs c = false := by + simp [isWs, h1, h2, h3, h4] + +theorem isWs_lt : isWs '<' = false := by decide +theorem isWs_slash : isWs '/' = false := by decide + +/-- Skipping whitespace over a list whose head is not whitespace + changes nothing. -/ +theorem skipWs_cons {c : Char} {cs : List Char} (h : isWs c = false) : + skipWs (c :: cs) = c :: cs := by + simp [skipWs, h] + +theorem isLegalChar_of {c : Char} (h : LegalChar c) : isLegalChar c = true := + isLegalChar_iff.mpr h + +theorem isNameStart_of {c : Char} (h : IsNameStart c) : isNameStart c = true := + isNameStart_iff.mpr h + +theorem isNameChar_of {c : Char} (h : IsNameChar c) : isNameChar c = true := + isNameChar_iff.mpr h + +theorem isNameChar_false_of {c : Char} (h : ¬ IsNameChar c) : + isNameChar c = false := by + cases hb : isNameChar c with + | true => exact absurd (isNameChar_iff.mp hb) h + | false => rfl + +/-- A name start character is a name character. -/ +theorem IsNameStart.toNameChar {c : Char} (h : IsNameStart c) : + IsNameChar c := + Or.inl h + +/-- A name start character differs from any character that fails + the name start test. -/ +theorem IsNameStart.ne_of_test {c d : Char} (h : IsNameStart c) + (hd : isNameStart d = false) : c ≠ d := by + intro e + subst e + have hb : isNameStart c = true := isNameStart_of h + rw [hb] at hd + exact Bool.false_ne_true hd.symm + +/-- A name start character is none of the marks that can follow a + name in a printed tag. -/ +theorem IsNameStart.ne_lt {c : Char} (h : IsNameStart c) : c ≠ '<' := + IsNameStart.ne_of_test h (by decide) + +theorem IsNameStart.ne_bang {c : Char} (h : IsNameStart c) : c ≠ '!' := + IsNameStart.ne_of_test h (by decide) + +theorem IsNameStart.ne_ws {c : Char} (h : IsNameStart c) : ¬ IsWs c := by + intro hw + rcases hw with e | e | e | e + · exact IsNameStart.ne_of_test h (by decide) e + · exact IsNameStart.ne_of_test h (by decide) e + · exact IsNameStart.ne_of_test h (by decide) e + · exact IsNameStart.ne_of_test h (by decide) e + +/-- A character that fails the name character test is not a name + character. -/ +theorem not_nameChar_of_test {c : Char} (h : isNameChar c = false) : + ¬ IsNameChar c := by + intro hc + have hb := isNameChar_iff.mpr hc + rw [h] at hb + exact Bool.false_ne_true hb + +/-- The marks that follow a name in a printed tag are not name + characters. -/ +theorem not_nameChar_slash : ¬ IsNameChar '/' := + not_nameChar_of_test (by decide) +theorem not_nameChar_gt : ¬ IsNameChar '>' := + not_nameChar_of_test (by decide) +theorem not_nameChar_eq : ¬ IsNameChar '=' := + not_nameChar_of_test (by decide) +theorem not_nameChar_quest : ¬ IsNameChar '?' := + not_nameChar_of_test (by decide) +theorem not_nameChar_space : ¬ IsNameChar ' ' := + not_nameChar_of_test (by decide) + +/-- The printed form of one character of character data: either + an escape, whose head is an ampersand, or the character + itself. -/ +theorem escapeTextChar_head (c : Char) : + (escapeTextChar c).head? = some '&' ∨ escapeTextChar c = [c] := by + unfold escapeTextChar + split + · simp + · split + · simp + · split + · simp + · split + · simp + · exact Or.inr rfl + +/-- An escaped character is never the empty list, and its head is + never a greater sign. The second fact is what keeps `]]>` from + ever forming in printed text: a greater sign only ever appears + inside `>`, behind an ampersand. -/ +theorem escapeTextChar_ne_nil (c : Char) : escapeTextChar c ≠ [] := by + intro he + rcases escapeTextChar_head c with h | h + · rw [he] at h + simp at h + · rw [he] at h + simp at h + +theorem escapeTextChar_head_ne_gt (c : Char) : + (escapeTextChar c).head? ≠ some '>' := by + rcases escapeTextChar_head c with h | h + · rw [h]; decide + · rw [h] + intro hcon + simp at hcon + subst hcon + have hgt : escapeTextChar '>' = ['&', 'g', 't', ';'] := by decide + rw [hgt] at h + simp at h + +/-- An escaped attribute character is never the empty list, and + its head is an ampersand when it is an escape. -/ +theorem escapeAttrChar_head (c : Char) : + (escapeAttrChar c).head? = some '&' ∨ escapeAttrChar c = [c] := by + unfold escapeAttrChar + split + · simp + · split + · simp + · split + · simp + · split + · simp + · split + · simp + · split + · simp + · exact Or.inr rfl + +theorem escapeAttrChar_ne_nil (c : Char) : escapeAttrChar c ≠ [] := by + intro he + rcases escapeAttrChar_head c with h | h + · rw [he] at h + simp at h + · rw [he] at h + simp at h + +/-- The head of a printed text run followed by more text: the + printed run of a nonempty list starts with the printed form of + its first character. -/ +theorem escapeText_head {c : Char} {cs : List Char} : + (escapeText (c :: cs)).head? = (escapeTextChar c).head? := by + have hne := escapeTextChar_ne_nil c + simp only [escapeText, List.flatMap_cons] + cases h : escapeTextChar c with + | nil => exact absurd h hne + | cons x xs => simp + +theorem escapeText_length_ge (cs : List Char) : + cs.length ≤ (escapeText cs).length := by + induction cs with + | nil => simp [escapeText] + | cons c cs ih => + have h1 : 1 ≤ (escapeTextChar c).length := by + cases h : escapeTextChar c with + | nil => exact absurd h (escapeTextChar_ne_nil c) + | cons x xs => simp + have hlen : (escapeText (c :: cs)).length = + (escapeTextChar c).length + (escapeText cs).length := by + have e1 : escapeText (c :: cs) = escapeTextChar c ++ escapeText cs := rfl + rw [e1, List.length_append] + rw [List.length_cons, hlen] + omega + +theorem escapeAttr_length_ge (cs : List Char) : + cs.length ≤ (escapeAttr cs).length := by + induction cs with + | nil => simp [escapeAttr] + | cons c cs ih => + have h1 : 1 ≤ (escapeAttrChar c).length := by + cases h : escapeAttrChar c with + | nil => exact absurd h (escapeAttrChar_ne_nil c) + | cons x xs => simp + have hlen : (escapeAttr (c :: cs)).length = + (escapeAttrChar c).length + (escapeAttr cs).length := by + have e1 : escapeAttr (c :: cs) = escapeAttrChar c ++ escapeAttr cs := rfl + rw [e1, List.length_append] + rw [List.length_cons, hlen] + omega + +/-! ## References -/ + +theorem parseRef_lt {rest : List Char} : + parseRef ('l' :: 't' :: ';' :: rest) = some ('<', rest) := rfl + +theorem parseRef_gt {rest : List Char} : + parseRef ('g' :: 't' :: ';' :: rest) = some ('>', rest) := rfl + +theorem parseRef_amp {rest : List Char} : + parseRef ('a' :: 'm' :: 'p' :: ';' :: rest) = some ('&', rest) := rfl + +theorem parseRef_quot {rest : List Char} : + parseRef ('q' :: 'u' :: 'o' :: 't' :: ';' :: rest) = some ('"', rest) := rfl + +/-- A run of digits at the head of a text is read whole: when the + text after the run does not start with a digit, the digit run + reader stops at the end of the run. -/ +theorem takeDigits_append {ds rest : List Char} + (hd : ∀ d ∈ ds, isDigit d = true) + (hr : ∀ c, rest.head? = some c → isDigit c = false) : + takeDigits (ds ++ rest) = (ds, rest) := by + induction ds generalizing rest with + | nil => + cases rest with + | nil => rfl + | cons c r => + have hc : isDigit c = false := hr c rfl + simp [takeDigits, hc] + | cons d ds ih => + have hdd : isDigit d = true := hd d (by simp) + have ih' := ih (fun x hx => hd x (List.mem_cons_of_mem d hx)) hr + simp [takeDigits, hdd, ih'] + +theorem parseRef_dec13 {rest : List Char} : + parseRef ('#' :: '1' :: '3' :: ';' :: rest) = some ('\r', rest) := by + have htake : takeDigits ('1' :: '3' :: ';' :: rest) = + (['1', '3'], ';' :: rest) := by + show takeDigits (['1', '3'] ++ (';' :: rest)) = (['1', '3'], ';' :: rest) + apply takeDigits_append + · decide + · intro c hc + have hcc : c = ';' := (Option.some.inj hc).symm + rw [hcc] + decide + have hval : digitsValue 10 (fun d => d.toNat - 48) ['1', '3'] = 13 := by + decide + have hchar : charRefChar 13 = some '\r' := by decide + simp [parseRef, htake, hval, hchar] + +theorem parseRef_dec9 {rest : List Char} : + parseRef ('#' :: '9' :: ';' :: rest) = some ('\t', rest) := by + have htake : takeDigits ('9' :: ';' :: rest) = (['9'], ';' :: rest) := by + show takeDigits (['9'] ++ (';' :: rest)) = (['9'], ';' :: rest) + apply takeDigits_append + · decide + · intro c hc + have hcc : c = ';' := (Option.some.inj hc).symm + rw [hcc] + decide + have hval : digitsValue 10 (fun d => d.toNat - 48) ['9'] = 9 := by decide + have hchar : charRefChar 9 = some '\t' := by decide + simp [parseRef, htake, hval, hchar] + +theorem parseRef_dec10 {rest : List Char} : + parseRef ('#' :: '1' :: '0' :: ';' :: rest) = some ('\n', rest) := by + have htake : takeDigits ('1' :: '0' :: ';' :: rest) = + (['1', '0'], ';' :: rest) := by + show takeDigits (['1', '0'] ++ (';' :: rest)) = (['1', '0'], ';' :: rest) + apply takeDigits_append + · decide + · intro c hc + have hcc : c = ';' := (Option.some.inj hc).symm + rw [hcc] + decide + have hval : digitsValue 10 (fun d => d.toNat - 48) ['1', '0'] = 10 := by + decide + have hchar : charRefChar 10 = some '\n' := by decide + simp [parseRef, htake, hval, hchar] + +/-! ## Text runs and attribute values -/ + +/-- The five shapes of a printed character of character data, with + the character each shape comes from. -/ +theorem escapeTextChar_cases (c : Char) : + (c = '&' ∧ escapeTextChar c = ['&', 'a', 'm', 'p', ';']) ∨ + (c = '<' ∧ escapeTextChar c = ['&', 'l', 't', ';']) ∨ + (c = '>' ∧ escapeTextChar c = ['&', 'g', 't', ';']) ∨ + (c = '\r' ∧ escapeTextChar c = ['&', '#', '1', '3', ';']) ∨ + (c ≠ '&' ∧ c ≠ '<' ∧ c ≠ '>' ∧ c ≠ '\r' ∧ escapeTextChar c = [c]) := by + by_cases h1 : c = '&' + · exact Or.inl ⟨h1, by simp [escapeTextChar, h1]⟩ + · by_cases h2 : c = '<' + · exact Or.inr (Or.inl ⟨h2, by simp [escapeTextChar, h1, h2]⟩) + · by_cases h3 : c = '>' + · exact Or.inr (Or.inr (Or.inl ⟨h3, by simp [escapeTextChar, h1, h2, h3]⟩)) + · by_cases h4 : c = '\r' + · exact Or.inr (Or.inr (Or.inr + (Or.inl ⟨h4, by simp [escapeTextChar, h1, h2, h3, h4]⟩))) + · exact Or.inr (Or.inr (Or.inr (Or.inr + ⟨h1, h2, h3, h4, by simp [escapeTextChar, h1, h2, h3, h4]⟩))) + +/-- The seven shapes of a printed character of an attribute + value. -/ +theorem escapeAttrChar_cases (c : Char) : + (c = '&' ∧ escapeAttrChar c = ['&', 'a', 'm', 'p', ';']) ∨ + (c = '<' ∧ escapeAttrChar c = ['&', 'l', 't', ';']) ∨ + (c = '"' ∧ escapeAttrChar c = ['&', 'q', 'u', 'o', 't', ';']) ∨ + (c = '\t' ∧ escapeAttrChar c = ['&', '#', '9', ';']) ∨ + (c = '\n' ∧ escapeAttrChar c = ['&', '#', '1', '0', ';']) ∨ + (c = '\r' ∧ escapeAttrChar c = ['&', '#', '1', '3', ';']) ∨ + (c ≠ '&' ∧ c ≠ '<' ∧ c ≠ '"' ∧ c ≠ '\t' ∧ c ≠ '\n' ∧ c ≠ '\r' ∧ + escapeAttrChar c = [c]) := by + by_cases h1 : c = '&' + · exact Or.inl ⟨h1, by simp [escapeAttrChar, h1]⟩ + · by_cases h2 : c = '<' + · exact Or.inr (Or.inl ⟨h2, by simp [escapeAttrChar, h1, h2]⟩) + · by_cases h3 : c = '"' + · exact Or.inr (Or.inr (Or.inl ⟨h3, by simp [escapeAttrChar, h1, h2, h3]⟩)) + · by_cases h4 : c = '\t' + · exact Or.inr (Or.inr (Or.inr + (Or.inl ⟨h4, by simp [escapeAttrChar, h1, h2, h3, h4]⟩))) + · by_cases h5 : c = '\n' + · exact Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨h5, by simp [escapeAttrChar, h1, h2, h3, h4, h5]⟩)))) + · by_cases h6 : c = '\r' + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨h6, by simp [escapeAttrChar, h1, h2, h3, h4, h5, h6]⟩))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + ⟨h1, h2, h3, h4, h5, h6, + by simp [escapeAttrChar, h1, h2, h3, h4, h5, h6]⟩))))) + +/-- A printed text run followed by the end of the text or by a + mark never holds the run `]]>` at the junction the text reader + is about to step over: the two characters the reader looks at + after a `]` it just read are never `]` and `>`. -/ +theorem escapeText_not_bracketGt {cs : List Char} {rest : List Char} + (hrest : rest = [] ∨ rest.head? = some '<') : + ¬ ((escapeText cs ++ rest).head? = some ']' ∧ + ((escapeText cs ++ rest).tail).head? = some '>') := by + intro hcon + obtain ⟨h1, h2⟩ := hcon + cases cs with + | nil => + simp only [escapeText, List.flatMap_nil, List.nil_append] at h1 + rcases hrest with h | h + · rw [h] at h1 + simp at h1 + · rw [h] at h1 + simp at h1 + | cons d ds => + have e1 : escapeText (d :: ds) ++ rest = + escapeTextChar d ++ (escapeText ds ++ rest) := by + have e0 : escapeText (d :: ds) = escapeTextChar d ++ escapeText ds := rfl + rw [e0, List.append_assoc] + rw [e1] at h1 h2 + rcases escapeTextChar_head d with hd | hd + · have hh : (escapeTextChar d ++ (escapeText ds ++ rest)).head? = + some '&' := by + cases hdd : escapeTextChar d with + | nil => exact absurd hdd (escapeTextChar_ne_nil d) + | cons x xs => + have hx : x = '&' := by + have h2' := hd + rw [hdd] at h2' + simp at h2' + exact h2' + simp [hdd, hx] + rw [hh] at h1 + simp at h1 + · rw [hd] at h2 + simp only [List.cons_append, List.tail_cons, List.nil_append] at h2 + cases ds with + | nil => + simp only [escapeText, List.flatMap_nil, List.nil_append] at h2 + rcases hrest with h | h + · rw [h] at h2 + simp at h2 + · rw [h] at h2 + simp at h2 + | cons e es => + have hgt := escapeTextChar_head_ne_gt e + have hh : (escapeText (e :: es) ++ rest).head? = + (escapeTextChar e).head? := by + have e2 : escapeText (e :: es) ++ rest = + escapeTextChar e ++ (escapeText es ++ rest) := by + have e0 : escapeText (e :: es) = + escapeTextChar e ++ escapeText es := rfl + rw [e0, List.append_assoc] + rw [e2] + cases hdd : escapeTextChar e with + | nil => exact absurd hdd (escapeTextChar_ne_nil e) + | cons x xs => simp [hdd] + rw [hh] at h2 + exact hgt h2 + +/-- Reading back a printed text run gives the run back, when the + text after it is empty or starts with a less sign (so the + reader stops there). -/ +theorem parseTextRun_escapeText : ∀ (cs : List Char) (rest : List Char), + (∀ c ∈ cs, LegalChar c) → + (rest = [] ∨ rest.head? = some '<') → + ∀ (f : Nat), cs.length + 1 ≤ f → + parseTextRun f (escapeText cs ++ rest) = some (cs, rest) := by + intro cs + induction cs with + | nil => + intro rest _ hrest f hf + cases f with + | zero => simp at hf + | succ f' => + cases rest with + | nil => simp [parseTextRun, escapeText] + | cons c t => + have hc : c = '<' := by + rcases hrest with h | h + · simp at h + · have h2 : (c :: t).head? = some c := rfl + rw [h2] at h + exact Option.some.inj h + subst hc + simp [parseTextRun, escapeText] + | cons c cs ih => + intro rest hlegal hrest f hf + have hlegal' : ∀ x ∈ cs, LegalChar x := + fun x hx => hlegal x (List.mem_cons_of_mem c hx) + have hclegal : LegalChar c := hlegal c (by simp) + cases f with + | zero => + simp only [List.length_cons] at hf + omega + | succ f' => + have hf' : cs.length + 1 ≤ f' := by + simp only [List.length_cons] at hf + omega + have ih' := ih rest hlegal' hrest f' hf' + have e0 : escapeText (c :: cs) = escapeTextChar c ++ escapeText cs := rfl + rw [e0, List.append_assoc] + rcases escapeTextChar_cases c with + ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2, h3, h4, h5⟩ + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + simp [parseTextRun, ih', parseRef_amp] + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + simp [parseTextRun, ih', parseRef_lt] + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + simp [parseTextRun, ih', parseRef_gt] + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + simp [parseTextRun, ih', parseRef_dec13] + · rw [h5] + simp only [List.cons_append] + by_cases hc : c = ']' + · subst hc + have hnb := escapeText_not_bracketGt (cs := cs) (rest := rest) hrest + simp only [parseTextRun, List.nil_append] + rw [if_pos trivial, if_neg hnb, ih'] + simp + · simp [parseTextRun, ih', h1, h2, h3, h4, hc, + isLegalChar_of hclegal] + +/-- Reading back a printed attribute value gives the value back. + The printer uses double quotes, so the quote here is the + double quote. -/ +theorem parseAttrValue_escapeAttr : ∀ (cs : List Char) (rest : List Char), + (∀ c ∈ cs, LegalChar c) → + ∀ (f : Nat), cs.length + 1 ≤ f → + parseAttrValue '"' f (escapeAttr cs ++ '"' :: rest) = some (cs, rest) := by + intro cs + induction cs with + | nil => + intro rest _ f hf + cases f with + | zero => simp at hf + | succ f' => simp [parseAttrValue, escapeAttr] + | cons c cs ih => + intro rest hlegal f hf + have hlegal' : ∀ x ∈ cs, LegalChar x := + fun x hx => hlegal x (List.mem_cons_of_mem c hx) + have hclegal : LegalChar c := hlegal c (by simp) + cases f with + | zero => + simp only [List.length_cons] at hf + omega + | succ f' => + have hf' : cs.length + 1 ≤ f' := by + simp only [List.length_cons] at hf + omega + have ih' := ih rest hlegal' f' hf' + have e0 : escapeAttr (c :: cs) = escapeAttrChar c ++ escapeAttr cs := rfl + rw [e0, List.append_assoc] + rcases escapeAttrChar_cases c with + ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | + ⟨h1, h2, h3, h4, h5, h6, h7⟩ + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + simp [parseAttrValue, ih', parseRef_amp] + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + simp [parseAttrValue, ih', parseRef_lt] + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + simp [parseAttrValue, ih', parseRef_quot] + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + simp [parseAttrValue, ih', parseRef_dec9] + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + simp [parseAttrValue, ih', parseRef_dec10] + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + simp [parseAttrValue, ih', parseRef_dec13] + · rw [h7] + simp only [List.cons_append] + simp [parseAttrValue, ih', h1, h2, h3, h4, h5, h6, + isLegalChar_of hclegal] + +/-- Reading back printed character data gives the data back, when + the reader stops at the text that follows. -/ +theorem parseCharData_escapeText (cs : List Char) (rest : List Char) + (hne : cs ≠ []) + (hlegal : ∀ c ∈ cs, LegalChar c) + (hrest : rest = [] ∨ rest.head? = some '<') + (hstop : ∀ f, 1 ≤ f → parseCharData f rest = some ([], rest)) + (f : Nat) (hf : cs.length + 2 ≤ f) : + parseCharData f (escapeText cs ++ rest) = some (cs, rest) := by + cases f with + | zero => omega + | succ f' => + have hf1 : cs.length + 1 ≤ f' := by omega + have htr := parseTextRun_escapeText cs rest hlegal hrest f' hf1 + have hst := hstop f' (by + have h1 : 1 ≤ cs.length := by + cases cs with + | nil => exact absurd rfl hne + | cons c cs' => simp + omega) + obtain ⟨c, cs', hcs⟩ : ∃ c cs', cs = c :: cs' := by + cases cs with + | nil => exact absurd rfl hne + | cons c cs' => exact ⟨c, cs', rfl⟩ + subst hcs + have e0 : escapeText (c :: cs') = escapeTextChar c ++ escapeText cs' := rfl + rw [e0, List.append_assoc] + rcases escapeTextChar_cases c with + ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2, h3, h4, h5⟩ + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + have htr2 : parseTextRun f' + ('&' :: 'a' :: 'm' :: 'p' :: ';' :: (escapeText cs' ++ rest)) = + some ('&' :: cs', rest) := htr + simp [parseCharData, htr2, hst] + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + have htr2 : parseTextRun f' + ('&' :: 'l' :: 't' :: ';' :: (escapeText cs' ++ rest)) = + some ('<' :: cs', rest) := htr + simp [parseCharData, htr2, hst] + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + have htr2 : parseTextRun f' + ('&' :: 'g' :: 't' :: ';' :: (escapeText cs' ++ rest)) = + some ('>' :: cs', rest) := htr + simp [parseCharData, htr2, hst] + · subst h1 + rw [h2] + simp only [List.cons_append, List.append_assoc] + have htr2 : parseTextRun f' + ('&' :: '#' :: '1' :: '3' :: ';' :: (escapeText cs' ++ rest)) = + some ('\r' :: cs', rest) := htr + simp [parseCharData, htr2, hst] + · rw [h5] + simp only [List.cons_append] + have htr2 : parseTextRun f' (c :: (escapeText cs' ++ rest)) = + some (c :: cs', rest) := by + have htr' := htr + rw [e0, h5] at htr' + simpa only [List.cons_append, List.append_assoc, List.nil_append] + using htr' + simp [parseCharData, htr2, hst, h2] + +/-! ## Names -/ + +theorem takeNameChars_append {ds rest : List Char} + (hd : ∀ d ∈ ds, isNameChar d = true) + (hr : ∀ c, rest.head? = some c → isNameChar c = false) : + takeNameChars (ds ++ rest) = (ds, rest) := by + induction ds generalizing rest with + | nil => + cases rest with + | nil => rfl + | cons c r => + have hc : isNameChar c = false := hr c rfl + simp [takeNameChars, hc] + | cons d ds ih => + have hdd : isNameChar d = true := hd d (by simp) + have ih' := ih (fun x hx => hd x (List.mem_cons_of_mem d hx)) hr + simp [takeNameChars, hdd, ih'] + +/-- A valid name at the head of a text is read whole, when the text + after it does not start with a name character. -/ +theorem parseName_append {cs rest : List Char} (hv : ValidName cs) + (hr : ∀ c, rest.head? = some c → isNameChar c = false) : + parseName (cs ++ rest) = some (cs, rest) := by + obtain ⟨c, ds, hcs, hstart, hchars⟩ := hv + subst hcs + have hsc : isNameStart c = true := isNameStart_of hstart + have htake := takeNameChars_append (ds := ds) (rest := rest) + (fun d hd => isNameChar_of (hchars d hd)) hr + simp [parseName, hsc, htake] + + +/-! ## Comments and processing instructions -/ + +/-- One step of the comment body reader over a dash that does not + close the comment. -/ +theorem parseCommentBody_dash_cons {d : Char} {xs : List Char} + (hd : d ≠ '-') : + parseCommentBody ('-' :: d :: xs) = + (parseCommentBody (d :: xs)).map fun (b, r) => ('-' :: b, r) := by + simp [parseCommentBody, hd] + +/-- Reading back a printed comment body gives the body back. -/ +theorem parseCommentBody_print : ∀ (cs : List Char) (rest : List Char), + NoDashDash cs → NotDashEnd cs → (∀ c ∈ cs, LegalChar c) → + parseCommentBody (cs ++ '-' :: '-' :: '>' :: rest) = some (cs, rest) := by + intro cs + induction cs with + | nil => + intro rest _ _ _ + simp [parseCommentBody] + | cons c cs ih => + intro rest hdd hde hlegal + have hlegal' : ∀ x ∈ cs, LegalChar x := + fun x hx => hlegal x (List.mem_cons_of_mem c hx) + have hclegal : LegalChar c := hlegal c (by simp) + have hdd' : NoDashDash cs := by + intro pre suf h + exact hdd (c :: pre) suf (by simp [h]) + have hde' : NotDashEnd cs := by + intro pre h + exact hde (c :: pre) (by simp [h]) + have ih' := ih rest hdd' hde' hlegal' + by_cases hc : c = '-' + · subst hc + cases cs with + | nil => + exfalso + exact hde [] (by simp) + | cons d ds => + have hd : d ≠ '-' := by + intro e + subst e + exact hdd [] ds (by simp) + have e1 : ('-' :: d :: ds) ++ '-' :: '-' :: '>' :: rest = + '-' :: d :: (ds ++ '-' :: '-' :: '>' :: rest) := by + simp [List.append_assoc] + rw [e1, parseCommentBody_dash_cons hd] + have ih2 : parseCommentBody (d :: (ds ++ '-' :: '-' :: '>' :: rest)) = + some (d :: ds, rest) := by + have := ih' + rwa [show (d :: ds) ++ '-' :: '-' :: '>' :: rest = + d :: (ds ++ '-' :: '-' :: '>' :: rest) by simp [List.append_assoc]] at this + rw [ih2] + rfl + · have e1 : (c :: cs) ++ '-' :: '-' :: '>' :: rest = + c :: (cs ++ '-' :: '-' :: '>' :: rest) := rfl + rw [e1] + simp [parseCommentBody, ih', hc, isLegalChar_of hclegal] + +/-- One step of the processing instruction data reader over a + question mark that does not close the instruction. -/ +theorem parsePIData_quest_cons {d : Char} {xs : List Char} + (hd : d ≠ '>') : + parsePIData ('?' :: d :: xs) = + (parsePIData (d :: xs)).map fun (b, r) => ('?' :: b, r) := by + simp [parsePIData, hd] + +/-- Reading back printed processing instruction data gives the + data back. -/ +theorem parsePIData_print : ∀ (d : List Char) (rest : List Char), + NoQClose d → (∀ c ∈ d, LegalChar c) → + parsePIData (d ++ '?' :: '>' :: rest) = some (d, rest) := by + intro d + induction d with + | nil => + intro rest _ _ + simp [parsePIData] + | cons c d ih => + intro rest hq hlegal + have hlegal' : ∀ x ∈ d, LegalChar x := + fun x hx => hlegal x (List.mem_cons_of_mem c hx) + have hclegal : LegalChar c := hlegal c (by simp) + have hq' : NoQClose d := by + intro pre suf h + exact hq (c :: pre) suf (by simp [h]) + have ih' := ih rest hq' hlegal' + by_cases hc : c = '?' + · subst hc + cases d with + | nil => + simp [parsePIData] + | cons e es => + have he : e ≠ '>' := by + intro hgt + subst hgt + exact hq [] es (by simp) + have e1 : ('?' :: e :: es) ++ '?' :: '>' :: rest = + '?' :: e :: (es ++ '?' :: '>' :: rest) := by + simp [List.append_assoc] + rw [e1, parsePIData_quest_cons he] + have ih2 : parsePIData (e :: (es ++ '?' :: '>' :: rest)) = + some (e :: es, rest) := ih' + rw [ih2] + rfl + · have e1 : (c :: d) ++ '?' :: '>' :: rest = + c :: (d ++ '?' :: '>' :: rest) := rfl + rw [e1] + simp [parsePIData, ih', hc, isLegalChar_of hclegal] + +/-- Whitespace, as the test the parser runs, is false of a + character that is no whitespace character. -/ +theorem isWs_false_of_not {c : Char} (h : ¬ IsWs c) : isWs c = false := by + have h1 : c ≠ ' ' := fun e => h (Or.inl e) + have h2 : c ≠ '\t' := fun e => h (Or.inr (Or.inl e)) + have h3 : c ≠ '\n' := fun e => h (Or.inr (Or.inr (Or.inl e))) + have h4 : c ≠ '\r' := fun e => h (Or.inr (Or.inr (Or.inr e))) + exact isWs_of_ne h1 h2 h3 h4 + +/-- Reading back a printed processing instruction gives the + instruction back. The input is the text after `'] else ' ' :: d ++ ['?', '>']) ++ + rest) = + some (.pi t d, rest) := by + have hres' : ¬ (t.map Char.toLower = ['x', 'm', 'l']) := hres + cases hd : d with + | nil => + subst hd + have hpn := parseName_append hname (rest := ['?', '>'] ++ rest) (by + intro c hc + simp at hc + rw [← hc] + exact isNameChar_false_of not_nameChar_quest) + rw [if_pos rfl, List.append_assoc] + simp only [parsePI] + rw [hpn] + simp [hres'] + | cons c0 d0 => + subst hd + have hpn := parseName_append hname + (rest := (' ' :: (c0 :: d0) ++ ['?', '>']) ++ rest) (by + intro c hc + simp at hc + rw [← hc] + exact isNameChar_false_of not_nameChar_space) + have hstart' : ¬ IsWs c0 := by + rcases hstart with h | h + · simp at h + · exact h c0 d0 rfl + have hsk : skipWs ((' ' :: (c0 :: d0) ++ ['?', '>']) ++ rest) = + (c0 :: d0) ++ '?' :: '>' :: rest := by + have e1 : (' ' :: (c0 :: d0) ++ ['?', '>']) ++ rest = + ' ' :: ((c0 :: d0) ++ '?' :: '>' :: rest) := by + simp [List.append_assoc] + rw [e1] + have hw : isWs ' ' = true := by decide + have hc0 : isWs c0 = false := isWs_false_of_not hstart' + simp [skipWs, hw, hc0] + have hpd := parsePIData_print (c0 :: d0) rest hq hlegal + rw [if_neg (by simp), List.append_assoc] + simp only [parsePI] + rw [hpn] + simp [hres', hsk, hpd, List.append_assoc, isWs] + have hsk2 : skipWs (' ' :: c0 :: (d0 ++ '?' :: '>' :: rest)) = + (c0 :: d0) ++ '?' :: '>' :: rest := by + have h1 : (' ' :: c0 :: (d0 ++ '?' :: '>' :: rest)) = + (' ' :: (c0 :: d0) ++ ['?', '>']) ++ rest := by + simp [List.append_assoc] + rw [h1] + exact hsk + rw [hsk2, hpd] + +/-! ## Printed lengths -/ + +/-- The printed attribute list is at least as long as the list of + attributes. -/ +theorem printAttrs_length_ge : ∀ (attrs : List (List Char × List Char)), + attrs.length ≤ (printAttrs attrs).length := by + intro attrs + induction attrs with + | nil => simp [printAttrs] + | cons kv rest ih => + have h2 := escapeAttr_length_ge kv.2 + simp only [printAttrs, List.length_append, List.length_cons] + omega + +/-- The printed attribute list is long enough to cover any one + value in it, plus one character per attribute. -/ +theorem printAttrs_length_ge_value : + ∀ (attrs : List (List Char × List Char)) (kv : List Char × List Char), + kv ∈ attrs → kv.2.length + attrs.length ≤ (printAttrs attrs).length := by + intro attrs + induction attrs with + | nil => intro kv h; simp at h + | cons kv0 rest ih => + intro kv h + have h3 := printAttrs_length_ge rest + rcases List.mem_cons.mp h with rfl | h' + · have h2 := escapeAttr_length_ge kv.2 + simp only [printAttrs, List.length_append, List.length_cons] + omega + · have h4 := ih kv h' + have h2 := escapeAttr_length_ge kv0.2 + simp only [printAttrs, List.length_append, List.length_cons] + omega + +/-! ## Stopping character data -/ + +/-- Character data stops at a less sign whose next character is + not the bang that would open a CDATA section. -/ +theorem parseCharData_stop_lt_cons {c : Char} {r : List Char} + (hc : c ≠ '!') : + ∀ f, 1 ≤ f → + parseCharData f ('<' :: c :: r) = some ([], '<' :: c :: r) := by + intro f hf + cases f with + | zero => simp at hf + | succ f' => simp [parseCharData, hc] + +/-- Character data stops at a less sign at the end of the text. -/ +theorem parseCharData_stop_lt_nil : + ∀ f, 1 ≤ f → parseCharData f ['<'] = some ([], ['<']) := by + intro f hf + cases f with + | zero => simp at hf + | succ f' => simp [parseCharData] + +/-- Character data stops at the marks that open a comment. -/ +theorem parseCharData_stop_comment {r : List Char} : + ∀ f, 1 ≤ f → + parseCharData f ('<' :: '!' :: '-' :: '-' :: r) = + some ([], '<' :: '!' :: '-' :: '-' :: r) := by + intro f hf + cases f with + | zero => simp at hf + | succ f' => simp [parseCharData] + +/-! ## Attributes -/ + +/-- Reading back a printed attribute list gives the attributes + back, on top of the ones already read. The end of the tag is + left to the caller: the statement ends in a hypothesis that + says what the reader does at the text that follows the printed + attributes. -/ +theorem parseAttrs_print : ∀ (attrs : List (List Char × List Char)) + (acc : List (List Char × List Char)) (tail : List Char) (f : Nat) + (res : Option (List (List Char × List Char) × List Char × Bool)), + AttrsOk attrs → + (∀ kv ∈ attrs, ¬ acc.any (fun p => p.1 = kv.1)) → + (∀ kv ∈ attrs, kv.2.length + attrs.length + 2 ≤ f) → + attrs.length + 1 ≤ f → + (∀ f', 1 ≤ f' → parseAttrs f' (acc ++ attrs) tail = res) → + parseAttrs f acc (printAttrs attrs ++ tail) = res := by + intro attrs + induction attrs with + | nil => + intro acc tail f res _ _ _ hf hfin + have h1 : parseAttrs f (acc ++ []) tail = res := hfin f (by + cases f with + | zero => simp at hf + | succ f' => omega) + simpa [printAttrs] using h1 + | cons kv attrs ih => + intro acc tail f res hok hdisj hfv hf hfin + obtain ⟨a, v⟩ := kv + have hname : ValidName a := hok.1 + have hval : ∀ c ∈ v, LegalChar c := hok.2.1 + have hnodup : ∀ kv2 ∈ attrs, kv2.1 ≠ a := hok.2.2.1 + have hok' : AttrsOk attrs := hok.2.2.2 + obtain ⟨c0, ds, ha, hc0, hds⟩ := hname + subst ha + cases f with + | zero => + simp only [List.length_cons] at hf + omega + | succ f' => + have hf' : attrs.length + 1 ≤ f' := by + simp only [List.length_cons] at hf + omega + have hfv' : ∀ kv2 ∈ attrs, kv2.2.length + attrs.length + 2 ≤ f' := by + intro kv2 h2 + have h3 := hfv kv2 (List.mem_cons_of_mem _ h2) + simp only [List.length_cons] at h3 + omega + have hdisj' : ∀ kv2 ∈ attrs, + ¬ (acc ++ [((c0 :: ds), v)]).any (fun p => p.1 = kv2.1) := by + intro kv2 h2 + rw [List.any_append] + simp only [List.any_cons, List.any_nil, Bool.or_eq_true, + Bool.or_false] + intro e + rcases e with e | e + · exact hdisj kv2 (List.mem_cons_of_mem _ h2) e + · exact hnodup kv2 h2 (of_decide_eq_true e).symm + have hfin' : ∀ f'', 1 ≤ f'' → + parseAttrs f'' ((acc ++ [((c0 :: ds), v)]) ++ attrs) tail = res := by + intro f'' hf'' + have h3 := hfin f'' hf'' + have e : (acc ++ [((c0 :: ds), v)]) ++ attrs = + acc ++ (((c0 :: ds), v) :: attrs) := by + simp [List.append_assoc] + rwa [← e] at h3 + have ih' := ih (acc ++ [((c0 :: ds), v)]) tail f' res hok' hdisj' + hfv' hf' hfin' + have hsk : skipWs (printAttrs (((c0 :: ds), v) :: attrs) ++ tail) = + (c0 :: ds) ++ + ('=' :: '"' :: escapeAttr v ++ '"' :: (printAttrs attrs ++ tail)) := by + have hws1 : isWs ' ' = true := by decide + have hws2 : isWs c0 = false := + isWs_false_of_not (IsNameStart.ne_ws hc0) + simp [printAttrs, skipWs, hws1, hws2, List.append_assoc] + have hpn : parseName + ((c0 :: ds) ++ + ('=' :: '"' :: escapeAttr v ++ '"' :: (printAttrs attrs ++ tail))) = + some ((c0 :: ds), + '=' :: '"' :: escapeAttr v ++ '"' :: (printAttrs attrs ++ tail)) := + parseName_append ⟨c0, ds, rfl, hc0, hds⟩ (by + intro c hc + simp only [List.head?] at hc + rw [← Option.some.inj hc] + exact isNameChar_false_of not_nameChar_eq) + have hpn2 : parseName + (c0 :: (ds ++ + ('=' :: '"' :: (escapeAttr v ++ '"' :: (printAttrs attrs ++ tail))))) = + some ((c0 :: ds), + '=' :: '"' :: (escapeAttr v ++ '"' :: (printAttrs attrs ++ tail))) := + hpn + have hval' : parseAttrValue '"' f' + (escapeAttr v ++ '"' :: (printAttrs attrs ++ tail)) = + some (v, printAttrs attrs ++ tail) := + parseAttrValue_escapeAttr v (printAttrs attrs ++ tail) hval f' (by + have h3 := hfv ((c0 :: ds), v) (by simp) + simp only [List.length_cons] at h3 + omega) + have hdup : acc.any (fun p => p.1 = (c0 :: ds)) = false := by + have h3 := hdisj ((c0 :: ds), v) (by simp) + cases h4 : acc.any (fun p => p.1 = (c0 :: ds)) with + | false => rfl + | true => exact absurd h4 (by exact h3) + have hc0ne1 : c0 ≠ '/' := by + intro e + subst e + have h5 : isNameStart '/' = true := isNameStart_of hc0 + have h6 : isNameStart '/' = false := by decide + rw [h6] at h5 + exact Bool.false_ne_true h5 + have hc0ne2 : c0 ≠ '>' := by + intro e + subst e + have h5 : isNameStart '>' = true := isNameStart_of hc0 + have h6 : isNameStart '>' = false := by decide + rw [h6] at h5 + exact Bool.false_ne_true h5 + have hstep : parseAttrs (f' + 1) acc + (printAttrs (((c0 :: ds), v) :: attrs) ++ tail) = + parseAttrs f' (acc ++ [((c0 :: ds), v)]) + (printAttrs attrs ++ tail) := by + simp [parseAttrs, hsk, hpn2, hval', hdup, hc0ne1, hc0ne2, + isNameStart_of hc0, List.cons_append, List.append_assoc, + skipWs_cons (by decide : isWs '=' = false), + skipWs_cons (by decide : isWs '"' = false)] + rwa [hstep] + +/-- Reading back a printed attribute list that ends a short form + tag. -/ +theorem parseAttrs_print_closed + (attrs : List (List Char × List Char)) + (acc : List (List Char × List Char)) (rest : List Char) (f : Nat) + (hok : AttrsOk attrs) + (hdisj : ∀ kv ∈ attrs, ¬ acc.any (fun p => p.1 = kv.1)) + (hfv : ∀ kv ∈ attrs, kv.2.length + attrs.length + 2 ≤ f) + (hf : attrs.length + 1 ≤ f) : + parseAttrs f acc (printAttrs attrs ++ '/' :: '>' :: rest) = + some (acc ++ attrs, rest, true) := by + apply parseAttrs_print attrs acc _ f _ hok hdisj hfv hf + intro f' hf' + cases f' with + | zero => simp at hf' + | succ f'' => + simp [parseAttrs, skipWs, isWs_slash, + (by decide : isWs '>' = false)] + +/-- Reading back a printed attribute list that ends a start tag. -/ +theorem parseAttrs_print_open + (attrs : List (List Char × List Char)) + (acc : List (List Char × List Char)) (rest : List Char) (f : Nat) + (hok : AttrsOk attrs) + (hdisj : ∀ kv ∈ attrs, ¬ acc.any (fun p => p.1 = kv.1)) + (hfv : ∀ kv ∈ attrs, kv.2.length + attrs.length + 2 ≤ f) + (hf : attrs.length + 1 ≤ f) : + parseAttrs f acc (printAttrs attrs ++ '>' :: rest) = + some (acc ++ attrs, rest, false) := by + apply parseAttrs_print attrs acc _ f _ hok hdisj hfv hf + intro f' hf' + cases f' with + | zero => simp at hf' + | succ f'' => + simp [parseAttrs, skipWs, (by decide : isWs '>' = false)] + +/-! ## Elements and content -/ + +/-- The element half of the round trip, at a bound on the length + of the printed element. -/ +abbrev ElemProp (n : Nat) : Prop := + ∀ (f : Nat), n + 1 ≤ f → ∀ (name : List Char) + (attrs : List (List Char × List Char)) (content : List Node) + (rest : List Char), + WFNode (.elem name attrs content) → + (printNode (.elem name attrs content)).length = n → + parseElement f (printNode (.elem name attrs content) ++ rest) = + some (.elem name attrs content, rest) + +/-- The content half of the round trip, at a bound two more than + the length of the printed content: the two end tag characters + that follow the content are part of the bound, which is what + makes the bound drop at an element inside the content. -/ +abbrev NodesProp (n : Nat) : Prop := + ∀ (f : Nat), n + 1 ≤ f → ∀ (nodes : List Node) (rest : List Char), + WFNodes nodes → + (printNodes nodes).length + 2 = n → + parseNodes f (printNodes nodes ++ '<' :: '/' :: rest) = + some (nodes, '<' :: '/' :: rest) + +/-- A name head is not any of the characters that would send the + content reader down another arm. -/ +theorem IsNameStart.ne_slash {c : Char} (h : IsNameStart c) : c ≠ '/' := by + intro e + subst e + have h5 : isNameStart '/' = true := isNameStart_of h + have h6 : isNameStart '/' = false := by decide + rw [h6] at h5 + exact Bool.false_ne_true h5 + +theorem IsNameStart.ne_quest {c : Char} (h : IsNameStart c) : c ≠ '?' := by + intro e + subst e + have h5 : isNameStart '?' = true := isNameStart_of h + have h6 : isNameStart '?' = false := by decide + rw [h6] at h5 + exact Bool.false_ne_true h5 + +/-- The two halves together, by strong induction on the bound. -/ +theorem elem_nodes : ∀ n, ElemProp n ∧ NodesProp n := by + have aux : ∀ k, ∀ n, n ≤ k → ElemProp n ∧ NodesProp n := by + intro k + induction k with + | zero => + intro n hn + have hn0 : n = 0 := by omega + subst hn0 + constructor + · intro f hf name attrs content rest hwf hlen + simp [printNode, printElem] at hlen + · intro f hf nodes rest hwf hlen + omega + | succ k ihk => + intro n hn + by_cases hn2 : n ≤ k + · exact ihk n hn2 + · have ih : ∀ m, m < n → ElemProp m ∧ NodesProp m := + fun m hm => ihk m (by omega) + constructor + · -- elements + intro f hf name attrs content rest hwf hlen + cases f with + | zero => simp at hf + | succ f' => + have hname : ValidName name := match hwf with + | .elem a _ _ => a + have hattrs : AttrsOk attrs := match hwf with + | .elem _ a _ => a + have hcontent : WFNodes content := match hwf with + | .elem _ _ a => a + obtain ⟨c0, ds, hnameq, hc0, hds⟩ := hname + subst hnameq + have hple : (printAttrs attrs).length + 4 ≤ + (printNode (.elem (c0 :: ds) attrs content)).length := by + by_cases hc : content = [] + · subst hc + simp [printNode, printElem, List.length_append] + · simp [printNode, printElem, hc, List.length_append] + omega + have hfv : ∀ kv ∈ attrs, kv.2.length + attrs.length + 2 ≤ f' := by + intro kv hkv + have h1 := printAttrs_length_ge_value attrs kv hkv + omega + have hfattrs : attrs.length + 1 ≤ f' := by + have h1 := printAttrs_length_ge attrs + omega + by_cases hc : content = [] + · subst hc + have hpn : parseName + ((c0 :: ds) ++ (printAttrs attrs ++ '/' :: '>' :: rest)) = + some ((c0 :: ds), printAttrs attrs ++ '/' :: '>' :: rest) := + parseName_append ⟨c0, ds, rfl, hc0, hds⟩ (by + intro c hc + have hc2 : ∀ x, (printAttrs attrs ++ '/' :: '>' :: rest).head? = + some x → isNameChar x = false := by + intro x hx + cases attrs with + | nil => + simp only [printAttrs, List.nil_append, + List.head?_cons] at hx + rw [← Option.some.inj hx] + exact isNameChar_false_of not_nameChar_slash + | cons kv as => + simp only [printAttrs, List.cons_append, + List.head?_cons] at hx + rw [← Option.some.inj hx] + exact isNameChar_false_of not_nameChar_space + exact hc2 c hc) + have hpn2 : parseName + (c0 :: (ds ++ (printAttrs attrs ++ '/' :: '>' :: rest))) = + some ((c0 :: ds), printAttrs attrs ++ '/' :: '>' :: rest) := + hpn + have hat : parseAttrs f' [] (printAttrs attrs ++ '/' :: '>' :: rest) = + some (attrs, rest, true) := by + have h := parseAttrs_print_closed attrs [] rest f' hattrs + (by intro kv _ e; simp at e) hfv hfattrs + simpa using h + simp [parseElement, printNode, printElem, hpn2, hat, + List.append_assoc] + · have hpn : parseName + ((c0 :: ds) ++ (printAttrs attrs ++ + ('>' :: (printNodes content ++ + '<' :: '/' :: ((c0 :: ds) ++ '>' :: rest))))) = + some ((c0 :: ds), printAttrs attrs ++ + ('>' :: (printNodes content ++ + '<' :: '/' :: ((c0 :: ds) ++ '>' :: rest)))) := + parseName_append ⟨c0, ds, rfl, hc0, hds⟩ (by + intro c hc + have hc2 : ∀ x, (printAttrs attrs ++ + ('>' :: (printNodes content ++ + '<' :: '/' :: ((c0 :: ds) ++ '>' :: rest)))).head? = + some x → isNameChar x = false := by + intro x hx + cases attrs with + | nil => + simp only [printAttrs, List.nil_append, + List.head?_cons] at hx + rw [← Option.some.inj hx] + exact isNameChar_false_of not_nameChar_gt + | cons kv as => + simp only [printAttrs, List.cons_append, + List.head?_cons] at hx + rw [← Option.some.inj hx] + exact isNameChar_false_of not_nameChar_space + exact hc2 c hc) + have hpn2 : parseName + (c0 :: (ds ++ (printAttrs attrs ++ + ('>' :: (printNodes content ++ + '<' :: '/' :: c0 :: (ds ++ '>' :: rest)))))) = + some ((c0 :: ds), printAttrs attrs ++ + ('>' :: (printNodes content ++ + '<' :: '/' :: c0 :: (ds ++ '>' :: rest)))) := + hpn + have hat : parseAttrs f' [] + (printAttrs attrs ++ + ('>' :: (printNodes content ++ + '<' :: '/' :: c0 :: (ds ++ '>' :: rest)))) = + some (attrs, printNodes content ++ + '<' :: '/' :: c0 :: (ds ++ '>' :: rest), false) := by + have h := parseAttrs_print_open attrs [] + (printNodes content ++ '<' :: '/' :: c0 :: (ds ++ '>' :: rest)) + f' hattrs (by intro kv _ e; simp at e) hfv hfattrs + simpa using h + have hm : (printNodes content).length + 2 < n := by + have hlb : (printNodes content).length + 3 ≤ + (printNode (.elem (c0 :: ds) attrs content)).length := by + simp [printNode, printElem, hc, List.length_append] + omega + omega + have hnodes : parseNodes f' + (printNodes content ++ '<' :: '/' :: c0 :: (ds ++ '>' :: rest)) = + some (content, '<' :: '/' :: c0 :: (ds ++ '>' :: rest)) := + (ih ((printNodes content).length + 2) hm).2 f' (by omega) + content (c0 :: (ds ++ '>' :: rest)) hcontent rfl + have hend2 : parseName (c0 :: (ds ++ '>' :: rest)) = + some ((c0 :: ds), '>' :: rest) := + parseName_append ⟨c0, ds, rfl, hc0, hds⟩ (by + intro c hc + simp only [List.head?_cons] at hc + rw [← Option.some.inj hc] + exact isNameChar_false_of not_nameChar_gt) + have hend : parseName ((c0 :: ds) ++ '>' :: rest) = + some ((c0 :: ds), '>' :: rest) := + parseName_append ⟨c0, ds, rfl, hc0, hds⟩ (by + intro c hc + simp only [List.head?_cons] at hc + rw [← Option.some.inj hc] + exact isNameChar_false_of not_nameChar_gt) + simp [parseElement, printNode, printElem, hc, hpn2, hat, hnodes, + hend2, skipWs_cons (by decide : isWs '>' = false), + List.append_assoc, List.cons_append] + · -- content lists + intro f hf nodes rest hwf hlen + cases f with + | zero => simp at hf + | succ f' => + cases nodes with + | nil => + simp [parseNodes, printNodes] + | cons n0 ns => + have hn0 : WFNode n0 := match hwf with + | .cons a _ _ => a + have hns : WFNodes ns := match hwf with + | .cons _ a _ => a + have hadj : (∃ cs, n0 = .text cs) → + ∀ cs, ns.head? ≠ some (.text cs) := match hwf with + | .cons _ _ a => a + have hlen2 : (printNode n0).length + (printNodes ns).length + 2 = + n := by + have h1 := hlen + simp only [printNodes, List.length_append] at h1 + omega + have hm : (printNodes ns).length + 2 < n := by + have hp : 1 ≤ (printNode n0).length := by + cases n0 with + | text cs => + cases hn0 with + | text hne hlegal => + have h1 := escapeText_length_ge cs + have h2 : 1 ≤ cs.length := by + cases cs with + | nil => exact absurd rfl hne + | cons c cs' => simp + simp only [printNode] + omega + | elem name attrs content => simp [printNode, printElem] + | comment cs => simp [printNode] + | pi t d => simp [printNode] + omega + have hIH : parseNodes f' (printNodes ns ++ '<' :: '/' :: rest) = + some (ns, '<' :: '/' :: rest) := + (ih ((printNodes ns).length + 2) hm).2 f' (by omega) ns rest + hns rfl + cases n0 with + | text t => + cases hn0 with + | text hne hlegal => + have hadj' : ∀ cs, ns.head? ≠ some (.text cs) := + hadj ⟨t, rfl⟩ + cases t with + | nil => exact absurd rfl hne + | cons c t' => + have hrest : (printNodes ns ++ '<' :: '/' :: rest) = [] ∨ + (printNodes ns ++ '<' :: '/' :: rest).head? = + some '<' := by + cases ns with + | nil => + right + simp [printNodes] + | cons n1 ns' => + right + cases n1 with + | text cs => + exfalso + exact hadj' cs rfl + | elem name attrs content => + simp [printNodes, printNode, printElem, List.cons_append] + | comment cs => + simp [printNodes, printNode, List.cons_append] + | pi t d => + simp [printNodes, printNode, List.cons_append] + have hstop : ∀ f, 1 ≤ f → + parseCharData f (printNodes ns ++ '<' :: '/' :: rest) = + some ([], printNodes ns ++ '<' :: '/' :: rest) := by + cases ns with + | nil => + intro f hf2 + simpa [printNodes] using + parseCharData_stop_lt_cons (c := '/') (by decide) f hf2 + | cons n1 ns' => + cases n1 with + | text cs => + intro f _ + exfalso + exact hadj' cs rfl + | elem name attrs content => + have hn1 : WFNode (.elem name attrs content) := + match hns with + | .cons a _ _ => a + cases hn1 with + | elem hname1 hattrs1 hcontent1 => + obtain ⟨c1, ds1, hq1, hc1, -⟩ := hname1 + intro f hf2 + cases f with + | zero => simp at hf2 + | succ f'' => + have hc1ne : c1 ≠ '!' := + IsNameStart.ne_bang hc1 + simp [parseCharData, printNodes, printNode, + printElem, hq1, hc1ne, List.append_assoc] + | comment cs => + intro f hf2 + simpa [printNodes, printNode] using + parseCharData_stop_comment + (r := (cs ++ '-' :: '-' :: '>' :: []) ++ + (printNodes ns' ++ '<' :: '/' :: rest)) f hf2 + | pi t d => + intro f hf2 + simpa [printNodes, printNode] using + parseCharData_stop_lt_cons (c := '?') (by decide) f hf2 + have hcd : parseCharData f' + (escapeText (c :: t') ++ + (printNodes ns ++ '<' :: '/' :: rest)) = + some (c :: t', printNodes ns ++ '<' :: '/' :: rest) := + parseCharData_escapeText (c :: t') _ (by simp) hlegal + hrest hstop f' (by + have h1 := escapeText_length_ge (c :: t') + have hlink : (printNode (.text (c :: t'))).length = + (escapeText (c :: t')).length := by + simp [printNode] + omega) + rcases escapeTextChar_cases c with + ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | + ⟨h1, h2, h3, h4, h5⟩ + · subst h1 + have hcdX : parseCharData f' + ('&' :: 'a' :: 'm' :: 'p' :: ';' :: (List.flatMap escapeTextChar t' ++ + (printNodes ns ++ '<' :: '/' :: rest))) = + some ('&' :: t', printNodes ns ++ '<' :: '/' :: rest) := + hcd + simp [parseNodes, printNodes, printNode, escapeText, h2, + List.append_assoc] + rw [hcdX] + simp [hIH] + · subst h1 + have hcdX : parseCharData f' + ('&' :: 'l' :: 't' :: ';' :: (List.flatMap escapeTextChar t' ++ + (printNodes ns ++ '<' :: '/' :: rest))) = + some ('<' :: t', printNodes ns ++ '<' :: '/' :: rest) := + hcd + simp [parseNodes, printNodes, printNode, escapeText, h2, + List.append_assoc] + rw [hcdX] + simp [hIH] + · subst h1 + have hcdX : parseCharData f' + ('&' :: 'g' :: 't' :: ';' :: (List.flatMap escapeTextChar t' ++ + (printNodes ns ++ '<' :: '/' :: rest))) = + some ('>' :: t', printNodes ns ++ '<' :: '/' :: rest) := + hcd + simp [parseNodes, printNodes, printNode, escapeText, h2, + List.append_assoc] + rw [hcdX] + simp [hIH] + · subst h1 + have hcdX : parseCharData f' + ('&' :: '#' :: '1' :: '3' :: ';' :: (List.flatMap escapeTextChar t' ++ + (printNodes ns ++ '<' :: '/' :: rest))) = + some ('\r' :: t', printNodes ns ++ '<' :: '/' :: rest) := + hcd + simp [parseNodes, printNodes, printNode, escapeText, h2, + List.append_assoc] + rw [hcdX] + simp [hIH] + · have hcdX : parseCharData f' + (c :: (List.flatMap escapeTextChar t' ++ + (printNodes ns ++ '<' :: '/' :: rest))) = + some (c :: t', printNodes ns ++ '<' :: '/' :: rest) := by + have h := hcd + rw [show escapeText (c :: t') = c :: escapeText t' by + simp [escapeText, h5]] at h + exact h + simp [parseNodes, printNodes, printNode, escapeText, + h5, h1, h2, List.append_assoc] + rw [hcdX] + simp [hIH] + | comment body => + cases hn0 with + | comment hdd hde hlegal => + have hcb : parseCommentBody + (body ++ '-' :: '-' :: '>' :: + (printNodes ns ++ '<' :: '/' :: rest)) = + some (body, printNodes ns ++ '<' :: '/' :: rest) := + parseCommentBody_print body _ hdd hde hlegal + simp [parseNodes, printNodes, printNode, hcb, hIH] + | pi t d => + cases hn0 with + | pi hname hres hq hlegal hstart => + have hpi : parsePI + (t ++ (if d = [] then ['?', '>'] + else ' ' :: d ++ ['?', '>']) ++ + (printNodes ns ++ '<' :: '/' :: rest)) = + some (.pi t d, printNodes ns ++ '<' :: '/' :: rest) := + parsePI_print t d _ hname hres hq hlegal hstart + have hpi2 := hpi + rw [List.append_assoc] at hpi2 + simp only [List.cons_append, List.nil_append] at hpi2 + simp [parseNodes, printNodes, printNode] + rw [hpi2] + simp [hIH] + | elem name attrs content => + cases hn0 with + | elem hname hattrs hcontent => + obtain ⟨c0, ds, hq0, hc0, hds⟩ := hname + have hmE : (printNode (.elem name attrs content)).length < + n := by + omega + have hE : parseElement f' + (printNode (.elem name attrs content) ++ + (printNodes ns ++ '<' :: '/' :: rest)) = + some (.elem name attrs content, + printNodes ns ++ '<' :: '/' :: rest) := + (ih (printNode (.elem name attrs content)).length hmE).1 + f' (by omega) name attrs content + (printNodes ns ++ '<' :: '/' :: rest) + (WFNode.elem ⟨c0, ds, hq0, hc0, hds⟩ hattrs hcontent) rfl + have hc0ne1 : c0 ≠ '/' := IsNameStart.ne_slash hc0 + have hc0ne2 : c0 ≠ '!' := IsNameStart.ne_bang hc0 + have hc0ne3 : c0 ≠ '?' := IsNameStart.ne_quest hc0 + simp only [printNode, printElem, hq0, List.append_assoc, + List.cons_append] at hE + simp [parseNodes, printNodes, printNode, printElem, hq0, + hc0ne1, hc0ne2, hc0ne3, isNameStart_of hc0, + List.append_assoc] + rw [hE] + simp [hIH] + + intro n + exact aux n n (Nat.le_refl n) + +/-- The misc parser stops at a tag whose second character starts + a name: that is an element start, not a comment or a + processing instruction. -/ +theorem parseMisc_stop {f : Nat} {c : Char} {cs : List Char} + (hc : IsNameStart c) : + parseMisc (f + 1) ('<' :: c :: cs) = some ([], '<' :: c :: cs) := by + have h1 : c ≠ '!' := IsNameStart.ne_bang hc + have h2 : c ≠ '?' := IsNameStart.ne_quest hc + have h3 : skipWs ('<' :: c :: cs) = '<' :: c :: cs := + skipWs_cons (by decide) + simp [parseMisc, h3, h1, h2] + +/-- Prologs and epilogs round trip: printing a list of comments + and processing instructions and parsing gives the list back, + with the continuation reached after it. -/ +theorem parseMisc_print : + ∀ (ms : List Node) (rest : List Char), + MiscOk ms → + (∀ f, 1 ≤ f → parseMisc f rest = some ([], skipWs rest)) → + ∀ f, (printNodes ms).length + 1 ≤ f → + parseMisc f (printNodes ms ++ rest) = some (ms, skipWs rest) := by + intro ms + induction ms with + | nil => + intro rest _ hstop f hf + simp only [printNodes, List.nil_append] + exact hstop f (by omega) + | cons n ms ih => + intro rest hok hstop f hf + have hokn : WFNode n ∧ + ((∃ cs, n = .comment cs) ∨ (∃ t d, n = .pi t d)) := + hok n (by simp) + have hoktail : MiscOk ms := + fun m hm => hok m (by simp [hm]) + cases f with + | zero => omega + | succ f' => + rcases hokn with ⟨hwf, hkind⟩ + rcases hkind with ⟨cs, rfl⟩ | ⟨t, d, rfl⟩ + · cases hwf with + | comment hdd hde hlegal => + have hcb : parseCommentBody + (cs ++ '-' :: '-' :: '>' :: (printNodes ms ++ rest)) = + some (cs, printNodes ms ++ rest) := + parseCommentBody_print cs _ hdd hde hlegal + have hlen : (printNodes ms).length + 1 ≤ f' := by + have h2 : (printNode (.comment cs)).length = cs.length + 7 := by + simp [printNode, List.length_append] + have h1 : (printNodes (.comment cs :: ms)).length = + (printNode (.comment cs)).length + + (printNodes ms).length := by + simp [printNodes, List.length_append] + omega + have hih := ih rest hoktail hstop f' hlen + simp [parseMisc, printNodes, printNode, skipWs, hcb, hih, + skipWs_cons (show isWs '<' = false by decide), + List.append_assoc] + · cases hwf with + | pi hname hres hq hlegal hstart => + have hpi : parsePI + (t ++ (if d = [] then ['?', '>'] + else ' ' :: d ++ ['?', '>']) ++ + (printNodes ms ++ rest)) = + some (.pi t d, printNodes ms ++ rest) := + parsePI_print t d _ hname hres hq hlegal hstart + have hlen : (printNodes ms).length + 1 ≤ f' := by + have h2 : 2 ≤ (printNode (.pi t d)).length := by + simp only [printNode, List.length_cons] + omega + have h1 : (printNodes (.pi t d :: ms)).length = + (printNode (.pi t d)).length + + (printNodes ms).length := by + simp [printNodes, List.length_append] + omega + have hpi2 := hpi + rw [List.append_assoc] at hpi2 + simp only [List.cons_append, List.nil_append] at hpi2 + have hih := ih rest hoktail hstop f' hlen + simp [parseMisc, printNodes, printNode, skipWs, hpi2, hih, + skipWs_cons (show isWs '<' = false by decide), + List.append_assoc] + +/-- The plan's claim: printing a well formed document and parsing + the print gives the same document back. -/ +theorem parse_print (d : Document) (hwf : WF d) : + parse (print d) = some d := by + obtain ⟨hpro, hroot, ⟨name, attrs, content, hreq⟩, hepi⟩ := hwf + rw [hreq] at hroot + cases hroot with + | elem hname hattrs hcontent => + obtain ⟨c0, ds, hq0, hc0, hds⟩ := hname + have harg : printNode d.root ++ printNodes d.epilog = + '<' :: c0 :: (ds ++ (printAttrs attrs ++ + (if content = [] then ['/', '>'] + else '>' :: (printNodes content ++ '<' :: '/' :: + ((c0 :: ds) ++ ['>'])))) ++ printNodes d.epilog) := by + rw [hreq, hq0] + simp [printNode, printElem, List.append_assoc, List.cons_append] + have hsw : skipWs (printNode d.root ++ printNodes d.epilog) = + printNode d.root ++ printNodes d.epilog := by + rw [harg] + exact skipWs_cons (by decide) + have hstoproot : ∀ f, 1 ≤ f → + parseMisc f (printNode d.root ++ printNodes d.epilog) = + some ([], skipWs (printNode d.root ++ printNodes d.epilog)) := by + intro f hf + cases f with + | zero => omega + | succ f' => + rw [harg, skipWs_cons (show isWs '<' = false by decide)] + exact parseMisc_stop hc0 + have hstopnil : ∀ f, 1 ≤ f → + parseMisc f [] = some ([], skipWs []) := by + intro f hf + cases f with + | zero => omega + | succ f' => simp [parseMisc, skipWs] + have hpro' : parseMisc ((printNodes d.prolog ++ + (printNode d.root ++ printNodes d.epilog)).length + 1) + (printNodes d.prolog ++ + (printNode d.root ++ printNodes d.epilog)) = + some (d.prolog, skipWs (printNode d.root ++ + printNodes d.epilog)) := + parseMisc_print d.prolog _ hpro hstoproot _ (by + simp only [List.length_append]; omega) + have hroot' : parseElement ((printNodes d.prolog ++ + (printNode d.root ++ printNodes d.epilog)).length + 1) + (printNode d.root ++ printNodes d.epilog) = + some (d.root, printNodes d.epilog) := by + rw [hreq] + exact (elem_nodes (printNode (.elem name attrs content)).length).1 + _ (by + have e : (printNode d.root).length = + (printNode (.elem name attrs content)).length := by + rw [hreq] + simp only [List.length_append]; omega) + name attrs content (printNodes d.epilog) + (WFNode.elem ⟨c0, ds, hq0, hc0, hds⟩ hattrs hcontent) rfl + have hepi' : parseMisc ((printNodes d.prolog ++ + (printNode d.root ++ printNodes d.epilog)).length + 1) (printNodes d.epilog) = + some (d.epilog, skipWs []) := by + have h := parseMisc_print d.epilog [] hepi hstopnil + ((printNodes d.prolog ++ + (printNode d.root ++ printNodes d.epilog)).length + 1) (by + simp only [List.length_append]; omega) + simpa using h + have hPd : print d = printNodes d.prolog ++ + (printNode d.root ++ printNodes d.epilog) := by + simp [print, List.append_assoc] + have hdoc : parseDocument ((printNodes d.prolog ++ + (printNode d.root ++ printNodes d.epilog)).length + 1) + (printNodes d.prolog ++ + (printNode d.root ++ printNodes d.epilog)) = some d := by + simp only [parseDocument, hpro', hsw, hroot', hepi', skipWs, + List.nil_append] + rfl + have hparse : parse (print d) = parseDocument ((printNodes d.prolog ++ + (printNode d.root ++ printNodes d.epilog)).length + 1) (print d) := by + have e : (printNodes d.prolog ++ + (printNode d.root ++ printNodes d.epilog)).length + 1 = (print d).length + 1 := by + simp only [print, List.length_append]; omega + rw [e] + rfl + rw [hparse, hPd] + exact hdoc + +end Xml.Proofs diff --git a/README.md b/README.md index 2a9ab1d..86ac722 100644 --- a/README.md +++ b/README.md @@ -1,32 +1,68 @@ -# xml +# xml: an XML safe-subset parser and printer, with a proved round trip -A Lean parser for a safe subset of XML. This is a Proven Commons project: it rebuilds a widely used format in Lean and proves the new code follows its written specification. It is not a full XML parser. It parses only the subset below. +A parser and printer in Lean for a safe subset of XML 1.0: elements, attributes, text, comments, processing instructions, character references, and CDATA sections, with one root element. There is no document type declaration, no entity declarations, no namespaces, and no XML declaration in the subset; a document with any of those is rejected, not parsed leniently. The printer writes one canonical form. The main claim is proved: printing a well formed document gives a text that parses to the same document. The tests run the parser against Python's `xml.etree.ElementTree` in subset mode; see `tests/TEST-RESULTS.md` for the counts. The full subset rules are in `SPEC.md`. -Status: not verified. No code has landed yet. Plan issue 1 holds the first slice, and it is unclaimed. The specification has not been approved by a reviewer, so do not call this verified. +Status: in progress. The specification has not yet been approved by a reviewer apart from its author, and no statement file (`Spec.lean`) has been added by a reviewer, so this is not verified. -## First slice +## What is proved -Elements, attributes, text, comments, processing instructions, character references, and CDATA sections. One root element. Attribute values are quoted. No document type declaration, no entity declarations, and no namespaces in this slice. A document containing a document type declaration is rejected, not parsed leniently. +The definitions are in `Xml/Value.lean` (the tree type, the printer, and the well-formedness rules) and `Xml/Parse.lean` (the parser). The proofs are in `Proofs/RoundTrip.lean`. -## Main claim +| Claim | Theorem | +|-------|---------| +| Parsing the printed form of a well formed document gives the document back. | `Xml.Proofs.parse_print` | +| The same for one element and for a list of content nodes, proved together by strong induction on the length of the printed form. | `Xml.Proofs.elem_nodes` | +| The same for a prolog or epilog list of comments and processing instructions. | `Xml.Proofs.parseMisc_print` | +| Reading back a printed comment body gives the body back. | `Xml.Proofs.parseCommentBody_print` | +| Reading back a printed processing instruction gives the instruction back. | `Xml.Proofs.parsePI_print` | +| Reading back escaped text and escaped attribute values gives the characters back. | `Xml.Proofs.parseCharData_escapeText`, `Xml.Proofs.parseAttrValue_escapeAttr` | -Printing a parsed document gives a document that parses to the same tree. A document with a document type declaration, an undefined entity reference, or mismatched tags is rejected. The parser never expands an entity, because no entities exist in the subset. +A document is well formed when its names match the subset's name rule, attribute names are unique per element, text holds only legal XML characters and no two text runs stand next to each other, comment bodies contain no `--` and do not end with `-`, processing instruction targets are valid and not the reserved word `xml`, and the prolog and epilog hold only comments and processing instructions. `SPEC.md` states the rules in full. `parse_print` checks against the standard axioms only (`propext`, `Classical.choice`, `Quot.sound`), which a reader can confirm with `#print axioms Xml.Proofs.parse_print`. -## Test oracles +The command-line tool in `Main.lean` calls these functions directly. -- Python ElementTree, Go encoding/xml, and Rust quick-xml, each in a strict subset mode. These parsers disagree outside the subset, on document type and entity handling. The differential harness counts out of subset cases separately, not as failures. +## What is not proved -## Score +- That the parser accepts every text the subset allows, and rejects every text it forbids. The round trip does not need either, so neither is proved. The differential tests check that behaviour instead, and the results file records the outcome, including any failure. +- Anything about documents outside the subset: documents with a document type declaration, entities beyond the five predefined ones, namespaces, an XML declaration, or non-ASCII names. The parser rejects them; whether a full XML parser would accept them is not a claim here. +- Reading requests and printing answers in `Main.lean`: splitting lines, the decimal parser, and the check that a code is a Unicode scalar value. The tests cover them, malformed requests included. +- Speed. The code works on lists of characters, which suits proofs, not large data. The parser's fuel is the length of the input text, which very deep inputs can reach. -14 out of 18, first pass score in mission issue 19, the round 4 sheet. Created at the org owner's direction on that sheet, on the judgement that the slice, claim, and oracles are sound and that it duplicates no existing repo. +Three deliberate choices, also stated in `SPEC.md`: -## What is not in this slice +- CDATA sections are a spelling, not a tree difference. CDATA content becomes ordinary character data in the same text node stream, and the printer never writes a CDATA section. The claim is at tree level, so this is sound. +- There is no line ending normalization in text, comments, processing instruction data, or CDATA: a literal carriage return reads as itself. Full XML normalizes it to a line feed. Inside attribute values both readings agree (either form reads as a space), and the printer always writes a carriage return as a character reference. +- The XML declaration is not in the model. A processing instruction target of `xml` in any letter case rejects everywhere, which keeps the declaration out. -- Document type declarations. -- Entities. -- Namespaces. -- Full XML 1.0. +## What you must trust -## Layout, when the first slice lands +- The Lean kernel, which checks the proofs. +- The Lean compiler, with the C compiler and linker shipped with it, and the runtime, which turn the proved definitions into the program that runs. +- Lean's core library, including the compiled code it puts in place of some definitions the proofs reason about. +- The operating system and hardware it runs on. +- Python's standard library, as the oracle in the differential tests. The results file names the version used. The plan also names Go's encoding/xml and Rust's quick-xml as oracles; neither is wired in yet, and the harness says so rather than counting them. -The layout follows the Proven Commons template in the mission repo, under bar/template. Spec.lean holds the statements a reviewer approves. Proofs.lean holds the proofs under the same names. Main.lean holds the command line tool used by the tests. The bar check runs in CI on every change. +This project has no dependencies beyond Lean itself. + +## Run it + +Needs Linux and [elan](https://github.com/leanprover/elan). Build, then feed request lines to the tool: + +``` +lake build +echo "parse 60,97,47,62" | .lake/build/bin/xml +``` + +That request is the text `` as character codes, and the answer is `ok:60,97,47,62`. A text the parser rejects, such as the single code `120` (the letter `x`), answers `none`. A malformed request answers `error`. See `SPEC.md` for the full protocol. + +## Re-check it + +Needs Linux, elan, and Python 3.11 or later. + +``` +lake build +grep -rn "sorry" --include="*.lean" Xml Proofs Main.lean Xml.lean Proofs.lean +python3 tests/run_tests.py +``` + +The grep should print nothing: there is no `sorry` anywhere. The test script rebuilds the tool if needed, runs the fixed cases, runs the differential tests against Python's `xml.etree.ElementTree` with a fixed seed, and writes the counts to `tests/TEST-RESULTS.md`. diff --git a/SPEC.md b/SPEC.md new file mode 100644 index 0000000..2f71396 --- /dev/null +++ b/SPEC.md @@ -0,0 +1,224 @@ +# Specification: xml + +A parser and printer in Lean for a safe subset of XML 1.0 (Fifth +Edition), narrowed as stated here. A reviewer who did not write +this specification approves it, together with any statement file +a reviewer adds later. No such file exists yet, so nothing here +counts toward the verified bar yet. + +Text is `List Char`. A Lean `Char` is one Unicode scalar value. + +## The subset in one paragraph + +A document is a prolog of comments and processing instructions, +one root element, and an epilog of comments and processing +instructions. There is no XML declaration, no document type +declaration, no entity declarations, and no namespaces. The only +entity references are the five predefined ones, plus character +references. Anything outside the rules below is rejected, never +parsed leniently. + +## Documents + +- The prolog and the epilog hold only comments and processing + instructions, with whitespace allowed between them and around + the root. Any other text at the top level (character data, a + second element, a document type declaration, a CDATA section) + rejects. +- There is exactly one root element. +- The XML declaration is not part of this subset. A processing + instruction whose target is `xml`, in any letter case, rejects + everywhere, which keeps the declaration form (``) + out. A producer that writes a declaration can be asked for the + same document without it. Other targets that merely start with + the letters xml, such as `xml-stylesheet`, are ordinary + processing instructions. + +## Names + +- A name starts with an ASCII letter (A to Z, a to z) or an + underscore. +- Later characters may also be ASCII digits, a hyphen, or a dot. +- A colon is never allowed in a name in this subset. In XML a + colon signals namespace use, and namespaces are out. +- Non-ASCII names are out of the subset. XML 1.0 allows far + more; that is later work, not this slice. + +## Elements and attributes + +- An element is a name, attributes, and either an empty element + tag (``) or content and a matching end tag (`...`). + Mismatched tags reject. +- An attribute is a name, an equals sign, and a quoted value. + Single and double quotes are both read; the printer writes + double quotes. +- A duplicate attribute name on one element rejects. +- Whitespace may appear between attributes, around the equals + sign, and before the closing bracket of a start tag or an end + tag. +- In an attribute value: character references and the five + predefined entities are expanded on read. A raw `<` rejects. + A raw `&` that does not begin a valid reference rejects. +- Attribute value normalization: a literal tab or line feed in + a value reads as one space, and a literal carriage return or + carriage return with line feed reads as one space. This is + XML's rule for CDATA type attributes, and every attribute here + is CDATA type because there is no document type declaration + to say otherwise. A tab or line feed spelled as a character + reference is not normalized; it reads as itself. The model + holds the normalized value, so printing and reparsing is + stable. + +## Text + +- Character data runs between markup. A raw `<` begins markup, + never text. A raw `&` must begin a valid reference. +- The five predefined entities decode: `<`, `>`, `&`, + `'`, `"`. Any other entity reference rejects, + because no entities exist in the subset. +- A character reference (`A` decimal, `A` hex; the x is + lowercase only) decodes to its character. The value must be a + legal XML character: tab, line feed, carriage return, 0x20 to + 0xD7FF, 0xE000 to 0xFFFD, or 0x10000 to 0x10FFFF. Anything + else (zero, a control character, a surrogate value, a value + past 0x10FFFF) rejects. +- A raw character in text, a comment, a processing instruction, + a CDATA section, or an attribute value must also be a legal + XML character, or the text rejects. +- The sequence `]]>` inside text rejects, as XML requires + outside a CDATA section. +- Adjacent character data merges into one text node in the + model: plain text, character references, and CDATA sections + between two markup items form a single run. The printer + writes one run, and the round trip claim is about this merged + tree. + +## CDATA sections + +- A CDATA section (``) may appear inside + element content only, never in the prolog or the epilog. +- The text inside is literal. In the model it becomes ordinary + character data in the same text node stream as its neighbours. + CDATA is a spelling, not a tree difference, exactly as the + choice of quote in an attribute is a spelling. The printer + never writes a CDATA section. + +## Comments + +- A comment is ``. The body must not + contain `--` and must not end with `-`. Both are XML's rules, + and they keep the closing marks unambiguous. +- The body is carried as the characters between the marks. +- A comment may appear in the prolog, in content, or in the + epilog, and is a node in place. + +## Processing instructions + +- A processing instruction is `` at once, + or whitespace and data up to `?>`. +- The target `xml` in any letter case is reserved and rejects + (see Documents). +- The data is carried as text. It may be empty. It must not + contain `?>`, and in the model it never starts with + whitespace: the whitespace after the target is a separator, + not part of the data. + +## Document type declarations and other ``. An element read from `` has no content + and also prints as ``: same tree, different spelling. +- In text: `&` as `&`, `<` as `<`, `>` as `>` (always + escaping `>` keeps `]]>` from ever forming in printed text), + and carriage return as ` `. Every other character prints + as itself. +- In attribute values: `&` as `&`, `<` as `<`, `"` as + `"`, and tab, line feed, and carriage return as + ` `, ` `, ` `. A literal tab in a printed value + would read back as a space under normalization, so character + references are how those characters are kept. +- A processing instruction with no data prints as ``; + with data, as `` with one space. +- A document prints as its prolog, its root, and its epilog, + with nothing between them. + +## Well formed trees + +The round trip is claimed for trees that satisfy a well +formedness predicate (`WF` in `Xml/Value.lean`): + +- every name matches the name rule above; +- attribute names are unique per element, and attribute values + hold only legal XML characters; +- text nodes are not empty, hold only legal XML characters, + and two text nodes never stand next to each other (the + parser merges them, so an unmerged tree could not come + back); +- comment bodies hold only legal characters, contain no `--`, + and do not end with `-`; +- processing instruction targets are valid names and not the + reserved word, their data holds only legal characters, never + contains `?>`, and never starts with whitespace; +- the root is an element, and the prolog and epilog hold only + comments and processing instructions. + +## The claim + +Printing a well formed document gives a text that parses to +the same document: `parse (print d) = some d`. The theorem is +`Xml.Proofs.parse_print`. It checks against the standard axioms +only (`propext`, `Classical.choice`, `Quot.sound`), which a +reader can confirm with `#print axioms +Xml.Proofs.parse_print`. + +## Boundaries and named differences + +- No line ending normalization in text, comments, processing + instruction data, or CDATA sections: a literal carriage + return there reads as itself. Full XML normalizes carriage + return and carriage return with line feed to a line feed + before parsing, and Python's ElementTree does so. That is a + difference between this subset and full XML, stated plainly: + a text a full XML parser reads one way can read with a line + feed where this parser keeps a carriage return. Inside + attribute values both readings agree, because normalization + there sends either form to a space, and in printed form a + carriage return is always a character reference. +- No document type declaration, no entities beyond the five, + no namespaces, no XML declaration, ASCII names only. A full + XML parser may accept documents this slice rejects for + exactly those reasons; the test harness counts those as out + of subset disagreements, not failures. +- ElementTree, the one oracle wired into the tests, drops the + prolog and epilog when it reads a document, so the harness + compares ElementTree's tree for the root element and checks + the prolog and epilog through the canonical print. The plan + also names Go's encoding/xml and Rust's quick-xml as oracles; + neither is wired in yet, and the harness says so rather than + counting them. + +## The request protocol + +The command line tool in `Main.lean` reads one request per +line and prints one answer per line. A request is the operation +`parse`, then one space, then the input as comma-separated +decimal character codes. The answer is `ok:` and the character +codes of the canonical print, `none` when the text is +rejected, and `error` when the request itself is malformed (an +unknown operation, a number that is not plain decimal digits, +or a code that is not a Unicode scalar value). A request with +no codes is the empty input, which answers `none`. A line may +end in LF or CR LF. diff --git a/Xml.lean b/Xml.lean new file mode 100644 index 0000000..d2357ca --- /dev/null +++ b/Xml.lean @@ -0,0 +1,2 @@ +import Xml.Value +import Xml.Parse diff --git a/Xml/Parse.lean b/Xml/Parse.lean new file mode 100644 index 0000000..b8f8834 --- /dev/null +++ b/Xml/Parse.lean @@ -0,0 +1,423 @@ +/- + The XML parser for the safe subset. It reads a list of characters + and returns a document, or `none` when the text sits outside the + subset grammar `SPEC.md` states. + + Rules the parser follows: + + - Any ` [] + | c :: cs => if isWs c then skipWs cs else c :: cs + +/-- A digit, as a test. -/ +def isDigit (c : Char) : Bool := + decide ('0' ≤ c ∧ c ≤ '9') + +/-- The value of one hex digit, in either case. -/ +def hexVal (c : Char) : Option Nat := + if '0' ≤ c ∧ c ≤ '9' then some (c.toNat - 48) + else if 'a' ≤ c ∧ c ≤ 'f' then some (c.toNat - 87) + else if 'A' ≤ c ∧ c ≤ 'F' then some (c.toNat - 55) + else none + +/-- A hex digit, as a test. -/ +def isHexDigit (c : Char) : Bool := + (hexVal c).isSome + +/-- The longest run of decimal digits at the head of the text, and + the text after it. -/ +def takeDigits : List Char → List Char × List Char + | [] => ([], []) + | c :: rest => + if isDigit c then + let (ds, r) := takeDigits rest + (c :: ds, r) + else ([], c :: rest) + +/-- The longest run of hex digits at the head of the text, and the + text after it. -/ +def takeHexDigits : List Char → List Char × List Char + | [] => ([], []) + | c :: rest => + if isHexDigit c then + let (ds, r) := takeHexDigits rest + (c :: ds, r) + else ([], c :: rest) + +/-- The value of a run of digits in the given base, where `dv` + gives the value of one digit. An empty run has value zero, + which the character reference check then rejects, since zero + names no legal character. -/ +def digitsValue (base : Nat) (dv : Char → Nat) (ds : List Char) : Nat := + ds.foldl (fun acc d => acc * base + dv d) 0 + +/-- The character a character reference value names, when the + value is a legal XML character; otherwise rejection. -/ +def charRefChar (n : Nat) : Option Char := + if n = 9 ∨ n = 10 ∨ n = 13 ∨ (0x20 ≤ n ∧ n ≤ 0xD7FF) ∨ + (0xE000 ≤ n ∧ n ≤ 0xFFFD) ∨ (0x10000 ≤ n ∧ n ≤ 0x10FFFF) + then some (Char.ofNat n) + else none + +/-- Read a reference, at the text after the ampersand: one of the + five predefined entities, or a character reference. Returns + the character the reference stands for and the text after the + semicolon. -/ +def parseRef : List Char → Option (Char × List Char) + | 'l' :: 't' :: ';' :: rest => some ('<', rest) + | 'g' :: 't' :: ';' :: rest => some ('>', rest) + | 'a' :: 'm' :: 'p' :: ';' :: rest => some ('&', rest) + | 'a' :: 'p' :: 'o' :: 's' :: ';' :: rest => some ('\'', rest) + | 'q' :: 'u' :: 'o' :: 't' :: ';' :: rest => some ('"', rest) + | '#' :: rest => + if rest.head? = some 'x' then + let (ds, r) := takeHexDigits rest.tail + match r with + | ';' :: r2 => (charRefChar (digitsValue 16 (fun d => (hexVal d).getD 0) ds)).map + fun ch => (ch, r2) + | _ => none + else + let (ds, r) := takeDigits rest + match r with + | ';' :: r2 => (charRefChar (digitsValue 10 (fun d => d.toNat - 48) ds)).map + fun ch => (ch, r2) + | _ => none + | _ => none + +/-- The longest run of name characters at the head of the text, + and the text after it. -/ +def takeNameChars : List Char → List Char × List Char + | [] => ([], []) + | c :: rest => + if isNameChar c then + let (ds, r) := takeNameChars rest + (c :: ds, r) + else ([], c :: rest) + +/-- Read a name at the head of the text: a name start character, + then name characters. -/ +def parseName : List Char → Option (List Char × List Char) + | c :: rest => + if isNameStart c then + let (ds, r) := takeNameChars rest + some (c :: ds, r) + else none + | [] => none + +/-- Read character data up to the next less sign or the end of the + text: plain characters that are legal XML characters, and + references. The run `]]>` is rejected, as XML requires. The + fuel bounds the number of characters and references read, + since a reference can stand for one character while taking + several. -/ +def parseTextRun : Nat → List Char → Option (List Char × List Char) + | 0, _ => none + | _ + 1, [] => some ([], []) + | fuel + 1, c :: rest => + if c = '<' then some ([], c :: rest) + else if c = '&' then + match parseRef rest with + | some (ch, r) => (parseTextRun fuel r).map fun (t, r2) => (ch :: t, r2) + | none => none + else if c = ']' then + if rest.head? = some ']' ∧ (rest.tail).head? = some '>' then none + else (parseTextRun fuel rest).map fun (t, r) => (c :: t, r) + else if isLegalChar c then + (parseTextRun fuel rest).map fun (t, r) => (c :: t, r) + else none + +/-- Read the body of a CDATA section, up to the closing marks. The + characters are literal: no reference is read, and the run `]]>` + ends the section wherever it stands. -/ +def parseCDATABody : List Char → Option (List Char × List Char) + | [] => none + | ']' :: ']' :: '>' :: rest => some ([], rest) + | c :: rest => + if isLegalChar c then + (parseCDATABody rest).map fun (t, r) => (c :: t, r) + else none + +/-- Read the body of a comment, up to the closing marks. Two + dashes in a row inside the body are rejected, as XML requires, + so the first closing marks end the comment. -/ +def parseCommentBody : List Char → Option (List Char × List Char) + | [] => none + | c :: rest => + if c = '-' then + match rest with + | '-' :: '>' :: r => some ([], r) + | '-' :: _ => none + | _ => + (parseCommentBody rest).map fun (b, r) => (c :: b, r) + else if isLegalChar c then + (parseCommentBody rest).map fun (b, r) => (c :: b, r) + else none + +/-- Read the data of a processing instruction, up to the closing + marks. The data is literal. -/ +def parsePIData : List Char → Option (List Char × List Char) + | [] => none + | c :: rest => + if c = '?' then + match rest with + | '>' :: r => some ([], r) + | _ => + (parsePIData rest).map fun (d, r) => (c :: d, r) + else if isLegalChar c then + (parsePIData rest).map fun (d, r) => (c :: d, r) + else none + +/-- Read an attribute value, at the text after the opening quote + `q`. Returns the normalized value and the text after the + closing quote. A literal less sign is rejected; a literal tab + or line feed reads as a space; a literal carriage return reads + as one space, with a line feed right after it read as part of + the same return. References read as the characters they name, + with no normalization. The fuel bounds the number of + characters and references read, as in `parseTextRun`. -/ +def parseAttrValue (q : Char) : Nat → List Char → Option (List Char × List Char) + | 0, _ => none + | _ + 1, [] => none + | fuel + 1, c :: rest => + if c = q then some ([], rest) + else if c = '<' then none + else if c = '&' then + match parseRef rest with + | some (ch, r) => (parseAttrValue q fuel r).map fun (v, r2) => (ch :: v, r2) + | none => none + else if c = '\t' ∨ c = '\n' then + (parseAttrValue q fuel rest).map fun (v, r) => (' ' :: v, r) + else if c = '\r' then + match rest with + | '\n' :: rest2 => + (parseAttrValue q fuel rest2).map fun (v, r) => (' ' :: v, r) + | _ => + (parseAttrValue q fuel rest).map fun (v, r) => (' ' :: v, r) + else if isLegalChar c then + (parseAttrValue q fuel rest).map fun (v, r) => (c :: v, r) + else none + +/-- Read one processing instruction, at the text after ` + if target.map Char.toLower = ['x', 'm', 'l'] then none + else + match r1 with + | '?' :: '>' :: r2 => some (.pi target [], r2) + | c :: _ => + if isWs c then + match parsePIData (skipWs r1) with + | some (d, r2) => some (.pi target d, r2) + | none => none + else none + | [] => none + | none => none + +/-- Read character data at the head of the text: plain runs, + references, and CDATA sections, merged into one list of + characters. Stops before a less sign that does not open a CDATA + section, and at the end of the text. -/ +def parseCharData : Nat → List Char → Option (List Char × List Char) + | 0, _ => none + | _ + 1, [] => some ([], []) + | fuel + 1, '<' :: '!' :: '[' :: 'C' :: 'D' :: 'A' :: 'T' :: 'A' :: '[' :: rest => + match parseCDATABody rest with + | some (t, r) => (parseCharData fuel r).map fun (t2, r2) => (t ++ t2, r2) + | none => none + | fuel + 1, '<' :: rest => some ([], '<' :: rest) + | fuel + 1, cs => + match parseTextRun fuel cs with + | some (t, r) => (parseCharData fuel r).map fun (t2, r2) => (t ++ t2, r2) + | none => none + +/-- Read the attributes of a start tag, and how the tag ends. + Attributes read so far are in `acc`, in order. Returns the + attributes, the text after the tag, and whether the tag was + the empty form. A repeated attribute name is rejected. -/ +def parseAttrs : Nat → List (List Char × List Char) → List Char → + Option (List (List Char × List Char) × List Char × Bool) + | 0, _, _ => none + | fuel + 1, acc, cs => + match skipWs cs with + | '/' :: '>' :: rest => some (acc, rest, true) + | '>' :: rest => some (acc, rest, false) + | c :: _ => + if isNameStart c then + match parseName (skipWs cs) with + | some (aname, r1) => + match skipWs r1 with + | '=' :: r2 => + match skipWs r2 with + | '"' :: r3 => + match parseAttrValue '"' fuel r3 with + | some (v, r4) => + if acc.any (fun kv => kv.1 = aname) then none + else parseAttrs fuel (acc ++ [(aname, v)]) r4 + | none => none + | '\'' :: r3 => + match parseAttrValue '\'' fuel r3 with + | some (v, r4) => + if acc.any (fun kv => kv.1 = aname) then none + else parseAttrs fuel (acc ++ [(aname, v)]) r4 + | none => none + | _ => none + | _ => none + | none => none + else none + | [] => none + +mutual +/-- Read one element, at the less sign of its start tag. -/ +def parseElement : Nat → List Char → Option (Node × List Char) + | 0, _ => none + | fuel + 1, cs => + match cs with + | '<' :: rest => + match parseName rest with + | some (name, r1) => + match parseAttrs fuel [] r1 with + | some (attrs, r2, true) => some (.elem name attrs [], r2) + | some (attrs, r2, false) => + match parseNodes fuel r2 with + | some (content, r3) => + match r3 with + | '<' :: '/' :: r4 => + match parseName r4 with + | some (ename, r5) => + match skipWs r5 with + | '>' :: r6 => + if ename = name then some (.elem name attrs content, r6) + else none + | _ => none + | none => none + | _ => none + | none => none + | none => none + | none => none + | _ => none + +/-- Read the content of an element: nodes up to the end tag, which + is not consumed. Also returns at the end of the text. -/ +def parseNodes : Nat → List Char → Option (List Node × List Char) + | 0, _ => none + | fuel + 1, cs => + match cs with + | [] => some ([], []) + | '<' :: '/' :: _ => some ([], cs) + | '<' :: '!' :: '-' :: '-' :: rest => + match parseCommentBody rest with + | some (body, r) => + (parseNodes fuel r).map fun (ns, r2) => (.comment body :: ns, r2) + | none => none + | '<' :: '!' :: '[' :: 'C' :: 'D' :: 'A' :: 'T' :: 'A' :: '[' :: _ => + match parseCharData fuel cs with + | some (t, r) => + if t = [] then parseNodes fuel r + else (parseNodes fuel r).map fun (ns, r2) => (.text t :: ns, r2) + | none => none + | '<' :: '?' :: rest => + match parsePI rest with + | some (n, r) => + (parseNodes fuel r).map fun (ns, r2) => (n :: ns, r2) + | none => none + | '<' :: c :: _ => + if isNameStart c then + match parseElement fuel cs with + | some (n, r) => + (parseNodes fuel r).map fun (ns, r2) => (n :: ns, r2) + | none => none + else none + | '<' :: [] => none + | _ => + match parseCharData fuel cs with + | some (t, r) => + if t = [] then parseNodes fuel r + else (parseNodes fuel r).map fun (ns, r2) => (.text t :: ns, r2) + | none => none +end + +/-- Read the miscellany of a prolog or an epilog: comments and + processing instructions, with whitespace around them. Returns + the nodes and the text that follows, which starts at the first + character that is neither whitespace nor a comment or a + processing instruction. -/ +def parseMisc : Nat → List Char → Option (List Node × List Char) + | 0, _ => none + | fuel + 1, cs => + let s := skipWs cs + match s with + | '<' :: '!' :: '-' :: '-' :: rest => + match parseCommentBody rest with + | some (body, r) => + (parseMisc fuel r).map fun (ns, r2) => (.comment body :: ns, r2) + | none => none + | '<' :: '?' :: rest => + match parsePI rest with + | some (n, r) => + (parseMisc fuel r).map fun (ns, r2) => (n :: ns, r2) + | none => none + | _ => some ([], s) + +/-- Parse a whole text: a prolog, one root element, an epilog, and + nothing else. -/ +def parseDocument (fuel : Nat) (cs : List Char) : Option Document := + match parseMisc fuel cs with + | some (prolog, r1) => + match parseElement fuel r1 with + | some (root, r2) => + match parseMisc fuel r2 with + | some (epilog, r3) => if skipWs r3 = [] then some ⟨prolog, root, epilog⟩ else none + | none => none + | none => none + | none => none + +/-- Parse a whole text, with the fuel the length of the text + allows. -/ +def parse (cs : List Char) : Option Document := + parseDocument (cs.length + 1) cs + +end Xml diff --git a/Xml/Value.lean b/Xml/Value.lean new file mode 100644 index 0000000..650702b --- /dev/null +++ b/Xml/Value.lean @@ -0,0 +1,271 @@ +/- + The XML tree type for the safe subset, the canonical printer, and + the well formed predicate that the round trip proof in `Proofs` + uses. + + The subset is XML 1.0 narrowed as `SPEC.md` states: elements, + attributes, text, comments, and processing instructions, with + character references and CDATA sections read as character data. + There is no document type declaration, no entity beyond the five + predefined ones, no namespace, and no XML declaration. + + A node is one of: + + - `text`: a run of character data, held as a list of characters. + Text written as plain characters, as character references, and + as CDATA sections all lands here as one run: the three are + spellings of the same character data, not different trees. + - `elem`: an element: a name, a list of attribute name and value + pairs in the order held, and a list of content nodes. + - `comment`: a comment, held as the characters between the marks. + - `pi`: a processing instruction: a target name and the data + after it, held as characters. + + A document is a list of prolog nodes (comments and processing + instructions only), one root element, and a list of epilog nodes. + + Attribute values are held normalized, the way the parser reads + them: a literal tab or newline in the source is a space in the + value, and the five predefined entities and the character + references are the characters they stand for. +-/ + +namespace Xml + +/-- A node in a document or in element content. -/ +inductive Node where + | text (cs : List Char) + | elem (name : List Char) (attrs : List (List Char × List Char)) + (content : List Node) + | comment (cs : List Char) + | pi (target : List Char) (data : List Char) + +/-- A document: prolog, one root element, epilog. -/ +structure Document where + prolog : List Node + root : Node + epilog : List Node + +/-! ## Characters and names -/ + +/-- A legal XML character, as a proposition, in code points: tab, + line feed, carriage return, then the ranges of the XML 1.0 + character production. A Lean `Char` is a Unicode scalar value, + so no character here can be half of a surrogate pair; the + surrogate range is excluded all the same, since a character + reference can name it. -/ +def LegalChar (c : Char) : Prop := + c.toNat = 9 ∨ c.toNat = 10 ∨ c.toNat = 13 ∨ + (0x20 ≤ c.toNat ∧ c.toNat ≤ 0xD7FF) ∨ + (0xE000 ≤ c.toNat ∧ c.toNat ≤ 0xFFFD) ∨ + (0x10000 ≤ c.toNat ∧ c.toNat ≤ 0x10FFFF) + +/-- The legal character test the parser runs. -/ +def isLegalChar (c : Char) : Bool := + decide (c.toNat = 9 ∨ c.toNat = 10 ∨ c.toNat = 13 ∨ + (0x20 ≤ c.toNat ∧ c.toNat ≤ 0xD7FF) ∨ + (0xE000 ≤ c.toNat ∧ c.toNat ≤ 0xFFFD) ∨ + (0x10000 ≤ c.toNat ∧ c.toNat ≤ 0x10FFFF)) + +theorem isLegalChar_iff {c : Char} : isLegalChar c = true ↔ LegalChar c := by + simp only [isLegalChar, LegalChar, decide_eq_true_eq] + +/-- The first character of a name in the subset: an ASCII letter or + an underscore. The colon is not a name character in this + subset, since namespaces are out. -/ +def IsNameStart (c : Char) : Prop := + ('A' ≤ c ∧ c ≤ 'Z') ∨ ('a' ≤ c ∧ c ≤ 'z') ∨ c = '_' + +/-- A later character of a name: a name start character, a digit, a + hyphen, or a point. -/ +def IsNameChar (c : Char) : Prop := + IsNameStart c ∨ ('0' ≤ c ∧ c ≤ '9') ∨ c = '-' ∨ c = '.' + +/-- The name start test the parser runs. -/ +def isNameStart (c : Char) : Bool := + decide (('A' ≤ c ∧ c ≤ 'Z') ∨ ('a' ≤ c ∧ c ≤ 'z') ∨ c = '_') + +theorem isNameStart_iff {c : Char} : isNameStart c = true ↔ IsNameStart c := by + simp only [isNameStart, IsNameStart, decide_eq_true_eq] + +/-- The name character test the parser runs. -/ +def isNameChar (c : Char) : Bool := + decide ((('A' ≤ c ∧ c ≤ 'Z') ∨ ('a' ≤ c ∧ c ≤ 'z') ∨ c = '_') ∨ + ('0' ≤ c ∧ c ≤ '9') ∨ c = '-' ∨ c = '.') + +theorem isNameChar_iff {c : Char} : isNameChar c = true ↔ IsNameChar c := by + simp only [isNameChar, IsNameChar, IsNameStart, decide_eq_true_eq] + +/-- A name that follows the subset rule: a name start character, + then name characters. -/ +def ValidName (cs : List Char) : Prop := + ∃ c ds, cs = c :: ds ∧ IsNameStart c ∧ ∀ x ∈ ds, IsNameChar x + +/-- Whitespace in XML: space, tab, line feed, carriage return, as a + proposition. -/ +def IsWs (c : Char) : Prop := + c = ' ' ∨ c = '\t' ∨ c = '\n' ∨ c = '\r' + +/-- No two dashes in a row anywhere in the list, stated as: the + list is never a part, then two dashes, then a part. The body of + a comment must satisfy this. -/ +def NoDashDash (cs : List Char) : Prop := + ∀ pre suf, cs ≠ pre ++ '-' :: '-' :: suf + +/-- The list does not end with a dash. The body of a comment must + also satisfy this, or the closing marks run into the body. -/ +def NotDashEnd (cs : List Char) : Prop := + ∀ pre, cs ≠ pre ++ ['-'] + +/-- No `?>` anywhere in the list, stated as: the list is never a + part, then a question mark and a greater sign, then a part. + The data of a processing instruction must satisfy this. -/ +def NoQClose (cs : List Char) : Prop := + ∀ pre suf, cs ≠ pre ++ '?' :: '>' :: suf + +/-- A processing instruction target is reserved when it is the word + `xml`, in any case. A document whose first processing + instruction target is `xml` is the XML declaration form, which + this subset does not hold. -/ +def IsXmlTarget (t : List Char) : Prop := + t.map Char.toLower = ['x', 'm', 'l'] + +/-! ## The printer -/ + +/-- The printed form of one character of character data. The + ampersand, the less sign, and the greater sign are written as + the predefined entities, so a printed text can never hold the + forbidden `]]>` run. A carriage return is written as a + character reference, so it reads back as itself. Every other + character is written as it is. -/ +def escapeTextChar (c : Char) : List Char := + if c = '&' then ['&', 'a', 'm', 'p', ';'] + else if c = '<' then ['&', 'l', 't', ';'] + else if c = '>' then ['&', 'g', 't', ';'] + else if c = '\r' then ['&', '#', '1', '3', ';'] + else [c] + +/-- The printed form of a run of character data. -/ +def escapeText (cs : List Char) : List Char := + cs.flatMap escapeTextChar + +/-- The printed form of one character of an attribute value. The + ampersand and the less sign are written as entities, the quote + as an entity, and tab, line feed, and carriage return as + character references, because a literal one of those three + would read back as a space under the parser's normalization. + Every other character is written as it is. -/ +def escapeAttrChar (c : Char) : List Char := + if c = '&' then ['&', 'a', 'm', 'p', ';'] + else if c = '<' then ['&', 'l', 't', ';'] + else if c = '"' then ['&', 'q', 'u', 'o', 't', ';'] + else if c = '\t' then ['&', '#', '9', ';'] + else if c = '\n' then ['&', '#', '1', '0', ';'] + else if c = '\r' then ['&', '#', '1', '3', ';'] + else [c] + +/-- The printed form of an attribute value, without the quotes. -/ +def escapeAttr (cs : List Char) : List Char := + cs.flatMap escapeAttrChar + +/-- The printed form of the attribute list: each pair preceded by + one space, the name, an equals sign, and the value in double + quotes. -/ +def printAttrs : List (List Char × List Char) → List Char + | [] => [] + | (k, v) :: rest => + ' ' :: k ++ ('=' :: '"' :: (escapeAttr v ++ '"' :: printAttrs rest)) + +mutual +/-- The canonical printed form of a node. An element with no + content prints in the short form. A processing instruction with + no data prints with no space before the closing marks. -/ +def printNode : Node → List Char + | .text cs => escapeText cs + | .elem name attrs content => printElem name attrs content + | .comment cs => '<' :: '!' :: '-' :: '-' :: (cs ++ '-' :: '-' :: '>' :: []) + | .pi t d => + '<' :: '?' :: + (t ++ (if d = [] then ['?', '>'] else ' ' :: d ++ ['?', '>'])) + +/-- An element in its printed form: the start tag, then the + content and the end tag, or the short form when the content is + empty. -/ +def printElem (name : List Char) (attrs : List (List Char × List Char)) + (content : List Node) : List Char := + '<' :: (name ++ printAttrs attrs ++ + (if content = [] then ['/', '>'] + else '>' :: (printNodes content ++ '<' :: '/' :: (name ++ ['>'])))) + +/-- A list of nodes in its printed form, one after another. -/ +def printNodes : List Node → List Char + | [] => [] + | n :: ns => printNode n ++ printNodes ns +end + +/-- A document in its printed form. -/ +def print (d : Document) : List Char := + printNodes d.prolog ++ printNode d.root ++ printNodes d.epilog + +/-! ## Well formed trees -/ + +/-- Attribute lists the printer can write and the parser reads + back: each name is a valid name, each value holds only legal + characters, no name appears twice, and the rest of the list is + in order. -/ +def AttrsOk : List (List Char × List Char) → Prop + | [] => True + | kv :: rest => + ValidName kv.1 ∧ (∀ c ∈ kv.2, LegalChar c) ∧ + (∀ kv2 ∈ rest, kv2.1 ≠ kv.1) ∧ AttrsOk rest + +mutual +/-- A node the printer can write and the parser reads back as the + same node. A text run is not empty and holds only legal + characters. A comment body has no two dashes in a row, does not + end with a dash, and holds only legal characters. A processing + instruction has a valid target that is not the reserved word, + and data that holds no `?>`, holds only legal characters, and + does not start with whitespace (the printer writes one space + before the data, and the parser skips whitespace there, so a + data value starting with whitespace would lose it). -/ +inductive WFNode : Node → Prop where + | text {cs : List Char} (hne : cs ≠ []) (hlegal : ∀ c ∈ cs, LegalChar c) : + WFNode (.text cs) + | elem {name : List Char} {attrs : List (List Char × List Char)} + {content : List Node} (hname : ValidName name) (hattrs : AttrsOk attrs) + (hcontent : WFNodes content) : WFNode (.elem name attrs content) + | comment {cs : List Char} (hdd : NoDashDash cs) (hde : NotDashEnd cs) + (hlegal : ∀ c ∈ cs, LegalChar c) : WFNode (.comment cs) + | pi {t d : List Char} (hname : ValidName t) (hres : ¬ IsXmlTarget t) + (hq : NoQClose d) (hlegal : ∀ c ∈ d, LegalChar c) + (hstart : d = [] ∨ ∀ c cs, d = c :: cs → ¬ IsWs c) : + WFNode (.pi t d) + +/-- A content list whose nodes are all well formed, with no two + text runs next to each other: the parser merges the character + data between two marks into one run, so a tree with two text + runs side by side would print to a text the parser reads back + as one run. -/ +inductive WFNodes : List Node → Prop where + | nil : WFNodes [] + | cons {n : Node} {ns : List Node} (hn : WFNode n) (hns : WFNodes ns) + (hadj : (∃ cs, n = .text cs) → ∀ cs, ns.head? ≠ some (.text cs)) : + WFNodes (n :: ns) +end + +/-- A node in a prolog or an epilog: a comment or a processing + instruction, and well formed. -/ +def MiscOk (ns : List Node) : Prop := + ∀ n ∈ ns, WFNode n ∧ + ((∃ cs, n = .comment cs) ∨ (∃ t d, n = .pi t d)) + +/-- A document the printer can write and the parser reads back: + prolog and epilog hold only comments and processing + instructions, and the root is an element. -/ +def WF (d : Document) : Prop := + MiscOk d.prolog ∧ WFNode d.root ∧ + (∃ name attrs content, d.root = .elem name attrs content) ∧ + MiscOk d.epilog + +end Xml diff --git a/lake-manifest.json b/lake-manifest.json new file mode 100644 index 0000000..5b8a3ba --- /dev/null +++ b/lake-manifest.json @@ -0,0 +1,6 @@ +{"version": "1.3.0", + "packagesDir": ".lake/packages", + "packages": [], + "name": "xml", + "lakeDir": ".lake", + "fixedToolchain": false} diff --git a/lakefile.toml b/lakefile.toml new file mode 100644 index 0000000..685b22c --- /dev/null +++ b/lakefile.toml @@ -0,0 +1,13 @@ +name = "xml" +version = "0.1.0" +defaultTargets = ["Xml", "Proofs", "xml"] + +[[lean_lib]] +name = "Xml" + +[[lean_lib]] +name = "Proofs" + +[[lean_exe]] +name = "xml" +root = "Main" diff --git a/lean-toolchain b/lean-toolchain new file mode 100644 index 0000000..a6aff06 --- /dev/null +++ b/lean-toolchain @@ -0,0 +1 @@ +leanprover/lean4:v4.35.0 diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md new file mode 100644 index 0000000..cfe0ecd --- /dev/null +++ b/tests/TEST-RESULTS.md @@ -0,0 +1,20 @@ +# Test results + +Written by `tests/run_tests.py`. Rerun it to check these numbers. + +- Oracle: Python 3.12.3 `xml.etree.ElementTree` (expat), subset mode as described in the harness +- Lean tool: Lean (version 4.35.0, x86_64-unknown-linux-gnu, commit eb6cafb7290e8bd5f2937522d8d804f58f02bafc, Release) +- Seed: 20261026 +- Fixed cases passed: 35 of 35 +- Generated in-subset documents: 3200 +- Generated documents where the tool's canonical print matches the tree and ElementTree agrees on the tree: 3200 +- ElementTree tree agreements on generated documents: 3200 +- Named rejections rejected by the tool: 43 of 43 +- Out of subset disagreements (ElementTree accepts, this slice rejects, by design): 4 + - document type declaration + - document type declaration with internal subset + - colon in an attribute name + - the XML declaration form +- Malformed requests answered error: 10 of 10 +- Bare parse requests answered none: yes +- Failures: 0 diff --git a/tests/run_tests.py b/tests/run_tests.py new file mode 100644 index 0000000..001121f --- /dev/null +++ b/tests/run_tests.py @@ -0,0 +1,745 @@ +#!/usr/bin/env python3 +"""Tests for the Lean XML safe-subset parser and printer. + +Three parts. + +1. Fixed cases: hand written documents covering each feature of + the subset (nesting, both quote forms, empty elements in both + spellings, attribute references and tab normalization, text + with the five entities and numeric references in both bases, + CDATA holding markup-like text, comments in the prolog, the + content, and the epilog, processing instructions, mixed + content). For each, the Lean answer must be the canonical + print written here. + +2. A differential run against Python's `xml.etree.ElementTree`, + with a recorded seed. Random documents inside the subset are + built as trees in Python, then spelled in XML with random + choices that do not change the tree: quote choice, CDATA + spellings of text, entity and character reference spellings, + the two empty element spellings, literal whitespace in + attribute values (which the subset normalizes to a space). + For every document: + + - the Lean tool must accept it, and its canonical print must + equal the canonical print computed in Python from the tree; + - ElementTree must accept it, and the tree ElementTree reads + (for the root element; ElementTree does not keep the prolog + and epilog) must equal the tree that was generated. + + Named differences, counted apart and not failures: + + - ElementTree normalizes a literal carriage return in text, + comments, processing instruction data, and CDATA to a line + feed (XML line ending normalization). This slice keeps the + carriage return as it is; it is a stated boundary in + SPEC.md. The generator therefore never writes a literal + carriage return in those positions (a carriage return in a + tree is always spelled as a character reference there). + Literal carriage returns and tabs in attribute values are + fine: both sides read them as a space. + +3. Named rejections: one input per rejection rule in SPEC.md. + The Lean tool must reject every one. ElementTree agrees with + most of them; where ElementTree accepts (a document type + declaration, a colon in a name, the XML declaration form), + that is an out of subset disagreement, counted apart, because + the subset is narrower than XML by design. + +Malformed request lines must be answered `error`, as in the +other slices' harnesses. + + python3 tests/run_tests.py [--seed N] [--count N] + +The tool is built first if needed, driven in batches of request +lines, and the results are written to tests/TEST-RESULTS.md. +The exit code is non-zero if any check fails. Python 3.11+. +""" + +import argparse +import random +import subprocess +import sys +import xml.etree.ElementTree as ET +from pathlib import Path + +ROOT = Path(__file__).resolve().parent.parent +EXE = ROOT / ".lake" / "build" / "bin" / "xml" +RESULTS = ROOT / "tests" / "TEST-RESULTS.md" +TIMEOUT = 900 +BUILD_TIMEOUT = 3600 +CHUNK = 2000 + +SEED_DEFAULT = 20261026 +COUNT_DEFAULT = 3200 + + +# ---------------------------------------------------------------- +# The tree model, mirroring Xml/Value.lean. +# +# A node is one of: +# ("text", s) +# ("elem", name, [(attr, value), ...], [node, ...]) +# ("comment", s) +# ("pi", target, data) +# A document is (prolog, root, epilog) with prolog and epilog +# lists of comment and pi nodes. + + +def escape_text(s): + out = [] + for c in s: + if c == "&": + out.append("&") + elif c == "<": + out.append("<") + elif c == ">": + out.append(">") + elif c == "\r": + out.append(" ") + else: + out.append(c) + return "".join(out) + + +def escape_attr(s): + out = [] + for c in s: + if c == "&": + out.append("&") + elif c == "<": + out.append("<") + elif c == '"': + out.append(""") + elif c == "\t": + out.append(" ") + elif c == "\n": + out.append(" ") + elif c == "\r": + out.append(" ") + else: + out.append(c) + return "".join(out) + + +def print_node(n): + kind = n[0] + if kind == "text": + return escape_text(n[1]) + if kind == "comment": + return "" + if kind == "pi": + if n[2] == "": + return "" + return "" + _, name, attrs, content = n + parts = ["<" + name] + for k, v in attrs: + parts.append(" " + k + '="' + escape_attr(v) + '"') + if not content: + parts.append("/>") + else: + parts.append(">") + for c in content: + parts.append(print_node(c)) + parts.append("") + return "".join(parts) + + +def print_doc(doc): + prolog, root, epilog = doc + return ("".join(print_node(n) for n in prolog) + + print_node(root) + + "".join(print_node(n) for n in epilog)) + + +# ---------------------------------------------------------------- +# ElementTree reading, converted to the model. Only the root +# element is compared: ElementTree drops the prolog and epilog. + + +def et_to_model(elem): + if elem.tag is ET.Comment: + return ("comment", elem.text or "") + if elem.tag is ET.ProcessingInstruction: + text = elem.text or "" + if " " in text: + target, data = text.split(" ", 1) + else: + target, data = text, "" + return ("pi", target, data) + content = [] + if elem.text: + content.append(("text", elem.text)) + for child in elem: + content.append(et_to_model(child)) + if child.tail: + content.append(("text", child.tail)) + return ("elem", elem.tag, list(elem.attrib.items()), content) + + +def et_parse(text): + builder = ET.TreeBuilder(insert_comments=True, insert_pis=True) + return ET.fromstring(text, parser=ET.XMLParser(target=builder)) + + +# ---------------------------------------------------------------- +# The tool driver: one request per line, character codes. + + +def codes(text): + return ",".join(str(ord(c)) for c in text) + + +def request(text): + return "parse " + codes(text) + + +def run_tool(lines, timeout=TIMEOUT): + proc = subprocess.Popen( + [str(EXE)], stdin=subprocess.PIPE, stdout=subprocess.PIPE, + stderr=subprocess.PIPE) + try: + out, _ = proc.communicate( + ("\n".join(lines) + "\n").encode(), timeout=timeout) + except subprocess.TimeoutExpired: + proc.kill() + raise + return out.decode().splitlines() + + +def run_requests(texts): + lines = [request(t) for t in texts] + answers = [] + for i in range(0, len(lines), CHUNK): + answers.extend(run_tool(lines[i:i + CHUNK])) + return answers + + +# ---------------------------------------------------------------- +# Fixed cases: (input, expected canonical print). + +FIXED = [ + ("", ""), + ("", ""), + ("x", "x"), + ("deep", "deep"), + ("t", 't'), + ("x", 'x'), + ("x", "x"), + # literal tab and newline in a value read as a space; a + # character reference to a tab stays a tab + ("", ''), + ("", ''), + ("", + ''), + ("<>&'"", "<>&'\""), + ("ABc", "ABc"), + ("éé", "éé"), + ("1 > 0 and 2 < 3", "1 > 0 and 2 < 3"), + (" & z]]>", "x <y> & z"), + ("t1t3", "t1t2t3"), + ("]]>", "]>"), + ("", ""), + ("", ""), + ("", ""), + ("", ""), + ("", ""), + ("", ""), + ("", ""), + ("xyzw", "xyzw"), + ("", ''), + ("x", "x"), + (" ", " "), + ("", ''), + ("text with ] and ]] but no close", + "text with ] and ]] but no close"), + ("<_x.y-z_9/>", "<_x.y-z_9/>"), + ("", ''), + ("\n spaced\n", "\n spaced\n"), + ("", ""), + ("t", + "t"), +] + +# Named rejections: (rule, input). ElementTree's verdict is +# recorded for each; where it accepts, the case is an out of +# subset disagreement, not a failure. +REJECTIONS = [ + ("document type declaration", ""), + ("document type declaration with internal subset", + "]>&e;"), + ("entity declaration door (any other "), + ("undefined entity", " "), + ("undefined entity in an attribute", ""), + ("mismatched tags", ""), + ("mismatched tags, nested", ""), + ("unclosed element", ""), + ("unclosed element after content", ""), + ("a second root element", ""), + ("text before the root", "x"), + ("text after the root", "x"), + ("duplicate attribute", ""), + ("raw < in an attribute value", ""), + ("]]> in text", "x]]>y"), + ("-- inside a comment", ""), + ("comment ending in a dash", ""), + ("surrogate character reference", "�"), + ("zero character reference", "�"), + ("character reference past the last character", + "�"), + ("colon in a name", ""), + ("colon in an attribute name", ""), + ("name starting with a digit", "<1a/>"), + ("attribute name starting with a digit", ""), + ("unquoted attribute value", ""), + ("missing equals", ""), + ("CDATA section in the prolog", ""), + ("CDATA section in the epilog", ""), + ("the XML declaration form", ""), + ("the XML declaration, upper case target", + ""), + ("bare ampersand in text", "a & b"), + ("reference without a semicolon", "&"), + ("empty reference", "&;"), + ("hex reference with no digits", "&#x;"), + ("control character reference", " "), + ("raw control character in text", "x\x0by"), + ("unterminated comment", ""), +] + +MALFORMED = [ + "parse x", + "parse 60,,62", + "parse 60, 62", + "parse -1", + "parse 1114112", + "parse 55296", + "print 60", + "PARSE 60", + "parse 60 62", + "", +] + +# parse with no codes is a plain empty input, not malformed: +# it must answer none (the empty text is not a document). + + +# ---------------------------------------------------------------- +# The generator: random trees in the subset, spelled with random +# choices that do not change the tree. Each generated case is +# (spelling, model document). The model is built alongside the +# spelling, token by token, so that the two always agree: a +# literal tab spelled in an attribute value is a space in the +# model, a character reference to a tab is a tab in the model. + +NAME_START = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_" +NAME_CHARS = NAME_START + "0123456789.-" +TEXT_PLAIN = ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" + "0123456789 .,;:!?()[]{}+-*/=_%$#@~^|") +COMMENT_WORDS = ["note", "a", "draft-1", "x", "see above", "ok", + "todo: fix", "caf\u00e9", "na\u00efve", "123"] + + +def gen_name(rng): + n = rng.randint(1, 7) + return rng.choice(NAME_START) + "".join( + rng.choice(NAME_CHARS) for _ in range(n - 1)) + + +def spell_text_char(rng, c, emitted): + """One spelling of a text character, and it is never a raw + less sign, a raw ampersand, or a raw greater sign right after + two right brackets.""" + if c == "&": + return "&" + if c == "<": + return "<" + if c == ">": + if rng.random() < 0.5: + return ">" + return ">" + if c == "\r": + return rng.choice([" ", " "]) + if c == "\n" or c == "\t": + return c + r = rng.random() + if r < 0.06: + return "&#%d;" % ord(c) + if r < 0.10: + return "&#x%X;" % ord(c) + return c + + +def gen_text_run(rng): + """A text run: returns (spelling, model text). The spelling + may split the run into plain pieces and CDATA sections; the + model is one merged run.""" + n = rng.randint(1, 14) + chars = [] + for _ in range(n): + r = rng.random() + if r < 0.72: + chars.append(rng.choice(TEXT_PLAIN)) + elif r < 0.78: + chars.append("&") + elif r < 0.84: + chars.append("<") + elif r < 0.90: + chars.append(">") + elif r < 0.94: + chars.append("\r") + elif r < 0.97: + chars.append("'") + else: + chars.append('"') + model = "".join(chars) + # Spell it: choose up to two cut points where a CDATA section + # starts or ends. Inside CDATA everything is literal except + # the model holds no ]]> (it cannot: > after ]] is possible, + # so keep CDATA pieces free of a ] ] > run by construction: + # a CDATA piece may not end with ]] when the next model char + # is >, and may not contain ]]> at all. The generator simply + # avoids CDATA around ] characters. + pieces = [] + i = 0 + emitted = "" + while i < len(chars): + if (rng.random() < 0.3 and chars[i] != "]" + and (i + 1 >= len(chars) or chars[i + 1] != "]")): + j = i + buf = [] + while (j < len(chars) and chars[j] not in "<&" + and chars[j] != "\r" + and not (chars[j] == "]" and j + 1 < len(chars) + and chars[j + 1] == "]")): + buf.append(chars[j]) + j += 1 + if buf and buf[-1] != "]": + pieces.append("") + emitted += "".join(buf) + i = j + continue + sp = spell_text_char(rng, chars[i], emitted) + pieces.append(sp) + emitted += chars[i] + i += 1 + return "".join(pieces), model + + +def gen_attr_value(rng): + """Returns (spelling inside the quotes, model value, quote). + The quote is chosen so a literal quote of the other kind may + appear.""" + quote = rng.choice(['"', "'"]) + toks = [] + model = [] + for _ in range(rng.randint(0, 10)): + r = rng.random() + if r < 0.55: + c = rng.choice(TEXT_PLAIN) + toks.append(c) + model.append(c) + elif r < 0.62: + toks.append("\t") # literal tab: model space + model.append(" ") + elif r < 0.68: + # literal newline: a model space, unless it completes + # a literal CRLF pair, which reads as one space + if not (toks and toks[-1] == "\r"): + model.append(" ") + toks.append("\n") + elif r < 0.72: + toks.append("\r") # literal CR: model space + model.append(" ") + elif r < 0.78: + toks.append(" ") + model.append("\t") + elif r < 0.82: + toks.append(" ") + model.append("\n") + elif r < 0.86: + toks.append(" ") + model.append("\r") + elif r < 0.90: + toks.append("<") + model.append("<") + elif r < 0.93: + toks.append("&") + model.append("&") + elif r < 0.96: + other = "'" if quote == '"' else '"' + toks.append(other) + model.append(other) + else: + toks.append(""" if quote == '"' else "'") + model.append(quote) + return "".join(toks), "".join(model), quote + + +def gen_comment(rng): + words = [rng.choice(COMMENT_WORDS) + for _ in range(rng.randint(0, 4))] + body = " " + " ".join(words) + " " if words else "" + if rng.random() < 0.3: + body = body + "- x " + return "", ("comment", body) + + +def gen_pi(rng): + target = gen_name(rng) + while target.lower() == "xml": + target = gen_name(rng) + if rng.random() < 0.35: + return "", ("pi", target, "") + words = [rng.choice(COMMENT_WORDS) + for _ in range(rng.randint(1, 3))] + data = " ".join(words) + return ("", + ("pi", target, data)) + + +def gen_element(rng, depth): + name = gen_name(rng) + used = set() + attrs = [] + attr_spell = [] + for _ in range(rng.randint(0, 3)): + an = gen_name(rng) + if an in used: + continue + used.add(an) + sp, val, q = gen_attr_value(rng) + attrs.append((an, val)) + eq = rng.choice(["=", " = ", "= ", " ="]) + attr_spell.append(" " + an + eq + q + sp + q) + content = [] + content_spell = [] + if depth < 4: + for _ in range(rng.randint(0, 4)): + r = rng.random() + if r < 0.38: + sub_sp, sub = gen_element(rng, depth + 1) + content.append(sub) + content_spell.append(sub_sp) + elif r < 0.52: + sp, node = gen_comment(rng) + content.append(node) + content_spell.append(sp) + elif r < 0.62: + sp, node = gen_pi(rng) + content.append(node) + content_spell.append(sp) + else: + sp, model = gen_text_run(rng) + if content and content[-1][0] == "text": + content[-1] = ("text", content[-1][1] + model) + else: + content.append(("text", model)) + content_spell.append(sp) + model = ("elem", name, attrs, content) + if not content: + if rng.random() < 0.5: + return "<" + name + "".join(attr_spell) + "/>", model + return ("<" + name + "".join(attr_spell) + ">", + model) + return ("<" + name + "".join(attr_spell) + ">" + + "".join(content_spell) + "", model) + + +def gen_document(rng): + prolog = [] + prolog_spell = [] + for _ in range(rng.randint(0, 2)): + if rng.random() < 0.5: + sp, node = gen_comment(rng) + else: + sp, node = gen_pi(rng) + prolog.append(node) + prolog_spell.append(sp) + root_sp, root = gen_element(rng, 0) + epilog = [] + epilog_spell = [] + for _ in range(rng.randint(0, 2)): + if rng.random() < 0.5: + sp, node = gen_comment(rng) + else: + sp, node = gen_pi(rng) + epilog.append(node) + epilog_spell.append(sp) + text = "".join(prolog_spell) + root_sp + "".join(epilog_spell) + return text, (prolog, root, epilog) + + +# ---------------------------------------------------------------- + + +def build_exe(): + if EXE.exists(): + return + subprocess.run(["lake", "build"], cwd=ROOT, check=True, + timeout=BUILD_TIMEOUT) + + +def lean_version(): + out = subprocess.run(["lean", "--version"], capture_output=True, + text=True, timeout=60, + env={**__import__("os").environ, + "PATH": str(Path.home() / ".elan" / "bin") + + ":" + __import__("os").environ["PATH"]}) + return out.stdout.strip() or "unknown" + + +def main(): + ap = argparse.ArgumentParser() + ap.add_argument("--seed", type=int, default=SEED_DEFAULT) + ap.add_argument("--count", type=int, default=COUNT_DEFAULT) + args = ap.parse_args() + rng = random.Random(args.seed) + + build_exe() + failures = [] + + # Part 1: fixed cases. + inputs = [t for t, _ in FIXED] + answers = run_requests(inputs) + fixed_ok = 0 + if len(answers) != len(inputs): + failures.append("fixed: tool gave %d answers for %d requests" + % (len(answers), len(inputs))) + answers += [""] * (len(inputs) - len(answers)) + for (text, expected), ans in zip(FIXED, answers): + want = "ok:" + codes(expected) + if ans == want: + fixed_ok += 1 + else: + failures.append("fixed case %r: got %r, want %r" + % (text, ans, want)) + + # Part 2: generated differential. + gen_inputs = [] + gen_docs = [] + for _ in range(args.count): + text, doc = gen_document(rng) + gen_inputs.append(text) + gen_docs.append(doc) + answers = run_requests(gen_inputs) + gen_ok = 0 + et_ok = 0 + gen_fail = 0 + for text, doc, ans in zip(gen_inputs, gen_docs, answers): + want = "ok:" + codes(print_doc(doc)) + good = True + if ans != want: + good = False + if gen_fail < 10: + failures.append( + "generated: tool answer differs for %r: got %r..." + % (text, ans[:120])) + try: + et_root = et_parse(text) + if et_to_model(et_root) != doc[1]: + good = False + if gen_fail < 10: + failures.append( + "generated: ElementTree tree differs for %r" + % (text,)) + else: + et_ok += 1 + et_canon = et_parse(print_doc(doc)) + if et_to_model(et_canon) != doc[1]: + good = False + if gen_fail < 10: + failures.append( + "generated: ElementTree tree of the print " + "differs for %r" % (text,)) + except ET.ParseError: + good = False + if gen_fail < 10: + failures.append( + "generated: ElementTree rejected in-subset %r" + % (text,)) + if good: + gen_ok += 1 + else: + gen_fail += 1 + + # Part 3: named rejections. Also record ElementTree's verdict + # on each: accepted means an out of subset disagreement. + rej_inputs = [t for _, t in REJECTIONS] + answers = run_requests(rej_inputs) + rej_ok = 0 + oos = [] + for (rule, text), ans in zip(REJECTIONS, answers): + if ans == "none": + rej_ok += 1 + else: + failures.append("rejection %s: tool answered %r for %r" + % (rule, ans, text)) + try: + et_parse(text) + oos.append(rule) + except ET.ParseError: + pass + + # Malformed requests. + bad_answers = run_tool(MALFORMED) + bad_ok = 0 + for line, ans in zip(MALFORMED, bad_answers): + if ans == "error": + bad_ok += 1 + else: + failures.append("malformed %r: got %r, want error" + % (line, ans)) + empty_ans = run_tool(["parse", "parse "]) + if empty_ans != ["none", "none"]: + failures.append("bare 'parse' answered %r, want two nones" + % (empty_ans,)) + + lines = [] + lines.append("# Test results") + lines.append("") + lines.append("Written by `tests/run_tests.py`. Rerun it to " + "check these numbers.") + lines.append("") + lines.append("- Oracle: Python %s `xml.etree.ElementTree` " + "(expat), subset mode as described in the harness" + % sys.version.split()[0]) + lines.append("- Lean tool: %s" % lean_version()) + lines.append("- Seed: %d" % args.seed) + lines.append("- Fixed cases passed: %d of %d" + % (fixed_ok, len(FIXED))) + lines.append("- Generated in-subset documents: %d" % len(gen_inputs)) + lines.append("- Generated documents where the tool's canonical " + "print matches the tree and ElementTree agrees on " + "the tree: %d" % gen_ok) + lines.append("- ElementTree tree agreements on generated " + "documents: %d" % et_ok) + lines.append("- Named rejections rejected by the tool: %d of %d" + % (rej_ok, len(REJECTIONS))) + lines.append("- Out of subset disagreements (ElementTree " + "accepts, this slice rejects, by design): %d" + % len(oos)) + for rule in oos: + lines.append(" - %s" % rule) + lines.append("- Malformed requests answered error: %d of %d" + % (bad_ok, len(MALFORMED))) + lines.append("- Bare parse requests answered none: %s" + % ("yes" if empty_ans == ["none", "none"] else "no")) + lines.append("- Failures: %d" % len(failures)) + for f in failures[:40]: + lines.append(" - %s" % f) + RESULTS.write_text("\n".join(lines) + "\n") + print("\n".join(lines)) + return 1 if failures else 0 + + +if __name__ == "__main__": + sys.exit(main()) From 4875cec609f0247a2b37c778d4cbe59882926736 Mon Sep 17 00:00:00 2001 From: shah Date: Tue, 27 Oct 2026 20:11:31 -0500 Subject: [PATCH 02/18] Add the bar file set: Spec.lean, comparator.json, bar.toml, CI workflow --- .github/workflows/bar.yml | 21 ++++ Proofs.lean | 1 + Proofs/SpecProofs.lean | 102 +++++++++++++++++++ README.md | 205 +++++++++++++++++++++++++++++--------- SPEC.md | 57 +++++++++-- Spec.lean | 115 +++++++++++++++++++++ bar.toml | 52 ++++++++++ comparator.json | 1 + lakefile.toml | 3 + 9 files changed, 500 insertions(+), 57 deletions(-) create mode 100644 .github/workflows/bar.yml create mode 100644 Proofs/SpecProofs.lean create mode 100644 Spec.lean create mode 100644 bar.toml create mode 100644 comparator.json diff --git a/.github/workflows/bar.yml b/.github/workflows/bar.yml new file mode 100644 index 0000000..32457ed --- /dev/null +++ b/.github/workflows/bar.yml @@ -0,0 +1,21 @@ +name: verified bar + +on: + push: + pull_request: + # Rerun when the spec reviewer approves, or an approval is dismissed. + pull_request_review: + types: [submitted, dismissed] + +jobs: + bar: + # pull-requests: read lets the check confirm the spec approval on GitHub. + permissions: + contents: read + pull-requests: read + # Both lines pin the same commit of Proven-Commons/mission: bar v2, as + # proposed in its pull request #2. Move both to a release tag once + # mission publishes one. + uses: Proven-Commons/mission/.github/workflows/verified-bar.yml@6ba85c27abaaf07905c9316aa96dc29f7b5847a2 + with: + bar-ref: 6ba85c27abaaf07905c9316aa96dc29f7b5847a2 diff --git a/Proofs.lean b/Proofs.lean index 1a31d95..2a0b7e9 100644 --- a/Proofs.lean +++ b/Proofs.lean @@ -1 +1,2 @@ import Proofs.RoundTrip +import Proofs.SpecProofs diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean new file mode 100644 index 0000000..f7af403 --- /dev/null +++ b/Proofs/SpecProofs.lean @@ -0,0 +1,102 @@ +/- + Proofs of the statements in `Spec.lean`, under the same names. + + The round trip is the theorem proved in + `Proofs/RoundTrip.lean`. The refusals are single inputs, + checked in the kernel with `decide +kernel`: no native + evaluation, which the bar forbids. +-/ + +import Xml +import Proofs.RoundTrip + +open Xml + +theorem Spec.parse_print (d : Document) (hwf : WF d) : + parse (print d) = some d := + Xml.Proofs.parse_print d hwf + + +theorem Spec.rejects_doctype : + (parse "".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_undefined_entity : + (parse " ".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_mismatched_tags : + (parse "".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_unclosed_element : + (parse "".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_second_root : + (parse "".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_text_before_root : + (parse "x".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_duplicate_attribute : + (parse "".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_lt_in_attribute : + (parse "".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_cdata_close_in_text : + (parse "x]]>y".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_dashdash_in_comment : + (parse "".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_surrogate_ref : + (parse "�".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_zero_ref : + (parse "�".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_colon_in_name : + (parse "".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_digit_name : + (parse "<1a/>".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_unquoted_attribute : + (parse "".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_cdata_in_prolog : + (parse "".toList).isSome = false := by + decide +kernel + + +theorem Spec.rejects_xml_declaration : + (parse "".toList).isSome = false := by + decide +kernel diff --git a/README.md b/README.md index 86ac722..4e1958d 100644 --- a/README.md +++ b/README.md @@ -1,68 +1,179 @@ # xml: an XML safe-subset parser and printer, with a proved round trip -A parser and printer in Lean for a safe subset of XML 1.0: elements, attributes, text, comments, processing instructions, character references, and CDATA sections, with one root element. There is no document type declaration, no entity declarations, no namespaces, and no XML declaration in the subset; a document with any of those is rejected, not parsed leniently. The printer writes one canonical form. The main claim is proved: printing a well formed document gives a text that parses to the same document. The tests run the parser against Python's `xml.etree.ElementTree` in subset mode; see `tests/TEST-RESULTS.md` for the counts. The full subset rules are in `SPEC.md`. +Status: in-progress + +A parser and printer in Lean for a safe subset of XML 1.0: +elements, attributes, text, comments, processing +instructions, character references, and CDATA sections, +with one root element. There is no document type +declaration, no entity declarations, no namespaces, and +no XML declaration in the subset; a document with any of +those is rejected, not parsed leniently. The definitions +are in `Xml/Value.lean` (the tree type, the printer, and +the well-formedness rules) and `Xml/Parse.lean` (the +parser). The proofs are in `Proofs/RoundTrip.lean`. The +full subset rules are in `SPEC.md`. + +The statements a reviewer approves are in `Spec.lean`, +with their proofs in `Proofs/SpecProofs.lean`. No reviewer +has approved them yet, so this project is not called +verified. + +## How to run it + +Needs Linux and [elan](https://github.com/leanprover/elan). +`lake build` builds the library, the proofs, and the +command line tool. The tool reads one request per line: +the word `parse`, a space, and the text as +comma-separated decimal character codes. It answers +`ok:` and the character codes of the canonical print +when the text parses, `none` when it is rejected, and +`error` when the request itself is malformed. -Status: in progress. The specification has not yet been approved by a reviewer apart from its author, and no statement file (`Spec.lean`) has been added by a reviewer, so this is not verified. +``` +echo "parse 60,97,47,62" | .lake/build/bin/xml +``` + +That request is the text ``, and the answer is +`ok:60,97,47,62`. See `SPEC.md` for the full protocol. + +`python3 tests/run_tests.py` rebuilds the tool if needed, +runs the fixed cases, and runs the differential tests +against Python's `xml.etree.ElementTree` in subset mode +with a fixed seed, writing the counts to +`tests/TEST-RESULTS.md`. ## What is proved -The definitions are in `Xml/Value.lean` (the tree type, the printer, and the well-formedness rules) and `Xml/Parse.lean` (the parser). The proofs are in `Proofs/RoundTrip.lean`. +Each claim below names the theorem behind it. The +theorems are stated in `Spec.lean` (the challenge file, +where they end in `sorry`) and proved in +`Proofs/SpecProofs.lean`, under the same names. +`comparator.json` lists all of them. | Claim | Theorem | |-------|---------| -| Parsing the printed form of a well formed document gives the document back. | `Xml.Proofs.parse_print` | -| The same for one element and for a list of content nodes, proved together by strong induction on the length of the printed form. | `Xml.Proofs.elem_nodes` | -| The same for a prolog or epilog list of comments and processing instructions. | `Xml.Proofs.parseMisc_print` | -| Reading back a printed comment body gives the body back. | `Xml.Proofs.parseCommentBody_print` | -| Reading back a printed processing instruction gives the instruction back. | `Xml.Proofs.parsePI_print` | -| Reading back escaped text and escaped attribute values gives the characters back. | `Xml.Proofs.parseCharData_escapeText`, `Xml.Proofs.parseAttrValue_escapeAttr` | - -A document is well formed when its names match the subset's name rule, attribute names are unique per element, text holds only legal XML characters and no two text runs stand next to each other, comment bodies contain no `--` and do not end with `-`, processing instruction targets are valid and not the reserved word `xml`, and the prolog and epilog hold only comments and processing instructions. `SPEC.md` states the rules in full. `parse_print` checks against the standard axioms only (`propext`, `Classical.choice`, `Quot.sound`), which a reader can confirm with `#print axioms Xml.Proofs.parse_print`. - -The command-line tool in `Main.lean` calls these functions directly. +| Parsing the printed form of a well formed document gives the document back. | `Spec.parse_print` | +| A document carrying a document type declaration is refused. | `Spec.rejects_doctype` | +| A reference to an entity the subset does not define is refused. | `Spec.rejects_undefined_entity` | +| An end tag that does not match the start tag is refused. | `Spec.rejects_mismatched_tags` | +| An element with no end tag is refused. | `Spec.rejects_unclosed_element` | +| A second root element is refused. | `Spec.rejects_second_root` | +| Character data before the root element is refused. | `Spec.rejects_text_before_root` | +| An attribute name standing twice on one element is refused. | `Spec.rejects_duplicate_attribute` | +| A raw less sign inside an attribute value is refused. | `Spec.rejects_lt_in_attribute` | +| The run `]]>` inside text is refused. | `Spec.rejects_cdata_close_in_text` | +| Two dashes in a row inside a comment body are refused. | `Spec.rejects_dashdash_in_comment` | +| A character reference naming a surrogate value is refused. | `Spec.rejects_surrogate_ref` | +| A character reference naming zero is refused. | `Spec.rejects_zero_ref` | +| A colon in a name is refused. | `Spec.rejects_colon_in_name` | +| A name starting with a digit is refused. | `Spec.rejects_digit_name` | +| An attribute value with no quotes is refused. | `Spec.rejects_unquoted_attribute` | +| A CDATA section in the prolog is refused. | `Spec.rejects_cdata_in_prolog` | +| The XML declaration form is refused. | `Spec.rejects_xml_declaration` | + +A document is well formed when its names match the +subset's name rule, attribute names are unique per +element, text holds only legal XML characters and no two +text runs stand next to each other, comment bodies +contain no `--` and do not end with `-`, processing +instruction targets are valid and not the reserved word +`xml`, and the prolog and epilog hold only comments and +processing instructions. `SPEC.md` states the rules in +full. + +The round trip theorem rests on the proof in +`Proofs/RoundTrip.lean`, where it is +`Xml.Proofs.parse_print`. It uses no axiom but the three +standard ones (`propext`, `Classical.choice`, +`Quot.sound`): `comparator.json` names those three as the +permitted axioms, and `lake comparator` checks each proof +in `Proofs/SpecProofs.lean` against its statement in +`Spec.lean` and against that list. The refusal theorems +are single inputs checked in the kernel with +`decide +kernel`. + +The command line tool in `Main.lean` calls `Xml.parse` +and `Xml.print` directly, the same functions the theorems +are about. ## What is not proved -- That the parser accepts every text the subset allows, and rejects every text it forbids. The round trip does not need either, so neither is proved. The differential tests check that behaviour instead, and the results file records the outcome, including any failure. -- Anything about documents outside the subset: documents with a document type declaration, entities beyond the five predefined ones, namespaces, an XML declaration, or non-ASCII names. The parser rejects them; whether a full XML parser would accept them is not a claim here. -- Reading requests and printing answers in `Main.lean`: splitting lines, the decimal parser, and the check that a code is a Unicode scalar value. The tests cover them, malformed requests included. -- Speed. The code works on lists of characters, which suits proofs, not large data. The parser's fuel is the length of the input text, which very deep inputs can reach. +- That the parser accepts every text the subset allows, + and rejects every text it forbids. The round trip does + not need either, and the refusal theorems pin single + inputs only, so neither holds in general as a proof. + The differential tests check that behaviour instead, + and the results file records the outcome, including any + failure. +- Anything about documents outside the subset: documents + with a document type declaration, entities beyond the + five predefined ones, namespaces, an XML declaration, + or non-ASCII names. The parser rejects them; whether a + full XML parser would accept them is not a claim here. +- Reading requests and printing answers in `Main.lean`: + splitting lines, the decimal parser, and the check that + a code is a Unicode scalar value. The tests cover them, + malformed requests included. +- Speed. The code works on lists of characters, which + suits proofs, not large data. The parser's fuel is the + length of the input text, which very deep inputs can + reach. Three deliberate choices, also stated in `SPEC.md`: -- CDATA sections are a spelling, not a tree difference. CDATA content becomes ordinary character data in the same text node stream, and the printer never writes a CDATA section. The claim is at tree level, so this is sound. -- There is no line ending normalization in text, comments, processing instruction data, or CDATA: a literal carriage return reads as itself. Full XML normalizes it to a line feed. Inside attribute values both readings agree (either form reads as a space), and the printer always writes a carriage return as a character reference. -- The XML declaration is not in the model. A processing instruction target of `xml` in any letter case rejects everywhere, which keeps the declaration out. +- CDATA sections are a spelling, not a tree difference. + CDATA content becomes ordinary character data in the + same text node stream, and the printer never writes a + CDATA section. The claim is at tree level, so this is + sound. +- There is no line ending normalization in text, + comments, processing instruction data, or CDATA: a + literal carriage return reads as itself. Full XML + normalizes it to a line feed. Inside attribute values + both readings agree (either form reads as a space), and + the printer always writes a carriage return as a + character reference. +- The XML declaration is not in the model. A processing + instruction target of `xml` in any letter case rejects + everywhere, which keeps the declaration out. ## What you must trust -- The Lean kernel, which checks the proofs. -- The Lean compiler, with the C compiler and linker shipped with it, and the runtime, which turn the proved definitions into the program that runs. -- Lean's core library, including the compiled code it puts in place of some definitions the proofs reason about. -- The operating system and hardware it runs on. -- Python's standard library, as the oracle in the differential tests. The results file names the version used. The plan also names Go's encoding/xml and Rust's quick-xml as oracles; neither is wired in yet, and the harness says so rather than counting them. - -This project has no dependencies beyond Lean itself. - -## Run it - -Needs Linux and [elan](https://github.com/leanprover/elan). Build, then feed request lines to the tool: - -``` -lake build -echo "parse 60,97,47,62" | .lake/build/bin/xml -``` - -That request is the text `` as character codes, and the answer is `ok:60,97,47,62`. A text the parser rejects, such as the single code `120` (the letter `x`), answers `none`. A malformed request answers `error`. See `SPEC.md` for the full protocol. +- The Lean kernel (Lean 4.35.0, pinned in + `lean-toolchain`), which checks every proof. +- The Lean compiler, which turns the proved definitions + into the program that runs. +- The Lean runtime, which runs that program. +- The hardware the program runs on. +- Every dependency in `lake-manifest.json`: the manifest + lists no packages, so there are no library dependencies + to trust beyond the Lean toolchain itself. +- That `SPEC.md` states the reading of XML 1.0 you + intend. The proofs are about the parser and printer in + this repo following each other exactly; the fidelity of + the spec to XML 1.0 is a reading, pinned in SPEC.md + where the standard leaves a choice open. +- Python's standard library, as the oracle in the + differential tests. The results file names the version + used. The plan also names Go's encoding/xml and Rust's + quick-xml as oracles; neither is wired in yet, and the + harness says so rather than counting them. +- There are no exceptions to item 4 of the bar: the + project uses none of the features it forbids. ## Re-check it -Needs Linux, elan, and Python 3.11 or later. - -``` -lake build -grep -rn "sorry" --include="*.lean" Xml Proofs Main.lean Xml.lean Proofs.lean -python3 tests/run_tests.py -``` - -The grep should print nothing: there is no `sorry` anywhere. The test script rebuilds the tool if needed, runs the fixed cases, runs the differential tests against Python's `xml.etree.ElementTree` with a fixed seed, and writes the counts to `tests/TEST-RESULTS.md`. +1. `lake comparator --paranoid`: builds the challenge + file `Spec.lean` and the proofs in a sandbox and + checks that each theorem named in `comparator.json` + proves exactly the statement in the challenge file, + uses no axiom but the three standard ones, and is + accepted by Lean's kernel and every other kernel + shipped with Lean. +2. `python3 tests/run_tests.py`: the fixed cases, the + named rejections, and the differential run against + Python's `xml.etree.ElementTree`, with counts and any + failures written to `tests/TEST-RESULTS.md`. +3. `lake build`: the library, the proofs, and the tool + build clean. diff --git a/SPEC.md b/SPEC.md index 2f71396..e3f5956 100644 --- a/SPEC.md +++ b/SPEC.md @@ -2,8 +2,8 @@ A parser and printer in Lean for a safe subset of XML 1.0 (Fifth Edition), narrowed as stated here. A reviewer who did not write -this specification approves it, together with any statement file -a reviewer adds later. No such file exists yet, so nothing here +this specification approves it, together with the statement file +`Spec.lean`. No reviewer has approved them yet, so nothing here counts toward the verified bar yet. Text is `List Char`. A Lean `Char` is one Unicode scalar value. @@ -175,14 +175,51 @@ formedness predicate (`WF` in `Xml/Value.lean`): - the root is an element, and the prolog and epilog hold only comments and processing instructions. -## The claim - -Printing a well formed document gives a text that parses to -the same document: `parse (print d) = some d`. The theorem is -`Xml.Proofs.parse_print`. It checks against the standard axioms -only (`propext`, `Classical.choice`, `Quot.sound`), which a -reader can confirm with `#print axioms -Xml.Proofs.parse_print`. +## Properties and their theorems + +Each property a reader can check in the page (`README.md`) +names its theorem. The theorems are stated in `Spec.lean` +and proved in `Proofs/SpecProofs.lean`. The refusal +theorems are single inputs; the tests in `tests/` cover +each rule on many more inputs. + +| Property | Theorem | +|----------|---------| +| Parsing the printed form of a well formed document gives the document back | `Spec.parse_print` | +| A document carrying a document type declaration is refused | `Spec.rejects_doctype` | +| A reference to an entity the subset does not define is refused | `Spec.rejects_undefined_entity` | +| An end tag that does not match the start tag is refused | `Spec.rejects_mismatched_tags` | +| An element with no end tag is refused | `Spec.rejects_unclosed_element` | +| A second root element is refused | `Spec.rejects_second_root` | +| Character data before the root element is refused | `Spec.rejects_text_before_root` | +| An attribute name standing twice on one element is refused | `Spec.rejects_duplicate_attribute` | +| A raw less sign inside an attribute value is refused | `Spec.rejects_lt_in_attribute` | +| The run `]]>` inside text is refused | `Spec.rejects_cdata_close_in_text` | +| Two dashes in a row inside a comment body are refused | `Spec.rejects_dashdash_in_comment` | +| A character reference naming a surrogate value is refused | `Spec.rejects_surrogate_ref` | +| A character reference naming zero is refused | `Spec.rejects_zero_ref` | +| A colon in a name is refused | `Spec.rejects_colon_in_name` | +| A name starting with a digit is refused | `Spec.rejects_digit_name` | +| An attribute value with no quotes is refused | `Spec.rejects_unquoted_attribute` | +| A CDATA section in the prolog is refused | `Spec.rejects_cdata_in_prolog` | +| The XML declaration form is refused | `Spec.rejects_xml_declaration` | + +The round trip behind `Spec.parse_print` is +`Xml.Proofs.parse_print` in `Proofs/RoundTrip.lean`. Its +proofs rest on helper round trips proved in the same file: +one element and a list of content nodes together +(`Xml.Proofs.elem_nodes`), a prolog or epilog list +(`Xml.Proofs.parseMisc_print`), a printed comment body +(`Xml.Proofs.parseCommentBody_print`), a printed +processing instruction (`Xml.Proofs.parsePI_print`), and +escaped text and attribute values read back +(`Xml.Proofs.parseCharData_escapeText`, +`Xml.Proofs.parseAttrValue_escapeAttr`). Each proof in +`Proofs/SpecProofs.lean` uses no axiom but the three +standard ones (`propext`, `Classical.choice`, +`Quot.sound`): `comparator.json` names those three as the +permitted axioms, and `lake comparator` checks the proofs +against that list. ## Boundaries and named differences diff --git a/Spec.lean b/Spec.lean new file mode 100644 index 0000000..86070d4 --- /dev/null +++ b/Spec.lean @@ -0,0 +1,115 @@ +/- + The specification as Lean statements: the challenge file. + + A reviewer who did not write this file approves it, and `bar.toml` + records the SHA-256 it had then. The proofs live in `Proofs` + (`Proofs/SpecProofs.lean`); `lake comparator` checks that each one + proves exactly the statement written here. The `sorry` below is + expected in this file only. + + The statements use only the definitions in `Xml/Value.lean` and + `Xml/Parse.lean`, the code under proof named in `bar.toml`. No + definition of their own is needed, so this project has no + `Spec/Defs.lean`. +-/ + +import Xml + +open Xml + +/-! ## The round trip + +The statement the slice stands on. It is the statement of the +proved theorem of the same shape in `Proofs/RoundTrip.lean`, over +the same well formedness predicate, `Xml.WF`. -/ + +/-- Parsing the printed form of a well formed document gives the + document back. So a printer that wrote nothing, or wrote + something shorter, fails this statement. -/ +theorem Spec.parse_print (d : Document) (hwf : WF d) : + parse (print d) = some d := sorry + +/-! ## Refused inputs + +Single inputs the parser refuses, one for each headline rule of +`SPEC.md`. Each input is one of the named rejection cases in the +test harness. The differential tests cover these rules on many +more inputs; these statements pin them so a reader of the +specification can check each rule against one concrete case. -/ + +/-- A document carrying a document type declaration is refused, + not read leniently. -/ +theorem Spec.rejects_doctype : + (parse "".toList).isSome = false := sorry + +/-- A reference to an entity the subset does not define is + refused: no entity is ever expanded, because none exist. -/ +theorem Spec.rejects_undefined_entity : + (parse " ".toList).isSome = false := sorry + +/-- An end tag that does not match the start tag is refused. -/ +theorem Spec.rejects_mismatched_tags : + (parse "".toList).isSome = false := sorry + +/-- An element with no end tag is refused. -/ +theorem Spec.rejects_unclosed_element : + (parse "".toList).isSome = false := sorry + +/-- A document has one root element; a second one is refused. -/ +theorem Spec.rejects_second_root : + (parse "".toList).isSome = false := sorry + +/-- Character data before the root element is refused. -/ +theorem Spec.rejects_text_before_root : + (parse "x".toList).isSome = false := sorry + +/-- An attribute name standing twice on one element is refused. -/ +theorem Spec.rejects_duplicate_attribute : + (parse "".toList).isSome = false := sorry + +/-- A raw less sign inside an attribute value is refused. -/ +theorem Spec.rejects_lt_in_attribute : + (parse "".toList).isSome = false := sorry + +/-- The run `]]>` inside text is refused, as XML requires + outside a CDATA section. -/ +theorem Spec.rejects_cdata_close_in_text : + (parse "x]]>y".toList).isSome = false := sorry + +/-- Two dashes in a row inside a comment body are refused. -/ +theorem Spec.rejects_dashdash_in_comment : + (parse "".toList).isSome = false := sorry + +/-- A character reference naming a surrogate value is refused: + a surrogate is not a legal XML character. -/ +theorem Spec.rejects_surrogate_ref : + (parse "�".toList).isSome = false := sorry + +/-- A character reference naming zero is refused: zero is not a + legal XML character. -/ +theorem Spec.rejects_zero_ref : + (parse "�".toList).isSome = false := sorry + +/-- A colon in a name is refused: in XML a colon signals + namespace use, and namespaces are out of this subset. -/ +theorem Spec.rejects_colon_in_name : + (parse "".toList).isSome = false := sorry + +/-- A name starting with a digit is refused. -/ +theorem Spec.rejects_digit_name : + (parse "<1a/>".toList).isSome = false := sorry + +/-- An attribute value with no quotes is refused. -/ +theorem Spec.rejects_unquoted_attribute : + (parse "".toList).isSome = false := sorry + +/-- A CDATA section in the prolog is refused: CDATA stands in + element content only. -/ +theorem Spec.rejects_cdata_in_prolog : + (parse "".toList).isSome = false := sorry + +/-- The XML declaration form is refused: the declaration is not + part of this subset, and a target of `xml` rejects + everywhere. -/ +theorem Spec.rejects_xml_declaration : + (parse "".toList).isSome = false := sorry diff --git a/bar.toml b/bar.toml new file mode 100644 index 0000000..16aab56 --- /dev/null +++ b/bar.toml @@ -0,0 +1,52 @@ +# Read by bar/check.py in Proven-Commons/mission. +# See playbook/verified-bar.md there for what each field means. + +[project] +name = "xml" +# "in-progress" until every bar item passes, then "verified". +status = "in-progress" +page = "README.md" +# GitHub handles of everyone who wrote the specification. +spec_authors = ["abu-aska"] +# The program people run. A change to it voids the approval. +entry_points = ["Main.lean"] + +[spec] +files = ["SPEC.md", "Spec.lean"] +# The code under proof: the functions the statements are about. +code = [ + # The data types the statements are about, and their constructors. + "Xml.Node", "Xml.Node.text", "Xml.Node.elem", "Xml.Node.comment", + "Xml.Node.pi", "Xml.Document", + # Characters, names, and the conditions a well formed tree meets. + "Xml.LegalChar", "Xml.isLegalChar", "Xml.IsNameStart", "Xml.IsNameChar", + "Xml.isNameStart", "Xml.isNameChar", "Xml.ValidName", "Xml.IsWs", + "Xml.NoDashDash", "Xml.NotDashEnd", "Xml.NoQClose", "Xml.IsXmlTarget", + "Xml.AttrsOk", "Xml.WFNode", "Xml.WFNode.text", "Xml.WFNode.elem", + "Xml.WFNode.comment", "Xml.WFNode.pi", "Xml.WFNodes", "Xml.WFNodes.nil", + "Xml.WFNodes.cons", "Xml.MiscOk", "Xml.WF", + # The printer. + "Xml.escapeTextChar", "Xml.escapeText", "Xml.escapeAttrChar", + "Xml.escapeAttr", "Xml.printAttrs", "Xml.printNode", "Xml.printElem", + "Xml.printNodes", "Xml.print", + # The parser helpers and the parser. + "Xml.isWs", "Xml.skipWs", "Xml.isDigit", "Xml.hexVal", "Xml.isHexDigit", + "Xml.takeDigits", "Xml.takeHexDigits", "Xml.digitsValue", + "Xml.charRefChar", "Xml.parseRef", "Xml.takeNameChars", "Xml.parseName", + "Xml.parseTextRun", "Xml.parseCDATABody", "Xml.parseCommentBody", + "Xml.parsePIData", "Xml.parseAttrValue", "Xml.parsePI", + "Xml.parseCharData", "Xml.parseAttrs", "Xml.parseElement", + "Xml.parseNodes", "Xml.parseMisc", "Xml.parseDocument", "Xml.parse", +] + +# One entry per approval, added in a pull request the reviewer approves. +# [[spec.approval]] +# reviewer = "github-handle" +# date = "2026-11-02" +# sha256 = "..." +# record = "https://github.com/Proven-Commons/xml/pull/" + +[tests] +results = "tests/TEST-RESULTS.md" +command = "python3 tests/run_tests.py" +files = ["tests/run_tests.py"] diff --git a/comparator.json b/comparator.json new file mode 100644 index 0000000..3837303 --- /dev/null +++ b/comparator.json @@ -0,0 +1 @@ +{"challenge_module":"Spec","permitted_axioms":["propext","Classical.choice","Quot.sound"],"solution_module":"Proofs","theorem_names":["Spec.parse_print","Spec.rejects_doctype","Spec.rejects_undefined_entity","Spec.rejects_mismatched_tags","Spec.rejects_unclosed_element","Spec.rejects_second_root","Spec.rejects_text_before_root","Spec.rejects_duplicate_attribute","Spec.rejects_lt_in_attribute","Spec.rejects_cdata_close_in_text","Spec.rejects_dashdash_in_comment","Spec.rejects_surrogate_ref","Spec.rejects_zero_ref","Spec.rejects_colon_in_name","Spec.rejects_digit_name","Spec.rejects_unquoted_attribute","Spec.rejects_cdata_in_prolog","Spec.rejects_xml_declaration"]} \ No newline at end of file diff --git a/lakefile.toml b/lakefile.toml index 685b22c..66452b8 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -8,6 +8,9 @@ name = "Xml" [[lean_lib]] name = "Proofs" +[[lean_lib]] +name = "Spec" + [[lean_exe]] name = "xml" root = "Main" From f5de5272507730450fbb39090eb019da426acc19 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 17:15:13 +0000 Subject: [PATCH 03/18] List zero-aska as a spec author in bar.toml The commits that follow change Spec.lean, SPEC.md, the tests and the page, all of which the spec hash covers. Under bar v2 a person who wrote the specification cannot approve it, so the second writer is listed next to the original author. Status stays in-progress with no approval entry. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- bar.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bar.toml b/bar.toml index 16aab56..bd4e0aa 100644 --- a/bar.toml +++ b/bar.toml @@ -7,7 +7,7 @@ name = "xml" status = "in-progress" page = "README.md" # GitHub handles of everyone who wrote the specification. -spec_authors = ["abu-aska"] +spec_authors = ["abu-aska", "zero-aska"] # The program people run. A change to it voids the approval. entry_points = ["Main.lean"] From 5576c8b27479dfbe046fd52c930162b8b60b4b9f Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 17:15:59 +0000 Subject: [PATCH 04/18] Make the test harness fail closed Review 1 finding 6 (repeated in review 3): run_tool never read the exit status, and the generated, rejection and malformed parts paired answers with inputs through zip with no length check, so a tool that died after ten answers still gave "Failures: 0". Generated failures were also recorded only while fewer than ten had been seen, and the tool was rebuilt only when the binary was missing. Now run_tool records a failure for a non-zero exit status, a timeout, or a number of answers that differs from the number of requests, and pads missing answers with a value no check accepts. Every failing check is counted, and only the printed list is cut at 40. The script always runs lake build, which does nothing when the build is current. Checked by pointing the harness at a wrapper that answers ten requests and then dies with SIGSEGV: the run now reports 3248 failures and exits 1. A normal run is unchanged: 0 failures. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- tests/TEST-RESULTS.md | 2 +- tests/run_tests.py | 118 ++++++++++++++++++++++-------------------- 2 files changed, 62 insertions(+), 58 deletions(-) diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index cfe0ecd..8ea02bb 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -2,7 +2,7 @@ Written by `tests/run_tests.py`. Rerun it to check these numbers. -- Oracle: Python 3.12.3 `xml.etree.ElementTree` (expat), subset mode as described in the harness +- Oracle: Python 3.13.17 `xml.etree.ElementTree` (expat), subset mode as described in the harness - Lean tool: Lean (version 4.35.0, x86_64-unknown-linux-gnu, commit eb6cafb7290e8bd5f2937522d8d804f58f02bafc, Release) - Seed: 20261026 - Fixed cases passed: 35 of 35 diff --git a/tests/run_tests.py b/tests/run_tests.py index 001121f..207d5a8 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -51,12 +51,17 @@ python3 tests/run_tests.py [--seed N] [--count N] -The tool is built first if needed, driven in batches of request -lines, and the results are written to tests/TEST-RESULTS.md. -The exit code is non-zero if any check fails. Python 3.11+. +The tool is built first with `lake build` (which does nothing +when the build is current), driven in batches of request lines, +and the results are written to tests/TEST-RESULTS.md. The run +fails closed: a tool that exits with a non-zero status, or gives +fewer or more answers than it was sent requests, is a failure, and +every failing check is counted. The exit code is non-zero if any +check fails. Python 3.11+. """ import argparse +import os import random import subprocess import sys @@ -195,24 +200,36 @@ def request(text): return "parse " + codes(text) -def run_tool(lines, timeout=TIMEOUT): - proc = subprocess.Popen( - [str(EXE)], stdin=subprocess.PIPE, stdout=subprocess.PIPE, - stderr=subprocess.PIPE) +def run_tool(lines, failures, part, timeout=TIMEOUT): + """Send the request lines to the tool and return one answer per + line. The run fails closed: a non-zero exit status, or a number + of answers that differs from the number of requests, is recorded + as a failure of `part`, and missing answers read as ``, + which no check accepts.""" try: - out, _ = proc.communicate( - ("\n".join(lines) + "\n").encode(), timeout=timeout) + proc = subprocess.run( + [str(EXE)], input=("\n".join(lines) + "\n").encode(), + capture_output=True, timeout=timeout) except subprocess.TimeoutExpired: - proc.kill() - raise - return out.decode().splitlines() + failures.append("%s: tool did not answer within %d seconds" + % (part, timeout)) + return [""] * len(lines) + answers = proc.stdout.decode(errors="replace").splitlines() + if proc.returncode != 0: + failures.append("%s: tool exited with status %d" + % (part, proc.returncode)) + if len(answers) != len(lines): + failures.append("%s: tool gave %d answers for %d requests" + % (part, len(answers), len(lines))) + answers = (answers + [""] * len(lines))[:len(lines)] + return answers -def run_requests(texts): +def run_requests(texts, failures, part): lines = [request(t) for t in texts] answers = [] for i in range(0, len(lines), CHUNK): - answers.extend(run_tool(lines[i:i + CHUNK])) + answers.extend(run_tool(lines[i:i + CHUNK], failures, part)) return answers @@ -581,19 +598,23 @@ def gen_document(rng): # ---------------------------------------------------------------- +def lake_env(): + env = dict(os.environ) + env["PATH"] = str(Path.home() / ".elan" / "bin") + ":" + env["PATH"] + return env + + def build_exe(): - if EXE.exists(): - return + """Always run `lake build`: it does nothing when the build is + current, and rebuilds the tool after a source change, so a stale + binary is never tested.""" subprocess.run(["lake", "build"], cwd=ROOT, check=True, - timeout=BUILD_TIMEOUT) + timeout=BUILD_TIMEOUT, env=lake_env()) def lean_version(): out = subprocess.run(["lean", "--version"], capture_output=True, - text=True, timeout=60, - env={**__import__("os").environ, - "PATH": str(Path.home() / ".elan" / "bin") - + ":" + __import__("os").environ["PATH"]}) + text=True, timeout=60, cwd=ROOT, env=lake_env()) return out.stdout.strip() or "unknown" @@ -609,12 +630,8 @@ def main(): # Part 1: fixed cases. inputs = [t for t, _ in FIXED] - answers = run_requests(inputs) + answers = run_requests(inputs, failures, "fixed cases") fixed_ok = 0 - if len(answers) != len(inputs): - failures.append("fixed: tool gave %d answers for %d requests" - % (len(answers), len(inputs))) - answers += [""] * (len(inputs) - len(answers)) for (text, expected), ans in zip(FIXED, answers): want = "ok:" + codes(expected) if ans == want: @@ -623,58 +640,43 @@ def main(): failures.append("fixed case %r: got %r, want %r" % (text, ans, want)) - # Part 2: generated differential. + # Part 2: generated differential. Every failing document is + # counted; only the printed list is cut short. gen_inputs = [] gen_docs = [] for _ in range(args.count): text, doc = gen_document(rng) gen_inputs.append(text) gen_docs.append(doc) - answers = run_requests(gen_inputs) + answers = run_requests(gen_inputs, failures, "generated") gen_ok = 0 et_ok = 0 - gen_fail = 0 for text, doc, ans in zip(gen_inputs, gen_docs, answers): want = "ok:" + codes(print_doc(doc)) - good = True + why = [] if ans != want: - good = False - if gen_fail < 10: - failures.append( - "generated: tool answer differs for %r: got %r..." - % (text, ans[:120])) + why.append("tool answered %r" % (ans[:120],)) try: et_root = et_parse(text) if et_to_model(et_root) != doc[1]: - good = False - if gen_fail < 10: - failures.append( - "generated: ElementTree tree differs for %r" - % (text,)) + why.append("ElementTree read a different tree") else: et_ok += 1 et_canon = et_parse(print_doc(doc)) if et_to_model(et_canon) != doc[1]: - good = False - if gen_fail < 10: - failures.append( - "generated: ElementTree tree of the print " - "differs for %r" % (text,)) - except ET.ParseError: - good = False - if gen_fail < 10: - failures.append( - "generated: ElementTree rejected in-subset %r" - % (text,)) - if good: - gen_ok += 1 + why.append("ElementTree read a different tree " + "from the canonical print") + except ET.ParseError as e: + why.append("ElementTree rejected it: %s" % e) + if why: + failures.append("generated %r: %s" % (text, "; ".join(why))) else: - gen_fail += 1 + gen_ok += 1 # Part 3: named rejections. Also record ElementTree's verdict # on each: accepted means an out of subset disagreement. rej_inputs = [t for _, t in REJECTIONS] - answers = run_requests(rej_inputs) + answers = run_requests(rej_inputs, failures, "named rejections") rej_ok = 0 oos = [] for (rule, text), ans in zip(REJECTIONS, answers): @@ -690,7 +692,7 @@ def main(): pass # Malformed requests. - bad_answers = run_tool(MALFORMED) + bad_answers = run_tool(MALFORMED, failures, "malformed requests") bad_ok = 0 for line, ans in zip(MALFORMED, bad_answers): if ans == "error": @@ -698,7 +700,7 @@ def main(): else: failures.append("malformed %r: got %r, want error" % (line, ans)) - empty_ans = run_tool(["parse", "parse "]) + empty_ans = run_tool(["parse", "parse "], failures, "bare parse") if empty_ans != ["none", "none"]: failures.append("bare 'parse' answered %r, want two nones" % (empty_ans,)) @@ -736,6 +738,8 @@ def main(): lines.append("- Failures: %d" % len(failures)) for f in failures[:40]: lines.append(" - %s" % f) + if len(failures) > 40: + lines.append(" - (%d more not shown)" % (len(failures) - 40)) RESULTS.write_text("\n".join(lines) + "\n") print("\n".join(lines)) return 1 if failures else 0 From c9e9422e747d28fbd340c2a909ad87acf60cf1b5 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 17:16:40 +0000 Subject: [PATCH 05/18] Record the oracle version and input count; fix the status line Review 3 found bar items 5 and 6 open on format: tests/TEST-RESULTS.md had no "- Inputs:" line, and the page's status line read "Status: in-progress", which the bar checker does not take as "in progress". Review 1 finding 7 also noted that "subset mode" had nothing behind it: et_parse is the stock ElementTree parser. The record now gives the oracle with the Python and expat versions and the exact parser setup, the seed, and an Inputs line with the number of requests sent to the tool. The README status line reads "Status: in progress". The README and the harness describe the ElementTree setup as it is (stock XMLParser, namespace processing on, comments and processing instructions kept) instead of "subset mode". The harness keeps lake build output off stdout unless the build fails. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- README.md | 16 ++++++++++------ tests/TEST-RESULTS.md | 4 +++- tests/run_tests.py | 27 ++++++++++++++++++++++----- 3 files changed, 35 insertions(+), 12 deletions(-) diff --git a/README.md b/README.md index 4e1958d..48aba21 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # xml: an XML safe-subset parser and printer, with a proved round trip -Status: in-progress +Status: in progress A parser and printer in Lean for a safe subset of XML 1.0: elements, attributes, text, comments, processing @@ -37,11 +37,15 @@ echo "parse 60,97,47,62" | .lake/build/bin/xml That request is the text ``, and the answer is `ok:60,97,47,62`. See `SPEC.md` for the full protocol. -`python3 tests/run_tests.py` rebuilds the tool if needed, -runs the fixed cases, and runs the differential tests -against Python's `xml.etree.ElementTree` in subset mode -with a fixed seed, writing the counts to -`tests/TEST-RESULTS.md`. +`python3 tests/run_tests.py` runs `lake build` (which +does nothing when the build is current), runs the fixed +cases, and runs the differential tests against Python's +`xml.etree.ElementTree` with a fixed seed, writing the +counts to `tests/TEST-RESULTS.md`. ElementTree has no +subset setting: it is the stock parser, with namespace +processing on, so documents outside the subset are told +apart by the harness's named rejection list and counted +apart, not by the oracle. ## What is proved diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index 8ea02bb..68ad51a 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -2,9 +2,11 @@ Written by `tests/run_tests.py`. Rerun it to check these numbers. -- Oracle: Python 3.13.17 `xml.etree.ElementTree` (expat), subset mode as described in the harness +- Oracle: Python 3.13.17 `xml.etree.ElementTree`, expat_2.6.1 (`ET.XMLParser`, which turns namespace processing on, with a `TreeBuilder` that keeps comments and processing instructions) - Lean tool: Lean (version 4.35.0, x86_64-unknown-linux-gnu, commit eb6cafb7290e8bd5f2937522d8d804f58f02bafc, Release) - Seed: 20261026 +- Inputs: 3290 + - every request sent to the tool: the fixed cases, the generated documents, the named rejections, the malformed requests, and two bare parse requests - Fixed cases passed: 35 of 35 - Generated in-subset documents: 3200 - Generated documents where the tool's canonical print matches the tree and ElementTree agrees on the tree: 3200 diff --git a/tests/run_tests.py b/tests/run_tests.py index 207d5a8..88c019d 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -62,6 +62,7 @@ import argparse import os +import pyexpat import random import subprocess import sys @@ -184,6 +185,10 @@ def et_to_model(elem): def et_parse(text): + """ElementTree's reading of a text. ET.XMLParser always runs + expat with namespace processing on; there is no subset setting. + Documents outside the subset are therefore told apart by the + named rejection list, not by the oracle.""" builder = ET.TreeBuilder(insert_comments=True, insert_pis=True) return ET.fromstring(text, parser=ET.XMLParser(target=builder)) @@ -608,8 +613,12 @@ def build_exe(): """Always run `lake build`: it does nothing when the build is current, and rebuilds the tool after a source change, so a stale binary is never tested.""" - subprocess.run(["lake", "build"], cwd=ROOT, check=True, - timeout=BUILD_TIMEOUT, env=lake_env()) + out = subprocess.run(["lake", "build"], cwd=ROOT, capture_output=True, + text=True, timeout=BUILD_TIMEOUT, env=lake_env()) + if out.returncode != 0: + sys.stderr.write(out.stdout + out.stderr) + raise SystemExit("lake build failed with status %d" + % out.returncode) def lean_version(): @@ -711,11 +720,19 @@ def main(): lines.append("Written by `tests/run_tests.py`. Rerun it to " "check these numbers.") lines.append("") - lines.append("- Oracle: Python %s `xml.etree.ElementTree` " - "(expat), subset mode as described in the harness" - % sys.version.split()[0]) + total = (len(FIXED) + len(gen_inputs) + len(REJECTIONS) + + len(MALFORMED) + 2) + lines.append("- Oracle: Python %s `xml.etree.ElementTree`, " + "%s (`ET.XMLParser`, which turns namespace " + "processing on, with a `TreeBuilder` that keeps " + "comments and processing instructions)" + % (sys.version.split()[0], pyexpat.EXPAT_VERSION)) lines.append("- Lean tool: %s" % lean_version()) lines.append("- Seed: %d" % args.seed) + lines.append("- Inputs: %d" % total) + lines.append(" - every request sent to the tool: the fixed cases, " + "the generated documents, the named rejections, the " + "malformed requests, and two bare parse requests") lines.append("- Fixed cases passed: %d of %d" % (fixed_ok, len(FIXED))) lines.append("- Generated in-subset documents: %d" % len(gen_inputs)) From ddef481dc732224908918b70761eae3e6c89e76e Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 17:19:59 +0000 Subject: [PATCH 06/18] Reject the attribute name xmlns Blocking item 1 of review 3 on 4875cec (first raised as review 1 finding 2): a default namespace declaration was accepted as an ordinary attribute. gave the tree a/xmlns=urn:x, while ElementTree reads {urn:x}a with no attributes, and the page said documents with namespaces are rejected. The colon ban on names does not catch it, because DefaultAttName is the plain name xmlns. - Xml/Value.lean: new xmlnsName; AttrsOk now also requires that no attribute is named xmlns, so the round trip still covers every tree the parser can give. - Xml/Parse.lean: parseAttrs refuses an attribute named xmlns. Prefixed declarations (xmlns:p) were already refused by the colon ban. Only the exact name is refused: xmlnsx, XMLNS and an element named xmlns declare nothing. - Spec.lean: Spec.rejects_xmlns, a general statement: an attribute named xmlns on the root element is refused after any well formed prolog and any well formed attributes before it, printed, whatever follows the name that does not make it longer. Proved in the new Proofs/Refusals.lean, re-exported from Proofs/SpecProofs.lean, and listed in comparator.json. bar.toml lists Xml.xmlnsName as code under proof. - Proofs/RoundTrip.lean: parseAttrs_print takes the new AttrsOk field. - tests: six named rejections (default declaration, empty, single quotes, after another attribute, on a child, prefixed) and a fixed case that accepts xmlnsx, XMLNS and xmln as plain attributes plus an element named xmlns. The generator never names an attribute xmlns. - SPEC.md and README.md state the rule and the new WF condition, and the new theorem's row says exactly what it covers. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Proofs.lean | 1 + Proofs/Refusals.lean | 157 +++++++++++++++++++++++++++++++++++++++++ Proofs/RoundTrip.lean | 9 +-- Proofs/SpecProofs.lean | 11 +++ README.md | 4 +- SPEC.md | 18 ++++- Spec.lean | 15 ++++ Xml/Parse.lean | 8 ++- Xml/Value.lean | 19 +++-- bar.toml | 2 +- comparator.json | 2 +- tests/TEST-RESULTS.md | 14 ++-- tests/run_tests.py | 16 ++++- 13 files changed, 255 insertions(+), 21 deletions(-) create mode 100644 Proofs/Refusals.lean diff --git a/Proofs.lean b/Proofs.lean index 2a0b7e9..6f0eac6 100644 --- a/Proofs.lean +++ b/Proofs.lean @@ -1,2 +1,3 @@ import Proofs.RoundTrip +import Proofs.Refusals import Proofs.SpecProofs diff --git a/Proofs/Refusals.lean b/Proofs/Refusals.lean new file mode 100644 index 0000000..244bf5f --- /dev/null +++ b/Proofs/Refusals.lean @@ -0,0 +1,157 @@ +/- + Refusal proofs: texts the parser turns away, stated for whole + families of inputs rather than single examples. + + Each family is a text whose head is a well formed prolog printed + in canonical form and the start of a root element, followed by + the forbidden form and then anything at all. The proofs follow + the parser through the prolog and the start tag with the round + trip lemmas of `Proofs/RoundTrip.lean`, then show the step that + turns the forbidden form away. +-/ + +import Xml +import Proofs.RoundTrip + +namespace Xml.Proofs + +open Xml + +/-! ## The root element -/ + +/-- A text made of a printed prolog and then a less sign and a name + start character is refused when the element reader refuses the + root at every fuel large enough. -/ +theorem parse_root_none (prolog : List Node) (hpro : MiscOk prolog) + (c : Char) (cs : List Char) (hc : IsNameStart c) + (he : ∀ f, cs.length + 3 ≤ f → parseElement f ('<' :: c :: cs) = none) : + parse (printNodes prolog ++ '<' :: c :: cs) = none := by + have hstop : ∀ f, 1 ≤ f → + parseMisc f ('<' :: c :: cs) = some ([], skipWs ('<' :: c :: cs)) := by + intro f hf + cases f with + | zero => omega + | succ f' => + rw [skipWs_cons (show isWs '<' = false by decide)] + exact parseMisc_stop hc + have hm := parseMisc_print prolog ('<' :: c :: cs) hpro hstop + ((printNodes prolog ++ '<' :: c :: cs).length + 1) + (by simp only [List.length_append]; omega) + rw [skipWs_cons (show isWs '<' = false by decide)] at hm + have hroot := he ((printNodes prolog ++ '<' :: c :: cs).length + 1) + (by simp only [List.length_append, List.length_cons]; omega) + show parseDocument _ _ = none + simp only [parseDocument, hm, hroot] + +/-- The element reader at a start tag whose name is read whole: it + refuses when the attribute reader refuses. -/ +theorem parseElement_attrs_none {g : Nat} {name tail : List Char} + (hn : ValidName name) + (ht : ∀ c, tail.head? = some c → isNameChar c = false) + (ha : parseAttrs g [] tail = none) : + parseElement (g + 1) ('<' :: (name ++ tail)) = none := by + simp [parseElement, parseName_append hn ht, ha] + +/-- The text after a name, when it starts with the printed + attributes and then more text, does not start with a name + character, as long as the more text does not. -/ +theorem printAttrs_head_not_name (attrs : List (List Char × List Char)) + (tail : List Char) + (ht : ∀ c, tail.head? = some c → isNameChar c = false) : + ∀ c, (printAttrs attrs ++ tail).head? = some c → isNameChar c = false := by + intro c hc + cases attrs with + | nil => exact ht c (by simpa [printAttrs] using hc) + | cons kv as => + simp only [printAttrs, List.cons_append, List.head?_cons] at hc + rw [← Option.some.inj hc] + exact isNameChar_false_of not_nameChar_space + +/-- A root start tag with printed attributes, at the head of a text + after a printed prolog, is refused when the attribute reader + refuses whatever follows the printed attributes, at any fuel + from one up. -/ +theorem parse_attrs_none (prolog : List Node) (hpro : MiscOk prolog) + (name : List Char) (hname : ValidName name) + (attrs : List (List Char × List Char)) (hattrs : AttrsOk attrs) + (tail : List Char) + (ht : ∀ c, tail.head? = some c → isNameChar c = false) + (hcont : ∀ f, 1 ≤ f → parseAttrs f attrs tail = none) : + parse (printNodes prolog ++ '<' :: (name ++ (printAttrs attrs ++ tail))) = + none := by + obtain ⟨c0, ds, hq, hc0, hds⟩ := hname + subst hq + rw [List.cons_append] + apply parse_root_none prolog hpro c0 _ hc0 + intro f hf + cases f with + | zero => omega + | succ g => + have hlen : ds.length + (printAttrs attrs).length + tail.length + 2 ≤ g := by + have h := hf + simp only [List.length_append] at h + omega + have hpa := printAttrs_length_ge attrs + have hpv := printAttrs_length_ge_value attrs + have ha : parseAttrs g [] (printAttrs attrs ++ tail) = none := by + apply parseAttrs_print attrs [] tail g none hattrs + (by intro kv _ e; simp at e) + · intro kv hkv + have h1 := hpv kv hkv + omega + · omega + · intro f' hf' + simpa using hcont f' hf' + exact parseElement_attrs_none (name := c0 :: ds) ⟨c0, ds, rfl, hc0, hds⟩ + (printAttrs_head_not_name attrs tail ht) ha + +/-! ## The name `xmlns` -/ + +theorem validName_xmlns : ValidName xmlnsName := + ⟨'x', ['m', 'l', 'n', 's'], rfl, isNameStart_iff.mp (by decide), + by intro x hx; simp at hx; rcases hx with rfl | rfl | rfl | rfl <;> + exact isNameChar_iff.mp (by decide)⟩ + +/-- The attribute reader refuses an attribute named `xmlns`, read + whole, whatever comes after the name. -/ +theorem parseAttrs_xmlns (f : Nat) (hf : 1 ≤ f) + (acc : List (List Char × List Char)) (rest : List Char) + (hr : ∀ c, rest.head? = some c → isNameChar c = false) : + parseAttrs f acc (' ' :: (xmlnsName ++ rest)) = none := by + cases f with + | zero => omega + | succ g => + have hsk : skipWs (' ' :: (xmlnsName ++ rest)) = + 'x' :: 'm' :: 'l' :: 'n' :: 's' :: rest := by + simp [skipWs, isWs, xmlnsName] + have hpn : parseName ('x' :: 'm' :: 'l' :: 'n' :: 's' :: rest) = + some (xmlnsName, rest) := + parseName_append validName_xmlns hr + simp [parseAttrs, hsk, hpn] + +/-- An attribute named `xmlns` on the root element is refused, + after any well formed prolog and any well formed attributes + before it, whatever follows the name. -/ +theorem rejects_xmlns (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (rest : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) + (hattrs : AttrsOk attrs) + (hrest : ∀ c, rest.head? = some c → ¬ IsNameChar c) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ + ' ' :: xmlnsName ++ rest) = none := by + have e : printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ + ' ' :: xmlnsName ++ rest = + printNodes prolog ++ '<' :: (name ++ (printAttrs attrs ++ + ' ' :: (xmlnsName ++ rest))) := by + simp [List.append_assoc] + rw [e] + apply parse_attrs_none prolog hpro name hname attrs hattrs + · intro c hc + simp at hc + rw [← hc] + exact isNameChar_false_of not_nameChar_space + · intro f hf + exact parseAttrs_xmlns f hf attrs rest + (fun c hc => isNameChar_false_of (hrest c hc)) + +end Xml.Proofs diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index 377c90b..2ba04e0 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -910,9 +910,10 @@ theorem parseAttrs_print : ∀ (attrs : List (List Char × List Char)) intro acc tail f res hok hdisj hfv hf hfin obtain ⟨a, v⟩ := kv have hname : ValidName a := hok.1 - have hval : ∀ c ∈ v, LegalChar c := hok.2.1 - have hnodup : ∀ kv2 ∈ attrs, kv2.1 ≠ a := hok.2.2.1 - have hok' : AttrsOk attrs := hok.2.2.2 + have hnx : a ≠ xmlnsName := hok.2.1 + have hval : ∀ c ∈ v, LegalChar c := hok.2.2.1 + have hnodup : ∀ kv2 ∈ attrs, kv2.1 ≠ a := hok.2.2.2.1 + have hok' : AttrsOk attrs := hok.2.2.2.2 obtain ⟨c0, ds, ha, hc0, hds⟩ := hname subst ha cases f with @@ -1001,7 +1002,7 @@ theorem parseAttrs_print : ∀ (attrs : List (List Char × List Char)) (printAttrs (((c0 :: ds), v) :: attrs) ++ tail) = parseAttrs f' (acc ++ [((c0 :: ds), v)]) (printAttrs attrs ++ tail) := by - simp [parseAttrs, hsk, hpn2, hval', hdup, hc0ne1, hc0ne2, + simp [parseAttrs, hsk, hpn2, hval', hdup, hc0ne1, hc0ne2, hnx, isNameStart_of hc0, List.cons_append, List.append_assoc, skipWs_cons (by decide : isWs '=' = false), skipWs_cons (by decide : isWs '"' = false)] diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index f7af403..e26bf7d 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -9,6 +9,7 @@ import Xml import Proofs.RoundTrip +import Proofs.Refusals open Xml @@ -100,3 +101,13 @@ theorem Spec.rejects_cdata_in_prolog : theorem Spec.rejects_xml_declaration : (parse "".toList).isSome = false := by decide +kernel + + +theorem Spec.rejects_xmlns (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (rest : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) + (hattrs : AttrsOk attrs) + (hrest : ∀ c, rest.head? = some c → ¬ IsNameChar c) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ + ' ' :: xmlnsName ++ rest) = none := + Xml.Proofs.rejects_xmlns prolog name attrs rest hpro hname hattrs hrest diff --git a/README.md b/README.md index 48aba21..f399c85 100644 --- a/README.md +++ b/README.md @@ -75,10 +75,12 @@ where they end in `sorry`) and proved in | An attribute value with no quotes is refused. | `Spec.rejects_unquoted_attribute` | | A CDATA section in the prolog is refused. | `Spec.rejects_cdata_in_prolog` | | The XML declaration form is refused. | `Spec.rejects_xml_declaration` | +| An attribute named `xmlns` (a default namespace declaration) on the root element is refused: after any well formed prolog and any well formed attributes before it, both printed in canonical form, whatever follows the name, as long as it does not make the name longer. | `Spec.rejects_xmlns` | A document is well formed when its names match the subset's name rule, attribute names are unique per -element, text holds only legal XML characters and no two +element and none is `xmlns`, text holds only legal XML +characters and no two text runs stand next to each other, comment bodies contain no `--` and do not end with `-`, processing instruction targets are valid and not the reserved word diff --git a/SPEC.md b/SPEC.md index e3f5956..24b56ea 100644 --- a/SPEC.md +++ b/SPEC.md @@ -40,7 +40,10 @@ parsed leniently. underscore. - Later characters may also be ASCII digits, a hyphen, or a dot. - A colon is never allowed in a name in this subset. In XML a - colon signals namespace use, and namespaces are out. + colon signals namespace use, and namespaces are out. The colon + rule alone does not keep namespaces out, because a default + namespace is declared with the plain name `xmlns`; see the + attribute rules below. - Non-ASCII names are out of the subset. XML 1.0 allows far more; that is later work, not this slice. @@ -53,6 +56,14 @@ parsed leniently. Single and double quotes are both read; the printer writes double quotes. - A duplicate attribute name on one element rejects. +- An attribute named `xmlns` rejects. In Namespaces in XML 1.0 + it declares a default namespace (`DefaultAttName ::= 'xmlns'`), + which namespace-aware parsers apply to the element's name and + its children's names, so accepting it as an ordinary attribute + would read a different tree from theirs. Only that exact name + is refused: `xmlnsx`, `XMLNS`, and an element named `xmlns` + declare nothing and are ordinary names. A prefixed declaration + (`xmlns:p`) rejects by the colon rule. - Whitespace may appear between attributes, around the equals sign, and before the closing bracket of a start tag or an end tag. @@ -161,8 +172,8 @@ The round trip is claimed for trees that satisfy a well formedness predicate (`WF` in `Xml/Value.lean`): - every name matches the name rule above; -- attribute names are unique per element, and attribute values - hold only legal XML characters; +- attribute names are unique per element and none is `xmlns`, + and attribute values hold only legal XML characters; - text nodes are not empty, hold only legal XML characters, and two text nodes never stand next to each other (the parser merges them, so an unmerged tree could not come @@ -203,6 +214,7 @@ each rule on many more inputs. | An attribute value with no quotes is refused | `Spec.rejects_unquoted_attribute` | | A CDATA section in the prolog is refused | `Spec.rejects_cdata_in_prolog` | | The XML declaration form is refused | `Spec.rejects_xml_declaration` | +| An attribute named `xmlns` on the root element is refused, after any well formed prolog and any well formed attributes before it, printed, whatever follows the name that does not make it longer | `Spec.rejects_xmlns` | The round trip behind `Spec.parse_print` is `Xml.Proofs.parse_print` in `Proofs/RoundTrip.lean`. Its diff --git a/Spec.lean b/Spec.lean index 86070d4..87ed777 100644 --- a/Spec.lean +++ b/Spec.lean @@ -113,3 +113,18 @@ theorem Spec.rejects_cdata_in_prolog : everywhere. -/ theorem Spec.rejects_xml_declaration : (parse "".toList).isSome = false := sorry + +/-- An attribute named `xmlns`, the default namespace declaration, + is refused: namespaces are out of this subset, and the colon + ban on names does not reach this name. Stated for the root + element of a text that starts with any well formed prolog, + printed, then the root's start tag with any well formed + attributes, printed, before it, and anything after the name + that does not make the name longer. -/ +theorem Spec.rejects_xmlns (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (rest : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) + (hattrs : AttrsOk attrs) + (hrest : ∀ c, rest.head? = some c → ¬ IsNameChar c) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ + ' ' :: xmlnsName ++ rest) = none := sorry diff --git a/Xml/Parse.lean b/Xml/Parse.lean index b8f8834..ed3bbd8 100644 --- a/Xml/Parse.lean +++ b/Xml/Parse.lean @@ -22,6 +22,10 @@ - The XML declaration is rejected: it is a processing instruction whose target is the word `xml`, and that target is reserved everywhere in this subset. + - An attribute named `xmlns` is rejected: it declares a default + namespace, and namespaces are out of this subset. Prefixed + declarations (`xmlns:p`) are already rejected by the colon + ban on names. Line endings are not normalized in character data, comments, processing instruction data, or CDATA sections: a carriage @@ -277,7 +281,8 @@ def parseCharData : Nat → List Char → Option (List Char × List Char) /-- Read the attributes of a start tag, and how the tag ends. Attributes read so far are in `acc`, in order. Returns the attributes, the text after the tag, and whether the tag was - the empty form. A repeated attribute name is rejected. -/ + the empty form. A repeated attribute name is rejected, and so + is the name `xmlns`, which would declare a default namespace. -/ def parseAttrs : Nat → List (List Char × List Char) → List Char → Option (List (List Char × List Char) × List Char × Bool) | 0, _, _ => none @@ -289,6 +294,7 @@ def parseAttrs : Nat → List (List Char × List Char) → List Char → if isNameStart c then match parseName (skipWs cs) with | some (aname, r1) => + if aname = xmlnsName then none else match skipWs r1 with | '=' :: r2 => match skipWs r2 with diff --git a/Xml/Value.lean b/Xml/Value.lean index 650702b..ad23a26 100644 --- a/Xml/Value.lean +++ b/Xml/Value.lean @@ -7,7 +7,8 @@ attributes, text, comments, and processing instructions, with character references and CDATA sections read as character data. There is no document type declaration, no entity beyond the five - predefined ones, no namespace, and no XML declaration. + predefined ones, no namespace (so no attribute named `xmlns`), and + no XML declaration. A node is one of: @@ -209,14 +210,22 @@ def print (d : Document) : List Char := /-! ## Well formed trees -/ +/-- The attribute name `xmlns`. In Namespaces in XML 1.0 it + declares a default namespace (`DefaultAttName ::= 'xmlns'`). + It has no colon, so the colon ban on names does not keep it + out; this subset has no namespaces, so no attribute may carry + this exact name. Other names, such as `xmlnsx` or `XMLNS`, are + ordinary names: they declare nothing. -/ +def xmlnsName : List Char := ['x', 'm', 'l', 'n', 's'] + /-- Attribute lists the printer can write and the parser reads - back: each name is a valid name, each value holds only legal - characters, no name appears twice, and the rest of the list is - in order. -/ + back: each name is a valid name and not `xmlns`, each value + holds only legal characters, no name appears twice, and the + rest of the list is in order. -/ def AttrsOk : List (List Char × List Char) → Prop | [] => True | kv :: rest => - ValidName kv.1 ∧ (∀ c ∈ kv.2, LegalChar c) ∧ + ValidName kv.1 ∧ kv.1 ≠ xmlnsName ∧ (∀ c ∈ kv.2, LegalChar c) ∧ (∀ kv2 ∈ rest, kv2.1 ≠ kv.1) ∧ AttrsOk rest mutual diff --git a/bar.toml b/bar.toml index bd4e0aa..3188055 100644 --- a/bar.toml +++ b/bar.toml @@ -22,7 +22,7 @@ code = [ "Xml.LegalChar", "Xml.isLegalChar", "Xml.IsNameStart", "Xml.IsNameChar", "Xml.isNameStart", "Xml.isNameChar", "Xml.ValidName", "Xml.IsWs", "Xml.NoDashDash", "Xml.NotDashEnd", "Xml.NoQClose", "Xml.IsXmlTarget", - "Xml.AttrsOk", "Xml.WFNode", "Xml.WFNode.text", "Xml.WFNode.elem", + "Xml.xmlnsName", "Xml.AttrsOk", "Xml.WFNode", "Xml.WFNode.text", "Xml.WFNode.elem", "Xml.WFNode.comment", "Xml.WFNode.pi", "Xml.WFNodes", "Xml.WFNodes.nil", "Xml.WFNodes.cons", "Xml.MiscOk", "Xml.WF", # The printer. diff --git a/comparator.json b/comparator.json index 3837303..d2ea3a5 100644 --- a/comparator.json +++ b/comparator.json @@ -1 +1 @@ -{"challenge_module":"Spec","permitted_axioms":["propext","Classical.choice","Quot.sound"],"solution_module":"Proofs","theorem_names":["Spec.parse_print","Spec.rejects_doctype","Spec.rejects_undefined_entity","Spec.rejects_mismatched_tags","Spec.rejects_unclosed_element","Spec.rejects_second_root","Spec.rejects_text_before_root","Spec.rejects_duplicate_attribute","Spec.rejects_lt_in_attribute","Spec.rejects_cdata_close_in_text","Spec.rejects_dashdash_in_comment","Spec.rejects_surrogate_ref","Spec.rejects_zero_ref","Spec.rejects_colon_in_name","Spec.rejects_digit_name","Spec.rejects_unquoted_attribute","Spec.rejects_cdata_in_prolog","Spec.rejects_xml_declaration"]} \ No newline at end of file +{"challenge_module":"Spec","permitted_axioms":["propext","Classical.choice","Quot.sound"],"solution_module":"Proofs","theorem_names":["Spec.parse_print","Spec.rejects_doctype","Spec.rejects_undefined_entity","Spec.rejects_mismatched_tags","Spec.rejects_unclosed_element","Spec.rejects_second_root","Spec.rejects_text_before_root","Spec.rejects_duplicate_attribute","Spec.rejects_lt_in_attribute","Spec.rejects_cdata_close_in_text","Spec.rejects_dashdash_in_comment","Spec.rejects_surrogate_ref","Spec.rejects_zero_ref","Spec.rejects_colon_in_name","Spec.rejects_digit_name","Spec.rejects_unquoted_attribute","Spec.rejects_cdata_in_prolog","Spec.rejects_xml_declaration","Spec.rejects_xmlns"]} \ No newline at end of file diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index 68ad51a..b9b5f74 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -5,17 +5,23 @@ Written by `tests/run_tests.py`. Rerun it to check these numbers. - Oracle: Python 3.13.17 `xml.etree.ElementTree`, expat_2.6.1 (`ET.XMLParser`, which turns namespace processing on, with a `TreeBuilder` that keeps comments and processing instructions) - Lean tool: Lean (version 4.35.0, x86_64-unknown-linux-gnu, commit eb6cafb7290e8bd5f2937522d8d804f58f02bafc, Release) - Seed: 20261026 -- Inputs: 3290 +- Inputs: 3298 - every request sent to the tool: the fixed cases, the generated documents, the named rejections, the malformed requests, and two bare parse requests -- Fixed cases passed: 35 of 35 +- Fixed cases passed: 37 of 37 - Generated in-subset documents: 3200 - Generated documents where the tool's canonical print matches the tree and ElementTree agrees on the tree: 3200 - ElementTree tree agreements on generated documents: 3200 -- Named rejections rejected by the tool: 43 of 43 -- Out of subset disagreements (ElementTree accepts, this slice rejects, by design): 4 +- Named rejections rejected by the tool: 49 of 49 +- Out of subset disagreements (ElementTree accepts, this slice rejects, by design): 10 - document type declaration - document type declaration with internal subset - colon in an attribute name + - default namespace declaration + - empty default namespace declaration + - default namespace declaration, single quotes + - default namespace declaration after another attribute + - default namespace declaration on a child element + - prefixed namespace declaration - the XML declaration form - Malformed requests answered error: 10 of 10 - Bare parse requests answered none: yes diff --git a/tests/run_tests.py b/tests/run_tests.py index 88c019d..14b1dc7 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -282,6 +282,11 @@ def run_requests(texts, failures, part): ("", ""), ("t", "t"), + # only the exact name xmlns declares a namespace; these are + # ordinary attribute names, and an element may be named xmlns + ("", + ''), + ("", ""), ] # Named rejections: (rule, input). ElementTree's verdict is @@ -313,6 +318,15 @@ def run_requests(texts, failures, part): "�"), ("colon in a name", ""), ("colon in an attribute name", ""), + ("default namespace declaration", ""), + ("empty default namespace declaration", ""), + ("default namespace declaration, single quotes", + ""), + ("default namespace declaration after another attribute", + ""), + ("default namespace declaration on a child element", + ""), + ("prefixed namespace declaration", ""), ("name starting with a digit", "<1a/>"), ("attribute name starting with a digit", ""), ("unquoted attribute value", ""), @@ -535,7 +549,7 @@ def gen_element(rng, depth): attr_spell = [] for _ in range(rng.randint(0, 3)): an = gen_name(rng) - if an in used: + if an in used or an == "xmlns": continue used.add(an) sp, val, q = gen_attr_value(rng) From 1f83b36435e178891cde3a06b15630023da42034 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 17:22:27 +0000 Subject: [PATCH 07/18] Require whitespace between attributes Review 1 finding 4, repeated in reviews 3 and 4: was accepted and printed as . XML 1.0 productions [40] and [44] read (S Attribute)*, so whitespace must stand before each attribute; expat, libxml2 and ElementTree reject the input, as do the W3C not-wf cases o-p40fail1 and o-p44fail4 that the tool accepted. - Xml/Parse.lean: new startsWithWs; parseAttrs reads a name only when the text before it starts with whitespace. After the element name the next character is never a name character, so the check only bites after a closing quote. - Proofs/RoundTrip.lean: the printer writes one space before each attribute, so parseAttrs_print needs one more fact. - Spec.lean: Spec.rejects_attribute_without_space, a general statement: on the root element, after any well formed prolog and at least one well formed attribute, printed, a name start character right after the closing quote is refused, whatever follows. Proved in Proofs/Refusals.lean and listed in comparator.json; bar.toml lists Xml.startsWithWs as code under proof. - tests: five named rejections (both quote kinds, both W3C forms, a child element) and a fixed case with tab and line feed separators. The generator now varies the whitespace before each attribute (never empty), before the end of a tag, in end tags, and at the top level, so the 3200 generated documents differ from the earlier run. - SPEC.md and README.md state the rule, and the new row says exactly what the theorem covers. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Proofs/Refusals.lean | 70 +++++++++++++++++++++++++++++++++++++++--- Proofs/RoundTrip.lean | 5 ++- Proofs/SpecProofs.lean | 11 +++++++ README.md | 1 + SPEC.md | 7 ++++- Spec.lean | 15 +++++++++ Xml/Parse.lean | 14 +++++++-- bar.toml | 2 +- comparator.json | 2 +- tests/TEST-RESULTS.md | 6 ++-- tests/run_tests.py | 48 ++++++++++++++++++++++++----- 11 files changed, 159 insertions(+), 22 deletions(-) diff --git a/Proofs/Refusals.lean b/Proofs/Refusals.lean index 244bf5f..294889a 100644 --- a/Proofs/Refusals.lean +++ b/Proofs/Refusals.lean @@ -75,7 +75,8 @@ theorem parse_attrs_none (prolog : List Node) (hpro : MiscOk prolog) (name : List Char) (hname : ValidName name) (attrs : List (List Char × List Char)) (hattrs : AttrsOk attrs) (tail : List Char) - (ht : ∀ c, tail.head? = some c → isNameChar c = false) + (ht : ∀ c, (printAttrs attrs ++ tail).head? = some c → + isNameChar c = false) (hcont : ∀ f, 1 ≤ f → parseAttrs f attrs tail = none) : parse (printNodes prolog ++ '<' :: (name ++ (printAttrs attrs ++ tail))) = none := by @@ -103,7 +104,7 @@ theorem parse_attrs_none (prolog : List Node) (hpro : MiscOk prolog) · intro f' hf' simpa using hcont f' hf' exact parseElement_attrs_none (name := c0 :: ds) ⟨c0, ds, rfl, hc0, hds⟩ - (printAttrs_head_not_name attrs tail ht) ha + ht ha /-! ## The name `xmlns` -/ @@ -127,7 +128,7 @@ theorem parseAttrs_xmlns (f : Nat) (hf : 1 ≤ f) have hpn : parseName ('x' :: 'm' :: 'l' :: 'n' :: 's' :: rest) = some (xmlnsName, rest) := parseName_append validName_xmlns hr - simp [parseAttrs, hsk, hpn] + simp [parseAttrs, hsk, hpn, startsWithWs, isWs] /-- An attribute named `xmlns` on the root element is refused, after any well formed prolog and any well formed attributes @@ -146,7 +147,8 @@ theorem rejects_xmlns (prolog : List Node) (name : List Char) simp [List.append_assoc] rw [e] apply parse_attrs_none prolog hpro name hname attrs hattrs - · intro c hc + · apply printAttrs_head_not_name + intro c hc simp at hc rw [← hc] exact isNameChar_false_of not_nameChar_space @@ -154,4 +156,64 @@ theorem rejects_xmlns (prolog : List Node) (name : List Char) exact parseAttrs_xmlns f hf attrs rest (fun c hc => isNameChar_false_of (hrest c hc)) +/-! ## Whitespace between attributes -/ + +/-- The printed attributes, when there is at least one, start with + a space, which is not a name character. -/ +theorem printAttrs_head_space (attrs : List (List Char × List Char)) + (hne : attrs ≠ []) (tail : List Char) : + ∀ c, (printAttrs attrs ++ tail).head? = some c → + isNameChar c = false := by + intro c hc + cases attrs with + | nil => exact absurd rfl hne + | cons kv as => + simp only [printAttrs, List.cons_append, List.head?_cons] at hc + rw [← Option.some.inj hc] + exact isNameChar_false_of not_nameChar_space + +/-- The attribute reader refuses a name that starts right where + the text does, with no whitespace before it. -/ +theorem parseAttrs_no_space (f : Nat) (hf : 1 ≤ f) + (acc : List (List Char × List Char)) (c : Char) (rest : List Char) + (hc : IsNameStart c) : + parseAttrs f acc (c :: rest) = none := by + cases f with + | zero => omega + | succ g => + have hw : isWs c = false := isWs_false_of_not (IsNameStart.ne_ws hc) + have h1 : c ≠ '/' := IsNameStart.ne_slash hc + have h2 : c ≠ '>' := IsNameStart.ne_of_test hc (by decide) + simp only [parseAttrs, skipWs, hw, startsWithWs, Bool.and_false, + Bool.false_eq_true, ite_false] + split + · rename_i r e + exact absurd (List.cons.inj e).1 h1 + · rename_i r e + exact absurd (List.cons.inj e).1 h2 + · rfl + · rfl + +/-- An attribute name that starts right after the closing quote of + the attribute before it, with no whitespace between them, is + refused, on the root element after any well formed prolog and + at least one well formed attribute, printed, whatever follows + the first character of the name. -/ +theorem rejects_attribute_without_space (prolog : List Node) + (name : List Char) (attrs : List (List Char × List Char)) + (c : Char) (rest : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) + (hattrs : AttrsOk attrs) (hne : attrs ≠ []) (hc : IsNameStart c) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ + c :: rest) = none := by + have e : printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ + c :: rest = + printNodes prolog ++ '<' :: (name ++ (printAttrs attrs ++ + c :: rest)) := by + simp [List.append_assoc] + rw [e] + exact parse_attrs_none prolog hpro name hname attrs hattrs (c :: rest) + (printAttrs_head_space attrs hne (c :: rest)) + (fun f hf => parseAttrs_no_space f hf attrs c rest hc) + end Xml.Proofs diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index 2ba04e0..1d43ad5 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -1002,8 +1002,11 @@ theorem parseAttrs_print : ∀ (attrs : List (List Char × List Char)) (printAttrs (((c0 :: ds), v) :: attrs) ++ tail) = parseAttrs f' (acc ++ [((c0 :: ds), v)]) (printAttrs attrs ++ tail) := by + have hsw : startsWithWs + (printAttrs (((c0 :: ds), v) :: attrs) ++ tail) = true := by + simp [printAttrs, startsWithWs, isWs] simp [parseAttrs, hsk, hpn2, hval', hdup, hc0ne1, hc0ne2, hnx, - isNameStart_of hc0, List.cons_append, List.append_assoc, + isNameStart_of hc0, hsw, List.cons_append, List.append_assoc, skipWs_cons (by decide : isWs '=' = false), skipWs_cons (by decide : isWs '"' = false)] rwa [hstep] diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index e26bf7d..6d95fd7 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -111,3 +111,14 @@ theorem Spec.rejects_xmlns (prolog : List Node) (name : List Char) parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ ' ' :: xmlnsName ++ rest) = none := Xml.Proofs.rejects_xmlns prolog name attrs rest hpro hname hattrs hrest + + +theorem Spec.rejects_attribute_without_space (prolog : List Node) + (name : List Char) (attrs : List (List Char × List Char)) + (c : Char) (rest : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) + (hattrs : AttrsOk attrs) (hne : attrs ≠ []) (hc : IsNameStart c) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ + c :: rest) = none := + Xml.Proofs.rejects_attribute_without_space prolog name attrs c rest + hpro hname hattrs hne hc diff --git a/README.md b/README.md index f399c85..1b9fb95 100644 --- a/README.md +++ b/README.md @@ -75,6 +75,7 @@ where they end in `sorry`) and proved in | An attribute value with no quotes is refused. | `Spec.rejects_unquoted_attribute` | | A CDATA section in the prolog is refused. | `Spec.rejects_cdata_in_prolog` | | The XML declaration form is refused. | `Spec.rejects_xml_declaration` | +| An attribute name that starts right after the closing quote of the attribute before it, with no whitespace between them, is refused: on the root element, after any well formed prolog and at least one well formed attribute, both printed in canonical form, whatever follows the first character of the name. | `Spec.rejects_attribute_without_space` | | An attribute named `xmlns` (a default namespace declaration) on the root element is refused: after any well formed prolog and any well formed attributes before it, both printed in canonical form, whatever follows the name, as long as it does not make the name longer. | `Spec.rejects_xmlns` | A document is well formed when its names match the diff --git a/SPEC.md b/SPEC.md index 24b56ea..3cde920 100644 --- a/SPEC.md +++ b/SPEC.md @@ -64,7 +64,11 @@ parsed leniently. is refused: `xmlnsx`, `XMLNS`, and an element named `xmlns` declare nothing and are ordinary names. A prefixed declaration (`xmlns:p`) rejects by the colon rule. -- Whitespace may appear between attributes, around the equals +- Whitespace (space, tab, line feed, carriage return) must stand + before each attribute, as XML 1.0 requires (`(S Attribute)*` in + productions [40] and [44]): an attribute name that starts right + after the closing quote of the one before it rejects, as in + ``. Whitespace may also appear around the equals sign, and before the closing bracket of a start tag or an end tag. - In an attribute value: character references and the five @@ -214,6 +218,7 @@ each rule on many more inputs. | An attribute value with no quotes is refused | `Spec.rejects_unquoted_attribute` | | A CDATA section in the prolog is refused | `Spec.rejects_cdata_in_prolog` | | The XML declaration form is refused | `Spec.rejects_xml_declaration` | +| An attribute name right after the closing quote of the attribute before it, with no whitespace between them, is refused, on the root element after any well formed prolog and at least one well formed attribute, printed, whatever follows the first character of the name | `Spec.rejects_attribute_without_space` | | An attribute named `xmlns` on the root element is refused, after any well formed prolog and any well formed attributes before it, printed, whatever follows the name that does not make it longer | `Spec.rejects_xmlns` | The round trip behind `Spec.parse_print` is diff --git a/Spec.lean b/Spec.lean index 87ed777..85fb390 100644 --- a/Spec.lean +++ b/Spec.lean @@ -128,3 +128,18 @@ theorem Spec.rejects_xmlns (prolog : List Node) (name : List Char) (hrest : ∀ c, rest.head? = some c → ¬ IsNameChar c) : parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ ' ' :: xmlnsName ++ rest) = none := sorry + +/-- An attribute must have whitespace before it, as XML 1.0 + productions [40] and [44] require: a name that starts right + after the closing quote of the attribute before it is refused. + Stated for the root element of a text that starts with any well + formed prolog, printed, then the root's start tag with at least + one well formed attribute, printed, then a name start + character, then anything. -/ +theorem Spec.rejects_attribute_without_space (prolog : List Node) + (name : List Char) (attrs : List (List Char × List Char)) + (c : Char) (rest : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) + (hattrs : AttrsOk attrs) (hne : attrs ≠ []) (hc : IsNameStart c) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ + c :: rest) = none := sorry diff --git a/Xml/Parse.lean b/Xml/Parse.lean index ed3bbd8..5b5f0f1 100644 --- a/Xml/Parse.lean +++ b/Xml/Parse.lean @@ -278,11 +278,19 @@ def parseCharData : Nat → List Char → Option (List Char × List Char) | some (t, r) => (parseCharData fuel r).map fun (t2, r2) => (t ++ t2, r2) | none => none +/-- Whether the text starts with whitespace. -/ +def startsWithWs : List Char → Bool + | c :: _ => isWs c + | [] => false + /-- Read the attributes of a start tag, and how the tag ends. Attributes read so far are in `acc`, in order. Returns the attributes, the text after the tag, and whether the tag was - the empty form. A repeated attribute name is rejected, and so - is the name `xmlns`, which would declare a default namespace. -/ + the empty form. Each attribute must have whitespace before it, + as XML 1.0 requires (`(S Attribute)*` in productions [40] and + [44]), so a name right after a closing quote is rejected. A + repeated attribute name is rejected, and so is the name + `xmlns`, which would declare a default namespace. -/ def parseAttrs : Nat → List (List Char × List Char) → List Char → Option (List (List Char × List Char) × List Char × Bool) | 0, _, _ => none @@ -291,7 +299,7 @@ def parseAttrs : Nat → List (List Char × List Char) → List Char → | '/' :: '>' :: rest => some (acc, rest, true) | '>' :: rest => some (acc, rest, false) | c :: _ => - if isNameStart c then + if isNameStart c && startsWithWs cs then match parseName (skipWs cs) with | some (aname, r1) => if aname = xmlnsName then none else diff --git a/bar.toml b/bar.toml index 3188055..b893615 100644 --- a/bar.toml +++ b/bar.toml @@ -35,7 +35,7 @@ code = [ "Xml.charRefChar", "Xml.parseRef", "Xml.takeNameChars", "Xml.parseName", "Xml.parseTextRun", "Xml.parseCDATABody", "Xml.parseCommentBody", "Xml.parsePIData", "Xml.parseAttrValue", "Xml.parsePI", - "Xml.parseCharData", "Xml.parseAttrs", "Xml.parseElement", + "Xml.parseCharData", "Xml.startsWithWs", "Xml.parseAttrs", "Xml.parseElement", "Xml.parseNodes", "Xml.parseMisc", "Xml.parseDocument", "Xml.parse", ] diff --git a/comparator.json b/comparator.json index d2ea3a5..89433a3 100644 --- a/comparator.json +++ b/comparator.json @@ -1 +1 @@ -{"challenge_module":"Spec","permitted_axioms":["propext","Classical.choice","Quot.sound"],"solution_module":"Proofs","theorem_names":["Spec.parse_print","Spec.rejects_doctype","Spec.rejects_undefined_entity","Spec.rejects_mismatched_tags","Spec.rejects_unclosed_element","Spec.rejects_second_root","Spec.rejects_text_before_root","Spec.rejects_duplicate_attribute","Spec.rejects_lt_in_attribute","Spec.rejects_cdata_close_in_text","Spec.rejects_dashdash_in_comment","Spec.rejects_surrogate_ref","Spec.rejects_zero_ref","Spec.rejects_colon_in_name","Spec.rejects_digit_name","Spec.rejects_unquoted_attribute","Spec.rejects_cdata_in_prolog","Spec.rejects_xml_declaration","Spec.rejects_xmlns"]} \ No newline at end of file +{"challenge_module":"Spec","permitted_axioms":["propext","Classical.choice","Quot.sound"],"solution_module":"Proofs","theorem_names":["Spec.parse_print","Spec.rejects_doctype","Spec.rejects_undefined_entity","Spec.rejects_mismatched_tags","Spec.rejects_unclosed_element","Spec.rejects_second_root","Spec.rejects_text_before_root","Spec.rejects_duplicate_attribute","Spec.rejects_lt_in_attribute","Spec.rejects_cdata_close_in_text","Spec.rejects_dashdash_in_comment","Spec.rejects_surrogate_ref","Spec.rejects_zero_ref","Spec.rejects_colon_in_name","Spec.rejects_digit_name","Spec.rejects_unquoted_attribute","Spec.rejects_cdata_in_prolog","Spec.rejects_xml_declaration","Spec.rejects_xmlns","Spec.rejects_attribute_without_space"]} \ No newline at end of file diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index b9b5f74..03d9f18 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -5,13 +5,13 @@ Written by `tests/run_tests.py`. Rerun it to check these numbers. - Oracle: Python 3.13.17 `xml.etree.ElementTree`, expat_2.6.1 (`ET.XMLParser`, which turns namespace processing on, with a `TreeBuilder` that keeps comments and processing instructions) - Lean tool: Lean (version 4.35.0, x86_64-unknown-linux-gnu, commit eb6cafb7290e8bd5f2937522d8d804f58f02bafc, Release) - Seed: 20261026 -- Inputs: 3298 +- Inputs: 3304 - every request sent to the tool: the fixed cases, the generated documents, the named rejections, the malformed requests, and two bare parse requests -- Fixed cases passed: 37 of 37 +- Fixed cases passed: 38 of 38 - Generated in-subset documents: 3200 - Generated documents where the tool's canonical print matches the tree and ElementTree agrees on the tree: 3200 - ElementTree tree agreements on generated documents: 3200 -- Named rejections rejected by the tool: 49 of 49 +- Named rejections rejected by the tool: 54 of 54 - Out of subset disagreements (ElementTree accepts, this slice rejects, by design): 10 - document type declaration - document type declaration with internal subset diff --git a/tests/run_tests.py b/tests/run_tests.py index 14b1dc7..afb0bb7 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -18,7 +18,10 @@ choices that do not change the tree: quote choice, CDATA spellings of text, entity and character reference spellings, the two empty element spellings, literal whitespace in - attribute values (which the subset normalizes to a space). + attribute values (which the subset normalizes to a space), + the whitespace before each attribute (never empty), around the + equals sign and before the end of a tag, and whitespace at the + top level around the prolog, the root and the epilog. For every document: - the Lean tool must accept it, and its canonical print must @@ -287,6 +290,8 @@ def run_requests(texts, failures, part): ("", ''), ("", ""), + # any whitespace separates attributes: space, tab, line feed + ("", ''), ] # Named rejections: (rule, input). ElementTree's verdict is @@ -330,6 +335,15 @@ def run_requests(texts, failures, part): ("name starting with a digit", "<1a/>"), ("attribute name starting with a digit", ""), ("unquoted attribute value", ""), + ("no whitespace between attributes", ""), + ("no whitespace between attributes, single quotes", + ""), + ("no whitespace between attributes (W3C o-p40fail1)", + ""), + ("no whitespace between attributes in an empty element tag", + ""), + ("no whitespace between attributes on a child element", + ""), ("missing equals", ""), ("CDATA section in the prolog", ""), ("CDATA section in the epilog", ""), @@ -542,6 +556,20 @@ def gen_pi(rng): ("pi", target, data)) +# Whitespace inside tags and at the top level. A separator before an +# attribute is never empty: XML 1.0 [40] and [44] require one. +SEPS = [" ", " ", " ", " ", "\t", "\n", " \n\t"] +OPT_WS = ["", "", "", " ", "\n", "\t "] + + +def gen_sep(rng): + return rng.choice(SEPS) + + +def gen_opt_ws(rng): + return rng.choice(OPT_WS) + + def gen_element(rng, depth): name = gen_name(rng) used = set() @@ -555,7 +583,7 @@ def gen_element(rng, depth): sp, val, q = gen_attr_value(rng) attrs.append((an, val)) eq = rng.choice(["=", " = ", "= ", " ="]) - attr_spell.append(" " + an + eq + q + sp + q) + attr_spell.append(gen_sep(rng) + an + eq + q + sp + q) content = [] content_spell = [] if depth < 4: @@ -581,13 +609,13 @@ def gen_element(rng, depth): content.append(("text", model)) content_spell.append(sp) model = ("elem", name, attrs, content) + stag = "<" + name + "".join(attr_spell) + gen_opt_ws(rng) + etag = "" if not content: if rng.random() < 0.5: - return "<" + name + "".join(attr_spell) + "/>", model - return ("<" + name + "".join(attr_spell) + ">", - model) - return ("<" + name + "".join(attr_spell) + ">" - + "".join(content_spell) + "", model) + return stag + "/>", model + return stag + ">" + etag, model + return stag + ">" + "".join(content_spell) + etag, model def gen_document(rng): @@ -610,7 +638,11 @@ def gen_document(rng): sp, node = gen_pi(rng) epilog.append(node) epilog_spell.append(sp) - text = "".join(prolog_spell) + root_sp + "".join(epilog_spell) + text = (gen_opt_ws(rng) + + "".join(sp + gen_opt_ws(rng) for sp in prolog_spell) + + root_sp + + "".join(gen_opt_ws(rng) + sp for sp in epilog_spell) + + gen_opt_ws(rng)) return text, (prolog, root, epilog) From fc29495e50d9b1afcacab01a7f545c9c4948e7e9 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 17:28:46 +0000 Subject: [PATCH 08/18] Normalize line ends before parsing, as XML 1.0 section 2.11 requires Review 1 finding 5, repeated in review 3: a literal carriage return was kept in the tree. x CR LF y read as x CR LF y and printed as x \ny, which every conforming parser reads with a CR, while ElementTree reads the input as x LF y. Section 2.11 requires CR LF, and a CR not followed by LF, to become one LF before parsing. The plan does not choose otherwise, so the parser now does that. - Xml/Parse.lean: new normEol; parse normalizes the text, then reads it. parseAttrValue drops its CR LF branch, which normalization made unreachable; a CR there would also read as a space. - Xml/Value.lean: WF now requires that comment bodies and processing instruction data hold no CR. After normalization the parser can never give one there (they have no character references), and the printer could not write one back. - Proofs/RoundTrip.lean: the print of a WF document holds no CR (noCR_print), so normalization leaves it unchanged and parse_print still holds. - Spec.lean: Spec.crlf_reads_as_lf and Spec.cr_reads_as_lf, general statements: anywhere in a text, CR LF reads exactly as LF, and a CR not followed by LF reads exactly as LF, unless the text before ends with a CR. Proved in the new Proofs/LineEnds.lean and listed in comparator.json; bar.toml lists Xml.normEol as code under proof. Proofs/Refusals.lean now follows the parser through normalization. - tests: ten fixed cases (text, CDATA, comments, PI data, attribute values, tags, the top level, a CR kept by reference). The generator spells line feeds of the tree as LF, CR LF or a lone CR in text, comments, PI data, tag whitespace and the top level, and ElementTree now agrees on all of them. The named difference the harness used to describe is gone. - SPEC.md gets a Line ends section and the WF conditions; the boundary that said CR is kept is removed, from README.md too. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Proofs.lean | 1 + Proofs/LineEnds.lean | 148 +++++++++++++++++++++++++++++++++++++++++ Proofs/Refusals.lean | 59 +++++++++++----- Proofs/RoundTrip.lean | 123 +++++++++++++++++++++++++++++++++- Proofs/SpecProofs.lean | 13 ++++ README.md | 32 ++++----- SPEC.md | 38 ++++++----- Spec.lean | 17 +++++ Xml/Parse.lean | 51 ++++++++------ Xml/Value.lean | 26 +++++--- bar.toml | 3 +- comparator.json | 2 +- tests/TEST-RESULTS.md | 4 +- tests/run_tests.py | 89 +++++++++++++++++++------ 14 files changed, 503 insertions(+), 103 deletions(-) create mode 100644 Proofs/LineEnds.lean diff --git a/Proofs.lean b/Proofs.lean index 6f0eac6..024daef 100644 --- a/Proofs.lean +++ b/Proofs.lean @@ -1,3 +1,4 @@ import Proofs.RoundTrip +import Proofs.LineEnds import Proofs.Refusals import Proofs.SpecProofs diff --git a/Proofs/LineEnds.lean b/Proofs/LineEnds.lean new file mode 100644 index 0000000..fbc7cf6 --- /dev/null +++ b/Proofs/LineEnds.lean @@ -0,0 +1,148 @@ +/- + Line ends: the parser normalizes them before it reads, as XML 1.0 + section 2.11 requires. The lemmas here say how the normalization + `normEol` acts on a text made of two parts, and the two theorems + at the end say what that means for `parse`: a carriage return + followed by a line feed reads as one line feed, and a carriage + return followed by anything else reads as a line feed. +-/ + +import Xml +import Proofs.RoundTrip + +namespace Xml.Proofs + +open Xml + +/-! ## Line ends in a text with a printed head -/ + +/-- Normalizing a text whose head holds no carriage return leaves + the head as it is. -/ +theorem normEol_append_noCR : ∀ (A B : List Char), '\r' ∉ A → + normEol (A ++ B) = A ++ normEol B + | [], _, _ => rfl + | c :: A, B, h => by + have hc : c ≠ '\r' := fun e => h (e ▸ List.mem_cons_self) + have hA : '\r' ∉ A := fun m => h (List.mem_cons_of_mem _ m) + rw [List.cons_append, normEol_cons_ne hc, normEol_append_noCR A B hA, + List.cons_append] + +/-- The head of a normalized text is the head of the text, or a + line feed. -/ +theorem normEol_head (cs : List Char) (c : Char) + (h : (normEol cs).head? = some c) : cs.head? = some c ∨ c = '\n' := by + match cs with + | [] => simp [normEol] at h + | '\r' :: '\n' :: rest => + rw [normEol.eq_2] at h + exact Or.inr (Option.some.inj h).symm + | '\r' :: [] => + rw [normEol.eq_3 _ (by intro r e; cases e)] at h + exact Or.inr (Option.some.inj h).symm + | '\r' :: d :: rest => + by_cases hd : d = '\n' + · subst hd + rw [normEol.eq_2] at h + exact Or.inr (Option.some.inj h).symm + · rw [normEol.eq_3 _ (by intro r e; exact hd (List.cons.inj e).1)] at h + exact Or.inr (Option.some.inj h).symm + | d :: rest => + by_cases hd : d = '\r' + · subst hd + cases rest with + | nil => + rw [normEol.eq_3 _ (by intro r e; cases e)] at h + exact Or.inr (Option.some.inj h).symm + | cons e rest' => + by_cases he : e = '\n' + · subst he + rw [normEol.eq_2] at h + exact Or.inr (Option.some.inj h).symm + · rw [normEol.eq_3 _ (by intro r e2; exact he (List.cons.inj e2).1)] at h + exact Or.inr (Option.some.inj h).symm + · rw [normEol_cons_ne hd] at h + exact Or.inl h + +/-- A text whose head is not a name character keeps that property + when its line ends are normalized. -/ +theorem normEol_head_not_name (cs : List Char) + (h : ∀ c, cs.head? = some c → ¬ IsNameChar c) : + ∀ c, (normEol cs).head? = some c → isNameChar c = false := by + intro c hc + rcases normEol_head cs c hc with h1 | h1 + · exact isNameChar_false_of (h c h1) + · subst h1 + decide + +/-- Normalizing a text made of two parts is normalizing each part, + when the first part does not end with a carriage return (which + could pair with a line feed at the head of the second). -/ +theorem normEol_append (A B : List Char) (h : ∀ x, A ≠ x ++ ['\r']) : + normEol (A ++ B) = normEol A ++ normEol B := by + induction A using normEol.induct with + | case1 => simp [normEol.eq_1] + | case2 rest ih => + have h' : ∀ x, rest ≠ x ++ ['\r'] := by + intro x e + exact h ('\r' :: '\n' :: x) (by rw [e]; rfl) + rw [List.cons_append, List.cons_append, normEol.eq_2, normEol.eq_2, + ih h', List.cons_append] + | case3 rest hrest ih => + cases rest with + | nil => exact absurd rfl (h []) + | cons d ds => + have h' : ∀ x, d :: ds ≠ x ++ ['\r'] := by + intro x e + exact h ('\r' :: x) (by rw [e]; rfl) + have hne : ∀ r, d :: ds ++ B ≠ '\n' :: r := by + intro r e + rw [List.cons_append] at e + exact hrest ds (by rw [(List.cons.inj e).1]) + rw [List.cons_append, normEol.eq_3 _ hne, normEol.eq_3 _ hrest, + ih h', List.cons_append] + | case4 c rest _ hc ih => + have h' : ∀ x, rest ≠ x ++ ['\r'] := by + intro x e + exact h (c :: x) (by rw [e]; rfl) + rw [List.cons_append, normEol_cons_ne hc, normEol_cons_ne hc, + ih h', List.cons_append] + +/-- A carriage return followed by a line feed reads as one line + feed, wherever it stands, unless the text before it ends with + a carriage return (which would pair with the line feed + first). -/ +theorem crlf_reads_as_lf (pre post : List Char) + (hpre : pre.getLast? ≠ some '\r') : + parse (pre ++ '\r' :: '\n' :: post) = parse (pre ++ '\n' :: post) := by + have h : ∀ x, pre ≠ x ++ ['\r'] := by + intro x e + exact hpre (List.getLast?_eq_some_iff.mpr ⟨x, e⟩) + have e1 : normEol (pre ++ '\r' :: '\n' :: post) = + normEol (pre ++ '\n' :: post) := by + rw [normEol_append _ _ h, normEol_append _ _ h, normEol.eq_2, + normEol_cons_ne (by decide)] + show parseDocument ((normEol _).length + 1) (normEol _) = + parseDocument ((normEol _).length + 1) (normEol _) + rw [e1] + +/-- A carriage return not followed by a line feed reads as a line + feed, wherever it stands, unless the text before it ends with + a carriage return. -/ +theorem cr_reads_as_lf (pre post : List Char) + (hpre : pre.getLast? ≠ some '\r') (hpost : post.head? ≠ some '\n') : + parse (pre ++ '\r' :: post) = parse (pre ++ '\n' :: post) := by + have h : ∀ x, pre ≠ x ++ ['\r'] := by + intro x e + exact hpre (List.getLast?_eq_some_iff.mpr ⟨x, e⟩) + have hp : ∀ r, post ≠ '\n' :: r := by + intro r e + rw [e] at hpost + exact hpost rfl + have e1 : normEol (pre ++ '\r' :: post) = normEol (pre ++ '\n' :: post) := by + rw [normEol_append _ _ h, normEol_append _ _ h, + normEol.eq_3 _ (fun r e => hp r e), normEol_cons_ne (by decide)] + show parseDocument ((normEol _).length + 1) (normEol _) = + parseDocument ((normEol _).length + 1) (normEol _) + rw [e1] + +end Xml.Proofs diff --git a/Proofs/Refusals.lean b/Proofs/Refusals.lean index 294889a..ba75759 100644 --- a/Proofs/Refusals.lean +++ b/Proofs/Refusals.lean @@ -12,6 +12,7 @@ import Xml import Proofs.RoundTrip +import Proofs.LineEnds namespace Xml.Proofs @@ -21,11 +22,22 @@ open Xml /-- A text made of a printed prolog and then a less sign and a name start character is refused when the element reader refuses the - root at every fuel large enough. -/ + root, with its line ends normalized, at every fuel large + enough. -/ theorem parse_root_none (prolog : List Node) (hpro : MiscOk prolog) - (c : Char) (cs : List Char) (hc : IsNameStart c) - (he : ∀ f, cs.length + 3 ≤ f → parseElement f ('<' :: c :: cs) = none) : - parse (printNodes prolog ++ '<' :: c :: cs) = none := by + (c : Char) (cs0 : List Char) (hc : IsNameStart c) + (he : ∀ f, (normEol cs0).length + 3 ≤ f → + parseElement f ('<' :: c :: normEol cs0) = none) : + parse (printNodes prolog ++ '<' :: c :: cs0) = none := by + have hcr : c ≠ '\r' := fun e => not_nameChar_cr (e ▸ IsNameStart.toNameChar hc) + have hn : normEol (printNodes prolog ++ '<' :: c :: cs0) = + printNodes prolog ++ '<' :: c :: normEol cs0 := by + rw [normEol_append_noCR _ _ (noCR_printNodes_misc prolog hpro), + normEol_cons_ne (by decide), normEol_cons_ne hcr] + show parseDocument ((normEol (printNodes prolog ++ '<' :: c :: cs0)).length + 1) + (normEol (printNodes prolog ++ '<' :: c :: cs0)) = none + rw [hn] + generalize normEol cs0 = cs at he have hstop : ∀ f, 1 ≤ f → parseMisc f ('<' :: c :: cs) = some ([], skipWs ('<' :: c :: cs)) := by intro f hf @@ -40,7 +52,6 @@ theorem parse_root_none (prolog : List Node) (hpro : MiscOk prolog) rw [skipWs_cons (show isWs '<' = false by decide)] at hm have hroot := he ((printNodes prolog ++ '<' :: c :: cs).length + 1) (by simp only [List.length_append, List.length_cons]; omega) - show parseDocument _ _ = none simp only [parseDocument, hm, hroot] /-- The element reader at a start tag whose name is read whole: it @@ -69,21 +80,26 @@ theorem printAttrs_head_not_name (attrs : List (List Char × List Char)) /-- A root start tag with printed attributes, at the head of a text after a printed prolog, is refused when the attribute reader - refuses whatever follows the printed attributes, at any fuel - from one up. -/ + refuses whatever follows the printed attributes, with its line + ends normalized, at any fuel from one up. -/ theorem parse_attrs_none (prolog : List Node) (hpro : MiscOk prolog) (name : List Char) (hname : ValidName name) (attrs : List (List Char × List Char)) (hattrs : AttrsOk attrs) - (tail : List Char) - (ht : ∀ c, (printAttrs attrs ++ tail).head? = some c → + (tail0 : List Char) + (ht : ∀ c, (printAttrs attrs ++ normEol tail0).head? = some c → isNameChar c = false) - (hcont : ∀ f, 1 ≤ f → parseAttrs f attrs tail = none) : - parse (printNodes prolog ++ '<' :: (name ++ (printAttrs attrs ++ tail))) = + (hcont : ∀ f, 1 ≤ f → parseAttrs f attrs (normEol tail0) = none) : + parse (printNodes prolog ++ '<' :: (name ++ (printAttrs attrs ++ tail0))) = none := by + have hnn := noCR_validName hname obtain ⟨c0, ds, hq, hc0, hds⟩ := hname subst hq rw [List.cons_append] apply parse_root_none prolog hpro c0 _ hc0 + have hds' : '\r' ∉ ds := fun m => hnn (List.mem_cons_of_mem _ m) + rw [normEol_append_noCR _ _ hds', + normEol_append_noCR _ _ (noCR_printAttrs attrs hattrs)] + generalize normEol tail0 = tail at ht hcont intro f hf cases f with | zero => omega @@ -146,15 +162,21 @@ theorem rejects_xmlns (prolog : List Node) (name : List Char) ' ' :: (xmlnsName ++ rest))) := by simp [List.append_assoc] rw [e] + have hn : normEol (' ' :: (xmlnsName ++ rest)) = + ' ' :: (xmlnsName ++ normEol rest) := by + rw [normEol_cons_ne (by decide), + normEol_append_noCR _ _ (by decide)] apply parse_attrs_none prolog hpro name hname attrs hattrs - · apply printAttrs_head_not_name + · rw [hn] + apply printAttrs_head_not_name intro c hc simp at hc rw [← hc] exact isNameChar_false_of not_nameChar_space · intro f hf - exact parseAttrs_xmlns f hf attrs rest - (fun c hc => isNameChar_false_of (hrest c hc)) + rw [hn] + exact parseAttrs_xmlns f hf attrs (normEol rest) + (normEol_head_not_name rest hrest) /-! ## Whitespace between attributes -/ @@ -212,8 +234,11 @@ theorem rejects_attribute_without_space (prolog : List Node) c :: rest)) := by simp [List.append_assoc] rw [e] - exact parse_attrs_none prolog hpro name hname attrs hattrs (c :: rest) - (printAttrs_head_space attrs hne (c :: rest)) - (fun f hf => parseAttrs_no_space f hf attrs c rest hc) + have hcr : c ≠ '\r' := fun e => not_nameChar_cr (e ▸ IsNameStart.toNameChar hc) + apply parse_attrs_none prolog hpro name hname attrs hattrs (c :: rest) + (printAttrs_head_space attrs hne _) + intro f hf + rw [normEol_cons_ne hcr] + exact parseAttrs_no_space f hf attrs c (normEol rest) hc end Xml.Proofs diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index 1d43ad5..eb30179 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -1553,10 +1553,130 @@ theorem parseMisc_print : skipWs_cons (show isWs '<' = false by decide), List.append_assoc] +/-! ## Line ends + +The parser normalizes line ends before it reads. The print of a well +formed document holds no carriage return: text and attribute values +write one as a character reference, and comments and processing +instructions hold none. So normalization leaves the print as it is. -/ + +theorem normEol_cons_ne {c : Char} (h : c ≠ '\r') (rest : List Char) : + normEol (c :: rest) = c :: normEol rest := + normEol.eq_4 c rest (fun _ e _ => h e) h + +theorem normEol_of_noCR : ∀ (cs : List Char), '\r' ∉ cs → normEol cs = cs + | [], _ => normEol.eq_1 + | c :: rest, h => by + have hc : c ≠ '\r' := fun e => h (e ▸ List.mem_cons_self) + have hr : '\r' ∉ rest := fun m => h (List.mem_cons_of_mem _ m) + rw [normEol_cons_ne hc, normEol_of_noCR rest hr] + +theorem noCR_escapeTextChar (c : Char) : '\r' ∉ escapeTextChar c := by + rcases escapeTextChar_cases c with + ⟨_, h⟩ | ⟨_, h⟩ | ⟨_, h⟩ | ⟨_, h⟩ | ⟨_, _, _, h4, h⟩ + · rw [h]; decide + · rw [h]; decide + · rw [h]; decide + · rw [h]; decide + · rw [h] + simp only [List.mem_singleton] + exact fun e => h4 e.symm + +theorem noCR_escapeAttrChar (c : Char) : '\r' ∉ escapeAttrChar c := by + rcases escapeAttrChar_cases c with + ⟨_, h⟩ | ⟨_, h⟩ | ⟨_, h⟩ | ⟨_, h⟩ | ⟨_, h⟩ | ⟨_, h⟩ | + ⟨_, _, _, _, _, h6, h⟩ + · rw [h]; decide + · rw [h]; decide + · rw [h]; decide + · rw [h]; decide + · rw [h]; decide + · rw [h]; decide + · rw [h] + simp only [List.mem_singleton] + exact fun e => h6 e.symm + +theorem noCR_escapeText (cs : List Char) : '\r' ∉ escapeText cs := by + simp only [escapeText, List.mem_flatMap, not_exists, not_and] + intro c _ + exact noCR_escapeTextChar c + +theorem noCR_escapeAttr (cs : List Char) : '\r' ∉ escapeAttr cs := by + simp only [escapeAttr, List.mem_flatMap, not_exists, not_and] + intro c _ + exact noCR_escapeAttrChar c + +theorem not_nameChar_cr : ¬ IsNameChar '\r' := + not_nameChar_of_test (by decide) + +theorem noCR_validName {cs : List Char} (h : ValidName cs) : '\r' ∉ cs := by + obtain ⟨c, ds, rfl, hc, hds⟩ := h + intro m + rcases List.mem_cons.mp m with e | e + · exact not_nameChar_cr (e ▸ IsNameStart.toNameChar hc) + · exact not_nameChar_cr (hds _ e) + +theorem noCR_printAttrs : ∀ (attrs : List (List Char × List Char)), + AttrsOk attrs → '\r' ∉ printAttrs attrs + | [], _ => by simp [printAttrs] + | (k, v) :: rest, h => by + have h1 := noCR_validName h.1 + have h2 := noCR_escapeAttr v + have h3 := noCR_printAttrs rest h.2.2.2.2 + simp [printAttrs, h1, h2, h3] + +mutual +theorem noCR_printNode : ∀ (n : Node), WFNode n → '\r' ∉ printNode n + | .text cs, _ => by simpa [printNode] using noCR_escapeText cs + | .elem name attrs content, h => by + cases h with + | elem hname hattrs hcontent => + have h1 := noCR_validName hname + have h2 := noCR_printAttrs attrs hattrs + have h3 := noCR_printNodes content hcontent + simp only [printNode, printElem] + split <;> simp [h1, h2, h3] + | .comment cs, h => by + cases h with + | comment _ _ _ hcr => simp [printNode, hcr] + | .pi t d, h => by + cases h with + | pi hname _ _ _ _ hcr => + have h1 := noCR_validName hname + simp only [printNode] + split <;> simp [h1, hcr] +theorem noCR_printNodes : ∀ (ns : List Node), WFNodes ns → + '\r' ∉ printNodes ns + | [], _ => by simp [printNodes] + | n :: ns, h => by + cases h with + | cons hn hns _ => + have h1 := noCR_printNode n hn + have h2 := noCR_printNodes ns hns + simp [printNodes, h1, h2] +end + +theorem noCR_printNodes_misc : ∀ (ns : List Node), MiscOk ns → + '\r' ∉ printNodes ns + | [], _ => by simp [printNodes] + | n :: ns, h => by + have h1 := noCR_printNode n (h n (by simp)).1 + have h2 := noCR_printNodes_misc ns (fun m hm => h m (by simp [hm])) + simp [printNodes, h1, h2] + +theorem noCR_print (d : Document) (hwf : WF d) : '\r' ∉ print d := by + obtain ⟨hpro, hroot, _, hepi⟩ := hwf + have h1 := noCR_printNodes_misc d.prolog hpro + have h2 := noCR_printNode d.root hroot + have h3 := noCR_printNodes_misc d.epilog hepi + simp [print, h1, h2, h3] + /-- The plan's claim: printing a well formed document and parsing the print gives the same document back. -/ theorem parse_print (d : Document) (hwf : WF d) : parse (print d) = some d := by + have hnorm : normEol (print d) = print d := + normEol_of_noCR _ (noCR_print d hwf) obtain ⟨hpro, hroot, ⟨name, attrs, content, hreq⟩, hepi⟩ := hwf rw [hreq] at hroot cases hroot with @@ -1633,7 +1753,8 @@ theorem parse_print (d : Document) (hwf : WF d) : (printNode d.root ++ printNodes d.epilog)).length + 1 = (print d).length + 1 := by simp only [print, List.length_append]; omega rw [e] - rfl + show parseDocument ((normEol (print d)).length + 1) (normEol (print d)) = _ + rw [hnorm] rw [hparse, hPd] exact hdoc diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index 6d95fd7..f0473d9 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -10,6 +10,7 @@ import Xml import Proofs.RoundTrip import Proofs.Refusals +import Proofs.LineEnds open Xml @@ -122,3 +123,15 @@ theorem Spec.rejects_attribute_without_space (prolog : List Node) c :: rest) = none := Xml.Proofs.rejects_attribute_without_space prolog name attrs c rest hpro hname hattrs hne hc + + +theorem Spec.crlf_reads_as_lf (pre post : List Char) + (hpre : pre.getLast? ≠ some '\r') : + parse (pre ++ '\r' :: '\n' :: post) = parse (pre ++ '\n' :: post) := + Xml.Proofs.crlf_reads_as_lf pre post hpre + + +theorem Spec.cr_reads_as_lf (pre post : List Char) + (hpre : pre.getLast? ≠ some '\r') (hpost : post.head? ≠ some '\n') : + parse (pre ++ '\r' :: post) = parse (pre ++ '\n' :: post) := + Xml.Proofs.cr_reads_as_lf pre post hpre hpost diff --git a/README.md b/README.md index 1b9fb95..3946e08 100644 --- a/README.md +++ b/README.md @@ -75,19 +75,28 @@ where they end in `sorry`) and proved in | An attribute value with no quotes is refused. | `Spec.rejects_unquoted_attribute` | | A CDATA section in the prolog is refused. | `Spec.rejects_cdata_in_prolog` | | The XML declaration form is refused. | `Spec.rejects_xml_declaration` | +| A carriage return followed by a line feed reads exactly as one line feed, anywhere in a text, unless the text before it ends with a carriage return (XML 1.0 section 2.11). | `Spec.crlf_reads_as_lf` | +| A carriage return not followed by a line feed reads exactly as a line feed, anywhere in a text, unless the text before it ends with a carriage return. | `Spec.cr_reads_as_lf` | | An attribute name that starts right after the closing quote of the attribute before it, with no whitespace between them, is refused: on the root element, after any well formed prolog and at least one well formed attribute, both printed in canonical form, whatever follows the first character of the name. | `Spec.rejects_attribute_without_space` | | An attribute named `xmlns` (a default namespace declaration) on the root element is refused: after any well formed prolog and any well formed attributes before it, both printed in canonical form, whatever follows the name, as long as it does not make the name longer. | `Spec.rejects_xmlns` | A document is well formed when its names match the subset's name rule, attribute names are unique per element and none is `xmlns`, text holds only legal XML -characters and no two -text runs stand next to each other, comment bodies -contain no `--` and do not end with `-`, processing -instruction targets are valid and not the reserved word -`xml`, and the prolog and epilog hold only comments and -processing instructions. `SPEC.md` states the rules in -full. +characters and no two text runs stand next to each +other, comment bodies contain no `--`, do not end with +`-` and hold no carriage return, processing instruction +targets are valid and not the reserved word `xml` and +their data holds no carriage return, and the prolog and +epilog hold only comments and processing instructions. +`SPEC.md` states the rules in full. + +The parser normalizes line ends before it reads, as +XML 1.0 section 2.11 requires: a carriage return and +line feed pair, and a lone carriage return, each read as +one line feed. A carriage return written as ` ` in +text or an attribute value reads as itself, and the +printer writes it that way. The round trip theorem rests on the proof in `Proofs/RoundTrip.lean`, where it is @@ -127,20 +136,13 @@ are about. length of the input text, which very deep inputs can reach. -Three deliberate choices, also stated in `SPEC.md`: +Two deliberate choices, also stated in `SPEC.md`: - CDATA sections are a spelling, not a tree difference. CDATA content becomes ordinary character data in the same text node stream, and the printer never writes a CDATA section. The claim is at tree level, so this is sound. -- There is no line ending normalization in text, - comments, processing instruction data, or CDATA: a - literal carriage return reads as itself. Full XML - normalizes it to a line feed. Inside attribute values - both readings agree (either form reads as a space), and - the printer always writes a carriage return as a - character reference. - The XML declaration is not in the model. A processing instruction target of `xml` in any letter case rejects everywhere, which keeps the declaration out. diff --git a/SPEC.md b/SPEC.md index 3cde920..3d12333 100644 --- a/SPEC.md +++ b/SPEC.md @@ -8,6 +8,21 @@ counts toward the verified bar yet. Text is `List Char`. A Lean `Char` is one Unicode scalar value. +## Line ends + +Before anything else, the parser normalizes line ends, as XML 1.0 +section 2.11 requires: a carriage return followed by a line feed +becomes one line feed, and a carriage return followed by anything +else, or by nothing, becomes a line feed. This holds everywhere: +in text, CDATA sections, comments, processing instruction data, +attribute values, tags, and between the top level items. So a +literal carriage return never reaches the tree. A carriage return +written as the character reference ` ` or ` ` in text or +in an attribute value reads as itself, and the printer writes a +carriage return in text or an attribute value as ` `, the only +way to keep one. A comment or a processing instruction has no +references, so it never holds a carriage return. + ## The subset in one paragraph A document is a prolog of comments and processing instructions, @@ -75,8 +90,9 @@ parsed leniently. predefined entities are expanded on read. A raw `<` rejects. A raw `&` that does not begin a valid reference rejects. - Attribute value normalization: a literal tab or line feed in - a value reads as one space, and a literal carriage return or - carriage return with line feed reads as one space. This is + a value reads as one space. A literal carriage return, alone or + before a line feed, has already become one line feed (see Line + ends), so it reads as one space too. This is XML's rule for CDATA type attributes, and every attribute here is CDATA type because there is no document type declaration to say otherwise. A tab or line feed spelled as a character @@ -183,10 +199,11 @@ formedness predicate (`WF` in `Xml/Value.lean`): parser merges them, so an unmerged tree could not come back); - comment bodies hold only legal characters, contain no `--`, - and do not end with `-`; + do not end with `-`, and hold no carriage return; - processing instruction targets are valid names and not the reserved word, their data holds only legal characters, never - contains `?>`, and never starts with whitespace; + contains `?>`, never starts with whitespace, and holds no + carriage return; - the root is an element, and the prolog and epilog hold only comments and processing instructions. @@ -218,6 +235,8 @@ each rule on many more inputs. | An attribute value with no quotes is refused | `Spec.rejects_unquoted_attribute` | | A CDATA section in the prolog is refused | `Spec.rejects_cdata_in_prolog` | | The XML declaration form is refused | `Spec.rejects_xml_declaration` | +| A carriage return followed by a line feed reads exactly as one line feed, anywhere in a text, unless the text before it ends with a carriage return | `Spec.crlf_reads_as_lf` | +| A carriage return not followed by a line feed reads exactly as a line feed, anywhere in a text, unless the text before it ends with a carriage return | `Spec.cr_reads_as_lf` | | An attribute name right after the closing quote of the attribute before it, with no whitespace between them, is refused, on the root element after any well formed prolog and at least one well formed attribute, printed, whatever follows the first character of the name | `Spec.rejects_attribute_without_space` | | An attribute named `xmlns` on the root element is refused, after any well formed prolog and any well formed attributes before it, printed, whatever follows the name that does not make it longer | `Spec.rejects_xmlns` | @@ -240,17 +259,6 @@ against that list. ## Boundaries and named differences -- No line ending normalization in text, comments, processing - instruction data, or CDATA sections: a literal carriage - return there reads as itself. Full XML normalizes carriage - return and carriage return with line feed to a line feed - before parsing, and Python's ElementTree does so. That is a - difference between this subset and full XML, stated plainly: - a text a full XML parser reads one way can read with a line - feed where this parser keeps a carriage return. Inside - attribute values both readings agree, because normalization - there sends either form to a space, and in printed form a - carriage return is always a character reference. - No document type declaration, no entities beyond the five, no namespaces, no XML declaration, ASCII names only. A full XML parser may accept documents this slice rejects for diff --git a/Spec.lean b/Spec.lean index 85fb390..2f39acf 100644 --- a/Spec.lean +++ b/Spec.lean @@ -143,3 +143,20 @@ theorem Spec.rejects_attribute_without_space (prolog : List Node) (hattrs : AttrsOk attrs) (hne : attrs ≠ []) (hc : IsNameStart c) : parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ c :: rest) = none := sorry + +/-- Line ends are normalized as XML 1.0 section 2.11 requires: a + carriage return followed by a line feed reads exactly as one + line feed, wherever it stands in the text, unless the text + before it ends with a carriage return (which pairs with the + line feed first). -/ +theorem Spec.crlf_reads_as_lf (pre post : List Char) + (hpre : pre.getLast? ≠ some '\r') : + parse (pre ++ '\r' :: '\n' :: post) = parse (pre ++ '\n' :: post) := + sorry + +/-- A carriage return that is not followed by a line feed reads + exactly as a line feed, wherever it stands in the text, unless + the text before it ends with a carriage return. -/ +theorem Spec.cr_reads_as_lf (pre post : List Char) + (hpre : pre.getLast? ≠ some '\r') (hpost : post.head? ≠ some '\n') : + parse (pre ++ '\r' :: post) = parse (pre ++ '\n' :: post) := sorry diff --git a/Xml/Parse.lean b/Xml/Parse.lean index 5b5f0f1..4fb8242 100644 --- a/Xml/Parse.lean +++ b/Xml/Parse.lean @@ -13,10 +13,15 @@ character reference, decimal or hexadecimal, naming a legal XML character. Any other reference is rejected: the subset has no entities to expand. + - Line ends are normalized before anything else, as XML 1.0 + section 2.11 requires: a carriage return followed by a line + feed, and a carriage return not followed by a line feed, each + read as one line feed. So no literal carriage return reaches + the readers below; one written as the character reference + ` ` still reads as itself. - In an attribute value, a literal tab or line feed reads as a - space, and a literal carriage return, with or without a line - feed after it, reads as one space. A character reference is - never normalized: it reads as the character it names. + space. A character reference is never normalized: it reads as + the character it names. - Character data runs, character references, and CDATA sections between two marks are merged into one text run. - The XML declaration is rejected: it is a processing @@ -27,10 +32,6 @@ declarations (`xmlns:p`) are already rejected by the colon ban on names. - Line endings are not normalized in character data, comments, - processing instruction data, or CDATA sections: a carriage - return reads as itself. `SPEC.md` states this boundary. - The functions that can nest or loop (`parseElement`, `parseNodes`, `parseAttrs`, `parseCharData`, `parseMisc`, `parseTextRun`, `parseAttrValue`) take a fuel count. Each step spends one unit, so the functions are @@ -213,11 +214,12 @@ def parsePIData : List Char → Option (List Char × List Char) /-- Read an attribute value, at the text after the opening quote `q`. Returns the normalized value and the text after the closing quote. A literal less sign is rejected; a literal tab - or line feed reads as a space; a literal carriage return reads - as one space, with a line feed right after it read as part of - the same return. References read as the characters they name, - with no normalization. The fuel bounds the number of - characters and references read, as in `parseTextRun`. -/ + or line feed reads as a space, which is XML's normalization + for CDATA type attributes. Line ends were normalized before + parsing, so a literal carriage return never reaches here; one + would also read as a space. References read as the characters + they name, with no normalization. The fuel bounds the number + of characters and references read, as in `parseTextRun`. -/ def parseAttrValue (q : Char) : Nat → List Char → Option (List Char × List Char) | 0, _ => none | _ + 1, [] => none @@ -228,14 +230,8 @@ def parseAttrValue (q : Char) : Nat → List Char → Option (List Char × List match parseRef rest with | some (ch, r) => (parseAttrValue q fuel r).map fun (v, r2) => (ch :: v, r2) | none => none - else if c = '\t' ∨ c = '\n' then + else if c = '\t' ∨ c = '\n' ∨ c = '\r' then (parseAttrValue q fuel rest).map fun (v, r) => (' ' :: v, r) - else if c = '\r' then - match rest with - | '\n' :: rest2 => - (parseAttrValue q fuel rest2).map fun (v, r) => (' ' :: v, r) - | _ => - (parseAttrValue q fuel rest).map fun (v, r) => (' ' :: v, r) else if isLegalChar c then (parseAttrValue q fuel rest).map fun (v, r) => (c :: v, r) else none @@ -429,9 +425,20 @@ def parseDocument (fuel : Nat) (cs : List Char) : Option Document := | none => none | none => none -/-- Parse a whole text, with the fuel the length of the text - allows. -/ +/-- The text with its line ends normalized, as XML 1.0 section + 2.11 requires before parsing: a carriage return followed by a + line feed becomes one line feed, and a carriage return + followed by anything else, or by nothing, becomes a line + feed. -/ +def normEol : List Char → List Char + | [] => [] + | '\r' :: '\n' :: rest => '\n' :: normEol rest + | '\r' :: rest => '\n' :: normEol rest + | c :: rest => c :: normEol rest + +/-- Parse a whole text: normalize its line ends, then read it with + the fuel the length of the normalized text allows. -/ def parse (cs : List Char) : Option Document := - parseDocument (cs.length + 1) cs + parseDocument ((normEol cs).length + 1) (normEol cs) end Xml diff --git a/Xml/Value.lean b/Xml/Value.lean index ad23a26..39fe132 100644 --- a/Xml/Value.lean +++ b/Xml/Value.lean @@ -232,12 +232,20 @@ mutual /-- A node the printer can write and the parser reads back as the same node. A text run is not empty and holds only legal characters. A comment body has no two dashes in a row, does not - end with a dash, and holds only legal characters. A processing - instruction has a valid target that is not the reserved word, - and data that holds no `?>`, holds only legal characters, and - does not start with whitespace (the printer writes one space - before the data, and the parser skips whitespace there, so a - data value starting with whitespace would lose it). -/ + end with a dash, holds only legal characters, and holds no + carriage return. A processing instruction has a valid target + that is not the reserved word, and data that holds no `?>`, + holds only legal characters, does not start with whitespace + (the printer writes one space before the data, and the parser + skips whitespace there, so a data value starting with + whitespace would lose it), and holds no carriage return. + + The carriage return rule: the parser normalizes line ends + before reading, so a literal carriage return reads as a line + feed. Text and attribute values can still hold one, written as + the character reference ` `, but a comment or processing + instruction has no references, so neither can hold one after + parsing, and the printer could not write one back. -/ inductive WFNode : Node → Prop where | text {cs : List Char} (hne : cs ≠ []) (hlegal : ∀ c ∈ cs, LegalChar c) : WFNode (.text cs) @@ -245,10 +253,12 @@ inductive WFNode : Node → Prop where {content : List Node} (hname : ValidName name) (hattrs : AttrsOk attrs) (hcontent : WFNodes content) : WFNode (.elem name attrs content) | comment {cs : List Char} (hdd : NoDashDash cs) (hde : NotDashEnd cs) - (hlegal : ∀ c ∈ cs, LegalChar c) : WFNode (.comment cs) + (hlegal : ∀ c ∈ cs, LegalChar c) (hcr : '\r' ∉ cs) : + WFNode (.comment cs) | pi {t d : List Char} (hname : ValidName t) (hres : ¬ IsXmlTarget t) (hq : NoQClose d) (hlegal : ∀ c ∈ d, LegalChar c) - (hstart : d = [] ∨ ∀ c cs, d = c :: cs → ¬ IsWs c) : + (hstart : d = [] ∨ ∀ c cs, d = c :: cs → ¬ IsWs c) + (hcr : '\r' ∉ d) : WFNode (.pi t d) /-- A content list whose nodes are all well formed, with no two diff --git a/bar.toml b/bar.toml index b893615..1a2e6ba 100644 --- a/bar.toml +++ b/bar.toml @@ -36,7 +36,8 @@ code = [ "Xml.parseTextRun", "Xml.parseCDATABody", "Xml.parseCommentBody", "Xml.parsePIData", "Xml.parseAttrValue", "Xml.parsePI", "Xml.parseCharData", "Xml.startsWithWs", "Xml.parseAttrs", "Xml.parseElement", - "Xml.parseNodes", "Xml.parseMisc", "Xml.parseDocument", "Xml.parse", + "Xml.parseNodes", "Xml.parseMisc", "Xml.parseDocument", "Xml.normEol", + "Xml.parse", ] # One entry per approval, added in a pull request the reviewer approves. diff --git a/comparator.json b/comparator.json index 89433a3..f6ba49e 100644 --- a/comparator.json +++ b/comparator.json @@ -1 +1 @@ -{"challenge_module":"Spec","permitted_axioms":["propext","Classical.choice","Quot.sound"],"solution_module":"Proofs","theorem_names":["Spec.parse_print","Spec.rejects_doctype","Spec.rejects_undefined_entity","Spec.rejects_mismatched_tags","Spec.rejects_unclosed_element","Spec.rejects_second_root","Spec.rejects_text_before_root","Spec.rejects_duplicate_attribute","Spec.rejects_lt_in_attribute","Spec.rejects_cdata_close_in_text","Spec.rejects_dashdash_in_comment","Spec.rejects_surrogate_ref","Spec.rejects_zero_ref","Spec.rejects_colon_in_name","Spec.rejects_digit_name","Spec.rejects_unquoted_attribute","Spec.rejects_cdata_in_prolog","Spec.rejects_xml_declaration","Spec.rejects_xmlns","Spec.rejects_attribute_without_space"]} \ No newline at end of file +{"challenge_module":"Spec","permitted_axioms":["propext","Classical.choice","Quot.sound"],"solution_module":"Proofs","theorem_names":["Spec.parse_print","Spec.rejects_doctype","Spec.rejects_undefined_entity","Spec.rejects_mismatched_tags","Spec.rejects_unclosed_element","Spec.rejects_second_root","Spec.rejects_text_before_root","Spec.rejects_duplicate_attribute","Spec.rejects_lt_in_attribute","Spec.rejects_cdata_close_in_text","Spec.rejects_dashdash_in_comment","Spec.rejects_surrogate_ref","Spec.rejects_zero_ref","Spec.rejects_colon_in_name","Spec.rejects_digit_name","Spec.rejects_unquoted_attribute","Spec.rejects_cdata_in_prolog","Spec.rejects_xml_declaration","Spec.rejects_xmlns","Spec.rejects_attribute_without_space","Spec.crlf_reads_as_lf","Spec.cr_reads_as_lf"]} \ No newline at end of file diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index 03d9f18..fa7ef36 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -5,9 +5,9 @@ Written by `tests/run_tests.py`. Rerun it to check these numbers. - Oracle: Python 3.13.17 `xml.etree.ElementTree`, expat_2.6.1 (`ET.XMLParser`, which turns namespace processing on, with a `TreeBuilder` that keeps comments and processing instructions) - Lean tool: Lean (version 4.35.0, x86_64-unknown-linux-gnu, commit eb6cafb7290e8bd5f2937522d8d804f58f02bafc, Release) - Seed: 20261026 -- Inputs: 3304 +- Inputs: 3314 - every request sent to the tool: the fixed cases, the generated documents, the named rejections, the malformed requests, and two bare parse requests -- Fixed cases passed: 38 of 38 +- Fixed cases passed: 48 of 48 - Generated in-subset documents: 3200 - Generated documents where the tool's canonical print matches the tree and ElementTree agrees on the tree: 3200 - ElementTree tree agreements on generated documents: 3200 diff --git a/tests/run_tests.py b/tests/run_tests.py index afb0bb7..2084bd8 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -30,17 +30,14 @@ (for the root element; ElementTree does not keep the prolog and epilog) must equal the tree that was generated. - Named differences, counted apart and not failures: - - - ElementTree normalizes a literal carriage return in text, - comments, processing instruction data, and CDATA to a line - feed (XML line ending normalization). This slice keeps the - carriage return as it is; it is a stated boundary in - SPEC.md. The generator therefore never writes a literal - carriage return in those positions (a carriage return in a - tree is always spelled as a character reference there). - Literal carriage returns and tabs in attribute values are - fine: both sides read them as a space. + Line ends: both sides normalize a literal carriage return and + line feed pair, and a lone carriage return, to a line feed + before parsing (XML 1.0 section 2.11). The generator spells a + line feed of the tree as a line feed, a carriage return and + line feed pair, or a lone carriage return, in text, comments, + processing instruction data, tags and the top level. A carriage + return in the tree's text or attribute values is spelled as a + character reference, the only way to keep one. 3. Named rejections: one input per rejection rule in SPEC.md. The Lean tool must reject every one. ElementTree agrees with @@ -292,6 +289,18 @@ def run_requests(texts, failures, part): ("", ""), # any whitespace separates attributes: space, tab, line feed ("", ''), + # line ends: CR LF and a lone CR read as LF (XML 1.0 2.11), + # everywhere; only a character reference keeps a CR + ("x\r\ny", "x\ny"), + ("x\ry", "x\ny"), + ("x\r\r\ny\n\rz\r", "x\n\ny\n\nz\n"), + (" \r\n ", " \n "), + ("", "x\ny\nz"), + ("", ""), + ("", ""), + ("", ''), + ("\r\n\r", ''), + ("x", "x"), ] # Named rejections: (rule, input). ElementTree's verdict is @@ -404,10 +413,23 @@ def gen_name(rng): rng.choice(NAME_CHARS) for _ in range(n - 1)) -def spell_text_char(rng, c, emitted): +def spell_line_end(rng, next_char): + """One spelling of a line feed of the tree: a line feed, a + carriage return and line feed pair, or a lone carriage return. + A lone carriage return is chosen only when the next character + of the spelling cannot be a literal line feed, which would + pair with it.""" + if next_char == "\n": + return rng.choice(["\n", "\r\n"]) + return rng.choice(["\n", "\r\n", "\r"]) + + +def spell_text_char(rng, c, emitted, next_char=None): """One spelling of a text character, and it is never a raw less sign, a raw ampersand, or a raw greater sign right after two right brackets.""" + if c == "\n": + return spell_line_end(rng, next_char) if c == "&": return "&" if c == "<": @@ -418,7 +440,7 @@ def spell_text_char(rng, c, emitted): return ">" if c == "\r": return rng.choice([" ", " "]) - if c == "\n" or c == "\t": + if c == "\t": return c r = rng.random() if r < 0.06: @@ -444,8 +466,10 @@ def gen_text_run(rng): chars.append("<") elif r < 0.90: chars.append(">") - elif r < 0.94: + elif r < 0.92: chars.append("\r") + elif r < 0.95: + chars.append("\n") elif r < 0.97: chars.append("'") else: @@ -477,7 +501,8 @@ def gen_text_run(rng): emitted += "".join(buf) i = j continue - sp = spell_text_char(rng, chars[i], emitted) + nxt = chars[i + 1] if i + 1 < len(chars) else None + sp = spell_text_char(rng, chars[i], emitted, nxt) pieces.append(sp) emitted += chars[i] i += 1 @@ -534,13 +559,35 @@ def gen_attr_value(rng): return "".join(toks), "".join(model), quote +def join_words(rng, words): + """Words joined by a space or, now and then, by a line end: + returns (spelling, model). Words never start with a line + feed, so a lone carriage return is safe between them.""" + sp = [] + model = [] + for i, w in enumerate(words): + if i > 0: + if rng.random() < 0.2: + sp.append(spell_line_end(rng, None)) + model.append("\n") + else: + sp.append(" ") + model.append(" ") + sp.append(w) + model.append(w) + return "".join(sp), "".join(model) + + def gen_comment(rng): words = [rng.choice(COMMENT_WORDS) for _ in range(rng.randint(0, 4))] - body = " " + " ".join(words) + " " if words else "" + sp, model = join_words(rng, words) + body_sp = " " + sp + " " if words else "" + body = " " + model + " " if words else "" if rng.random() < 0.3: + body_sp = body_sp + "- x " body = body + "- x " - return "", ("comment", body) + return "", ("comment", body) def gen_pi(rng): @@ -551,15 +598,15 @@ def gen_pi(rng): return "", ("pi", target, "") words = [rng.choice(COMMENT_WORDS) for _ in range(rng.randint(1, 3))] - data = " ".join(words) - return ("", + sp, data = join_words(rng, words) + return ("", ("pi", target, data)) # Whitespace inside tags and at the top level. A separator before an # attribute is never empty: XML 1.0 [40] and [44] require one. -SEPS = [" ", " ", " ", " ", "\t", "\n", " \n\t"] -OPT_WS = ["", "", "", " ", "\n", "\t "] +SEPS = [" ", " ", " ", " ", "\t", "\n", " \n\t", "\r\n", "\r"] +OPT_WS = ["", "", "", " ", "\n", "\t ", "\r\n", "\r"] def gen_sep(rng): From 985565fb7235623de9ab4b8ad67ae929da6bf9ff Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 17:50:44 +0000 Subject: [PATCH 09/18] Restate three proof steps so the nanoda kernel accepts them lake comparator --paranoid failed on this branch, as the author reported on 4875cec: nanoda, one of the six kernels, overflowed its stack. Exporting each theorem and running nanoda on it alone showed the cause: a simp step that reduces a match over character literal patterns (for example parseAttrs on '>' :: rest) leaves a term that makes nanoda compare the function with its own matcher, and that check recurses deeper than nanoda's stack. A one-line example with a three-arm match on Char literals reproduces it; Nat and Bool literal patterns do not. The same reduction proved by rfl, or by split, is accepted. - Proofs/RoundTrip.lean: parseAttrs_print_open ends in rfl; the new parsePI_space states the processing instruction step after a space and is proved by split; parsePI_print uses it. - Proofs/Refusals.lean: parseAttrs_xmlns rewrites and ends in rfl. No statement changes. Each theorem in RoundTrip, Refusals, LineEnds and SpecProofs now passes nanoda on its own. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Proofs/Refusals.lean | 3 ++- Proofs/RoundTrip.lean | 48 +++++++++++++++++++++++++++++++------------ 2 files changed, 37 insertions(+), 14 deletions(-) diff --git a/Proofs/Refusals.lean b/Proofs/Refusals.lean index ba75759..aabc735 100644 --- a/Proofs/Refusals.lean +++ b/Proofs/Refusals.lean @@ -144,7 +144,8 @@ theorem parseAttrs_xmlns (f : Nat) (hf : 1 ≤ f) have hpn : parseName ('x' :: 'm' :: 'l' :: 'n' :: 's' :: rest) = some (xmlnsName, rest) := parseName_append validName_xmlns hr - simp [parseAttrs, hsk, hpn, startsWithWs, isWs] + rw [parseAttrs, hsk, hpn] + rfl /-- An attribute named `xmlns` on the root element is refused, after any well formed prolog and any well formed attributes diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index eb30179..4ffda73 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -758,6 +758,34 @@ theorem isWs_false_of_not {c : Char} (h : ¬ IsWs c) : isWs c = false := by have h4 : c ≠ '\r' := fun e => h (Or.inr (Or.inr (Or.inr e))) exact isWs_of_ne h1 h2 h3 h4 +/-- One step of the processing instruction reader, when the target + is followed by a space: the data reader runs after the + whitespace. Proved by splitting the reader's match rather than + by `simp`, which keeps the proof term small for every kernel. -/ +theorem parsePI_space {cs t X : List Char} + (hpn : parseName cs = some (t, ' ' :: X)) + (hres : ¬ (t.map Char.toLower = ['x', 'm', 'l'])) : + parsePI cs = + (parsePIData (skipWs (' ' :: X))).map (fun p => (Node.pi t p.1, p.2)) := by + rw [parsePI, hpn] + split + · rename_i target r1 e + cases e + rw [if_neg hres] + split + · rename_i r2 e + exact absurd (List.cons.inj e).1 (by decide) + · rename_i c tl e + cases e + rw [if_pos (show isWs ' ' = true by decide)] + cases parsePIData (skipWs (' ' :: X)) with + | none => rfl + | some p => rfl + · rename_i e + cases e + · rename_i e + cases e + /-- Reading back a printed processing instruction gives the instruction back. The input is the text after `' :: rest)) = - (c0 :: d0) ++ '?' :: '>' :: rest := by - have h1 : (' ' :: c0 :: (d0 ++ '?' :: '>' :: rest)) = - (' ' :: (c0 :: d0) ++ ['?', '>']) ++ rest := by - simp [List.append_assoc] - rw [h1] - exact hsk - rw [hsk2, hpd] + have e1 : (' ' :: (c0 :: d0) ++ ['?', '>']) ++ rest = + ' ' :: ((c0 :: d0) ++ '?' :: '>' :: rest) := by + simp [List.append_assoc] + rw [e1] at hpn hsk + rw [e1, parsePI_space hpn hres', hsk, hpd] + rfl /-! ## Printed lengths -/ @@ -1044,8 +1067,7 @@ theorem parseAttrs_print_open intro f' hf' cases f' with | zero => simp at hf' - | succ f'' => - simp [parseAttrs, skipWs, (by decide : isWs '>' = false)] + | succ f'' => rfl /-! ## Elements and content -/ From 7218082db5b597eb95ead33b3b7945aab90ea204 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:01:45 +0000 Subject: [PATCH 10/18] Prove that every accepted document is well formed, and the plan's claim Review 1 finding 3 (repeated in review 3), and the general statement that review 3's blocking item 2 prefers: the plan's main claim, "printing a parsed document gives a document that parses to the same tree", needs parse -> WF, and no theorem gave it. - Proofs/ParseWF.lean (new): Xml.Proofs.parse_wf, for every text cs, parse cs = some d -> WF d. It goes reader by reader: each gives back legal characters, valid names, comment bodies with no -- and no final -, PI data with no ?> that does not start with whitespace, attribute lists that meet AttrsOk (unique names, none xmlns), and a rest of the text made of characters of its input, so no comment or PI data can hold a carriage return after normalization. The one non-local fact, that no two text runs stand next to each other, is nodes_head_not_text: character data stops at the end or at a less sign that does not open CDATA, and the content reader never starts its answer with a text run there. Then print_parse follows from the round trip. Every theorem in the file passes nanoda on its own. - Spec.lean: Spec.parse_wf and Spec.print_parse, with a note that a parser refusing every text meets both and Spec.parse_print rules it out. Re-exported from Proofs/SpecProofs.lean and listed in comparator.json. - tests: a new part sends every canonical print the tool gave back to it and requires the same print (3248 of 3248). - README.md and SPEC.md: two rows, and "What is not proved" now says that neither statement ties the tree to the text it came from (a parser that read &e; as some character would meet both), which rests on the tests. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Proofs.lean | 1 + Proofs/ParseWF.lean | 1105 ++++++++++++++++++++++++++++++++++++++++ Proofs/SpecProofs.lean | 11 + README.md | 22 +- SPEC.md | 11 + Spec.lean | 26 + comparator.json | 2 +- tests/TEST-RESULTS.md | 5 +- tests/run_tests.py | 38 +- 9 files changed, 1205 insertions(+), 16 deletions(-) create mode 100644 Proofs/ParseWF.lean diff --git a/Proofs.lean b/Proofs.lean index 024daef..08943dd 100644 --- a/Proofs.lean +++ b/Proofs.lean @@ -1,4 +1,5 @@ import Proofs.RoundTrip import Proofs.LineEnds +import Proofs.ParseWF import Proofs.Refusals import Proofs.SpecProofs diff --git a/Proofs/ParseWF.lean b/Proofs/ParseWF.lean new file mode 100644 index 0000000..0752033 --- /dev/null +++ b/Proofs/ParseWF.lean @@ -0,0 +1,1105 @@ +/- + Every document the parser accepts is well formed: `parse cs = some d` + gives `WF d`, for every text `cs`. Together with the round trip, + printing an accepted document gives a text that parses back to the + same document, which is the plan's main claim as written. + + The proof goes layer by layer, as the parser does. For each reader + it shows what the reader gives back (legal characters, a valid + name, a comment body with no `--`, and so on), and that the text + left over is made of characters of the text it was given. That + second fact carries one more property through: the parser reads a + text whose line ends were normalized, so it holds no carriage + return, and neither does any part of it, so no comment body and no + processing instruction data can hold one. + + The one property that is not local is that no two text runs stand + next to each other in element content. The content reader takes + all character data up to the next markup in one step, so the text + after a text run is empty or starts with a less sign that does not + open a CDATA section, and the content reader never starts its + answer with a text run at such a text. +-/ + +import Xml +import Proofs.RoundTrip + +namespace Xml.Proofs + +open Xml + +/-! ## Small facts -/ + +theorem sub_refl (cs : List Char) : cs ⊆ cs := fun _ h => h + +theorem sub_cons {r cs : List Char} (c : Char) (h : r ⊆ cs) : r ⊆ c :: cs := + fun _ hx => List.mem_cons_of_mem _ (h hx) + +theorem sub_trans {a b c : List Char} (h1 : a ⊆ b) (h2 : b ⊆ c) : a ⊆ c := + fun _ hx => h2 (h1 hx) + +theorem sub_append_right (a b : List Char) : b ⊆ a ++ b := + fun _ hx => List.mem_append_right _ hx + +theorem sub_append_left (a b : List Char) : a ⊆ a ++ b := + fun _ hx => List.mem_append_left _ hx + +theorem toNat_ofNat_valid (n : Nat) (h : n.isValidChar) : + (Char.ofNat n).toNat = n := by + simp only [Char.ofNat, h, dite_true] + rfl + +/-- A character reference that the reader accepts names a legal + character. -/ +theorem charRefChar_legal {n : Nat} {c : Char} (h : charRefChar n = some c) : + LegalChar c := by + unfold charRefChar at h + split at h + · rename_i hn + cases h + have hv : n.isValidChar := by + unfold Nat.isValidChar + omega + unfold LegalChar + rw [toNat_ofNat_valid n hv] + exact hn + · cases h + +theorem legal_of_test {c : Char} (h : isLegalChar c = true) : LegalChar c := + isLegalChar_iff.mp h + +theorem legal_space : LegalChar ' ' := legal_of_test (by decide) + +/-! ## Whitespace and names -/ + +theorem skipWs_sub : ∀ cs, skipWs cs ⊆ cs + | [] => sub_refl _ + | c :: cs => by + simp only [skipWs] + split + · exact sub_cons c (skipWs_sub cs) + · exact sub_refl _ + +theorem skipWs_head : ∀ (cs : List Char) (c : Char), + (skipWs cs).head? = some c → isWs c = false + | [], c, h => by simp [skipWs] at h + | d :: cs, c, h => by + simp only [skipWs] at h + split at h + · exact skipWs_head cs c h + · rename_i hd + simp only [List.head?_cons, Option.some.injEq] at h + subst h + simpa using hd + +theorem takeNameChars_spec : ∀ (cs ds r : List Char), + takeNameChars cs = (ds, r) → cs = ds ++ r ∧ ∀ d ∈ ds, isNameChar d = true + | [], ds, r, h => by + simp only [takeNameChars, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + simp + | c :: cs, ds, r, h => by + simp only [takeNameChars] at h + split at h + · rename_i hc + rcases hp : takeNameChars cs with ⟨ds', r'⟩ + rw [hp] at h + simp only [Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + obtain ⟨h1, h2⟩ := takeNameChars_spec cs ds' r' hp + refine ⟨by simp [h1], ?_⟩ + intro d hd + rcases List.mem_cons.mp hd with e | hd + · rw [e]; exact hc + · exact h2 d hd + · simp only [Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + simp + +theorem parseName_spec {cs n r : List Char} (h : parseName cs = some (n, r)) : + ValidName n ∧ cs = n ++ r := by + match cs, h with + | c :: rest, h => + simp only [parseName] at h + split at h + · rename_i hc + rcases hp : takeNameChars rest with ⟨ds, r'⟩ + rw [hp] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + obtain ⟨h1, h2⟩ := takeNameChars_spec rest ds r' hp + exact ⟨⟨c, ds, rfl, isNameStart_iff.mp hc, + fun x hx => isNameChar_iff.mp (h2 x hx)⟩, by simp [h1]⟩ + · cases h + +theorem parseName_sub {cs n r : List Char} (h : parseName cs = some (n, r)) : + r ⊆ cs := by + obtain ⟨_, e⟩ := parseName_spec h + rw [e] + exact sub_append_right _ _ + +/-! ## References -/ + +theorem takeDigits_spec : ∀ (cs ds r : List Char), + takeDigits cs = (ds, r) → cs = ds ++ r + | [], ds, r, h => by + simp only [takeDigits, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + rfl + | c :: cs, ds, r, h => by + simp only [takeDigits] at h + split at h + · rcases hp : takeDigits cs with ⟨ds', r'⟩ + rw [hp] at h + simp only [Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + simp [takeDigits_spec cs ds' r' hp] + · simp only [Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + rfl + +theorem takeHexDigits_spec : ∀ (cs ds r : List Char), + takeHexDigits cs = (ds, r) → cs = ds ++ r + | [], ds, r, h => by + simp only [takeHexDigits, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + rfl + | c :: cs, ds, r, h => by + simp only [takeHexDigits] at h + split at h + · rcases hp : takeHexDigits cs with ⟨ds', r'⟩ + rw [hp] at h + simp only [Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + simp [takeHexDigits_spec cs ds' r' hp] + · simp only [Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + rfl + +/-- A reference the reader accepts stands for a legal character, and + the text after it is part of the text it was read from. -/ +theorem parseRef_spec {cs : List Char} {ch : Char} {r : List Char} + (h : parseRef cs = some (ch, r)) : LegalChar ch ∧ r ⊆ cs := by + unfold parseRef at h + split at h + · cases h + exact ⟨legal_of_test (by decide), + sub_cons _ (sub_cons _ (sub_cons _ (sub_refl _)))⟩ + · cases h + exact ⟨legal_of_test (by decide), + sub_cons _ (sub_cons _ (sub_cons _ (sub_refl _)))⟩ + · cases h + exact ⟨legal_of_test (by decide), + sub_cons _ (sub_cons _ (sub_cons _ (sub_cons _ (sub_refl _))))⟩ + · cases h + exact ⟨legal_of_test (by decide), sub_cons _ (sub_cons _ + (sub_cons _ (sub_cons _ (sub_cons _ (sub_refl _)))))⟩ + · cases h + exact ⟨legal_of_test (by decide), sub_cons _ (sub_cons _ + (sub_cons _ (sub_cons _ (sub_cons _ (sub_refl _)))))⟩ + · rename_i rest + split at h + · rcases hp : takeHexDigits rest.tail with ⟨ds, r1⟩ + rw [hp] at h + have hsub : r1 ⊆ '#' :: rest := by + have e := takeHexDigits_spec _ ds r1 hp + intro x hx + apply List.mem_cons_of_mem + cases rest with + | nil => simp at e; rw [e.2] at hx; exact absurd hx (by simp) + | cons y ys => + simp only [List.tail_cons] at e + rw [e] + exact List.mem_cons_of_mem _ (List.mem_append_right _ hx) + split at h + rename_i ds' r' heq + simp only [Prod.mk.injEq] at heq + obtain ⟨rfl, rfl⟩ := heq + split at h + · rename_i r2 + rw [Option.map_eq_some_iff] at h + obtain ⟨c, hc, e⟩ := h + simp only [Prod.mk.injEq] at e + obtain ⟨rfl, rfl⟩ := e + exact ⟨charRefChar_legal hc, + sub_trans (sub_cons ';' (sub_refl r2)) hsub⟩ + · cases h + · rcases hp : takeDigits rest with ⟨ds, r1⟩ + rw [hp] at h + have hsub : r1 ⊆ '#' :: rest := by + rw [takeDigits_spec _ ds r1 hp] + exact sub_cons _ (sub_append_right _ _) + split at h + rename_i ds' r' heq + simp only [Prod.mk.injEq] at heq + obtain ⟨rfl, rfl⟩ := heq + split at h + · rename_i r2 + rw [Option.map_eq_some_iff] at h + obtain ⟨c, hc, e⟩ := h + simp only [Prod.mk.injEq] at e + obtain ⟨rfl, rfl⟩ := e + exact ⟨charRefChar_legal hc, + sub_trans (sub_cons ';' (sub_refl r2)) hsub⟩ + · cases h + · cases h + +/-! ## Text, CDATA, comments, processing instruction data, values -/ + +/-- A pattern-matching map that puts a character in front of the + first part of the result, undone. -/ +theorem map_cons_some {o : Option (List Char × List Char)} {c : Char} + {t r : List Char} + (h : (o.map fun (x : List Char × List Char) => (c :: x.1, x.2)) = some (t, r)) : + ∃ t', o = some (t', r) ∧ t = c :: t' := by + cases o with + | none => cases h + | some p => + obtain ⟨t', r'⟩ := p + simp only [Option.map_some, Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨t', rfl, rfl⟩ + +theorem legal_cons {c : Char} {t : List Char} (hc : LegalChar c) + (ht : ∀ x ∈ t, LegalChar x) : ∀ x ∈ c :: t, LegalChar x := by + intro x hx + rcases List.mem_cons.mp hx with e | hx + · rw [e]; exact hc + · exact ht x hx + +theorem parseTextRun_spec : ∀ (f : Nat) (cs t r : List Char), + parseTextRun f cs = some (t, r) → (∀ c ∈ t, LegalChar c) ∧ r ⊆ cs + | 0, cs, t, r, h => by + rw [parseTextRun] at h + cases h + | f + 1, [], t, r, h => by + rw [parseTextRun] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨by simp, sub_refl _⟩ + | f + 1, c :: rest, t, r, h => by + rw [parseTextRun] at h + split at h + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨by simp, sub_refl _⟩ + · split at h + · split at h + · rename_i ch r1 hr + rw [Option.map_eq_some_iff] at h + obtain ⟨⟨t', r2⟩, h1, e⟩ := h + simp only [Prod.mk.injEq] at e + obtain ⟨rfl, rfl⟩ := e + obtain ⟨hl, hs⟩ := parseTextRun_spec f r1 t' r2 h1 + obtain ⟨hcl, hrs⟩ := parseRef_spec hr + exact ⟨legal_cons hcl hl, sub_trans hs (sub_trans hrs (sub_cons _ (sub_refl _)))⟩ + · cases h + · split at h + · rename_i hb + split at h + · cases h + · obtain ⟨t', h1, rfl⟩ := map_cons_some h + obtain ⟨hl, hs⟩ := parseTextRun_spec f rest t' r h1 + rw [hb] + exact ⟨legal_cons (legal_of_test (by decide)) hl, sub_cons _ hs⟩ + · split at h + · rename_i hlc + obtain ⟨t', h1, rfl⟩ := map_cons_some h + obtain ⟨hl, hs⟩ := parseTextRun_spec f rest t' r h1 + exact ⟨legal_cons (legal_of_test hlc) hl, sub_cons _ hs⟩ + · cases h + +theorem parseCDATABody_spec : ∀ (cs t r : List Char), + parseCDATABody cs = some (t, r) → (∀ c ∈ t, LegalChar c) ∧ r ⊆ cs + | [], t, r, h => by + unfold parseCDATABody at h + cases h + | c :: rest, t, r, h => by + unfold parseCDATABody at h + split at h + · rename_i heq + cases heq + · rename_i rest' heq + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + rw [heq] + exact ⟨by simp, sub_cons _ (sub_cons _ (sub_cons _ (sub_refl _)))⟩ + · rename_i c' rest' _ heq + simp only [List.cons.injEq] at heq + obtain ⟨rfl, rfl⟩ := heq + split at h + · rename_i hlc + obtain ⟨t', h1, rfl⟩ := map_cons_some h + obtain ⟨hl, hs⟩ := parseCDATABody_spec rest t' r h1 + exact ⟨legal_cons (legal_of_test hlc) hl, sub_cons _ hs⟩ + · cases h + +/-- The text where character data stops: the end, or a less sign + that does not open a CDATA section. -/ +def StopCD (r : List Char) : Prop := + r = [] ∨ ∃ r', r = '<' :: r' ∧ + ∀ x, r' ≠ '!' :: '[' :: 'C' :: 'D' :: 'A' :: 'T' :: 'A' :: '[' :: x + +theorem parseCharData_spec : ∀ (f : Nat) (cs t r : List Char), + parseCharData f cs = some (t, r) → + (∀ c ∈ t, LegalChar c) ∧ r ⊆ cs ∧ StopCD r + | 0, cs, t, r, h => by + unfold parseCharData at h + cases h + | f + 1, cs, t, r, h => by + unfold parseCharData at h + split at h + · rename_i heq + exact absurd heq (by omega) + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨by simp, sub_refl _, Or.inl rfl⟩ + · rename_i fuel rest heq + have hf : f = fuel := Nat.succ.inj heq + subst hf + split at h + · rename_i t1 r1 h1 + rw [Option.map_eq_some_iff] at h + obtain ⟨⟨t2, r2⟩, h2, e⟩ := h + simp only [Prod.mk.injEq] at e + obtain ⟨rfl, rfl⟩ := e + obtain ⟨hl1, hs1⟩ := parseCDATABody_spec rest t1 r1 h1 + obtain ⟨hl2, hs2, hst⟩ := parseCharData_spec f r1 t2 r2 h2 + refine ⟨?_, ?_, hst⟩ + · intro x hx + rcases List.mem_append.mp hx with hx | hx + · exact hl1 x hx + · exact hl2 x hx + · exact sub_trans hs2 (sub_trans hs1 (fun _ hx => by simp [hx])) + · cases h + · rename_i fuel rest hne heq + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + refine ⟨by simp, sub_refl _, Or.inr ⟨rest, rfl, ?_⟩⟩ + intro x e + exact hne x e + · rename_i cs' _ _ fuel heq _ _ _ + have hf : f = fuel := Nat.succ.inj heq + subst hf + split at h + · rename_i t1 r1 h1 + rw [Option.map_eq_some_iff] at h + obtain ⟨⟨t2, r2⟩, h2, e⟩ := h + simp only [Prod.mk.injEq] at e + obtain ⟨rfl, rfl⟩ := e + obtain ⟨hl1, hs1⟩ := parseTextRun_spec f cs' t1 r1 h1 + obtain ⟨hl2, hs2, hst⟩ := parseCharData_spec f r1 t2 r2 h2 + refine ⟨?_, sub_trans hs2 hs1, hst⟩ + intro x hx + rcases List.mem_append.mp hx with hx | hx + · exact hl1 x hx + · exact hl2 x hx + · cases h + +theorem sub_cons_cons {a b : List Char} (c : Char) (h : a ⊆ b) : + c :: a ⊆ c :: b := by + intro x hx + rcases List.mem_cons.mp hx with e | hx + · rw [e]; exact List.mem_cons_self + · exact List.mem_cons_of_mem _ (h hx) + +theorem noDashDash_nil : NoDashDash [] := by + intro pre suf e + have := congrArg List.length e + simp at this + +theorem notDashEnd_nil : NotDashEnd [] := by + intro pre e + have := congrArg List.length e + simp at this + +/-- What the comment body reader gives back: a body with no `--`, + not ending with `-`, of legal characters, made of characters of + the text, and the text after the closing marks. The last part + says how the body starts, which the induction needs: an empty + body means the text started with the closing marks. -/ +theorem parseCommentBody_spec : ∀ (cs b r : List Char), + parseCommentBody cs = some (b, r) → + NoDashDash b ∧ NotDashEnd b ∧ (∀ c ∈ b, LegalChar c) ∧ b ⊆ cs ∧ + r ⊆ cs ∧ ((b = [] ∧ cs.head? = some '-') ∨ (b ≠ [] ∧ b.head? = cs.head?)) + | [], b, r, h => by + unfold parseCommentBody at h + cases h + | c :: rest, b, r, h => by + unfold parseCommentBody at h + split at h + · rename_i hc + split at h + · rename_i r' + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + refine ⟨noDashDash_nil, notDashEnd_nil, by simp, by simp, ?_, + Or.inl ⟨rfl, by simp [hc]⟩⟩ + exact sub_cons _ (sub_cons _ (sub_cons _ (sub_refl _))) + · cases h + · rename_i hn1 hn2 + obtain ⟨b', h1, rfl⟩ := map_cons_some h + obtain ⟨hdd, hde, hl, hbs, hrs, hhead⟩ := parseCommentBody_spec rest b' r h1 + have hb' : b' ≠ [] ∧ b'.head? ≠ some '-' := by + rcases hhead with ⟨_, hh⟩ | ⟨hne, hh⟩ + · exfalso + cases rest with + | nil => simp at hh + | cons x xs => + simp only [List.head?_cons, Option.some.injEq] at hh + subst hh + exact hn2 xs rfl + · refine ⟨hne, ?_⟩ + rw [hh] + intro e + cases rest with + | nil => simp at e + | cons x xs => + simp only [List.head?_cons, Option.some.injEq] at e + subst e + exact hn2 xs rfl + subst hc + refine ⟨?_, ?_, legal_cons (legal_of_test (by decide)) hl, + sub_cons_cons _ hbs, sub_cons _ hrs, Or.inr ⟨by simp, rfl⟩⟩ + · intro pre suf e + cases pre with + | nil => + simp only [List.nil_append, List.cons.injEq, true_and] at e + exact hb'.2 (by rw [e]; rfl) + | cons y pre' => + simp only [List.cons_append, List.cons.injEq] at e + exact hdd pre' suf e.2 + · intro pre e + cases pre with + | nil => + simp only [List.nil_append, List.cons.injEq, true_and] at e + exact hb'.1 e + | cons y pre' => + simp only [List.cons_append, List.cons.injEq] at e + exact hde pre' e.2 + · split at h + · rename_i hc hlc + obtain ⟨b', h1, rfl⟩ := map_cons_some h + obtain ⟨hdd, hde, hl, hbs, hrs, _⟩ := parseCommentBody_spec rest b' r h1 + refine ⟨?_, ?_, legal_cons (legal_of_test hlc) hl, + sub_cons_cons _ hbs, sub_cons _ hrs, Or.inr ⟨by simp, rfl⟩⟩ + · intro pre suf e + cases pre with + | nil => + simp only [List.nil_append, List.cons.injEq] at e + exact hc e.1 + | cons y pre' => + simp only [List.cons_append, List.cons.injEq] at e + exact hdd pre' suf e.2 + · intro pre e + cases pre with + | nil => + simp only [List.nil_append, List.cons.injEq] at e + exact hc e.1 + | cons y pre' => + simp only [List.cons_append, List.cons.injEq] at e + exact hde pre' e.2 + · cases h + +theorem noQClose_nil : NoQClose [] := by + intro pre suf e + have := congrArg List.length e + simp at this + +/-- What the processing instruction data reader gives back: data + with no `?>`, of legal characters, made of characters of the + text, and the text after the closing marks; and how the data + starts. -/ +theorem parsePIData_spec : ∀ (cs d r : List Char), + parsePIData cs = some (d, r) → + NoQClose d ∧ (∀ c ∈ d, LegalChar c) ∧ d ⊆ cs ∧ r ⊆ cs ∧ + ((d = [] ∧ cs.head? = some '?') ∨ (d ≠ [] ∧ d.head? = cs.head?)) + | [], d, r, h => by + unfold parsePIData at h + cases h + | c :: rest, d, r, h => by + unfold parsePIData at h + split at h + · rename_i hc + split at h + · rename_i r' + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨noQClose_nil, by simp, by simp, + sub_cons _ (sub_cons _ (sub_refl _)), Or.inl ⟨rfl, by simp [hc]⟩⟩ + · rename_i hn + obtain ⟨d', h1, rfl⟩ := map_cons_some h + obtain ⟨hq, hl, hds, hrs, hhead⟩ := parsePIData_spec rest d' r h1 + subst hc + refine ⟨?_, legal_cons (legal_of_test (by decide)) hl, + sub_cons_cons _ hds, sub_cons _ hrs, Or.inr ⟨by simp, rfl⟩⟩ + intro pre suf e + cases pre with + | nil => + simp only [List.nil_append, List.cons.injEq, true_and] at e + subst e + rcases hhead with ⟨hne, _⟩ | ⟨_, hh⟩ + · exact List.cons_ne_nil _ _ hne + · cases rest with + | nil => simp at hh + | cons x xs => + simp only [List.head?_cons, Option.some.injEq] at hh + subst hh + exact hn xs rfl + | cons y pre' => + simp only [List.cons_append, List.cons.injEq] at e + exact hq pre' suf e.2 + · split at h + · rename_i hc hlc + obtain ⟨d', h1, rfl⟩ := map_cons_some h + obtain ⟨hq, hl, hds, hrs, _⟩ := parsePIData_spec rest d' r h1 + refine ⟨?_, legal_cons (legal_of_test hlc) hl, + sub_cons_cons _ hds, sub_cons _ hrs, Or.inr ⟨by simp, rfl⟩⟩ + intro pre suf e + cases pre with + | nil => + simp only [List.nil_append, List.cons.injEq] at e + exact hc e.1 + | cons y pre' => + simp only [List.cons_append, List.cons.injEq] at e + exact hq pre' suf e.2 + · cases h + +/-- What the attribute value reader gives back: legal characters, + and the text after the closing quote. -/ +theorem parseAttrValue_spec (q : Char) : ∀ (f : Nat) (cs v r : List Char), + parseAttrValue q f cs = some (v, r) → (∀ c ∈ v, LegalChar c) ∧ r ⊆ cs + | 0, cs, v, r, h => by + rw [parseAttrValue] at h + cases h + | f + 1, [], v, r, h => by + rw [parseAttrValue] at h + cases h + | f + 1, c :: rest, v, r, h => by + rw [parseAttrValue] at h + split at h + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨by simp, sub_cons _ (sub_refl _)⟩ + · split at h + · cases h + · split at h + · split at h + · rename_i ch r1 hr + rw [Option.map_eq_some_iff] at h + obtain ⟨⟨v', r2⟩, h1, e⟩ := h + simp only [Prod.mk.injEq] at e + obtain ⟨rfl, rfl⟩ := e + obtain ⟨hl, hs⟩ := parseAttrValue_spec q f r1 v' r2 h1 + obtain ⟨hcl, hrs⟩ := parseRef_spec hr + exact ⟨legal_cons hcl hl, + sub_trans hs (sub_trans hrs (sub_cons _ (sub_refl _)))⟩ + · cases h + · split at h + · obtain ⟨v', h1, rfl⟩ := map_cons_some h + obtain ⟨hl, hs⟩ := parseAttrValue_spec q f rest v' r h1 + exact ⟨legal_cons legal_space hl, sub_cons _ hs⟩ + · split at h + · rename_i hlc + obtain ⟨v', h1, rfl⟩ := map_cons_some h + obtain ⟨hl, hs⟩ := parseAttrValue_spec q f rest v' r h1 + exact ⟨legal_cons (legal_of_test hlc) hl, sub_cons _ hs⟩ + · cases h + +/-! ## Processing instructions and attribute lists -/ + +theorem not_IsWs_of_false {c : Char} (h : isWs c = false) : ¬ IsWs c := by + intro hw + have : isWs c = true := by + rcases hw with e | e | e | e <;> rw [e] <;> decide + rw [this] at h + cases h + +/-- What the processing instruction reader gives back: an + instruction, well formed when the text holds no carriage + return, and the text after it. -/ +theorem parsePI_spec {cs : List Char} {n : Node} {r : List Char} + (h : parsePI cs = some (n, r)) : + ('\r' ∉ cs → WFNode n) ∧ (∃ t d, n = .pi t d) ∧ r ⊆ cs := by + unfold parsePI at h + split at h + · rename_i target r1 hpn + obtain ⟨hvn, hcs⟩ := parseName_spec hpn + split at h + · cases h + · rename_i hres + split at h + · rename_i r2 + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + refine ⟨fun _ => ?_, ⟨target, [], rfl⟩, ?_⟩ + · exact WFNode.pi hvn hres noQClose_nil (by simp) (Or.inl rfl) (by simp) + · rw [hcs] + exact sub_trans (sub_cons _ (sub_cons _ (sub_refl _))) (sub_append_right _ _) + · rename_i c tl _ + split at h + · split at h + · rename_i d r2 hpd + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + obtain ⟨hq, hl, hds, hrs, hhead⟩ := parsePIData_spec _ d r2 hpd + have hsk : skipWs (c :: tl) ⊆ cs := by + rw [hcs] + exact sub_trans (skipWs_sub _) (sub_append_right _ _) + refine ⟨fun hcr => ?_, ⟨target, d, rfl⟩, sub_trans hrs hsk⟩ + refine WFNode.pi hvn hres hq hl ?_ (fun m => hcr (hsk (hds m))) + rcases hhead with ⟨hd, _⟩ | ⟨_, hh⟩ + · exact Or.inl hd + · right + intro x xs e + subst e + exact not_IsWs_of_false (skipWs_head _ x (by rw [← hh]; rfl)) + · cases h + · cases h + · cases h + · cases h + +theorem AttrsOk_append : ∀ (acc : List (List Char × List Char)) (a v : List Char), + AttrsOk acc → ValidName a → a ≠ xmlnsName → (∀ c ∈ v, LegalChar c) → + (∀ kv ∈ acc, kv.1 ≠ a) → AttrsOk (acc ++ [(a, v)]) + | [], a, v, _, h1, h2, h3, _ => by + simp only [List.nil_append, AttrsOk] + exact ⟨h1, h2, h3, by simp, trivial⟩ + | kv :: rest, a, v, hok, h1, h2, h3, h4 => by + simp only [List.cons_append, AttrsOk] at hok ⊢ + obtain ⟨g1, g2, g3, g4, g5⟩ := hok + refine ⟨g1, g2, g3, ?_, AttrsOk_append rest a v g5 h1 h2 h3 + (fun k hk => h4 k (List.mem_cons_of_mem _ hk))⟩ + intro kv2 hkv2 + rcases List.mem_append.mp hkv2 with hk | hk + · exact g4 kv2 hk + · simp only [List.mem_singleton] at hk + subst hk + exact fun e => h4 kv List.mem_cons_self e.symm + +/-- What the attribute reader gives back: on top of a list of + attributes that meets `AttrsOk`, a list that meets it too, and + the text after the tag. -/ +theorem parseAttrs_spec : ∀ (f : Nat) (acc : List (List Char × List Char)) + (cs : List Char) (attrs : List (List Char × List Char)) (r : List Char) + (b : Bool), parseAttrs f acc cs = some (attrs, r, b) → AttrsOk acc → + AttrsOk attrs ∧ r ⊆ cs + | 0, acc, cs, attrs, r, b, h, _ => by + rw [parseAttrs] at h + cases h + | f + 1, acc, cs, attrs, r, b, h, hok => by + rw [parseAttrs] at h + have hsk := skipWs_sub cs + split at h + · rename_i rest heq + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + rw [heq] at hsk + exact ⟨hok, sub_trans (sub_cons _ (sub_cons _ (sub_refl _))) hsk⟩ + · rename_i rest heq + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + rw [heq] at hsk + exact ⟨hok, sub_trans (sub_cons _ (sub_refl _)) hsk⟩ + · split at h + · split at h + · rename_i aname r1 hpn + obtain ⟨hvn, hcs⟩ := parseName_spec hpn + have hr1 : r1 ⊆ cs := by + rw [hcs] at hsk + exact sub_trans (sub_append_right _ _) hsk + split at h + · cases h + · rename_i hnx + split at h + · rename_i r2 heq2 + have hr2 : r2 ⊆ cs := by + have := skipWs_sub r1 + rw [heq2] at this + exact sub_trans (sub_trans (sub_cons _ (sub_refl _)) this) hr1 + split at h + · rename_i r3 heq3 + have hr3 : r3 ⊆ cs := by + have := skipWs_sub r2 + rw [heq3] at this + exact sub_trans (sub_trans (sub_cons _ (sub_refl _)) this) hr2 + split at h + · rename_i v r4 hv + obtain ⟨hlv, hr4⟩ := parseAttrValue_spec _ f r3 v r4 hv + split at h + · cases h + · rename_i hany + have hd : ∀ kv ∈ acc, kv.1 ≠ aname := by + intro kv hkv e + apply hany + exact List.any_eq_true.mpr ⟨kv, hkv, by simp [e]⟩ + obtain ⟨hA, hR⟩ := parseAttrs_spec f _ r4 attrs r b h + (AttrsOk_append acc aname v hok hvn hnx hlv hd) + exact ⟨hA, sub_trans hR (sub_trans hr4 hr3)⟩ + · cases h + · rename_i r3 heq3 + have hr3 : r3 ⊆ cs := by + have := skipWs_sub r2 + rw [heq3] at this + exact sub_trans (sub_trans (sub_cons _ (sub_refl _)) this) hr2 + split at h + · rename_i v r4 hv + obtain ⟨hlv, hr4⟩ := parseAttrValue_spec _ f r3 v r4 hv + split at h + · cases h + · rename_i hany + have hd : ∀ kv ∈ acc, kv.1 ≠ aname := by + intro kv hkv e + apply hany + exact List.any_eq_true.mpr ⟨kv, hkv, by simp [e]⟩ + obtain ⟨hA, hR⟩ := parseAttrs_spec f _ r4 attrs r b h + (AttrsOk_append acc aname v hok hvn hnx hlv hd) + exact ⟨hA, sub_trans hR (sub_trans hr4 hr3)⟩ + · cases h + · cases h + · cases h + · cases h + · cases h + · cases h + +/-! ## Elements and content -/ + +theorem map_cons_some_node {o : Option (List Node × List Char)} {n : Node} + {ns : List Node} {r : List Char} + (h : (o.map fun (x : List Node × List Char) => (n :: x.1, x.2)) = some (ns, r)) : + ∃ ns', o = some (ns', r) ∧ ns = n :: ns' := by + cases o with + | none => cases h + | some p => + obtain ⟨ns', r'⟩ := p + simp only [Option.map_some, Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨ns', rfl, rfl⟩ + +/-- The element reader only ever gives back an element. -/ +theorem parseElement_is_elem {f : Nat} {cs : List Char} {n : Node} + {r : List Char} (h : parseElement f cs = some (n, r)) : + ∃ nm a c, n = .elem nm a c := by + cases f with + | zero => + unfold parseElement at h + cases h + | succ f => + unfold parseElement at h + iterate 8 (all_goals (try (split at h))) + all_goals first + | (cases h; done) + | (simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨_, _, _, rfl⟩) + +/-- At a text where character data stops, the content reader never + starts its answer with a text run. This is what keeps two text + runs from standing next to each other in the tree. -/ +theorem nodes_head_not_text (f : Nat) (r : List Char) (ns : List Node) + (r2 : List Char) (hst : StopCD r) (h : parseNodes f r = some (ns, r2)) : + ∀ x, ns.head? ≠ some (.text x) := by + cases f with + | zero => + unfold parseNodes at h + cases h + | succ f => + unfold parseNodes at h + split at h + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + intro x e + cases e + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + intro x e + cases e + · split at h + · obtain ⟨ns', _, rfl⟩ := map_cons_some_node h + intro x e + cases e + · cases h + · exfalso + rcases hst with e | ⟨r', e, hn⟩ + · cases e + · simp only [List.cons.injEq, true_and] at e + rename_i tail + exact hn tail e.symm + · split at h + · rename_i n r1 hpi + obtain ⟨_, ⟨t, d, rfl⟩, _⟩ := parsePI_spec hpi + obtain ⟨ns', _, rfl⟩ := map_cons_some_node h + intro x e + cases e + · cases h + · split at h + · split at h + · rename_i n r1 hel + obtain ⟨nm, a, c, rfl⟩ := parseElement_is_elem hel + obtain ⟨ns', _, rfl⟩ := map_cons_some_node h + intro x e + cases e + · cases h + · cases h + · cases h + · exfalso + rename_i h1 _ _ _ _ h6 h7 + rcases hst with e | ⟨r', e, _⟩ + · exact h1 e + · cases r' with + | nil => exact h7 e + | cons c tl => exact h6 c tl e + +/-- The element and content readers, together, by induction on the + fuel: on a text with no carriage return, the element reader gives + a well formed element, the content reader a well formed content + list, and each leaves a part of the text. -/ +theorem elem_nodes_wf : ∀ f, + (∀ cs n r, parseElement f cs = some (n, r) → '\r' ∉ cs → + WFNode n ∧ r ⊆ cs) ∧ + (∀ cs ns r, parseNodes f cs = some (ns, r) → '\r' ∉ cs → + WFNodes ns ∧ r ⊆ cs) + | 0 => by + refine ⟨fun cs n r h _ => ?_, fun cs ns r h _ => ?_⟩ + · unfold parseElement at h + cases h + · unfold parseNodes at h + cases h + | f + 1 => by + obtain ⟨ihE, ihN⟩ := elem_nodes_wf f + constructor + · intro cs n r h hcr + unfold parseElement at h + split at h + · rename_i rest + split at h + · rename_i name r1 hpn + obtain ⟨hvn, hcs⟩ := parseName_spec hpn + have hr1 : r1 ⊆ '<' :: rest := by + rw [hcs] + exact sub_cons _ (sub_append_right _ _) + split at h + · rename_i attrs r2 hat + obtain ⟨hA, hr2⟩ := parseAttrs_spec f [] r1 attrs r2 true hat trivial + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨WFNode.elem hvn hA WFNodes.nil, sub_trans hr2 hr1⟩ + · rename_i attrs r2 hat + obtain ⟨hA, hr2⟩ := parseAttrs_spec f [] r1 attrs r2 false hat trivial + split at h + · rename_i content r3 hn + obtain ⟨hW, hr3⟩ := ihN r2 content r3 hn + (fun m => hcr (hr1 (hr2 m))) + split at h + · rename_i r4 + split at h + · rename_i ename r5 hpe + have hr5 : r5 ⊆ r4 := parseName_sub hpe + split at h + · rename_i r6 heq6 + split at h + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + refine ⟨WFNode.elem hvn hA hW, ?_⟩ + have h6 : r6 ⊆ skipWs r5 := by + rw [heq6] + exact sub_cons _ (sub_refl _) + exact sub_trans h6 (sub_trans (skipWs_sub r5) + (sub_trans hr5 (sub_trans + (sub_cons _ (sub_cons _ (sub_refl _))) + (sub_trans hr3 (sub_trans hr2 hr1))))) + · cases h + · cases h + · cases h + · cases h + · cases h + · cases h + · cases h + · cases h + · intro cs ns r h hcr + unfold parseNodes at h + split at h + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨WFNodes.nil, sub_refl _⟩ + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨WFNodes.nil, sub_refl _⟩ + · rename_i rest + split at h + · rename_i body r1 hcb + obtain ⟨hdd, hde, hl, hbs, hr1, _⟩ := parseCommentBody_spec rest body r1 hcb + have hrest : rest ⊆ '<' :: '!' :: '-' :: '-' :: rest := + sub_cons _ (sub_cons _ (sub_cons _ (sub_cons _ (sub_refl _)))) + obtain ⟨ns', h1, rfl⟩ := map_cons_some_node h + obtain ⟨hW, hr⟩ := ihN r1 ns' r h1 (fun m => hcr (hrest (hr1 m))) + refine ⟨WFNodes.cons + (WFNode.comment hdd hde hl (fun m => hcr (hrest (hbs m)))) hW ?_, + sub_trans hr (sub_trans hr1 hrest)⟩ + intro ⟨x, e⟩ + cases e + · cases h + · split at h + · rename_i t r1 hcd + obtain ⟨hl, hr1, hst⟩ := parseCharData_spec f _ t r1 hcd + split at h + · obtain ⟨hW, hr⟩ := ihN r1 ns r h (fun m => hcr (hr1 m)) + exact ⟨hW, sub_trans hr hr1⟩ + · rename_i hne + obtain ⟨ns', h1, rfl⟩ := map_cons_some_node h + obtain ⟨hW, hr⟩ := ihN r1 ns' r h1 (fun m => hcr (hr1 m)) + exact ⟨WFNodes.cons (WFNode.text hne hl) hW + (fun _ => nodes_head_not_text f r1 ns' r hst h1), + sub_trans hr hr1⟩ + · cases h + · rename_i rest + split at h + · rename_i n r1 hpi + obtain ⟨hwf, ⟨t, d, rfl⟩, hr1⟩ := parsePI_spec hpi + have hrest : rest ⊆ '<' :: '?' :: rest := + sub_cons _ (sub_cons _ (sub_refl _)) + obtain ⟨ns', h1, rfl⟩ := map_cons_some_node h + obtain ⟨hW, hr⟩ := ihN r1 ns' r h1 (fun m => hcr (hrest (hr1 m))) + refine ⟨WFNodes.cons (hwf (fun m => hcr (hrest m))) hW ?_, + sub_trans hr (sub_trans hr1 hrest)⟩ + intro ⟨x, e⟩ + cases e + · cases h + · split at h + · split at h + · rename_i n r1 hel + obtain ⟨hwf, hr1⟩ := ihE _ n r1 hel hcr + obtain ⟨nm, a, c, rfl⟩ := parseElement_is_elem hel + obtain ⟨ns', h1, rfl⟩ := map_cons_some_node h + obtain ⟨hW, hr⟩ := ihN r1 ns' r h1 (fun m => hcr (hr1 m)) + refine ⟨WFNodes.cons hwf hW ?_, sub_trans hr hr1⟩ + intro ⟨x, e⟩ + cases e + · cases h + · cases h + · cases h + · split at h + · rename_i t r1 hcd + obtain ⟨hl, hr1, hst⟩ := parseCharData_spec f _ t r1 hcd + split at h + · obtain ⟨hW, hr⟩ := ihN r1 ns r h (fun m => hcr (hr1 m)) + exact ⟨hW, sub_trans hr hr1⟩ + · rename_i hne + obtain ⟨ns', h1, rfl⟩ := map_cons_some_node h + obtain ⟨hW, hr⟩ := ihN r1 ns' r h1 (fun m => hcr (hr1 m)) + exact ⟨WFNodes.cons (WFNode.text hne hl) hW + (fun _ => nodes_head_not_text f r1 ns' r hst h1), + sub_trans hr hr1⟩ + · cases h + +/-! ## Prolog, epilog, document -/ + +theorem parseMisc_spec : ∀ (f : Nat) (cs : List Char) (ns : List Node) + (r : List Char), parseMisc f cs = some (ns, r) → '\r' ∉ cs → + MiscOk ns ∧ r ⊆ cs + | 0, cs, ns, r, h, _ => by + unfold parseMisc at h + cases h + | f + 1, cs, ns, r, h, hcr => by + unfold parseMisc at h + dsimp only at h + have hsk := skipWs_sub cs + split at h + · rename_i rest heq + split at h + · rename_i body r1 hcb + obtain ⟨hdd, hde, hl, hbs, hr1, _⟩ := parseCommentBody_spec rest body r1 hcb + have hrest : rest ⊆ cs := by + rw [heq] at hsk + exact sub_trans + (sub_cons _ (sub_cons _ (sub_cons _ (sub_cons _ (sub_refl _))))) hsk + obtain ⟨ns', h1, rfl⟩ := map_cons_some_node h + obtain ⟨hM, hr⟩ := parseMisc_spec f r1 ns' r h1 + (fun m => hcr (hrest (hr1 m))) + refine ⟨?_, sub_trans hr (sub_trans hr1 hrest)⟩ + intro n hn + rcases List.mem_cons.mp hn with e | hn + · subst e + exact ⟨WFNode.comment hdd hde hl (fun m => hcr (hrest (hbs m))), + Or.inl ⟨body, rfl⟩⟩ + · exact hM n hn + · cases h + · rename_i rest heq + split at h + · rename_i n r1 hpi + obtain ⟨hwf, ⟨t, d, rfl⟩, hr1⟩ := parsePI_spec hpi + have hrest : rest ⊆ cs := by + rw [heq] at hsk + exact sub_trans (sub_cons _ (sub_cons _ (sub_refl _))) hsk + obtain ⟨ns', h1, rfl⟩ := map_cons_some_node h + obtain ⟨hM, hr⟩ := parseMisc_spec f r1 ns' r h1 + (fun m => hcr (hrest (hr1 m))) + refine ⟨?_, sub_trans hr (sub_trans hr1 hrest)⟩ + intro n hn + rcases List.mem_cons.mp hn with e | hn + · subst e + exact ⟨hwf (fun m => hcr (hrest m)), Or.inr ⟨t, d, rfl⟩⟩ + · exact hM n hn + · cases h + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨fun n hn => absurd hn List.not_mem_nil, hsk⟩ + +theorem parseDocument_wf {f : Nat} {cs : List Char} {d : Document} + (h : parseDocument f cs = some d) (hcr : '\r' ∉ cs) : WF d := by + unfold parseDocument at h + split at h + · rename_i prolog r1 hm + obtain ⟨hP, hr1⟩ := parseMisc_spec f cs prolog r1 hm hcr + split at h + · rename_i root r2 he + obtain ⟨hR, hr2⟩ := (elem_nodes_wf f).1 r1 root r2 he (fun m => hcr (hr1 m)) + obtain ⟨nm, a, c, hshape⟩ := parseElement_is_elem he + split at h + · rename_i epilog r3 hm2 + obtain ⟨hE, _⟩ := parseMisc_spec f r2 epilog r3 hm2 + (fun m => hcr (hr1 (hr2 m))) + split at h + · simp only [Option.some.injEq] at h + subst h + exact ⟨hP, hR, ⟨nm, a, c, hshape⟩, hE⟩ + · cases h + · cases h + · cases h + · cases h + +/-- The normalized text holds no carriage return. -/ +theorem normEol_noCR (cs : List Char) : '\r' ∉ normEol cs := by + induction cs using normEol.induct with + | case1 => simp [normEol.eq_1] + | case2 rest ih => + rw [normEol.eq_2] + intro m + rcases List.mem_cons.mp m with e | m + · cases e + · exact ih m + | case3 rest hrest ih => + rw [normEol.eq_3 _ hrest] + intro m + rcases List.mem_cons.mp m with e | m + · cases e + · exact ih m + | case4 c rest _ hc ih => + rw [normEol_cons_ne hc] + intro m + rcases List.mem_cons.mp m with e | m + · exact hc e.symm + · exact ih m + +/-- Every document the parser accepts is well formed. -/ +theorem parse_wf (cs : List Char) (d : Document) (h : parse cs = some d) : + WF d := + parseDocument_wf h (normEol_noCR cs) + +/-- The plan's main claim: printing a parsed document gives a text + that parses to the same document. -/ +theorem print_parse (cs : List Char) (d : Document) (h : parse cs = some d) : + parse (print d) = some d := + parse_print d (parse_wf cs d h) + +end Xml.Proofs diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index f0473d9..3a3dfd8 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -11,6 +11,7 @@ import Xml import Proofs.RoundTrip import Proofs.Refusals import Proofs.LineEnds +import Proofs.ParseWF open Xml @@ -19,6 +20,16 @@ theorem Spec.parse_print (d : Document) (hwf : WF d) : Xml.Proofs.parse_print d hwf +theorem Spec.parse_wf (cs : List Char) (d : Document) + (h : parse cs = some d) : WF d := + Xml.Proofs.parse_wf cs d h + + +theorem Spec.print_parse (cs : List Char) (d : Document) + (h : parse cs = some d) : parse (print d) = some d := + Xml.Proofs.print_parse cs d h + + theorem Spec.rejects_doctype : (parse "".toList).isSome = false := by decide +kernel diff --git a/README.md b/README.md index 3946e08..68ce47a 100644 --- a/README.md +++ b/README.md @@ -58,6 +58,8 @@ where they end in `sorry`) and proved in | Claim | Theorem | |-------|---------| | Parsing the printed form of a well formed document gives the document back. | `Spec.parse_print` | +| Every text the parser accepts gives a well formed document (`Xml.WF`, described below): among other things, no name holds a colon or starts with a digit, no attribute name stands twice on one element and none is `xmlns`, every character is a legal XML character, and comment bodies hold no `--`. | `Spec.parse_wf` | +| Printing a document the parser accepted gives a text that parses back to the same document (the plan's main claim, as written). | `Spec.print_parse` | | A document carrying a document type declaration is refused. | `Spec.rejects_doctype` | | A reference to an entity the subset does not define is refused. | `Spec.rejects_undefined_entity` | | An end tag that does not match the start tag is refused. | `Spec.rejects_mismatched_tags` | @@ -115,13 +117,21 @@ are about. ## What is not proved +- That the tree the parser gives is the right reading of + the text. `Spec.parse_wf` says the tree is well formed + and `Spec.print_parse` that it survives printing, but + neither ties the tree to the text it came from: a parser + that read `&e;` as some character, or dropped an + attribute, would meet both. A parser that refuses every + text also meets both; `Spec.parse_print` rules that one + out. The differential tests check the reading against + ElementTree instead. - That the parser accepts every text the subset allows, - and rejects every text it forbids. The round trip does - not need either, and the refusal theorems pin single - inputs only, so neither holds in general as a proof. - The differential tests check that behaviour instead, - and the results file records the outcome, including any - failure. + and rejects every text it forbids. The refusal theorems + pin single inputs only, so neither holds in general as a + proof. The differential tests check that behaviour + instead, and the results file records the outcome, + including any failure. - Anything about documents outside the subset: documents with a document type declaration, entities beyond the five predefined ones, namespaces, an XML declaration, diff --git a/SPEC.md b/SPEC.md index 3d12333..45ea0bb 100644 --- a/SPEC.md +++ b/SPEC.md @@ -218,6 +218,8 @@ each rule on many more inputs. | Property | Theorem | |----------|---------| | Parsing the printed form of a well formed document gives the document back | `Spec.parse_print` | +| Every text the parser accepts gives a well formed document (`WF`, as stated under Well formed trees) | `Spec.parse_wf` | +| Printing a document the parser accepted gives a text that parses back to the same document | `Spec.print_parse` | | A document carrying a document type declaration is refused | `Spec.rejects_doctype` | | A reference to an entity the subset does not define is refused | `Spec.rejects_undefined_entity` | | An end tag that does not match the start tag is refused | `Spec.rejects_mismatched_tags` | @@ -240,6 +242,15 @@ each rule on many more inputs. | An attribute name right after the closing quote of the attribute before it, with no whitespace between them, is refused, on the root element after any well formed prolog and at least one well formed attribute, printed, whatever follows the first character of the name | `Spec.rejects_attribute_without_space` | | An attribute named `xmlns` on the root element is refused, after any well formed prolog and any well formed attributes before it, printed, whatever follows the name that does not make it longer | `Spec.rejects_xmlns` | +`Spec.parse_wf` holds for every text: whatever the parser +accepts meets every rule under Well formed trees. With the +round trip it gives `Spec.print_parse`, the plan's main claim +as written. Both hold for a parser that refuses every text; +`Spec.parse_print` is the statement such a parser fails. +Neither says that the tree is the right reading of the text: +that rests on the tests. The proof is +`Xml.Proofs.parse_wf` in `Proofs/ParseWF.lean`. + The round trip behind `Spec.parse_print` is `Xml.Proofs.parse_print` in `Proofs/RoundTrip.lean`. Its proofs rest on helper round trips proved in the same file: diff --git a/Spec.lean b/Spec.lean index 2f39acf..2e375f1 100644 --- a/Spec.lean +++ b/Spec.lean @@ -29,6 +29,32 @@ the same well formedness predicate, `Xml.WF`. -/ theorem Spec.parse_print (d : Document) (hwf : WF d) : parse (print d) = some d := sorry +/-! ## Every accepted document + +The two statements below hold for every text. A parser that refuses +every text meets both, so they are paired with `Spec.parse_print`, +which such a parser fails. -/ + +/-- Every text the parser accepts gives a well formed document, as + `Xml.WF` defines it: every name follows the subset's name rule + (so no name holds a colon or starts with a digit), no attribute + name stands twice on an element and none is `xmlns`, every + character in text, attribute values, comments and processing + instruction data is a legal XML character, no two text runs + stand next to each other and none is empty, comment bodies hold + no `--`, do not end with `-` and hold no carriage return, + processing instruction targets are not `xml` in any letter case + and their data holds no `?>`, does not start with whitespace and + holds no carriage return, the root is an element, and the prolog + and epilog hold only comments and processing instructions. -/ +theorem Spec.parse_wf (cs : List Char) (d : Document) + (h : parse cs = some d) : WF d := sorry + +/-- The plan's main claim, as written: printing a parsed document + gives a text that parses to the same document. -/ +theorem Spec.print_parse (cs : List Char) (d : Document) + (h : parse cs = some d) : parse (print d) = some d := sorry + /-! ## Refused inputs Single inputs the parser refuses, one for each headline rule of diff --git a/comparator.json b/comparator.json index f6ba49e..be03d4e 100644 --- a/comparator.json +++ b/comparator.json @@ -1 +1 @@ -{"challenge_module":"Spec","permitted_axioms":["propext","Classical.choice","Quot.sound"],"solution_module":"Proofs","theorem_names":["Spec.parse_print","Spec.rejects_doctype","Spec.rejects_undefined_entity","Spec.rejects_mismatched_tags","Spec.rejects_unclosed_element","Spec.rejects_second_root","Spec.rejects_text_before_root","Spec.rejects_duplicate_attribute","Spec.rejects_lt_in_attribute","Spec.rejects_cdata_close_in_text","Spec.rejects_dashdash_in_comment","Spec.rejects_surrogate_ref","Spec.rejects_zero_ref","Spec.rejects_colon_in_name","Spec.rejects_digit_name","Spec.rejects_unquoted_attribute","Spec.rejects_cdata_in_prolog","Spec.rejects_xml_declaration","Spec.rejects_xmlns","Spec.rejects_attribute_without_space","Spec.crlf_reads_as_lf","Spec.cr_reads_as_lf"]} \ No newline at end of file +{"challenge_module":"Spec","permitted_axioms":["propext","Classical.choice","Quot.sound"],"solution_module":"Proofs","theorem_names":["Spec.parse_print","Spec.parse_wf","Spec.print_parse","Spec.rejects_doctype","Spec.rejects_undefined_entity","Spec.rejects_mismatched_tags","Spec.rejects_unclosed_element","Spec.rejects_second_root","Spec.rejects_text_before_root","Spec.rejects_duplicate_attribute","Spec.rejects_lt_in_attribute","Spec.rejects_cdata_close_in_text","Spec.rejects_dashdash_in_comment","Spec.rejects_surrogate_ref","Spec.rejects_zero_ref","Spec.rejects_colon_in_name","Spec.rejects_digit_name","Spec.rejects_unquoted_attribute","Spec.rejects_cdata_in_prolog","Spec.rejects_xml_declaration","Spec.rejects_xmlns","Spec.rejects_attribute_without_space","Spec.crlf_reads_as_lf","Spec.cr_reads_as_lf"]} \ No newline at end of file diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index fa7ef36..11f941c 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -5,12 +5,13 @@ Written by `tests/run_tests.py`. Rerun it to check these numbers. - Oracle: Python 3.13.17 `xml.etree.ElementTree`, expat_2.6.1 (`ET.XMLParser`, which turns namespace processing on, with a `TreeBuilder` that keeps comments and processing instructions) - Lean tool: Lean (version 4.35.0, x86_64-unknown-linux-gnu, commit eb6cafb7290e8bd5f2937522d8d804f58f02bafc, Release) - Seed: 20261026 -- Inputs: 3314 - - every request sent to the tool: the fixed cases, the generated documents, the named rejections, the malformed requests, and two bare parse requests +- Inputs: 6562 + - every request sent to the tool: the fixed cases, the generated documents, the canonical prints sent back, the named rejections, the malformed requests, and two bare parse requests - Fixed cases passed: 48 of 48 - Generated in-subset documents: 3200 - Generated documents where the tool's canonical print matches the tree and ElementTree agrees on the tree: 3200 - ElementTree tree agreements on generated documents: 3200 +- Canonical prints that parse back to the same print: 3248 of 3248 - Named rejections rejected by the tool: 54 of 54 - Out of subset disagreements (ElementTree accepts, this slice rejects, by design): 10 - document type declaration diff --git a/tests/run_tests.py b/tests/run_tests.py index 2084bd8..1a5f36c 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -1,7 +1,7 @@ #!/usr/bin/env python3 """Tests for the Lean XML safe-subset parser and printer. -Three parts. +Four parts. 1. Fixed cases: hand written documents covering each feature of the subset (nesting, both quote forms, empty elements in both @@ -39,7 +39,11 @@ return in the tree's text or attribute values is spelled as a character reference, the only way to keep one. -3. Named rejections: one input per rejection rule in SPEC.md. +3. Print then parse: every canonical print the tool gave in parts + 1 and 2 is sent back, and the answer must be the same print + (`Spec.print_parse`, run on the compiled tool). + +4. Named rejections: one input per rejection rule in SPEC.md. The Lean tool must reject every one. ElementTree agrees with most of them; where ElementTree accepts (a document type declaration, a colon in a name, the XML declaration form), @@ -733,6 +737,7 @@ def main(): # Part 1: fixed cases. inputs = [t for t, _ in FIXED] answers = run_requests(inputs, failures, "fixed cases") + fixed_answers = answers fixed_ok = 0 for (text, expected), ans in zip(FIXED, answers): want = "ok:" + codes(expected) @@ -751,6 +756,7 @@ def main(): gen_inputs.append(text) gen_docs.append(doc) answers = run_requests(gen_inputs, failures, "generated") + gen_answers = answers gen_ok = 0 et_ok = 0 for text, doc, ans in zip(gen_inputs, gen_docs, answers): @@ -775,7 +781,22 @@ def main(): else: gen_ok += 1 - # Part 3: named rejections. Also record ElementTree's verdict + # Part 3: print then parse. Every canonical print the tool gave + # in parts 1 and 2 is sent back; the answer must be the same + # print (Spec.print_parse, run on the compiled tool). + printed = [] + for ans in fixed_answers + gen_answers: + if ans.startswith("ok:") and len(ans) > 3: + printed.append("".join(chr(int(x)) for x in ans[3:].split(","))) + re_answers = run_requests(printed, failures, "print then parse") + reprint_ok = 0 + for text, ans in zip(printed, re_answers): + if ans == "ok:" + codes(text): + reprint_ok += 1 + else: + failures.append("print then parse %r: got %r" % (text, ans[:120])) + + # Part 4: named rejections. Also record ElementTree's verdict # on each: accepted means an out of subset disagreement. rej_inputs = [t for _, t in REJECTIONS] answers = run_requests(rej_inputs, failures, "named rejections") @@ -813,8 +834,8 @@ def main(): lines.append("Written by `tests/run_tests.py`. Rerun it to " "check these numbers.") lines.append("") - total = (len(FIXED) + len(gen_inputs) + len(REJECTIONS) - + len(MALFORMED) + 2) + total = (len(FIXED) + len(gen_inputs) + len(printed) + + len(REJECTIONS) + len(MALFORMED) + 2) lines.append("- Oracle: Python %s `xml.etree.ElementTree`, " "%s (`ET.XMLParser`, which turns namespace " "processing on, with a `TreeBuilder` that keeps " @@ -824,8 +845,9 @@ def main(): lines.append("- Seed: %d" % args.seed) lines.append("- Inputs: %d" % total) lines.append(" - every request sent to the tool: the fixed cases, " - "the generated documents, the named rejections, the " - "malformed requests, and two bare parse requests") + "the generated documents, the canonical prints sent " + "back, the named rejections, the malformed requests, " + "and two bare parse requests") lines.append("- Fixed cases passed: %d of %d" % (fixed_ok, len(FIXED))) lines.append("- Generated in-subset documents: %d" % len(gen_inputs)) @@ -834,6 +856,8 @@ def main(): "the tree: %d" % gen_ok) lines.append("- ElementTree tree agreements on generated " "documents: %d" % et_ok) + lines.append("- Canonical prints that parse back to the same " + "print: %d of %d" % (reprint_ok, len(printed))) lines.append("- Named rejections rejected by the tool: %d of %d" % (rej_ok, len(REJECTIONS))) lines.append("- Out of subset disagreements (ElementTree " From dfe9a88eb8bf585a421547852cda673833aa8f3f Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:54:25 +0000 Subject: [PATCH 11/18] State refusals for families of texts, and make every row say what its theorem says Blocking item 2 of review 3 on 4875cec: the "What is proved" tables in README.md and SPEC.md stated 17 general rules ("a reference to an entity the subset does not define is refused", "a DOCTYPE is refused") while each theorem pinned one input. A parseRef that expands &e; and © met all 18 statements. Each single-input refusal in Spec.lean is replaced by a statement over a family of texts, and every row now names that family and no more. Most families are: any well formed prolog, printed; for most, the root's start tag with any valid name and attributes meeting AttrsOk, printed; then the forbidden form; then anything. - Spec.rejects_undefined_entity: in the root's first run of character data (any text with no < and no & before it), &name; for any valid name other than lt, gt, amp, apos, quot is refused. The new Spec.rejects_undefined_entity_in_attribute says the same for an attribute value of the root. Both refuse the reviewer's mutant. - rejects_doctype and rejects_cdata_in_prolog: after any prolog. rejects_xml_declaration: ): in the root's first run of character data. rejects_dashdash_in_comment: a comment that is the root's first content, with a body a WF comment may hold, then -- and any character but >. rejects_duplicate_attribute, rejects_lt_in_attribute, rejects_unquoted_attribute: on the root, after its printed attributes. All are proved in Proofs/Refusals.lean and listed in comparator.json (25 theorems). README "What is not proved" now says that each refusal covers only the positions its row names, so "no entity is ever expanded" is a theorem only in the root's first text run and in the root's attribute values. SPEC.md uses the same rows and says the rules are the specification, with the theorems listed separately. The nanoda kernel overflowed its stack on some of these proofs. It does so when it must compare a character literal with a different literal pattern while checking a matcher, and how deep it goes depends on what it checked before. The step lemmas therefore take the characters as variables, and the literal cases instantiate them. The whole export of the 25 theorems passes nanoda, and lake comparator --paranoid accepts all of them under all six kernels. tests: 18 named rejections for the same rules in other positions (after a prolog, after text, after other attributes, after a whole document). 72 of 72 rejected; 0 failures. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Proofs/Refusals.lean | 1409 ++++++++++++++++++++++++++++++++++++++++ Proofs/RoundTrip.lean | 4 +- Proofs/SpecProofs.lean | 267 ++++---- README.md | 127 ++-- SPEC.md | 87 ++- Spec.lean | 334 ++++++---- comparator.json | 2 +- tests/TEST-RESULTS.md | 7 +- tests/run_tests.py | 24 + 9 files changed, 1947 insertions(+), 314 deletions(-) diff --git a/Proofs/Refusals.lean b/Proofs/Refusals.lean index aabc735..6aaa4da 100644 --- a/Proofs/Refusals.lean +++ b/Proofs/Refusals.lean @@ -13,6 +13,7 @@ import Xml import Proofs.RoundTrip import Proofs.LineEnds +import Proofs.ParseWF namespace Xml.Proofs @@ -242,4 +243,1412 @@ theorem rejects_attribute_without_space (prolog : List Node) rw [normEol_cons_ne hcr] exact parseAttrs_no_space f hf attrs c (normEol rest) hc +/-! ## Toolkit: after the prolog -/ + +/-- A text made of a printed prolog and then a part where the prolog + reader stops and the element reader refuses, with its line ends + normalized, is refused. -/ +theorem parse_prolog_none (prolog : List Node) (hpro : MiscOk prolog) + (X0 : List Char) + (hstop : ∀ f, 1 ≤ f → + parseMisc f (normEol X0) = some ([], skipWs (normEol X0))) + (he : ∀ f, 1 ≤ f → parseElement f (skipWs (normEol X0)) = none) : + parse (printNodes prolog ++ X0) = none := by + have hn : normEol (printNodes prolog ++ X0) = printNodes prolog ++ normEol X0 := + normEol_append_noCR _ _ (noCR_printNodes_misc prolog hpro) + show parseDocument ((normEol (printNodes prolog ++ X0)).length + 1) + (normEol (printNodes prolog ++ X0)) = none + rw [hn] + generalize normEol X0 = X at hstop he + have hm := parseMisc_print prolog X hpro hstop + ((printNodes prolog ++ X).length + 1) + (by simp only [List.length_append]; omega) + have hroot := he ((printNodes prolog ++ X).length + 1) (by omega) + simp only [parseDocument, hm, hroot] + +/-- The prolog reader stops at a less sign followed by a character + that is neither the bang of a comment nor a question mark. -/ +theorem parseMisc_stop_lt {f : Nat} {c : Char} {cs : List Char} + (h1 : c ≠ '!') (h2 : c ≠ '?') : + parseMisc (f + 1) ('<' :: c :: cs) = some ([], '<' :: c :: cs) := by + have h3 : skipWs ('<' :: c :: cs) = '<' :: c :: cs := + skipWs_cons (by decide) + simp [parseMisc, h3, h1, h2] + +/-- The prolog reader stops at a less sign, a character that is not + a question mark, and a character that is not a dash. The two + characters are variables here: the nanoda kernel recurses past + its stack when it has to compare a character literal with a + different literal pattern while checking a matcher, so the + literal case below instantiates this one. -/ +theorem parseMisc_stop_two {f : Nat} {b c : Char} {cs : List Char} + (hb : b ≠ '?') (hc : c ≠ '-') : + parseMisc (f + 1) ('<' :: b :: c :: cs) = + some ([], '<' :: b :: c :: cs) := by + have h3 : skipWs ('<' :: b :: c :: cs) = '<' :: b :: c :: cs := + skipWs_cons (by decide) + simp [parseMisc, h3, hb, hc] + +/-- The prolog reader stops at ` rfl + | succ f => + unfold parseElement + split + · rename_i rest heq + exact absurd (List.cons.inj heq).1 hc + · rfl + +/-- The element reader refuses a less sign that a name does not + follow. -/ +theorem parseElement_bad_name {f : Nat} {cs : List Char} + (h : parseName cs = none) : parseElement f ('<' :: cs) = none := by + cases f with + | zero => rfl + | succ f => + unfold parseElement + split + · rename_i rest heq + cases heq + rw [h] + · rename_i hne + exact absurd rfl (hne cs) + +theorem parseName_not_start {c : Char} {cs : List Char} + (h : isNameStart c = false) : parseName (c :: cs) = none := by + simp [parseName, h] + +/-! ## Toolkit: root content -/ + +/-- The element reader refuses when the start tag is read and the + content reader refuses. -/ +theorem parseElement_content_none {g : Nat} {rest name r1 : List Char} + {attrs : List (List Char × List Char)} {r2 : List Char} + (hpn : parseName rest = some (name, r1)) + (hat : parseAttrs g [] r1 = some (attrs, r2, false)) + (hn : parseNodes g r2 = none) : parseElement (g + 1) ('<' :: rest) = none := by + unfold parseElement + split + · rename_i rest' heq + cases heq + rw [hpn] + split + · rename_i name' r1' heq2 + cases heq2 + rw [hat] + split + · rename_i heq3 + cases heq3 + · rename_i attrs' r2' heq3 + cases heq3 + rw [hn] + · rename_i heq3 + cases heq3 + · rename_i heq2 + cases heq2 + · rename_i hne + exact absurd rfl (hne rest) + +/-- A root start tag with printed attributes and a closing bracket, + after a printed prolog, is refused when the content reader + refuses what follows, with its line ends normalized, at every + fuel from one up. -/ +theorem parse_content_none (prolog : List Node) (hpro : MiscOk prolog) + (name : List Char) (hname : ValidName name) + (attrs : List (List Char × List Char)) (hattrs : AttrsOk attrs) + (tail0 : List Char) + (hcont : ∀ f, 1 ≤ f → parseNodes f (normEol tail0) = none) : + parse (printNodes prolog ++ '<' :: (name ++ (printAttrs attrs ++ '>' :: tail0))) = + none := by + have hnn := noCR_validName hname + obtain ⟨c0, ds, hq, hc0, hds⟩ := hname + subst hq + rw [List.cons_append] + apply parse_root_none prolog hpro c0 _ hc0 + have hds' : '\r' ∉ ds := fun m => hnn (List.mem_cons_of_mem _ m) + rw [normEol_append_noCR _ _ hds', + normEol_append_noCR _ _ (noCR_printAttrs attrs hattrs), + normEol_cons_ne (by decide)] + generalize normEol tail0 = tail at hcont + intro f hf + cases f with + | zero => omega + | succ g => + have hlen : ds.length + (printAttrs attrs).length + tail.length + 2 ≤ g := by + have h := hf + simp only [List.length_append, List.length_cons] at h + omega + have hpv := printAttrs_length_ge_value attrs + have hat : parseAttrs g [] (printAttrs attrs ++ '>' :: tail) = + some (attrs, tail, false) := by + have h := parseAttrs_print_open attrs [] tail g hattrs + (by intro kv _ e; simp at e) + (fun kv hkv => by have := hpv kv hkv; omega) + (by have := printAttrs_length_ge attrs; omega) + simpa using h + have hpn : parseName (c0 :: (ds ++ (printAttrs attrs ++ '>' :: tail))) = + some (c0 :: ds, printAttrs attrs ++ '>' :: tail) := + parseName_append (cs := c0 :: ds) ⟨c0, ds, rfl, hc0, hds⟩ + (printAttrs_head_not_name attrs _ (by + intro c hc + simp at hc + rw [← hc] + exact isNameChar_false_of not_nameChar_gt)) + exact parseElement_content_none hpn hat (hcont g (by omega)) + +/-! ## Toolkit: readers that fail -/ + +/-- Normalizing a text made of two parts is normalizing each part, + when the second part does not start with a line feed. -/ +theorem normEol_append_of_head (A B : List Char) (hB : B.head? ≠ some '\n') : + normEol (A ++ B) = normEol A ++ normEol B := by + induction A using normEol.induct with + | case1 => simp [normEol.eq_1] + | case2 rest ih => + rw [List.cons_append, List.cons_append, normEol.eq_2, normEol.eq_2, ih, + List.cons_append] + | case3 rest hrest ih => + have hne : ∀ r, rest ++ B ≠ '\n' :: r := by + intro r e + cases rest with + | nil => + simp only [List.nil_append] at e + rw [e] at hB + exact hB rfl + | cons x xs => + simp only [List.cons_append, List.cons.injEq] at e + exact hrest xs (by rw [e.1]) + rw [List.cons_append, normEol.eq_3 _ hne, normEol.eq_3 _ hrest, ih, + List.cons_append] + | case4 c rest _ hc ih => + rw [List.cons_append, normEol_cons_ne hc, normEol_cons_ne hc, ih, + List.cons_append] + +/-- A character of a normalized text is a character of the text, + or a line feed. -/ +theorem normEol_mem (cs : List Char) (x : Char) (h : x ∈ normEol cs) : + x ∈ cs ∨ x = '\n' := by + induction cs using normEol.induct with + | case1 => simp [normEol.eq_1] at h + | case2 rest ih => + rw [normEol.eq_2] at h + rcases List.mem_cons.mp h with e | h + · exact Or.inr e + · rcases ih h with h | h + · exact Or.inl (List.mem_cons_of_mem _ (List.mem_cons_of_mem _ h)) + · exact Or.inr h + | case3 rest hrest ih => + rw [normEol.eq_3 _ hrest] at h + rcases List.mem_cons.mp h with e | h + · exact Or.inr e + · rcases ih h with h | h + · exact Or.inl (List.mem_cons_of_mem _ h) + · exact Or.inr h + | case4 c rest _ hc ih => + rw [normEol_cons_ne hc] at h + rcases List.mem_cons.mp h with e | h + · exact Or.inl (e ▸ List.mem_cons_self) + · rcases ih h with h | h + · exact Or.inl (List.mem_cons_of_mem _ h) + · exact Or.inr h + +theorem normEol_not_mem {cs : List Char} {x : Char} (h : x ∉ cs) + (hx : x ≠ '\n') : x ∉ normEol cs := by + intro m + rcases normEol_mem cs x m with m | e + · exact h m + · exact hx e + +/-- A text run reader fails on a part with no less sign and no + ampersand followed by a text it fails on, at every fuel. -/ +theorem parseTextRun_fail : ∀ (pre X : List Char), '<' ∉ pre → '&' ∉ pre → + (∀ f, parseTextRun f X = none) → ∀ f, parseTextRun f (pre ++ X) = none + | [], X, _, _, hX, f => hX f + | c :: pre, X, hlt, hamp, hX, f => by + have hc1 : c ≠ '<' := fun e => hlt (e ▸ List.mem_cons_self) + have hc2 : c ≠ '&' := fun e => hamp (e ▸ List.mem_cons_self) + have ih := parseTextRun_fail pre X (fun m => hlt (List.mem_cons_of_mem _ m)) + (fun m => hamp (List.mem_cons_of_mem _ m)) hX + cases f with + | zero => rfl + | succ f => + rw [List.cons_append, parseTextRun.eq_3, ite_eq_right hc1, ite_eq_right hc2] + split + · split + · rfl + · rw [ih f] + rfl + · split + · rw [ih f] + rfl + · rfl + +/-- The character data reader fails on a text that does not start + with a less sign and on which the text run reader fails. -/ +theorem parseCharData_fail (cs : List Char) (hne : cs ≠ []) + (hlt : cs.head? ≠ some '<') (hT : ∀ f, parseTextRun f cs = none) : + ∀ f, parseCharData f cs = none := by + intro f + cases f with + | zero => rfl + | succ f => + unfold parseCharData + split + · rename_i heq + exact absurd heq (by omega) + · exact absurd rfl hne + · exact absurd rfl hlt + · exact absurd rfl hlt + · rename_i fuel heq _ _ _ + have hf : f = fuel := Nat.succ.inj heq + subst hf + rw [hT f] + +/-- The content reader fails on a text that does not start with a + less sign and on which the character data reader fails. -/ +theorem parseNodes_fail (cs : List Char) (hne : cs ≠ []) + (hlt : cs.head? ≠ some '<') (hC : ∀ f, parseCharData f cs = none) : + ∀ f, parseNodes f cs = none := by + intro f + cases f with + | zero => rfl + | succ f => + unfold parseNodes + split + · exact absurd rfl hne + · exact absurd rfl hlt + · exact absurd rfl hlt + · exact absurd rfl hlt + · exact absurd rfl hlt + · exact absurd rfl hlt + · exact absurd rfl hlt + · rw [hC f] + +/-- The head of a text made of a part with no less sign and then a + text that does not start with a less sign is not a less sign. -/ +theorem head_not_lt (A X : List Char) (hA : '<' ∉ A) (hX : X.head? ≠ some '<') : + (A ++ X).head? ≠ some '<' := by + cases A with + | nil => simpa using hX + | cons a as => + intro e + simp only [List.cons_append, List.head?_cons, Option.some.injEq] at e + exact hA (e ▸ List.mem_cons_self) + +/-- Root content that starts with character data (no less sign, no + ampersand), then a text the text run reader fails on, is + refused. -/ +theorem content_fail (pre X : List Char) (hlt : '<' ∉ pre) (hamp : '&' ∉ pre) + (hX : X ≠ []) (hXlt : X.head? ≠ some '<') + (hT : ∀ f, parseTextRun f X = none) : + ∀ f, 1 ≤ f → parseNodes f (pre ++ X) = none := by + intro f _ + apply parseNodes_fail + · intro e + exact hX (List.append_eq_nil_iff.mp e).2 + · exact head_not_lt pre X hlt hXlt + · apply parseCharData_fail + · intro e + exact hX (List.append_eq_nil_iff.mp e).2 + · exact head_not_lt pre X hlt hXlt + · exact parseTextRun_fail pre X hlt hamp hT + +/-! ## Undefined entities and bad character references -/ + +theorem not_nameChar_semicolon : ¬ IsNameChar ';' := + not_nameChar_of_test (by decide) + +theorem noSemi_validName {cs : List Char} (h : ValidName cs) : ';' ∉ cs := by + obtain ⟨c, ds, rfl, hc, hds⟩ := h + intro m + rcases List.mem_cons.mp m with e | e + · exact not_nameChar_semicolon (e ▸ IsNameStart.toNameChar hc) + · exact not_nameChar_semicolon (hds _ e) + +theorem eq_of_append_semicolon : ∀ (w e post rest : List Char), ';' ∉ e → + ';' ∉ w → e ++ ';' :: post = w ++ ';' :: rest → e = w + | [], e, post, rest, he, _, h => by + cases e with + | nil => rfl + | cons x xs => + simp only [List.cons_append, List.nil_append, List.cons.injEq] at h + exact absurd (by rw [← h.1]; exact List.mem_cons_self) he + | x :: w, e, post, rest, he, hw, h => by + cases e with + | nil => + simp only [List.nil_append, List.cons_append, List.cons.injEq] at h + exact absurd (by rw [h.1]; exact List.mem_cons_self) hw + | cons y e' => + simp only [List.cons_append, List.cons.injEq] at h + obtain ⟨rfl, h2⟩ := h + rw [eq_of_append_semicolon w e' post rest + (fun m => he (List.mem_cons_of_mem _ m)) + (fun m => hw (List.mem_cons_of_mem _ m)) h2] + +/-- The names of the five predefined entities. -/ +abbrev fiveEntities : List (List Char) := + [['l', 't'], ['g', 't'], ['a', 'm', 'p'], ['a', 'p', 'o', 's'], + ['q', 'u', 'o', 't']] + +/-- The reference reader refuses a reference to any valid name other + than the five predefined entities, whatever follows it. -/ +theorem parseRef_undefined (e post : List Char) (he : ValidName e) + (hfive : e ∉ fiveEntities) : parseRef (e ++ ';' :: post) = none := by + have hsemi : ';' ∉ e := noSemi_validName he + unfold parseRef + split + · rename_i rest heq + have := eq_of_append_semicolon ['l', 't'] e post rest hsemi (by decide) heq + exact absurd (by rw [this]; decide) hfive + · rename_i rest heq + have := eq_of_append_semicolon ['g', 't'] e post rest hsemi (by decide) heq + exact absurd (by rw [this]; decide) hfive + · rename_i rest heq + have := eq_of_append_semicolon ['a', 'm', 'p'] e post rest hsemi (by decide) heq + exact absurd (by rw [this]; decide) hfive + · rename_i rest heq + have := eq_of_append_semicolon ['a', 'p', 'o', 's'] e post rest hsemi + (by decide) heq + exact absurd (by rw [this]; decide) hfive + · rename_i rest heq + have := eq_of_append_semicolon ['q', 'u', 'o', 't'] e post rest hsemi + (by decide) heq + exact absurd (by rw [this]; decide) hfive + · rename_i rest heq + obtain ⟨c, ds, rfl, hc, _⟩ := he + simp only [List.cons_append, List.cons.injEq] at heq + exact absurd heq.1 (IsNameStart.ne_of_test hc (by decide)) + · rfl + +theorem textRun_undefined (e post : List Char) (he : ValidName e) + (hfive : e ∉ fiveEntities) : + ∀ f, parseTextRun f ('&' :: (e ++ ';' :: post)) = none := by + intro f + cases f with + | zero => rfl + | succ f => + rw [parseTextRun.eq_3, ite_eq_right (by decide), ite_eq_left rfl, + parseRef_undefined e post he hfive] + +theorem textRun_surrogate (post : List Char) : + ∀ f, parseTextRun f + ('&' :: '#' :: 'x' :: 'D' :: '8' :: '0' :: '0' :: ';' :: post) = none := by + intro f + cases f with + | zero => rfl + | succ f => rfl + +theorem textRun_zero (post : List Char) : + ∀ f, parseTextRun f ('&' :: '#' :: '0' :: ';' :: post) = none := by + intro f + cases f with + | zero => rfl + | succ f => rfl + +theorem textRun_cdata_close (post : List Char) : + ∀ f, parseTextRun f (']' :: ']' :: '>' :: post) = none := by + intro f + cases f with + | zero => rfl + | succ f => rfl + +/-- Normalizing a text run that ends in a fixed tail with no carriage + return and no leading line feed. -/ +theorem normEol_pre_tail (pre T : List Char) (hT : '\r' ∉ T) + (hh : T.head? ≠ some '\n') : normEol (pre ++ T) = normEol pre ++ T := by + rw [normEol_append_of_head _ _ hh, normEol_of_noCR _ hT] + +/-! ## Attribute values that fail -/ + +/-- The attribute value reader fails on a part with no double quote + and no ampersand followed by a text it fails on. -/ +theorem parseAttrValue_fail : ∀ (pre X : List Char), '"' ∉ pre → '&' ∉ pre → + (∀ f, parseAttrValue '"' f X = none) → + ∀ f, parseAttrValue '"' f (pre ++ X) = none + | [], X, _, _, hX, f => hX f + | c :: pre, X, hq, hamp, hX, f => by + have hc1 : c ≠ '"' := fun e => hq (e ▸ List.mem_cons_self) + have hc2 : c ≠ '&' := fun e => hamp (e ▸ List.mem_cons_self) + have ih := parseAttrValue_fail pre X (fun m => hq (List.mem_cons_of_mem _ m)) + (fun m => hamp (List.mem_cons_of_mem _ m)) hX + cases f with + | zero => rfl + | succ f => + rw [List.cons_append, parseAttrValue.eq_3, ite_eq_right hc1] + split + · rfl + · split + · rw [ih f] + rfl + · split + · rw [ih f] + rfl + · rfl + +theorem attrValue_lt (rest : List Char) : + ∀ f, parseAttrValue '"' f ('<' :: rest) = none := by + intro f + cases f with + | zero => rfl + | succ f => rfl + +theorem attrValue_undefined (e post : List Char) (he : ValidName e) + (hfive : e ∉ fiveEntities) : + ∀ f, parseAttrValue '"' f ('&' :: (e ++ ';' :: post)) = none := by + intro f + cases f with + | zero => rfl + | succ f => + rw [parseAttrValue.eq_3, ite_eq_right (by decide), ite_eq_right (by decide), + ite_eq_left rfl, parseRef_undefined e post he hfive] + +/-! ## One attribute step -/ + +theorem AttrsOk_mem : ∀ (attrs : List (List Char × List Char)) + (kv : List Char × List Char), AttrsOk attrs → kv ∈ attrs → + ValidName kv.1 ∧ kv.1 ≠ xmlnsName + | [], _, _, h => absurd h List.not_mem_nil + | kv0 :: rest, kv, hok, h => by + rcases List.mem_cons.mp h with e | h + · subst e + exact ⟨hok.1, hok.2.1⟩ + · exact AttrsOk_mem rest kv hok.2.2.2.2 h + +/-- The attribute reader at a space, a valid name, an equals sign + and a double quote: it refuses when the value reader refuses, or + when the name is already among the attributes read. -/ +theorem parseAttrs_dq_none (g : Nat) (acc : List (List Char × List Char)) + (a W : List Char) (ha : ValidName a) + (H : ∀ v r4, parseAttrValue '"' g W = some (v, r4) → + (acc.any fun kv => decide (kv.1 = a)) = true) : + parseAttrs (g + 1) acc (' ' :: (a ++ '=' :: '"' :: W)) = none := by + obtain ⟨c0, ds, rfl, hc0, hds⟩ := ha + have hw0 : isWs c0 = false := isWs_false_of_not (IsNameStart.ne_ws hc0) + have hsk : skipWs (' ' :: ((c0 :: ds) ++ '=' :: '"' :: W)) = + c0 :: (ds ++ '=' :: '"' :: W) := by + rw [List.cons_append, skipWs.eq_2, ite_eq_left (by decide)] + exact skipWs_cons hw0 + have hpn : parseName (c0 :: (ds ++ '=' :: '"' :: W)) = + some (c0 :: ds, '=' :: '"' :: W) := + parseName_append (cs := c0 :: ds) ⟨c0, ds, rfl, hc0, hds⟩ (by + intro c hc + simp at hc + rw [← hc] + exact isNameChar_false_of not_nameChar_eq) + rw [parseAttrs.eq_2, hsk] + split + · rename_i rest heq + exact absurd (List.cons.inj heq).1 (IsNameStart.ne_slash hc0) + · rename_i rest heq + exact absurd (List.cons.inj heq).1 (IsNameStart.ne_of_test hc0 (by decide)) + · rename_i c tl _ _ heq + obtain ⟨rfl, rfl⟩ := List.cons.inj heq + rw [ite_eq_left (by simp [isNameStart_of hc0, startsWithWs, isWs]), hpn] + split + · rename_i aname r1 heq2 + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj heq2) + split + · rfl + · rw [skipWs_cons (by decide : isWs '=' = false)] + split + · rename_i r2 heq3 + obtain ⟨_, rfl⟩ := List.cons.inj heq3 + rw [skipWs_cons (by decide : isWs '"' = false)] + split + · rename_i r3 heq4 + obtain ⟨_, rfl⟩ := List.cons.inj heq4 + split + · rename_i v r4 hv + rw [ite_eq_left (H v r4 hv)] + · rfl + · rename_i r3 heq4 + exact absurd (List.cons.inj heq4).1 (by decide) + · rfl + · rfl + · rename_i heq2 + cases heq2 + · rename_i heq + cases heq + +/-- The attribute reader at a space, a valid name, an equals sign + and a character that is no quote and no whitespace: refused. -/ +theorem parseAttrs_unquoted_none (g : Nat) (acc : List (List Char × List Char)) + (a : List Char) (c : Char) (W : List Char) (ha : ValidName a) + (hc1 : c ≠ '"') (hc2 : c ≠ '\'') (hcw : isWs c = false) : + parseAttrs (g + 1) acc (' ' :: (a ++ '=' :: c :: W)) = none := by + obtain ⟨c0, ds, rfl, hc0, hds⟩ := ha + have hw0 : isWs c0 = false := isWs_false_of_not (IsNameStart.ne_ws hc0) + have hsk : skipWs (' ' :: ((c0 :: ds) ++ '=' :: c :: W)) = + c0 :: (ds ++ '=' :: c :: W) := by + rw [List.cons_append, skipWs.eq_2, ite_eq_left (by decide)] + exact skipWs_cons hw0 + have hpn : parseName (c0 :: (ds ++ '=' :: c :: W)) = + some (c0 :: ds, '=' :: c :: W) := + parseName_append (cs := c0 :: ds) ⟨c0, ds, rfl, hc0, hds⟩ (by + intro x hx + simp at hx + rw [← hx] + exact isNameChar_false_of not_nameChar_eq) + rw [parseAttrs.eq_2, hsk] + split + · rename_i rest heq + exact absurd (List.cons.inj heq).1 (IsNameStart.ne_slash hc0) + · rename_i rest heq + exact absurd (List.cons.inj heq).1 (IsNameStart.ne_of_test hc0 (by decide)) + · rename_i c' tl _ _ heq + obtain ⟨rfl, rfl⟩ := List.cons.inj heq + rw [ite_eq_left (by simp [isNameStart_of hc0, startsWithWs, isWs]), hpn] + split + · rename_i aname r1 heq2 + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj heq2) + split + · rfl + · rw [skipWs_cons (by decide : isWs '=' = false)] + split + · rename_i r2 heq3 + obtain ⟨_, rfl⟩ := List.cons.inj heq3 + rw [skipWs_cons hcw] + split + · rename_i r3 heq4 + exact absurd (List.cons.inj heq4).1 hc1 + · rename_i r3 heq4 + exact absurd (List.cons.inj heq4).1 hc2 + · rfl + · rfl + · rename_i heq2 + cases heq2 + · rename_i heq + cases heq + +/-- The attribute reader refuses a text that starts with a + character that is no whitespace, no slash and no closing + bracket: an attribute needs whitespace before it. -/ +theorem parseAttrs_head_none (f : Nat) (hf : 1 ≤ f) + (acc : List (List Char × List Char)) (c : Char) (rest : List Char) + (hw : isWs c = false) (h1 : c ≠ '/') (h2 : c ≠ '>') : + parseAttrs f acc (c :: rest) = none := by + cases f with + | zero => omega + | succ g => + rw [parseAttrs.eq_2, skipWs_cons hw] + split + · rename_i r heq + exact absurd (List.cons.inj heq).1 h1 + · rename_i r heq + exact absurd (List.cons.inj heq).1 h2 + · rename_i c' tl _ _ heq + obtain ⟨rfl, rfl⟩ := List.cons.inj heq + rw [ite_eq_right (by simp [startsWithWs, hw])] + · rename_i heq + cases heq + +/-! ## Element-level helpers -/ + +/-- The element reader refuses when the end tag names another + element. -/ +theorem parseElement_mismatch {g : Nat} {rest name r1 : List Char} + {attrs : List (List Char × List Char)} {r2 : List Char} + {content : List Node} {other R : List Char} + (hpn : parseName rest = some (name, r1)) + (hat : parseAttrs g [] r1 = some (attrs, r2, false)) + (hn : parseNodes g r2 = some (content, '<' :: '/' :: (other ++ '>' :: R))) + (hon : parseName (other ++ '>' :: R) = some (other, '>' :: R)) + (hne : other ≠ name) : + parseElement (g + 1) ('<' :: rest) = none := by + unfold parseElement + split + · rename_i rest' heq + cases heq + rw [hpn] + split + · rename_i name' r1' heq2 + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj heq2) + rw [hat] + split + · rename_i heq3 + cases heq3 + · rename_i attrs' r2' heq3 + cases heq3 + rw [hn] + split + · rename_i content' r3 heq4 + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj heq4) + split + · rename_i r4 heq5 + obtain ⟨-, heq5⟩ := List.cons.inj heq5 + obtain ⟨-, rfl⟩ := List.cons.inj heq5 + rw [hon] + split + · rename_i ename r5 heq6 + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj heq6) + rw [skipWs_cons (by decide : isWs '>' = false)] + split + · rw [ite_eq_right hne] + · rfl + · rename_i heq6 + cases heq6 + · rename_i hne' + exact absurd rfl (hne' _) + · rename_i heq4 + cases heq4 + · rename_i heq3 + cases heq3 + · rename_i heq2 + cases heq2 + · rename_i hne' + exact absurd rfl (hne' rest) + +/-- The element reader refuses when the content reader stops at the + end of the text, with no end tag. -/ +theorem parseElement_unclosed {g : Nat} {rest name r1 : List Char} + {attrs : List (List Char × List Char)} {r2 : List Char} + (hpn : parseName rest = some (name, r1)) + (hat : parseAttrs g [] r1 = some (attrs, r2, false)) + (hn : ∀ ns r3, parseNodes g r2 = some (ns, r3) → r3 = []) : + parseElement (g + 1) ('<' :: rest) = none := by + unfold parseElement + split + · rename_i rest' heq + cases heq + rw [hpn] + split + · rename_i name' r1' heq2 + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj heq2) + rw [hat] + split + · rename_i heq3 + cases heq3 + · rename_i attrs' r2' heq3 + cases heq3 + split + · rename_i content r3 hc + have := hn content r3 hc + subst this + rfl + · rfl + · rename_i heq3 + cases heq3 + · rename_i heq2 + cases heq2 + · rename_i hne' + exact absurd rfl (hne' rest) + +/-- A comment body reader refuses a body a well formed comment may + hold followed by two dashes and anything but a closing bracket. -/ +theorem parseCommentBody_dashdash : ∀ (body Z : List Char), + NoDashDash body → NotDashEnd body → (∀ c ∈ body, LegalChar c) → + Z.head? ≠ some '>' → parseCommentBody (body ++ '-' :: '-' :: Z) = none + | [], Z, _, _, _, hZ => by + rw [List.nil_append] + unfold parseCommentBody + rw [ite_eq_left rfl] + split + · rename_i r heq + obtain ⟨-, rfl⟩ := List.cons.inj heq + exact absurd rfl hZ + · rfl + · rename_i h1 h2 + exact absurd rfl (h2 Z) + | c :: body, Z, hdd, hde, hlegal, hZ => by + have hlegal' : ∀ x ∈ body, LegalChar x := + fun x hx => hlegal x (List.mem_cons_of_mem c hx) + have hdd' : NoDashDash body := by + intro pre suf h + exact hdd (c :: pre) suf (by simp [h]) + have hde' : NotDashEnd body := by + intro pre h + exact hde (c :: pre) (by simp [h]) + have ih := parseCommentBody_dashdash body Z hdd' hde' hlegal' hZ + by_cases hc : c = '-' + · subst hc + cases body with + | nil => exact absurd rfl (hde []) + | cons d ds => + have hd : d ≠ '-' := by + intro e + subst e + exact hdd [] ds (by simp) + rw [List.cons_append, List.cons_append, parseCommentBody_dash_cons hd, + ← List.cons_append, ih] + rfl + · rw [List.cons_append] + unfold parseCommentBody + rw [ite_eq_right hc, ite_eq_left (isLegalChar_of (hlegal c List.mem_cons_self)), + ih] + rfl + +/-- The content reader at `".toList).isSome = false := by - decide +kernel - - -theorem Spec.rejects_surrogate_ref : - (parse "�".toList).isSome = false := by - decide +kernel - - -theorem Spec.rejects_zero_ref : - (parse "�".toList).isSome = false := by - decide +kernel - - -theorem Spec.rejects_colon_in_name : - (parse "".toList).isSome = false := by - decide +kernel - - -theorem Spec.rejects_digit_name : - (parse "<1a/>".toList).isSome = false := by - decide +kernel - - -theorem Spec.rejects_unquoted_attribute : - (parse "".toList).isSome = false := by - decide +kernel - - -theorem Spec.rejects_cdata_in_prolog : - (parse "".toList).isSome = false := by - decide +kernel - - -theorem Spec.rejects_xml_declaration : - (parse "".toList).isSome = false := by - decide +kernel - +theorem Spec.cr_reads_as_lf (pre post : List Char) + (hpre : pre.getLast? ≠ some '\r') (hpost : post.head? ≠ some '\n') : + parse (pre ++ '\r' :: post) = parse (pre ++ '\n' :: post) := + Xml.Proofs.cr_reads_as_lf pre post hpre hpost -theorem Spec.rejects_xmlns (prolog : List Node) (name : List Char) - (attrs : List (List Char × List Char)) (rest : List Char) - (hpro : MiscOk prolog) (hname : ValidName name) - (hattrs : AttrsOk attrs) - (hrest : ∀ c, rest.head? = some c → ¬ IsNameChar c) : +theorem Spec.rejects_doctype (prolog : List Node) (rest : List Char) + (hpro : MiscOk prolog) : + parse (printNodes prolog ++ ['<', '!', 'D', 'O', 'C', 'T', 'Y', 'P', 'E'] ++ + rest) = none := + Xml.Proofs.rejects_doctype prolog rest hpro + +theorem Spec.rejects_cdata_in_prolog (prolog : List Node) (rest : List Char) + (hpro : MiscOk prolog) : + parse (printNodes prolog ++ ['<', '!', '[', 'C', 'D', 'A', 'T', 'A', '['] ++ + rest) = none := + Xml.Proofs.rejects_cdata_in_prolog prolog rest hpro + +theorem Spec.rejects_xml_declaration (t rest : List Char) (ht : ValidName t) + (hx : IsXmlTarget t) (hr : ∀ c, rest.head? = some c → ¬ IsNameChar c) : + parse ('<' :: '?' :: t ++ rest) = none := + Xml.Proofs.rejects_xml_declaration t rest ht hx hr + +theorem Spec.rejects_text_before_root (prolog : List Node) (c : Char) + (rest : List Char) (hpro : MiscOk prolog) (hws : ¬ IsWs c) + (hlt : c ≠ '<') : parse (printNodes prolog ++ c :: rest) = none := + Xml.Proofs.rejects_text_before_root prolog c rest hpro hws hlt + +theorem Spec.rejects_second_root (d : Document) (c : Char) (rest : List Char) + (hwf : WF d) (hc : IsNameStart c) : + parse (print d ++ '<' :: c :: rest) = none := + Xml.Proofs.rejects_second_root d c rest hwf hc + +theorem Spec.rejects_digit_name (prolog : List Node) (d : Char) + (rest : List Char) (hpro : MiscOk prolog) + (hd : d ∈ ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']) : + parse (printNodes prolog ++ '<' :: d :: rest) = none := + Xml.Proofs.rejects_digit_name prolog d rest hpro hd + +theorem Spec.rejects_colon_in_name (prolog : List Node) (name rest : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) : + parse (printNodes prolog ++ '<' :: name ++ ':' :: rest) = none := + Xml.Proofs.rejects_colon_in_name prolog name rest hpro hname + +theorem Spec.rejects_mismatched_tags (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (content : List Node) + (other rest : List Char) + (hpro : MiscOk prolog) (hel : WFNode (.elem name attrs content)) + (hother : ValidName other) (hne : other ≠ name) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ '>' :: + printNodes content ++ '<' :: '/' :: other ++ '>' :: rest) = none := + Xml.Proofs.rejects_mismatched_tags prolog name attrs content other rest hpro hel hother hne + +theorem Spec.rejects_unclosed_element (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ ['>']) = + none := + Xml.Proofs.rejects_unclosed_element prolog name attrs hpro hname hattrs + + +theorem Spec.rejects_undefined_entity (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (pre e post : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (hlt : '<' ∉ pre) (hamp : '&' ∉ pre) (he : ValidName e) + (hfive : e ∉ [['l', 't'], ['g', 't'], ['a', 'm', 'p'], ['a', 'p', 'o', 's'], + ['q', 'u', 'o', 't']]) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ '>' :: pre ++ + '&' :: e ++ ';' :: post) = none := + Xml.Proofs.rejects_undefined_entity prolog name attrs pre e post hpro hname hattrs hlt hamp he hfive + +theorem Spec.rejects_undefined_entity_in_attribute (prolog : List Node) + (name : List Char) (attrs : List (List Char × List Char)) + (a pre e post : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (ha : ValidName a) (hq : '"' ∉ pre) (hamp : '&' ∉ pre) (he : ValidName e) + (hfive : e ∉ [['l', 't'], ['g', 't'], ['a', 'm', 'p'], ['a', 'p', 'o', 's'], + ['q', 'u', 'o', 't']]) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ ' ' :: a ++ + '=' :: '"' :: pre ++ '&' :: e ++ ';' :: post) = none := + Xml.Proofs.rejects_undefined_entity_in_attribute prolog name attrs a pre e post hpro hname hattrs ha hq hamp he hfive + +theorem Spec.rejects_surrogate_ref (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (pre post : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (hlt : '<' ∉ pre) (hamp : '&' ∉ pre) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ '>' :: pre ++ + ['&', '#', 'x', 'D', '8', '0', '0', ';'] ++ post) = none := + Xml.Proofs.rejects_surrogate_ref prolog name attrs pre post hpro hname hattrs hlt hamp + +theorem Spec.rejects_zero_ref (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (pre post : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (hlt : '<' ∉ pre) (hamp : '&' ∉ pre) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ '>' :: pre ++ + ['&', '#', '0', ';'] ++ post) = none := + Xml.Proofs.rejects_zero_ref prolog name attrs pre post hpro hname hattrs hlt hamp + +theorem Spec.rejects_cdata_close_in_text (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (pre post : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (hlt : '<' ∉ pre) (hamp : '&' ∉ pre) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ '>' :: pre ++ + [']', ']', '>'] ++ post) = none := + Xml.Proofs.rejects_cdata_close_in_text prolog name attrs pre post hpro hname hattrs hlt hamp + +theorem Spec.rejects_dashdash_in_comment (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (body : List Char) (c : Char) + (rest : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (hbody : WFNode (.comment body)) (hc : c ≠ '>') : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ '>' :: + '<' :: '!' :: '-' :: '-' :: body ++ '-' :: '-' :: c :: rest) = none := + Xml.Proofs.rejects_dashdash_in_comment prolog name attrs body c rest hpro hname hattrs hbody hc + +theorem Spec.rejects_duplicate_attribute (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (a v rest : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (hdup : ∃ w, (a, w) ∈ attrs) : parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ - ' ' :: xmlnsName ++ rest) = none := - Xml.Proofs.rejects_xmlns prolog name attrs rest hpro hname hattrs hrest - + printAttrs [(a, v)] ++ rest) = none := + Xml.Proofs.rejects_duplicate_attribute prolog name attrs a v rest hpro hname hattrs hdup + +theorem Spec.rejects_lt_in_attribute (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (a pre rest : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (ha : ValidName a) (hq : '"' ∉ pre) (hamp : '&' ∉ pre) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ ' ' :: a ++ + '=' :: '"' :: pre ++ '<' :: rest) = none := + Xml.Proofs.rejects_lt_in_attribute prolog name attrs a pre rest hpro hname hattrs ha hq hamp + +theorem Spec.rejects_unquoted_attribute (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (a : List Char) (c : Char) + (rest : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (ha : ValidName a) (hc1 : c ≠ '"') (hc2 : c ≠ '\'') (hcw : ¬ IsWs c) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ ' ' :: a ++ + '=' :: c :: rest) = none := + Xml.Proofs.rejects_unquoted_attribute prolog name attrs a c rest hpro hname hattrs ha hc1 hc2 hcw theorem Spec.rejects_attribute_without_space (prolog : List Node) (name : List Char) (attrs : List (List Char × List Char)) @@ -132,17 +181,13 @@ theorem Spec.rejects_attribute_without_space (prolog : List Node) (hattrs : AttrsOk attrs) (hne : attrs ≠ []) (hc : IsNameStart c) : parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ c :: rest) = none := - Xml.Proofs.rejects_attribute_without_space prolog name attrs c rest - hpro hname hattrs hne hc - + Xml.Proofs.rejects_attribute_without_space prolog name attrs c rest hpro hname hattrs hne hc -theorem Spec.crlf_reads_as_lf (pre post : List Char) - (hpre : pre.getLast? ≠ some '\r') : - parse (pre ++ '\r' :: '\n' :: post) = parse (pre ++ '\n' :: post) := - Xml.Proofs.crlf_reads_as_lf pre post hpre - - -theorem Spec.cr_reads_as_lf (pre post : List Char) - (hpre : pre.getLast? ≠ some '\r') (hpost : post.head? ≠ some '\n') : - parse (pre ++ '\r' :: post) = parse (pre ++ '\n' :: post) := - Xml.Proofs.cr_reads_as_lf pre post hpre hpost +theorem Spec.rejects_xmlns (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (rest : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) + (hattrs : AttrsOk attrs) + (hrest : ∀ c, rest.head? = some c → ¬ IsNameChar c) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ + ' ' :: xmlnsName ++ rest) = none := + Xml.Proofs.rejects_xmlns prolog name attrs rest hpro hname hattrs hrest diff --git a/README.md b/README.md index 68ce47a..6757218 100644 --- a/README.md +++ b/README.md @@ -7,12 +7,17 @@ elements, attributes, text, comments, processing instructions, character references, and CDATA sections, with one root element. There is no document type declaration, no entity declarations, no namespaces, and -no XML declaration in the subset; a document with any of -those is rejected, not parsed leniently. The definitions -are in `Xml/Value.lean` (the tree type, the printer, and -the well-formedness rules) and `Xml/Parse.lean` (the -parser). The proofs are in `Proofs/RoundTrip.lean`. The -full subset rules are in `SPEC.md`. +no XML declaration in the subset; the parser rejects a +document with any of those rather than parsing it +leniently. "What is proved" below says which of these +rejections are theorems, and for which texts; the tests +check the rest. The definitions are in `Xml/Value.lean` +(the tree type, the printer, and the well-formedness +rules) and `Xml/Parse.lean` (the parser). The proofs are +in `Proofs/`: the round trip in `RoundTrip.lean`, well +formedness of every accepted document in `ParseWF.lean`, +line ends in `LineEnds.lean`, and the refused texts in +`Refusals.lean`. The full subset rules are in `SPEC.md`. The statements a reviewer approves are in `Spec.lean`, with their proofs in `Proofs/SpecProofs.lean`. No reviewer @@ -55,32 +60,44 @@ where they end in `sorry`) and proved in `Proofs/SpecProofs.lean`, under the same names. `comparator.json` lists all of them. +The first five hold for every text or every well formed +document. The refusals after them are each about a family +of texts, and each row says which family. Most families +share a shape: a well formed prolog (comments and +processing instructions, as `Xml.WF` allows them), +printed in canonical form; then, for most, the root's +start tag with any valid name and any well formed +attributes, also printed; then the form the rule turns +away; then anything at all. "Printed" means written the +way `Xml.print` writes it. + | Claim | Theorem | |-------|---------| | Parsing the printed form of a well formed document gives the document back. | `Spec.parse_print` | -| Every text the parser accepts gives a well formed document (`Xml.WF`, described below): among other things, no name holds a colon or starts with a digit, no attribute name stands twice on one element and none is `xmlns`, every character is a legal XML character, and comment bodies hold no `--`. | `Spec.parse_wf` | +| Every text the parser accepts gives a well formed document (`Xml.WF`, described below): among other things, no name anywhere in the tree holds a colon or starts with a digit, no attribute name stands twice on one element and none is `xmlns`, every character is a legal XML character, and comment bodies hold no `--`. | `Spec.parse_wf` | | Printing a document the parser accepted gives a text that parses back to the same document (the plan's main claim, as written). | `Spec.print_parse` | -| A document carrying a document type declaration is refused. | `Spec.rejects_doctype` | -| A reference to an entity the subset does not define is refused. | `Spec.rejects_undefined_entity` | -| An end tag that does not match the start tag is refused. | `Spec.rejects_mismatched_tags` | -| An element with no end tag is refused. | `Spec.rejects_unclosed_element` | -| A second root element is refused. | `Spec.rejects_second_root` | -| Character data before the root element is refused. | `Spec.rejects_text_before_root` | -| An attribute name standing twice on one element is refused. | `Spec.rejects_duplicate_attribute` | -| A raw less sign inside an attribute value is refused. | `Spec.rejects_lt_in_attribute` | -| The run `]]>` inside text is refused. | `Spec.rejects_cdata_close_in_text` | -| Two dashes in a row inside a comment body are refused. | `Spec.rejects_dashdash_in_comment` | -| A character reference naming a surrogate value is refused. | `Spec.rejects_surrogate_ref` | -| A character reference naming zero is refused. | `Spec.rejects_zero_ref` | -| A colon in a name is refused. | `Spec.rejects_colon_in_name` | -| A name starting with a digit is refused. | `Spec.rejects_digit_name` | -| An attribute value with no quotes is refused. | `Spec.rejects_unquoted_attribute` | -| A CDATA section in the prolog is refused. | `Spec.rejects_cdata_in_prolog` | -| The XML declaration form is refused. | `Spec.rejects_xml_declaration` | | A carriage return followed by a line feed reads exactly as one line feed, anywhere in a text, unless the text before it ends with a carriage return (XML 1.0 section 2.11). | `Spec.crlf_reads_as_lf` | | A carriage return not followed by a line feed reads exactly as a line feed, anywhere in a text, unless the text before it ends with a carriage return. | `Spec.cr_reads_as_lf` | -| An attribute name that starts right after the closing quote of the attribute before it, with no whitespace between them, is refused: on the root element, after any well formed prolog and at least one well formed attribute, both printed in canonical form, whatever follows the first character of the name. | `Spec.rejects_attribute_without_space` | -| An attribute named `xmlns` (a default namespace declaration) on the root element is refused: after any well formed prolog and any well formed attributes before it, both printed in canonical form, whatever follows the name, as long as it does not make the name longer. | `Spec.rejects_xmlns` | +| After a printed prolog, `` is refused, whatever follows. | `Spec.rejects_cdata_close_in_text` | +| For a comment that is the root's first content: `".toList).isSome = false := sorry - -/-- A character reference naming a surrogate value is refused: - a surrogate is not a legal XML character. -/ -theorem Spec.rejects_surrogate_ref : - (parse "�".toList).isSome = false := sorry - -/-- A character reference naming zero is refused: zero is not a - legal XML character. -/ -theorem Spec.rejects_zero_ref : - (parse "�".toList).isSome = false := sorry - -/-- A colon in a name is refused: in XML a colon signals - namespace use, and namespaces are out of this subset. -/ -theorem Spec.rejects_colon_in_name : - (parse "".toList).isSome = false := sorry - -/-- A name starting with a digit is refused. -/ -theorem Spec.rejects_digit_name : - (parse "<1a/>".toList).isSome = false := sorry - -/-- An attribute value with no quotes is refused. -/ -theorem Spec.rejects_unquoted_attribute : - (parse "".toList).isSome = false := sorry - -/-- A CDATA section in the prolog is refused: CDATA stands in - element content only. -/ -theorem Spec.rejects_cdata_in_prolog : - (parse "".toList).isSome = false := sorry - -/-- The XML declaration form is refused: the declaration is not - part of this subset, and a target of `xml` rejects - everywhere. -/ -theorem Spec.rejects_xml_declaration : - (parse "".toList).isSome = false := sorry - -/-- An attribute named `xmlns`, the default namespace declaration, - is refused: namespaces are out of this subset, and the colon - ban on names does not reach this name. Stated for the root - element of a text that starts with any well formed prolog, - printed, then the root's start tag with any well formed - attributes, printed, before it, and anything after the name - that does not make the name longer. -/ -theorem Spec.rejects_xmlns (prolog : List Node) (name : List Char) - (attrs : List (List Char × List Char)) (rest : List Char) - (hpro : MiscOk prolog) (hname : ValidName name) - (hattrs : AttrsOk attrs) - (hrest : ∀ c, rest.head? = some c → ¬ IsNameChar c) : - parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ - ' ' :: xmlnsName ++ rest) = none := sorry - -/-- An attribute must have whitespace before it, as XML 1.0 - productions [40] and [44] require: a name that starts right - after the closing quote of the attribute before it is refused. - Stated for the root element of a text that starts with any well - formed prolog, printed, then the root's start tag with at least - one well formed attribute, printed, then a name start - character, then anything. -/ -theorem Spec.rejects_attribute_without_space (prolog : List Node) - (name : List Char) (attrs : List (List Char × List Char)) - (c : Char) (rest : List Char) - (hpro : MiscOk prolog) (hname : ValidName name) - (hattrs : AttrsOk attrs) (hne : attrs ≠ []) (hc : IsNameStart c) : - parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ - c :: rest) = none := sorry +/-! ## Line ends -/ /-- Line ends are normalized as XML 1.0 section 2.11 requires: a carriage return followed by a line feed reads exactly as one @@ -186,3 +73,222 @@ theorem Spec.crlf_reads_as_lf (pre post : List Char) theorem Spec.cr_reads_as_lf (pre post : List Char) (hpre : pre.getLast? ≠ some '\r') (hpost : post.head? ≠ some '\n') : parse (pre ++ '\r' :: post) = parse (pre ++ '\n' :: post) := sorry + +/-! ## Refused texts + +Each statement below is about a family of texts, not one input. The +families share a shape: a text that starts with a well formed +prolog (`MiscOk`), printed in canonical form, then, for most of +them, the root's start tag with a valid name and well formed +attributes (`AttrsOk`), also printed, then the form the rule turns +away, then anything at all. Each docstring says which part is +fixed. None says that the form is refused in every position: a +statement about the root's first text run says nothing about a +nested element. `SPEC.md` and `README.md` list what is left +out. -/ + +/-- A document type declaration right after the prolog is refused, + whatever follows `' :: + printNodes content ++ '<' :: '/' :: other ++ '>' :: rest) = none := sorry + +/-- An element with no end tag is refused: right after the prolog, + the root's start tag with any valid name and well formed + attributes, printed, at the very end of the text. -/ +theorem Spec.rejects_unclosed_element (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ ['>']) = + none := sorry + +/-- A reference to an entity other than the five predefined ones is + refused, in the root's first run of character data: after the + prolog and the root's start tag, any text with no less sign and + no ampersand, then `&`, any valid name other than `lt`, `gt`, + `amp`, `apos` and `quot`, and `;`, whatever follows. No such + entity is expanded there. -/ +theorem Spec.rejects_undefined_entity (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (pre e post : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (hlt : '<' ∉ pre) (hamp : '&' ∉ pre) (he : ValidName e) + (hfive : e ∉ [['l', 't'], ['g', 't'], ['a', 'm', 'p'], ['a', 'p', 'o', 's'], + ['q', 'u', 'o', 't']]) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ '>' :: pre ++ + '&' :: e ++ ';' :: post) = none := sorry + +/-- The same in an attribute value: after the prolog and the root's + start tag with its well formed attributes, a space, any valid + attribute name, `="`, any text with no double quote and no + ampersand, then `&`, a valid name other than the five, and `;`, + whatever follows. -/ +theorem Spec.rejects_undefined_entity_in_attribute (prolog : List Node) + (name : List Char) (attrs : List (List Char × List Char)) + (a pre e post : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (ha : ValidName a) (hq : '"' ∉ pre) (hamp : '&' ∉ pre) (he : ValidName e) + (hfive : e ∉ [['l', 't'], ['g', 't'], ['a', 'm', 'p'], ['a', 'p', 'o', 's'], + ['q', 'u', 'o', 't']]) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ ' ' :: a ++ + '=' :: '"' :: pre ++ '&' :: e ++ ';' :: post) = none := sorry + +/-- The character reference `�`, a surrogate, is refused in + the root's first run of character data: after the prolog and + the root's start tag, any text with no less sign and no + ampersand, then `�`, whatever follows. -/ +theorem Spec.rejects_surrogate_ref (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (pre post : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (hlt : '<' ∉ pre) (hamp : '&' ∉ pre) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ '>' :: pre ++ + ['&', '#', 'x', 'D', '8', '0', '0', ';'] ++ post) = none := sorry + +/-- The character reference `�` is refused in the same place. -/ +theorem Spec.rejects_zero_ref (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (pre post : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (hlt : '<' ∉ pre) (hamp : '&' ∉ pre) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ '>' :: pre ++ + ['&', '#', '0', ';'] ++ post) = none := sorry + +/-- The run `]]>` is refused in the root's first run of character + data: after the prolog and the root's start tag, any text with + no less sign and no ampersand, then `]]>`, whatever follows. -/ +theorem Spec.rejects_cdata_close_in_text (prolog : List Node) (name : List Char) + (attrs : List (List Char × List Char)) (pre post : List Char) + (hpro : MiscOk prolog) (hname : ValidName name) (hattrs : AttrsOk attrs) + (hlt : '<' ∉ pre) (hamp : '&' ∉ pre) : + parse (printNodes prolog ++ '<' :: name ++ printAttrs attrs ++ '>' :: pre ++ + [']', ']', '>'] ++ post) = none := sorry + +/-- Two dashes inside a comment are refused, for a comment that is + the root's first content: after the prolog and the root's start + tag, `"), + ("CDATA section after a processing instruction", ""), + ("xml declaration target in mixed case", ""), + ("text after a prolog", "x"), + ("second element after a document with an epilog", ""), + ("digit element name after a prolog", "<9/>"), + ("colon in a name after a prolog", ""), + ("mismatched end tag after content and attributes", + "x"), + ("unclosed element with attributes", ""), + ("undefined entity after text", "text &e; more"), + ("undefined entity in an attribute after text", ""), + ("surrogate reference after text", "x�"), + ("zero reference after text", "x�"), + ("]]> after text", "text]]>"), + ("-- in a comment after a well formed body", + ""), + ("duplicate attribute after another", ""), + ("raw < after text in an attribute value", ""), + ("unquoted value after another attribute", ""), ("empty document", ""), ("whitespace only document", " \n "), ("comment only document", ""), From fa1dcfedaf3290fa0bdb3d1227e10abd1ef40002 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:55:21 +0000 Subject: [PATCH 12/18] Bring comments and the Re-check steps up to date - Xml/Parse.lean: list the whitespace rule for attributes, and say what is and is not proved about the fuel (enough for every canonical print; not proved for every accepted text), instead of "always enough". - Proofs/RoundTrip.lean: the header said a spec statement still had to be added by a reviewer; Spec.parse_print states it now. - tests/run_tests.py: the named rejections are no longer one input per rule. - README.md Re-check it: the test command also sends every canonical print back to the tool; lake build is described as building with no errors, since the original proof file carries linter warnings. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Proofs/RoundTrip.lean | 7 +++---- README.md | 10 ++++++---- Xml/Parse.lean | 12 ++++++++---- tests/run_tests.py | 15 +++++++++------ 4 files changed, 26 insertions(+), 18 deletions(-) diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index bb910b1..c2b7d26 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -2,10 +2,9 @@ The round trip proof: for every well formed document, parsing its printed form gives the document back. - The statement proved here is `parse_print`. A matching statement - in a spec file still has to be added by a reviewer, so this file - builds on its own, in the same shape as the proofs of the other - slices. + The statement proved here is `parse_print`; `Spec.parse_print` + in `Spec.lean` states it, and `Proofs/SpecProofs.lean` proves + that statement with this theorem. The proof goes layer by layer: references, text runs, attribute values, character data, names, comment bodies, processing diff --git a/README.md b/README.md index 6757218..f04a11f 100644 --- a/README.md +++ b/README.md @@ -220,8 +220,10 @@ Two deliberate choices, also stated in `SPEC.md`: accepted by Lean's kernel and every other kernel shipped with Lean. 2. `python3 tests/run_tests.py`: the fixed cases, the - named rejections, and the differential run against - Python's `xml.etree.ElementTree`, with counts and any - failures written to `tests/TEST-RESULTS.md`. + differential run against Python's + `xml.etree.ElementTree`, every canonical print sent + back to the tool, the named rejections, and the + malformed requests, with counts and any failures + written to `tests/TEST-RESULTS.md`. 3. `lake build`: the library, the proofs, and the tool - build clean. + build with no errors. diff --git a/Xml/Parse.lean b/Xml/Parse.lean index 4fb8242..1bad019 100644 --- a/Xml/Parse.lean +++ b/Xml/Parse.lean @@ -31,13 +31,17 @@ namespace, and namespaces are out of this subset. Prefixed declarations (`xmlns:p`) are already rejected by the colon ban on names. + - Each attribute needs whitespace before it, as XML 1.0 + productions [40] and [44] require. The functions that can nest or loop (`parseElement`, `parseNodes`, `parseAttrs`, `parseCharData`, `parseMisc`, - `parseTextRun`, `parseAttrValue`) take a fuel count. Each step spends one unit, so the functions are - total on hostile input. The top level `parse` passes one more - than the length of the text, which is always enough for a text - the grammar accepts. + `parseTextRun`, `parseAttrValue`) take a fuel count. Each step + spends one unit, so the functions are total on hostile input. + The top level `parse` passes one more than the length of the + normalized text. The round trip proof shows that is enough for + every canonical print; that it is enough for every text the + grammar accepts is not proved. -/ import Xml.Value diff --git a/tests/run_tests.py b/tests/run_tests.py index fef9143..1528295 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -43,12 +43,15 @@ 1 and 2 is sent back, and the answer must be the same print (`Spec.print_parse`, run on the compiled tool). -4. Named rejections: one input per rejection rule in SPEC.md. - The Lean tool must reject every one. ElementTree agrees with - most of them; where ElementTree accepts (a document type - declaration, a colon in a name, the XML declaration form), - that is an out of subset disagreement, counted apart, because - the subset is narrower than XML by design. +4. Named rejections: inputs for every rejection rule in SPEC.md, + most of them in more than one position (at the start, after + a prolog, after text, after other attributes, in a nested + element). The Lean tool must reject every one. ElementTree + agrees with most of them; where ElementTree accepts (a + document type declaration, a colon in a name, a namespace + declaration, the XML declaration form), that is an out of + subset disagreement, counted apart, because the subset is + narrower than XML by design. Malformed request lines must be answered `error`, as in the other slices' harnesses. From 58d4d3405e636f3bd7b27b4bf9c8f38821076577 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:55:51 +0000 Subject: [PATCH 13/18] Add the test inputs review 1 listed as missing Review 1 finding 7 (minor): the named rejections had no case for A (upper case X), ￾, a DOCTYPE inside content, or Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- tests/TEST-RESULTS.md | 4 ++-- tests/run_tests.py | 8 +++++++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index bbb3811..fe62021 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -5,14 +5,14 @@ Written by `tests/run_tests.py`. Rerun it to check these numbers. - Oracle: Python 3.13.17 `xml.etree.ElementTree`, expat_2.6.1 (`ET.XMLParser`, which turns namespace processing on, with a `TreeBuilder` that keeps comments and processing instructions) - Lean tool: Lean (version 4.35.0, x86_64-unknown-linux-gnu, commit eb6cafb7290e8bd5f2937522d8d804f58f02bafc, Release) - Seed: 20261026 -- Inputs: 6580 +- Inputs: 6584 - every request sent to the tool: the fixed cases, the generated documents, the canonical prints sent back, the named rejections, the malformed requests, and two bare parse requests - Fixed cases passed: 48 of 48 - Generated in-subset documents: 3200 - Generated documents where the tool's canonical print matches the tree and ElementTree agrees on the tree: 3200 - ElementTree tree agreements on generated documents: 3200 - Canonical prints that parse back to the same print: 3248 of 3248 -- Named rejections rejected by the tool: 72 of 72 +- Named rejections rejected by the tool: 76 of 76 - Out of subset disagreements (ElementTree accepts, this slice rejects, by design): 11 - document type declaration - document type declaration with internal subset diff --git a/tests/run_tests.py b/tests/run_tests.py index 1528295..12e793d 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -400,6 +400,11 @@ def run_requests(texts, failures, part): ("duplicate attribute after another", ""), ("raw < after text in an attribute value", ""), ("unquoted value after another attribute", ""), + # inputs review 1 (finding 7) listed as missing + ("hex reference with an upper case X", "A"), + ("reference to a non-character", "￾"), + ("document type declaration in content", ""), + ("xml declaration after the root", ""), ("empty document", ""), ("whitespace only document", " \n "), ("comment only document", ""), @@ -433,7 +438,8 @@ def run_requests(texts, failures, part): NAME_START = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_" NAME_CHARS = NAME_START + "0123456789.-" TEXT_PLAIN = ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" - "0123456789 .,;:!?()[]{}+-*/=_%$#@~^|") + "0123456789 .,;:!?()[]{}+-*/=_%$#@~^|" + "\u00e9\u4e2d\ufffd\U0001f600") COMMENT_WORDS = ["note", "a", "draft-1", "x", "see above", "ok", "todo: fix", "caf\u00e9", "na\u00efve", "123"] From 008de981d0f2227209d355255b3b69742b0c6b49 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 21:58:21 +0000 Subject: [PATCH 14/18] State "no entity is expanded" as a rule, and test where it is not proved The independent check found that SPEC.md, under "Document type declarations and other &e;. The sentence now says the parser must never expand such an entity, names the two theorems and the positions they cover, and says every other position rests on the tests. The README already said so under What is not proved. The tests gain seven named rejections in positions no theorem covers: inside a nested element, after a child element, after a comment, after a CDATA section, after a predefined reference, in a nested element's attribute, and in an attribute after a reference. The tool refuses all of them, and so does ElementTree. tests/TEST-RESULTS.md is rewritten from a fresh run: 6591 inputs, 83 of 83 named rejections, 0 failures. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- SPEC.md | 10 ++++++++-- tests/TEST-RESULTS.md | 4 ++-- tests/run_tests.py | 13 +++++++++++++ 3 files changed, 23 insertions(+), 4 deletions(-) diff --git a/SPEC.md b/SPEC.md index 3053479..137135a 100644 --- a/SPEC.md +++ b/SPEC.md @@ -166,8 +166,14 @@ parsed leniently. - The same door rejects every other `"), ("raw < after text in an attribute value", ""), ("unquoted value after another attribute", ""), + # undefined entities where no theorem covers them (the refusal + # statements reach the root's first text run and the root's + # attribute values only; see SPEC.md and README) + ("undefined entity in a nested element", "&e;"), + ("undefined entity after a child element", "&e;"), + ("undefined entity after a comment", "&e;"), + ("undefined entity after a CDATA section", + "&e;"), + ("undefined entity after a predefined one", "&&e;"), + ("undefined entity in a nested element's attribute", + ""), + ("undefined entity in an attribute after a reference", + ""), # inputs review 1 (finding 7) listed as missing ("hex reference with an upper case X", "A"), ("reference to a non-character", "￾"), From 1b5846e04401072e83421da7de8f83d8233c896a Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 21:58:40 +0000 Subject: [PATCH 15/18] Name the theorem behind the README's carriage return sentence The independent check found one sentence under What is proved that named no theorem: "A carriage return written as in text or an attribute value reads as itself, and the printer writes it that way." Bar item 2 asks every claim on the page to name its theorem. Only canonical prints back it, through Spec.parse_print. Nothing proves how , or elsewhere, reads. The paragraph now says what is proved: line ends read as the rows for Spec.crlf_reads_as_lf and Spec.cr_reads_as_lf state, and a carriage return in a well formed tree prints as and survives the round trip by Spec.parse_print. It sends the rest to What is not proved. That section now says a parser that read , or outside a canonical print, as another legal character would meet every statement, and that the differential tests check the reading. Two fixed cases cover those spellings: and in a single quoted attribute value, and and in a nested element's text and attribute. Both read as a carriage return, as ElementTree reads them. tests/TEST-RESULTS.md is rewritten from a fresh run: 6595 inputs, 50 of 50 fixed cases, 0 failures. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- README.md | 19 ++++++++++++++----- tests/TEST-RESULTS.md | 6 +++--- tests/run_tests.py | 5 +++++ 3 files changed, 22 insertions(+), 8 deletions(-) diff --git a/README.md b/README.md index f04a11f..40ec073 100644 --- a/README.md +++ b/README.md @@ -116,9 +116,14 @@ root. The parser normalizes line ends before it reads, as XML 1.0 section 2.11 requires: a carriage return and line feed pair, and a lone carriage return, each read as -one line feed. A carriage return written as ` ` in -text or an attribute value reads as itself, and the -printer writes it that way. +one line feed, as the rows for `Spec.crlf_reads_as_lf` +and `Spec.cr_reads_as_lf` state. A carriage return can +still stand in the text or an attribute value of a well +formed tree. The printer writes it as ` `, and +`Spec.parse_print` says that print reads back to the +same tree, so the carriage return survives the round +trip. How ` ` or ` ` reads when written anywhere +else is not proved (see below). A parser that refuses every text meets every statement above except `Spec.parse_print`, which rules it out. @@ -142,8 +147,12 @@ are about. and `Spec.print_parse` that it survives printing, but neither ties the tree to the text it came from: a parser that read `&e;` as some character, or dropped an - attribute, would meet both. The differential tests check - the reading against ElementTree instead. + attribute, would meet both. Nor does any other + statement: a parser that read ` `, or ` ` + outside a canonical print, as a legal character other + than a carriage return would meet every statement on + this page. The differential tests check the reading + against ElementTree instead. - That the parser rejects every text the subset forbids. Each refusal theorem covers the family its row names and no other position. For example, a reference to an diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index 1ac764d..382ab07 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -5,13 +5,13 @@ Written by `tests/run_tests.py`. Rerun it to check these numbers. - Oracle: Python 3.13.17 `xml.etree.ElementTree`, expat_2.6.1 (`ET.XMLParser`, which turns namespace processing on, with a `TreeBuilder` that keeps comments and processing instructions) - Lean tool: Lean (version 4.35.0, x86_64-unknown-linux-gnu, commit eb6cafb7290e8bd5f2937522d8d804f58f02bafc, Release) - Seed: 20261026 -- Inputs: 6591 +- Inputs: 6595 - every request sent to the tool: the fixed cases, the generated documents, the canonical prints sent back, the named rejections, the malformed requests, and two bare parse requests -- Fixed cases passed: 48 of 48 +- Fixed cases passed: 50 of 50 - Generated in-subset documents: 3200 - Generated documents where the tool's canonical print matches the tree and ElementTree agrees on the tree: 3200 - ElementTree tree agreements on generated documents: 3200 -- Canonical prints that parse back to the same print: 3248 of 3248 +- Canonical prints that parse back to the same print: 3250 of 3250 - Named rejections rejected by the tool: 83 of 83 - Out of subset disagreements (ElementTree accepts, this slice rejects, by design): 11 - document type declaration diff --git a/tests/run_tests.py b/tests/run_tests.py index c0c9361..de174c5 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -302,6 +302,11 @@ def run_requests(texts, failures, part): ("x\ry", "x\ny"), ("x\r\r\ny\n\rz\r", "x\n\ny\n\nz\n"), (" \r\n ", " \n "), + # a reference keeps a CR in any spelling and position, not only + # in a canonical print (no theorem covers these; see README) + ("", ''), + (" y ", + ' y '), ("", "x\ny\nz"), ("", ""), ("", ""), From 491b0b6fe7b5f5cbf7d759a59f4bdd6978a46c33 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 21:58:58 +0000 Subject: [PATCH 16/18] Mark the unused fuel in one parseCharData arm The independent check listed the build's linter warnings. One was in Xml/Parse.lean: the arm of parseCharData that stops before a less sign binds the fuel as fuel but never uses it. The arm now binds it as _, so the linter is quiet. The match, its equation lemmas and what the function computes are unchanged. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Xml/Parse.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Xml/Parse.lean b/Xml/Parse.lean index 1bad019..eb7f423 100644 --- a/Xml/Parse.lean +++ b/Xml/Parse.lean @@ -272,7 +272,7 @@ def parseCharData : Nat → List Char → Option (List Char × List Char) match parseCDATABody rest with | some (t, r) => (parseCharData fuel r).map fun (t2, r2) => (t ++ t2, r2) | none => none - | fuel + 1, '<' :: rest => some ([], '<' :: rest) + | _ + 1, '<' :: rest => some ([], '<' :: rest) | fuel + 1, cs => match parseTextRun fuel cs with | some (t, r) => (parseCharData fuel r).map fun (t2, r2) => (t ++ t2, r2) From 751dca9af0059acc7930a6ed4ce0a41dd9d60fd9 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 21:58:58 +0000 Subject: [PATCH 17/18] Clear the linter warnings in the round trip proofs The independent check listed 57 linter warnings in Proofs/RoundTrip.lean, all from the original round trip proof. 53 were simp arguments the linter found unused: mostly List.append_assoc and hypotheses such as h1 to h4 that simp never rewrote with. They are removed, as the linter suggests. The other four used if_pos and if_neg, which Lean 4.35 deprecates in favour of ite_eq_left and ite_eq_right, with the same statements. The new names replace them. No statement changed. lake build now reports no warnings at all. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Proofs/RoundTrip.lean | 84 +++++++++++++++++++++---------------------- 1 file changed, 41 insertions(+), 43 deletions(-) diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index c2b7d26..59e5e34 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -306,12 +306,12 @@ theorem escapeTextChar_cases (c : Char) : by_cases h1 : c = '&' · exact Or.inl ⟨h1, by simp [escapeTextChar, h1]⟩ · by_cases h2 : c = '<' - · exact Or.inr (Or.inl ⟨h2, by simp [escapeTextChar, h1, h2]⟩) + · exact Or.inr (Or.inl ⟨h2, by simp [escapeTextChar, h2]⟩) · by_cases h3 : c = '>' - · exact Or.inr (Or.inr (Or.inl ⟨h3, by simp [escapeTextChar, h1, h2, h3]⟩)) + · exact Or.inr (Or.inr (Or.inl ⟨h3, by simp [escapeTextChar, h3]⟩)) · by_cases h4 : c = '\r' · exact Or.inr (Or.inr (Or.inr - (Or.inl ⟨h4, by simp [escapeTextChar, h1, h2, h3, h4]⟩))) + (Or.inl ⟨h4, by simp [escapeTextChar, h4]⟩))) · exact Or.inr (Or.inr (Or.inr (Or.inr ⟨h1, h2, h3, h4, by simp [escapeTextChar, h1, h2, h3, h4]⟩))) @@ -329,18 +329,18 @@ theorem escapeAttrChar_cases (c : Char) : by_cases h1 : c = '&' · exact Or.inl ⟨h1, by simp [escapeAttrChar, h1]⟩ · by_cases h2 : c = '<' - · exact Or.inr (Or.inl ⟨h2, by simp [escapeAttrChar, h1, h2]⟩) + · exact Or.inr (Or.inl ⟨h2, by simp [escapeAttrChar, h2]⟩) · by_cases h3 : c = '"' - · exact Or.inr (Or.inr (Or.inl ⟨h3, by simp [escapeAttrChar, h1, h2, h3]⟩)) + · exact Or.inr (Or.inr (Or.inl ⟨h3, by simp [escapeAttrChar, h3]⟩)) · by_cases h4 : c = '\t' · exact Or.inr (Or.inr (Or.inr - (Or.inl ⟨h4, by simp [escapeAttrChar, h1, h2, h3, h4]⟩))) + (Or.inl ⟨h4, by simp [escapeAttrChar, h4]⟩))) · by_cases h5 : c = '\n' · exact Or.inr (Or.inr (Or.inr (Or.inr - (Or.inl ⟨h5, by simp [escapeAttrChar, h1, h2, h3, h4, h5]⟩)))) + (Or.inl ⟨h5, by simp [escapeAttrChar, h5]⟩)))) · by_cases h6 : c = '\r' · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr - (Or.inl ⟨h6, by simp [escapeAttrChar, h1, h2, h3, h4, h5, h6]⟩))))) + (Or.inl ⟨h6, by simp [escapeAttrChar, h6]⟩))))) · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr ⟨h1, h2, h3, h4, h5, h6, by simp [escapeAttrChar, h1, h2, h3, h4, h5, h6]⟩))))) @@ -380,7 +380,7 @@ theorem escapeText_not_bracketGt {cs : List Char} {rest : List Char} rw [hdd] at h2' simp at h2' exact h2' - simp [hdd, hx] + simp [hx] rw [hh] at h1 simp at h1 · rw [hd] at h2 @@ -405,7 +405,7 @@ theorem escapeText_not_bracketGt {cs : List Char} {rest : List Char} rw [e2] cases hdd : escapeTextChar e with | nil => exact absurd hdd (escapeTextChar_ne_nil e) - | cons x xs => simp [hdd] + | cons x xs => simp rw [hh] at h2 exact hgt h2 @@ -455,19 +455,19 @@ theorem parseTextRun_escapeText : ∀ (cs : List Char) (rest : List Char), ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2, h3, h4, h5⟩ · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] simp [parseTextRun, ih', parseRef_amp] · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] simp [parseTextRun, ih', parseRef_lt] · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] simp [parseTextRun, ih', parseRef_gt] · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] simp [parseTextRun, ih', parseRef_dec13] · rw [h5] simp only [List.cons_append] @@ -475,9 +475,9 @@ theorem parseTextRun_escapeText : ∀ (cs : List Char) (rest : List Char), · subst hc have hnb := escapeText_not_bracketGt (cs := cs) (rest := rest) hrest simp only [parseTextRun, List.nil_append] - rw [if_pos trivial, if_neg hnb, ih'] + rw [ite_eq_left trivial, ite_eq_right hnb, ih'] simp - · simp [parseTextRun, ih', h1, h2, h3, h4, hc, + · simp [parseTextRun, ih', h1, h2, hc, isLegalChar_of hclegal] /-- Reading back a printed attribute value gives the value back. @@ -515,27 +515,27 @@ theorem parseAttrValue_escapeAttr : ∀ (cs : List Char) (rest : List Char), ⟨h1, h2, h3, h4, h5, h6, h7⟩ · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] simp [parseAttrValue, ih', parseRef_amp] · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] simp [parseAttrValue, ih', parseRef_lt] · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] simp [parseAttrValue, ih', parseRef_quot] · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] simp [parseAttrValue, ih', parseRef_dec9] · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] simp [parseAttrValue, ih', parseRef_dec10] · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] simp [parseAttrValue, ih', parseRef_dec13] · rw [h7] simp only [List.cons_append] @@ -573,28 +573,28 @@ theorem parseCharData_escapeText (cs : List Char) (rest : List Char) ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2, h3, h4, h5⟩ · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] have htr2 : parseTextRun f' ('&' :: 'a' :: 'm' :: 'p' :: ';' :: (escapeText cs' ++ rest)) = some ('&' :: cs', rest) := htr simp [parseCharData, htr2, hst] · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] have htr2 : parseTextRun f' ('&' :: 'l' :: 't' :: ';' :: (escapeText cs' ++ rest)) = some ('<' :: cs', rest) := htr simp [parseCharData, htr2, hst] · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] have htr2 : parseTextRun f' ('&' :: 'g' :: 't' :: ';' :: (escapeText cs' ++ rest)) = some ('>' :: cs', rest) := htr simp [parseCharData, htr2, hst] · subst h1 rw [h2] - simp only [List.cons_append, List.append_assoc] + simp only [List.cons_append] have htr2 : parseTextRun f' ('&' :: '#' :: '1' :: '3' :: ';' :: (escapeText cs' ++ rest)) = some ('\r' :: cs', rest) := htr @@ -684,13 +684,13 @@ theorem parseCommentBody_print : ∀ (cs : List Char) (rest : List Char), exact hdd [] ds (by simp) have e1 : ('-' :: d :: ds) ++ '-' :: '-' :: '>' :: rest = '-' :: d :: (ds ++ '-' :: '-' :: '>' :: rest) := by - simp [List.append_assoc] + simp rw [e1, parseCommentBody_dash_cons hd] have ih2 : parseCommentBody (d :: (ds ++ '-' :: '-' :: '>' :: rest)) = some (d :: ds, rest) := by have := ih' rwa [show (d :: ds) ++ '-' :: '-' :: '>' :: rest = - d :: (ds ++ '-' :: '-' :: '>' :: rest) by simp [List.append_assoc]] at this + d :: (ds ++ '-' :: '-' :: '>' :: rest) by simp] at this rw [ih2] rfl · have e1 : (c :: cs) ++ '-' :: '-' :: '>' :: rest = @@ -737,7 +737,7 @@ theorem parsePIData_print : ∀ (d : List Char) (rest : List Char), exact hq [] es (by simp) have e1 : ('?' :: e :: es) ++ '?' :: '>' :: rest = '?' :: e :: (es ++ '?' :: '>' :: rest) := by - simp [List.append_assoc] + simp rw [e1, parsePIData_quest_cons he] have ih2 : parsePIData (e :: (es ++ '?' :: '>' :: rest)) = some (e :: es, rest) := ih' @@ -804,7 +804,7 @@ theorem parsePI_print (t d : List Char) (rest : List Char) simp at hc rw [← hc] exact isNameChar_false_of not_nameChar_quest) - rw [if_pos rfl, List.append_assoc] + rw [ite_eq_left rfl, List.append_assoc] simp only [parsePI] rw [hpn] simp [hres'] @@ -830,7 +830,7 @@ theorem parsePI_print (t d : List Char) (rest : List Char) have hc0 : isWs c0 = false := isWs_false_of_not hstart' simp [skipWs, hw, hc0] have hpd := parsePIData_print (c0 :: d0) rest hq hlegal - rw [if_neg (by simp), List.append_assoc] + rw [ite_eq_right (by simp), List.append_assoc] have e1 : (' ' :: (c0 :: d0) ++ ['?', '>']) ++ rest = ' ' :: ((c0 :: d0) ++ '?' :: '>' :: rest) := by simp [List.append_assoc] @@ -1027,8 +1027,8 @@ theorem parseAttrs_print : ∀ (attrs : List (List Char × List Char)) have hsw : startsWithWs (printAttrs (((c0 :: ds), v) :: attrs) ++ tail) = true := by simp [printAttrs, startsWithWs, isWs] - simp [parseAttrs, hsk, hpn2, hval', hdup, hc0ne1, hc0ne2, hnx, - isNameStart_of hc0, hsw, List.cons_append, List.append_assoc, + simp [parseAttrs, hsk, hpn2, hval', hdup, hc0ne1, hnx, + isNameStart_of hc0, hsw, List.cons_append, skipWs_cons (by decide : isWs '=' = false), skipWs_cons (by decide : isWs '"' = false)] rwa [hstep] @@ -1049,8 +1049,7 @@ theorem parseAttrs_print_closed cases f' with | zero => simp at hf' | succ f'' => - simp [parseAttrs, skipWs, isWs_slash, - (by decide : isWs '>' = false)] + simp [parseAttrs, skipWs, isWs_slash] /-- Reading back a printed attribute list that ends a start tag. -/ theorem parseAttrs_print_open @@ -1435,7 +1434,7 @@ theorem elem_nodes : ∀ n, ElemProp n ∧ NodesProp n := by simp [escapeText, h5]] at h exact h simp [parseNodes, printNodes, printNode, escapeText, - h5, h1, h2, List.append_assoc] + h5, h2, List.append_assoc] rw [hcdX] simp [hIH] | comment body => @@ -1458,7 +1457,7 @@ theorem elem_nodes : ∀ n, ElemProp n ∧ NodesProp n := by parsePI_print t d _ hname hres hq hlegal hstart have hpi2 := hpi rw [List.append_assoc] at hpi2 - simp only [List.cons_append, List.nil_append] at hpi2 + simp only [List.cons_append] at hpi2 simp [parseNodes, printNodes, printNode] rw [hpi2] simp [hIH] @@ -1484,7 +1483,7 @@ theorem elem_nodes : ∀ n, ElemProp n ∧ NodesProp n := by simp only [printNode, printElem, hq0, List.append_assoc, List.cons_append] at hE simp [parseNodes, printNodes, printNode, printElem, hq0, - hc0ne1, hc0ne2, hc0ne3, isNameStart_of hc0, + hc0ne2, isNameStart_of hc0, List.append_assoc] rw [hE] simp [hIH] @@ -1546,7 +1545,7 @@ theorem parseMisc_print : simp [printNodes, List.length_append] omega have hih := ih rest hoktail hstop f' hlen - simp [parseMisc, printNodes, printNode, skipWs, hcb, hih, + simp [parseMisc, printNodes, printNode, hcb, hih, skipWs_cons (show isWs '<' = false by decide), List.append_assoc] · cases hwf with @@ -1568,9 +1567,9 @@ theorem parseMisc_print : omega have hpi2 := hpi rw [List.append_assoc] at hpi2 - simp only [List.cons_append, List.nil_append] at hpi2 + simp only [List.cons_append] at hpi2 have hih := ih rest hoktail hstop f' hlen - simp [parseMisc, printNodes, printNode, skipWs, hpi2, hih, + simp [parseMisc, printNodes, printNode, hpi2, hih, skipWs_cons (show isWs '<' = false by decide), List.append_assoc] @@ -1765,8 +1764,7 @@ theorem parse_print (d : Document) (hwf : WF d) : (printNode d.root ++ printNodes d.epilog)).length + 1) (printNodes d.prolog ++ (printNode d.root ++ printNodes d.epilog)) = some d := by - simp only [parseDocument, hpro', hsw, hroot', hepi', skipWs, - List.nil_append] + simp only [parseDocument, hpro', hsw, hroot', hepi', skipWs] rfl have hparse : parse (print d) = parseDocument ((printNodes d.prolog ++ (printNode d.root ++ printNodes d.epilog)).length + 1) (print d) := by From 671b4dd82b31feac285e9643bd5cb215f09b270f Mon Sep 17 00:00:00 2001 From: Claude Date: Thu, 29 Oct 2026 19:40:06 +0000 Subject: [PATCH 18/18] Declare the Apache-2.0 package license in lakefile.toml The org's license policy (mission#9, mission#26) asks each Lake package to set license = "Apache-2.0". The LICENSE file came from main. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- lakefile.toml | 1 + 1 file changed, 1 insertion(+) diff --git a/lakefile.toml b/lakefile.toml index 66452b8..23f609f 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -1,5 +1,6 @@ name = "xml" version = "0.1.0" +license = "Apache-2.0" defaultTargets = ["Xml", "Proofs", "xml"] [[lean_lib]]