test/f1b-parity-probe.sgl

1;;; F1b -- DELEGATION PARITY between `#lang sigil/doc` and `#lang folio/doc`.

2;;;

3;;; THE CLAIM: folio delegates the grammar rather than reimplementing it.

4;;;

5;;; THE EVIDENCE: the same shared-construct body, byte for byte, under both

6;;; languages produces a BYTE-IDENTICAL canonical datum -- every field AND every

7;;; node's full source location. A profile that had forked paragraph formation,

8;;; inline folding, escapes, body handling or location arithmetic could not

9;;; produce that, and a profile that merely produced the same SHAPE would still

10;;; differ in positions.

11;;;

12;;; HOW THE POSITIONS ARE MADE COMPARABLE, which is the part that makes the

13;;; strong form possible at all. `#lang sigil/doc` and `#lang folio/doc` are

14;;; both fifteen bytes, and the two fixtures' root lines are padded to the same

15;;; byte length, so the shared body begins at the same offset in both files and

16;;; every node in it has the same line, column, position and span. The gate

17;;; asserts that alignment before this probe runs, with a message saying how to

18;;; re-pad, so a future edit cannot silently turn the strong comparison into a

19;;; weak one.

20;;;

21;;; THAT FIFTEEN-BYTE EQUALITY IS WHY THE SIGIL-SIDE FIXTURE STAYED IN THE BASE

22;;; LANGUAGE when sigil-doc's D8 moved the base root set to `(article)`. The

23;;; fixture was re-rooted `@chapter` -> `@article` (8 bytes either way, so the

24;;; alignment is untouched) rather than re-headed to `#lang sigil/doc/book`,

25;;; which is twenty bytes and would have shifted the shared body by five. The

26;;; other reason is the claim itself: this probe is about delegation to the BASE

27;;; grammar, and the book genre is a sibling language, not that.

28;;;

29;;; ONE FIELD IS NORMALISED AND EXACTLY ONE: `srcloc-file`, which necessarily

30;;; differs because the two manuscripts are two files. The substitution is

31;;; proven to FIRE below rather than assumed -- an unfired normalisation would

32;;; leave two strings that differ for a reason nobody sees.

33;;;

34;;; AND THE COMPARATOR IS PROVEN ABLE TO MOVE. `f1b-parity-shifted.sgd` is the

35;;; folio manuscript with a root line ONE BYTE LONGER and a byte-identical body,

36;;; so every child's offset shifts by one. Its datum must DIFFER. Without that

37;;; control a 40 KB equality is the most convincing vacuous gate there is: the

38;;; bigger and more precise the comparison, the more it reads as overwhelming

39;;; evidence and the less anyone asks whether it can fail.

40;;;

41;;; `(sigil test)` is not used; a direct `sigil <file>` run registers `test`

42;;; forms and never executes them. The harness is hand-rolled and its failure

43;;; path is exercised every run via `F1B_PROBE_SELFTEST`.

44(import (sigil core) (sigil fs) (sigil syntax) (folio doc))

46(define checks-run 0)

47(define checks-failed 0)

48(define (check label ok?)

49 (set! checks-run (+ checks-run 1))

50 (if (not ok?)

51 (begin (set! checks-failed (+ checks-failed 1))

52 (display (string-append " FAIL: " label)) (newline))))

