multiple attributes; combine field and fieldarr

Sigrid Solveig Haflínudóttir committed 2 years ago

Commit 260b5881 parent 1d8152b1 file · +67 −45Browse files

Unified · Split

   (-> type? positive?)
   (/ (type-bits t) 8))
-(define-struct field (type name unused)
+(define (field-unused? f)
+  (assoc 'unused (field-attrs f)))
+(define (field-count f)
+  (assoc 'count (field-attrs f)))
+(define (field-ptr f)
+  (if (field-count f) "*" ""))
+(define-struct field (type name attrs)
   #:transparent
   #:methods gen:code
   [(define/generic super-c-type c-type)
    (define (gen-h f)
-     (list (~a (if (field-unused f) "// unused " "")
+     (list (~a (if (field-unused? f) "// unused " "")
                (super-c-type (field-type f))
                " "
+               (field-ptr f)
                (field-name f)
                ";")))
    (define (gen-c f)
-     (list (if (field-unused f)
+     (define (size t)
-               (~a "if(skip_bytes(ctx, " (type-size (field-type f)) ") < 0){")
+       (if (type? t) (type-size t) 0))
-               (~a "if(read_" (type-name (field-type f)) "(ctx, &v->" (field-name f) ") < 0){"))
+     (define (name t)
+       (if (type? t) (type-name t) (cmplx-name t)))
+     (list (match (field-count f)
+             [#f
+              (if (field-unused? f)
+                  (~a "if(skip_bytes(ctx, " (size (field-type f)) ") < 0){")
+                  (~a "if(read_" (name (field-type f)) "(ctx, &v->" (field-name f) ") < 0){"))]
+             [count
+              (~a "if(read_array(ctx, &v->"
+                  (field-name f)
+                  ", read_"
+                  (super-c-type (field-type f))
+                  ", v->"
+                  (cadr count)
+                  ") < 0){")])
            (~a "\twerror(\"%s: %r\", \"" (field-name f) "\");")
            (~a "\tgoto err;")
            (~a "}")))])
-(define-struct (fieldarr field) (count)
-  #:transparent
-  #:methods gen:code
-  [(define/generic super-c-type c-type)
-   (define (gen-h a)
-     (list (~a (super-c-type (field-type a)) " *" (field-name a) ";")))
-   (define (gen-c a)
-     (list (~a "if(read_array(ctx, &v->"
-               (field-name a)
-               ", read_"
-               (super-c-type (field-type a))
-               ", v->"
-               (fieldarr-count a)
-               ") < 0){")
-           (~a "\twerror(\"%s: %r\", \"" (field-name a) "\");")
-           (~a "\tgoto err;")
-           (~a "}")))])
 (define-struct cmplx (name fields tag)
   #:transparent
   #:methods gen:code
          (set! cmplxs (append cmplxs (list typ))))]
     [(_ typ:id fields:expr) #'(mkcmplx typ fields "")]))
+(define-for-syntax fields '())
+(define-syntax (mkattr stx)
+  (syntax-parse stx
+    [(_ ({~literal =} vs:number ...+)) #''(= vs ...)]
+    [(_ ({~literal count} n:id))
+     (begin
+       (if (assoc (syntax->datum #`n) fields)
+           #''(count n)
+           (raise-syntax-error #f "no such field" stx #'n)))]
+    [(_ {~literal unused}) #''(unused #t)]))
 (define-syntax (mkfield stx)
   (syntax-parse stx
-    [(_ {~literal //} type:id name:id)
+    [(_ type:id name:id attrs ...)
-     #'(field type
+     (begin
-              `name
+       (let ([f #'(field type
-              #t)]
+                         `name
-    [(_ type:id name:id [count:id]) #'(fieldarr type `name #f `count)]
+                         (list (mkattr [~@ attrs]) ...))])
-    [(_ type:id name:id)
+         (begin
-     #'(field type
+           (set! fields (append fields (list (syntax->datum #'(name type)))))
-              `name
+           f)))]))
-              #f)]))
 (define-syntax (mkfields stx)
   (syntax-parse stx
-    [(_ x ...) #'(list (mkfield {~@ . x}) ...)]))
+    [(_ x ...)
+     (begin
+       (set! fields '())
+       #'(list (mkfield [~@ . x]) ...))]))
 (mktype uint8 8 u8int)
 (mktype int8 8 s8int)
 (mkcmplx TableRecord (mkfields {Tag tableTag} {uint32 checksum} {Offset32 offset} {uint32 length}))
 (mkcmplx TableDirectory
-         (mkfields {uint32 sfntVersion}
+         (mkfields {uint32 sfntVersion (= #x000100000 #x4f54544f)}
                    {uint16 numTables}
                    {uint16 searchRange}
                    {uint16 entrySelector}
                    {uint16 rangeShift}
-                   {TableRecord tableRecords [numTables]}))
+                   {TableRecord tableRecords (count numTables)}))
 (mkcmplx EncodingRecord
-         (mkfields {uint16 platformID} {uint16 encodingID} {Offset32 subtableOffset}))
+         (mkfields {uint16 platformID (= 0 1 2 3 4)} {uint16 encodingID} {Offset32 subtableOffset}))
 (mkcmplx TableCmap
-         (mkfields {uint16 version} {uint16 numTables} {EncodingRecord encodingRecords [numTables]})
+         (mkfields {uint16 version (= 0)}
+                   {uint16 numTables}
+                   {EncodingRecord encodingRecords (count numTables)})
          "cmap")
 (mkcmplx TableHead
-         (mkfields {uint16 majorVersion}
+         (mkfields {uint16 majorVersion (= 1)}
-                   {uint16 minorVersion}
+                   {uint16 minorVersion (= 0)}
                    {Fixed fontRevision}
                    {uint32 checksumAdjustment}
-                   {uint32 magicNumber}
+                   {uint32 magicNumber (= #x5f0f3cf5)}
                    {uint16 flags}
                    {uint16 unitsPerEm}
-                   {// LONGDATETIME created}
+                   {LONGDATETIME created unused}
-                   {// LONGDATETIME modified}
+                   {LONGDATETIME modified unused}
                    {int16 xMin}
                    {int16 yMin}
                    {int16 xMax}
                    {int16 yMax}
                    {uint16 macStyle}
                    {uint16 lowestRecPPEM}
-                   {int16 fontDirectionHint}
+                   {int16 fontDirectionHint unused (= -2 -1 0 1 2)}
-                   {int16 indexToLocFormat}
+                   {int16 indexToLocFormat (= 0 1)}
-                   {int16 glyphDataFormat})
+                   {int16 glyphDataFormat (= 0)})
          "head")
 (printf (format gen-h))

multiple attributes; combine field and fieldarr

Keyboard shortcuts

General

Issues and pull requests

Issues, pull requests and Inbox

Repository code