test/f2a-span-manifest.sgl

1;;; F2a span manifest -- the descriptor's spans, emitted as flat text so that a

2;;; verifier written in ANOTHER LANGUAGE can check them against the manuscript's

3;;; raw bytes.

4;;;

5;;; WHY A MANIFEST AND NOT AN ASSERTION.

6;;;

7;;; The acceptance bar for this phase is that span exactness is MEASURED AGAINST

8;;; SOURCE BYTES, not against the parse tree the spans came from. Any check

9;;; written here, in this language, against this descriptor, shares the

10;;; descriptor's reader, the descriptor's coordinate arithmetic and the

11;;; descriptor's idea of where things are -- so it agrees with itself and proves

12;;; nothing. That is taxonomy shape 13 in its real form: not "we did not test

13;;; enough" but "every instrument we pointed at it had the same blind spot".

14;;;

15;;; So this file only REPORTS. `test/f2a-span-verify.py` opens the manuscript in

16;;; BINARY mode, slices `bytes[start:start+length]`, recomputes every offset from

17;;; the file itself, and decides. It shares no code, no reader and no arithmetic

18;;; with anything here.

19;;;

20;;; This file also does not use `(sigil test)`: a direct `sigil <file>` run

21;;; REGISTERS `test` forms and never executes them -- measured, `1 = 2` printed

22;;; nothing and exited 0. Everything below either prints or raises.

23(import (sigil core) (sigil fs) (sigil language) (folio doc inspect))

25(define source-path

26 (let ((v (getenv "F2A_MANIFEST_SOURCE")))

27 (if (and v (> (string-length v) 0)) v "test/fixtures/f2a-corpus.sgd")))

29(define source (read-file-string source-path))

31;; The revision is an INPUT to the inspector (ruled 2026-08-11: sigil-crypto is

32;; native-only and a WASM folio client must be able to compute revisions

33;; itself). The gate supplies the real one, computed by `sha256sum` -- a

34;; DIFFERENT implementation from anything in this repository, which is the

35;; point. The placeholder below only keeps this file runnable by hand.

