shithub: fnt

Info  •  Files  •  Log  •  Branches

multiple attributes; combine field and fieldarr

--- a/otf.rkt

+++ b/otf.rkt

@@ -47,42 +47,48 @@

   (-> 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)

-               (~a "if(skip_bytes(ctx, " (type-size (field-type f)) ") < 0){")

-               (~a "if(read_" (type-name (field-type f)) "(ctx, &v->" (field-name f) ") < 0){"))

+     (define (size t)

+       (if (type? t) (type-size t) 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

@@ -135,21 +141,35 @@

          (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)

-     #'(field type

-              `name

-              #t)]

-    [(_ type:id name:id [count:id]) #'(fieldarr type `name #f `count)]

-    [(_ type:id name:id)

-     #'(field type

-              `name

-              #f)]))

+    [(_ type:id name:id attrs ...)

+     (begin

+       (let ([f #'(field type

+                         `name

+                         (list (mkattr [~@ attrs]) ...))])

+         (begin

+           (set! fields (append fields (list (syntax->datum #'(name type)))))

+           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)

@@ -177,30 +197,32 @@

 (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}

-                   {uint16 minorVersion}

+         (mkfields {uint16 majorVersion (= 1)}

+                   {uint16 minorVersion (= 0)}

                    {Fixed fontRevision}

                    {uint32 checksumAdjustment}

-                   {uint32 magicNumber}

+                   {uint32 magicNumber (= #x5f0f3cf5)}

                    {uint16 flags}

                    {uint16 unitsPerEm}

-                   {// LONGDATETIME created}

-                   {// LONGDATETIME modified}

+                   {LONGDATETIME created unused}

+                   {LONGDATETIME modified unused}

                    {int16 xMin}

                    {int16 yMin}

                    {int16 xMax}

@@ -207,9 +229,9 @@

                    {int16 yMax}

                    {uint16 macStyle}

                    {uint16 lowestRecPPEM}

-                   {int16 fontDirectionHint}

-                   {int16 indexToLocFormat}

-                   {int16 glyphDataFormat})

+                   {int16 fontDirectionHint unused (= -2 -1 0 1 2)}

+                   {int16 indexToLocFormat (= 0 1)}

+                   {int16 glyphDataFormat (= 0)})

          "head")

 (printf (format gen-h))