Unified · Split
| @@ -47,42 +47,48 @@ · 46 unmodified lines | ||
| 47 | 47 | (-> type? positive?) |
| 48 | 48 | (/ (type-bits t) 8)) |
| 49 | 49 | |
| 50 | −(define-struct field (type name unused) | |
| 50 | +(define (field-unused? f) | |
| 51 | + (assoc 'unused (field-attrs f))) | |
| 52 | + | |
| 53 | +(define (field-count f) | |
| 54 | + (assoc 'count (field-attrs f))) | |
| 55 | + | |
| 56 | +(define (field-ptr f) | |
| 57 | + (if (field-count f) "*" "")) | |
| 58 | + | |
| 59 | +(define-struct field (type name attrs) | |
| 51 | 60 | #:transparent |
| 52 | 61 | #:methods gen:code |
| 53 | 62 | [(define/generic super-c-type c-type) |
| 54 | 63 | (define (gen-h f) |
| 55 | − (list (~a (if (field-unused f) "// unused " "") | |
| 64 | + (list (~a (if (field-unused? f) "// unused " "") | |
| 56 | 65 | (super-c-type (field-type f)) |
| 57 | 66 | " " |
| 67 | + (field-ptr f) | |
| 58 | 68 | (field-name f) |
| 59 | 69 | ";"))) |
| 60 | 70 | (define (gen-c f) |
| 61 | − (list (if (field-unused f) | |
| 62 | − (~a "if(skip_bytes(ctx, " (type-size (field-type f)) ") < 0){") | |
| 63 | − (~a "if(read_" (type-name (field-type f)) "(ctx, &v->" (field-name f) ") < 0){")) | |
| 71 | + (define (size t) | |
| 72 | + (if (type? t) (type-size t) 0)) | |
| 73 | + (define (name t) | |
| 74 | + (if (type? t) (type-name t) (cmplx-name t))) | |
| 75 | + (list (match (field-count f) | |
| 76 | + [#f | |
| 77 | + (if (field-unused? f) | |
| 78 | + (~a "if(skip_bytes(ctx, " (size (field-type f)) ") < 0){") | |
| 79 | + (~a "if(read_" (name (field-type f)) "(ctx, &v->" (field-name f) ") < 0){"))] | |
| 80 | + [count | |
| 81 | + (~a "if(read_array(ctx, &v->" | |
| 82 | + (field-name f) | |
| 83 | + ", read_" | |
| 84 | + (super-c-type (field-type f)) | |
| 85 | + ", v->" | |
| 86 | + (cadr count) | |
| 87 | + ") < 0){")]) | |
| 64 | 88 | (~a "\twerror(\"%s: %r\", \"" (field-name f) "\");") |
| 65 | 89 | (~a "\tgoto err;") |
| 66 | 90 | (~a "}")))]) |
| 67 | 91 | |
| 68 | −(define-struct (fieldarr field) (count) | |
| 69 | − #:transparent | |
| 70 | − #:methods gen:code | |
| 71 | − [(define/generic super-c-type c-type) | |
| 72 | − (define (gen-h a) | |
| 73 | − (list (~a (super-c-type (field-type a)) " *" (field-name a) ";"))) | |
| 74 | − (define (gen-c a) | |
| 75 | − (list (~a "if(read_array(ctx, &v->" | |
| 76 | − (field-name a) | |
| 77 | − ", read_" | |
| 78 | − (super-c-type (field-type a)) | |
| 79 | − ", v->" | |
| 80 | − (fieldarr-count a) | |
| 81 | − ") < 0){") | |
| 82 | − (~a "\twerror(\"%s: %r\", \"" (field-name a) "\");") | |
| 83 | − (~a "\tgoto err;") | |
| 84 | − (~a "}")))]) | |
| 85 | − | |
| 86 | 92 | (define-struct cmplx (name fields tag) |
| 87 | 93 | #:transparent |
| 88 | 94 | #:methods gen:code |
| @@ -135,21 +141,35 @@ · 46 unmodified lines | ||
| 135 | 141 | (set! cmplxs (append cmplxs (list typ))))] |
| 136 | 142 | [(_ typ:id fields:expr) #'(mkcmplx typ fields "")])) |
| 137 | 143 | |
| 144 | +(define-for-syntax fields '()) | |
| 145 | + | |
| 146 | +(define-syntax (mkattr stx) | |
| 147 | + (syntax-parse stx | |
| 148 | + [(_ ({~literal =} vs:number ...+)) #''(= vs ...)] | |
| 149 | + [(_ ({~literal count} n:id)) | |
| 150 | + (begin | |
| 151 | + (if (assoc (syntax->datum #`n) fields) | |
| 152 | + #''(count n) | |
| 153 | + (raise-syntax-error #f "no such field" stx #'n)))] | |
| 154 | + [(_ {~literal unused}) #''(unused #t)])) | |
| 155 | + | |
| 138 | 156 | (define-syntax (mkfield stx) |
| 139 | 157 | (syntax-parse stx |
| 140 | − [(_ {~literal //} type:id name:id) | |
| 141 | − #'(field type | |
| 142 | − `name | |
| 143 | − #t)] | |
| 144 | − [(_ type:id name:id [count:id]) #'(fieldarr type `name #f `count)] | |
| 145 | − [(_ type:id name:id) | |
| 146 | − #'(field type | |
| 147 | − `name | |
| 148 | − #f)])) | |
| 158 | + [(_ type:id name:id attrs ...) | |
| 159 | + (begin | |
| 160 | + (let ([f #'(field type | |
| 161 | + `name | |
| 162 | + (list (mkattr [~@ attrs]) ...))]) | |
| 163 | + (begin | |
| 164 | + (set! fields (append fields (list (syntax->datum #'(name type))))) | |
| 165 | + f)))])) | |
| 149 | 166 | |
| 150 | 167 | (define-syntax (mkfields stx) |
| 151 | 168 | (syntax-parse stx |
| 152 | − [(_ x ...) #'(list (mkfield {~@ . x}) ...)])) | |
| 169 | + [(_ x ...) | |
| 170 | + (begin | |
| 171 | + (set! fields '()) | |
| 172 | + #'(list (mkfield [~@ . x]) ...))])) | |
| 153 | 173 | |
| 154 | 174 | (mktype uint8 8 u8int) |
| 155 | 175 | (mktype int8 8 s8int) |
| @@ -177,39 +197,41 @@ · 21 unmodified lines | ||
| 177 | 197 | (mkcmplx TableRecord (mkfields {Tag tableTag} {uint32 checksum} {Offset32 offset} {uint32 length})) |
| 178 | 198 | |
| 179 | 199 | (mkcmplx TableDirectory |
| 180 | − (mkfields {uint32 sfntVersion} | |
| 200 | + (mkfields {uint32 sfntVersion (= #x000100000 #x4f54544f)} | |
| 181 | 201 | {uint16 numTables} |
| 182 | 202 | {uint16 searchRange} |
| 183 | 203 | {uint16 entrySelector} |
| 184 | 204 | {uint16 rangeShift} |
| 185 | − {TableRecord tableRecords [numTables]})) | |
| 205 | + {TableRecord tableRecords (count numTables)})) | |
| 186 | 206 | |
| 187 | 207 | (mkcmplx EncodingRecord |
| 188 | − (mkfields {uint16 platformID} {uint16 encodingID} {Offset32 subtableOffset})) | |
| 208 | + (mkfields {uint16 platformID (= 0 1 2 3 4)} {uint16 encodingID} {Offset32 subtableOffset})) | |
| 189 | 209 | |
| 190 | 210 | (mkcmplx TableCmap |
| 191 | − (mkfields {uint16 version} {uint16 numTables} {EncodingRecord encodingRecords [numTables]}) | |
| 211 | + (mkfields {uint16 version (= 0)} | |
| 212 | + {uint16 numTables} | |
| 213 | + {EncodingRecord encodingRecords (count numTables)}) | |
| 192 | 214 | "cmap") |
| 193 | 215 | |
| 194 | 216 | (mkcmplx TableHead |
| 195 | − (mkfields {uint16 majorVersion} | |
| 196 | − {uint16 minorVersion} | |
| 217 | + (mkfields {uint16 majorVersion (= 1)} | |
| 218 | + {uint16 minorVersion (= 0)} | |
| 197 | 219 | {Fixed fontRevision} |
| 198 | 220 | {uint32 checksumAdjustment} |
| 199 | − {uint32 magicNumber} | |
| 221 | + {uint32 magicNumber (= #x5f0f3cf5)} | |
| 200 | 222 | {uint16 flags} |
| 201 | 223 | {uint16 unitsPerEm} |
| 202 | − {// LONGDATETIME created} | |
| 203 | − {// LONGDATETIME modified} | |
| 224 | + {LONGDATETIME created unused} | |
| 225 | + {LONGDATETIME modified unused} | |
| 204 | 226 | {int16 xMin} |
| 205 | 227 | {int16 yMin} |
| 206 | 228 | {int16 xMax} |
| 207 | 229 | {int16 yMax} |
| 208 | 230 | {uint16 macStyle} |
| 209 | 231 | {uint16 lowestRecPPEM} |
| 210 | − {int16 fontDirectionHint} | |
| 211 | − {int16 indexToLocFormat} | |
| 212 | − {int16 glyphDataFormat}) | |
| 232 | + {int16 fontDirectionHint unused (= -2 -1 0 1 2)} | |
| 233 | + {int16 indexToLocFormat (= 0 1)} | |
| 234 | + {int16 glyphDataFormat (= 0)}) | |
| 213 | 235 | "head") |
| 214 | 236 | |
| 215 | 237 | (printf (format gen-h)) |