54(define (string-has? haystack needle)

55 (let ((h (string-length haystack)) (n (string-length needle)))

56 (let loop ((i 0))

57 (cond ((> (+ i n) h) #f)

58 ((string=? needle (substring haystack i (+ i n))) #t)

59 (else (loop (+ i 1)))))))

61(define (string-replace-all haystack needle replacement)

62 (let ((h (string-length haystack)) (n (string-length needle)))

63 (let loop ((i 0) (out ""))

64 (cond

65 ((> (+ i n) h) (string-append out (substring haystack i h)))

66 ((string=? needle (substring haystack i (+ i n)))

67 (loop (+ i n) (string-append out replacement)))

68 (else (loop (+ i 1) (string-append out (substring haystack i (+ i 1)))))))))

70;; ---------------------------------------------------------------------------

71;; Load all three manuscripts through the REAL `#lang` path.

72;;

73;; `load` and not `eval`: SD-P1's headline finding about keyword formals turned

74;; out to be an INSTRUMENT ARTIFACT of driving parsed forms through `eval`,

75;; which reaches CPS conversion without the top-level macro-expansion pass. A

76;; parity arm built on `eval` would be measuring the harness as much as the

77;; product.

78;;

79;; The three bind different names -- `document` from sigil/doc's `'one` profile,

80;; `document-roots` from folio's `'one-or-more` -- so the second load cannot

81;; rebind the first underneath an assertion. The folio pair is loaded into

82;; separate holders explicitly for the same reason.

83;; ---------------------------------------------------------------------------

84(load "test/fixtures/f1b-parity-sigil.sgd")

85(define sigil-root document)

87(load "test/fixtures/f1b-parity-folio.sgd")

88(define folio-root (car document-roots))

90(load "test/fixtures/f1b-parity-shifted.sgd")

91(define shifted-root (car document-roots))

93(check "the sigil/doc root is a document" (document? sigil-root))

94(check "the folio/doc root is a note" (note? folio-root))

95(check "the shifted root is a note" (note? shifted-root))

97(define sigil-children (document-children sigil-root))

98(define folio-children (note-children folio-root))

99(define shifted-children (note-children shifted-root))

100

101;; A comparison of two empty lists agrees with itself and proves nothing.

102(check "the shared body produced children" (pair? sigil-children))

103(check "both languages produced the same number of children"

104 (= (length sigil-children) (length folio-children)))

105

106;; ---------------------------------------------------------------------------

107;; Serialize the CHILDREN under an identical synthetic wrapper, so that the two

108;; roots' own differing fields -- an article's title and authors versus a note's

109;; id and tags -- are outside the comparison and the shared body is all of it.

110;; ---------------------------------------------------------------------------

111(define wrapper-location (make-srcloc "f1b-parity-wrapper" 1 1 0 0))

112(define (serialize children)

113 (document->string (make-document 'article "parity" '() children wrapper-location)))

114

115(define raw-sigil (serialize sigil-children))

116(define raw-folio (serialize folio-children))

117(define raw-shifted (serialize shifted-children))

118

119(check "the sigil/doc serialization is substantial" (> (string-length raw-sigil) 2000))

120(check "the folio/doc serialization is substantial" (> (string-length raw-folio) 2000))

121

122;; The one normalised field, and the proof it was there to normalise.

123(check "the raw sigil/doc datum names its own source file"

124 (string-has? raw-sigil "f1b-parity-sigil.sgd"))

125(check "the raw folio/doc datum names its own source file"

126 (string-has? raw-folio "f1b-parity-folio.sgd"))

127

128(define (normalise s)

129 (string-replace-all

130 (string-replace-all

131 (string-replace-all s "f1b-parity-sigil.sgd" "f1b-parity-SOURCE.sgd")

132 "f1b-parity-folio.sgd" "f1b-parity-SOURCE.sgd")

133 "f1b-parity-shifted.sgd" "f1b-parity-SOURCE.sgd"))

134

135(define norm-sigil (normalise raw-sigil))

136(define norm-folio (normalise raw-folio))

137(define norm-shifted (normalise raw-shifted))

138

139(check "normalisation FIRED on the sigil/doc datum"

140 (and (not (string-has? norm-sigil "f1b-parity-sigil.sgd"))

141 (string-has? norm-sigil "f1b-parity-SOURCE.sgd")))

142(check "normalisation FIRED on the folio/doc datum"

143 (and (not (string-has? norm-folio "f1b-parity-folio.sgd"))

144 (string-has? norm-folio "f1b-parity-SOURCE.sgd")))

145(check "normalisation changed nothing else in length"

146 (= (string-length norm-sigil) (string-length norm-folio)))

147

148;; ---------------------------------------------------------------------------

149;; THE PARITY ASSERTION.

150;; ---------------------------------------------------------------------------

151(check "the two languages produce a BYTE-IDENTICAL canonical datum for the shared body"

152 (string=? norm-sigil norm-folio))

153

154;; ---------------------------------------------------------------------------

155;; THE COMPARATOR MOVES. Same body, one byte earlier in the file.

156;; ---------------------------------------------------------------------------

157(check "the shifted manuscript produced the same number of children"

158 (= (length folio-children) (length shifted-children)))

159(check "a ONE-BYTE shift in the header changes the canonical datum"

160 (not (string=? norm-folio norm-shifted)))

161(check "the shifted datum is otherwise the same size"

162 (= (string-length norm-folio) (string-length norm-shifted)))

163

164;; ---------------------------------------------------------------------------

165;; POPULATION. The kinds the shared body actually exercises, DERIVED from the

166;; tree rather than from the list of constructs I meant to write. The gate

167;; compares this set against `(sigil doc author)`'s exports and states every

168;; exclusion with a reason; a count with no denominator is a sample wearing a

169;; population's clothes.

170;; ---------------------------------------------------------------------------

171(define (kind-of n)

172 (cond ((document? n) "document") ((section? n) "section") ((paragraph? n) "paragraph")

173 ((text? n) "text") ((emphasis? n) "emphasis") ((code? n) "code")

174 ((code-block? n) "code-block") ((item-list? n) "item-list") ((list-item? n) "list-item")

175 ((table? n) "table") ((table-row? n) "table-row") ((table-cell? n) "table-cell")

176 ((video? n) "video") ((term? n) "term") ((term-reference? n) "term-reference")

177 ((glossary? n) "glossary") ((admonition? n) "admonition") ((exercise? n) "exercise")

178 ((example? n) "example") ((project-check? n) "project-check") ((anchor? n) "anchor")

179 ((reference? n) "reference") ((url-link? n) "url-link")

180 (else "UNCLASSIFIED")))

181

182(define kinds-seen '())

183(document-fold

184 (lambda (state n)

185 (let ((k (kind-of n)))

186 (if (not (member k kinds-seen)) (set! kinds-seen (cons k kinds-seen)))

187 state))

188 #f

189 (make-document 'article "parity" '() folio-children wrapper-location))

190

191(check "every node in the shared body was classified"

192 (not (member "UNCLASSIFIED" kinds-seen)))

193(for-each (lambda (k) (display (string-append "F1B_PARITY_KIND " k)) (newline))

194 kinds-seen)

195

196;; ---------------------------------------------------------------------------

197;; Self-test.

198;; ---------------------------------------------------------------------------

199(if (getenv "F1B_PROBE_SELFTEST")

200 (check "deliberate failure injected by F1B_PROBE_SELFTEST" #f))

201

202(display (string-append "F1B_PARITY_PROBE checks=" (number->string checks-run)

203 " failed=" (number->string checks-failed)

204 " bytes=" (number->string (string-length norm-folio))

205 " children=" (number->string (length folio-children))

206 " kinds=" (number->string (length kinds-seen))))

207(newline)

208(if (> checks-failed 0)

209 (error "F1b parity probe failed" checks-failed))