36(define revision

37 (let ((v (getenv "F2A_MANIFEST_REVISION")))

38 (if (and v (valid-revision? v)) v (string-append "sha256:" (make-string 64 #\0)))))

40(define header-end

41 (let ((header (inspect-language-source source source-path)))

42 (and (language-header? header) (language-header-end header))))

44(define descriptor (inspect-folio-source source source-path revision header-end))

46;; ---------------------------------------------------------------------------

47;; Escaping. A field value or a node name can contain a tab or a newline, and a

48;; line-oriented manifest that let one through would hand the verifier a

49;; truncated record it would parse as a short line rather than as an error.

50;; ---------------------------------------------------------------------------

51(define (escape s)

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

53 (if (>= i (string-length s))

54 out

55 (let ((c (string-ref s i)))

56 (loop (+ i 1)

57 (string-append out

58 (cond ((char=? c #\\) "\\\\")

59 ((char=? c #\tab) "\\t")

60 ((char=? c #\newline) "\\n")

61 ((char=? c #\return) "\\r")

62 (else (string c)))))))))

64(define (num v) (if v (number->string v) "-"))

66(define (value-type v)

67 (cond ((string? v) "string")

68 ((symbol? v) "symbol")

69 ((number? v) "number")

70 ((boolean? v) "boolean")

71 ((pair? v) "list")

72 ((null? v) "list")

73 (else "other")))

75(define (value-text v)

76 (cond ((string? v) v)

77 ((symbol? v) (symbol->string v))

78 ((number? v) (number->string v))

79 ((boolean? v) (if v "#t" "#f"))

80 (else "")))

82(define nodes-emitted 0)

83(define fields-emitted 0)

85(define (emit . parts)

86 (let loop ((rest parts))

87 (cond ((null? rest) (newline))

88 (else (display (car rest))

89 (if (pair? (cdr rest)) (display "\t"))

90 (loop (cdr rest))))))

92(define (span-cols s)

93 (list (num (span-byte-start s)) (num (span-byte-length s))

94 (num (span-scalar-start s)) (num (span-scalar-end s))

95 (num (span-line s)) (num (span-column s))

96 (num (span-end-line s)) (num (span-end-column s))))

98(define (emit-span-row tag path extra span)

99 (apply emit (append (list tag path) extra (span-cols span))))

100

101(define (walk node path)

102 (set! nodes-emitted (+ nodes-emitted 1))

103 (emit-span-row "NODE" path

104 ;; EVERY column is escaped, not just the ones that looked

105 ;; risky. An unescaped tab anywhere shifts the metadata columns

106 ;; while the span columns -- always the last eight -- stay in

107 ;; place, so the row parses as a VALID row carrying the wrong

108 ;; name, kind or id.

109 (list (escape (symbol->string (inspected-node-kind node)))

110 (if (inspected-node-name node)

111 (escape (symbol->string (inspected-node-name node)))

112 "-")

113 (escape (symbol->string (inspected-node-vocabulary node)))

114 (if (inspected-node-id node) (escape (inspected-node-id node)) "-"))

115 (inspected-node-span node))

116 (for-each

117 (lambda (f)

118 (set! fields-emitted (+ fields-emitted 1))

119 (if (field-span f)

120 (emit-span-row "FIELD" path

121 (list (if (field-name f) (escape (symbol->string (field-name f))) "-")

122 (number->string (field-index f))

123 (escape (value-type (field-value f)))

124 (escape (value-text (field-value f))))

125 (field-span f))

126 ;; A field with no span is a REAL condition -- an argument whose syntax

127 ;; carried no srcloc -- and it is emitted as such rather than skipped.

128 ;; A verifier that never sees the row cannot notice the hole.

129 (emit "FIELD-NO-SPAN" path

130 (if (field-name f) (escape (symbol->string (field-name f))) "-")

131 (number->string (field-index f)))))

132 (inspected-node-fields node))

133 (let loop ((children (inspected-node-children node)) (i 0))

134 (if (pair? children)

135 (begin (walk (car children) (string-append path "." (number->string i)))

136 (loop (cdr children) (+ i 1))))))

137

138(emit "SOURCE" (escape source-path))

139(emit "REVISION" (descriptor-revision descriptor))

140(emit "LENGTHS"

141 (number->string (descriptor-byte-length descriptor))

142 (number->string (descriptor-scalar-length descriptor)))

143(emit "HEADER-END" (num (descriptor-header-end descriptor)))

144(emit "PARSED" (if (descriptor-parsed? descriptor) "yes" "no"))

145

146(for-each (lambda (d)

147 (emit "DIAGNOSTIC"

148 (symbol->string (diagnostic-severity d))

149 (symbol->string (diagnostic-code d))

150 (escape (diagnostic->string d))))

151 (descriptor-diagnostics descriptor))

152

153(let loop ((roots (descriptor-nodes descriptor)) (i 0))

154 (if (pair? roots)

155 (begin (walk (car roots) (number->string i))

156 (loop (cdr roots) (+ i 1)))))

157

158;; A descriptor holding a callable is the one thing that would make "this data

159;; cannot be evaluated" false. Reported as data, checked by the verifier.

160(for-each (lambda (path) (emit "CALLABLE" (escape path)))

161 (descriptor-callable-values descriptor))

162

163;; THE TRAILER IS LOAD-BEARING. A manifest truncated by a crash, a full disk or

164;; a redirect that returned before the writer finished looks exactly like a

165;; manifest of a small document. The verifier refuses to grade a manifest whose

166;; trailer is missing or whose counts disagree with the rows it actually parsed.

167(display "F2A_MANIFEST_DONE nodes=")

168(display nodes-emitted)

169(display " fields=")

170(display fields-emitted)

171(newline)