;; This is a total rewrite of OTF parser generator logic, from Racket to sl(1) (defmacro (defstruct name . fields)  "Defines a structure type with a specific name and fields."  (let* {[first (car fields)]         [doc (and (string? first) first)]         [fields (or (and doc (cdr fields)) fields)]         [num-fields (length fields)]         [fields-car (map (λ (f) (if (cons? f) (car f) f)) fields)]         [is? (symbol (string name "?"))]         [make (symbol (string "make-" name))]         [undefined (gensym)]}   `(begin      (def (,is? s)        (and [vector? s]             [eq? (aref s 0) ',name]             [= (length s) ,(1+ num-fields)]))      (when ,doc        (symbol-set-doc ',name ,doc))      (def (,make ,@fields)        (vector ',name ,@fields-car))      ,@(map-int (λ (i) [let* {[fld (list-ref fields-car i)]                               [fun (symbol (string name "-" fld))]}                          `(def (,fun s (v ',undefined))                             (assert (,is? s))                             (if (eq? v ',undefined)                                 (aref s ,[1+ i])                                 (aset! s ,[1+ i] v)))])                 num-fields)))) (doc-for (defstruct name doc . fields)) (defstruct type  "OTF type."  name bit-size c-type c-fmt (parse nil)) (defstruct c-fmt  "C printf-like formatting value.Verb is a C format string (\"%d\", for example).  The optional args isa function that accepts one argument, a C variable name as a string,and returns the C expressions that are to be formatted according toverb value."  verb  (args identity)) (defmacro (mktype name bit-size c-type c-fmt (parse nil))  "Define a basic OTF type."  (unless (and (>= bit-size 8) (= (mod0 bit-size 8) 0))    (throw 'invalid-bit-size bit-size))  `(begin     (if (has? otf-types ',name)         (throw 'duplicate-type-name ',name))         (put! otf-types               ',name               (make-type ',name ,bit-size ',c-type ,c-fmt ,parse)))) (def otf-types  "Valid basic OTF types."  (table)) (def (c-fmt-int bits (signed nil))  "Return a c-fmt for printing a signed or unsigned integer of a specific bit width."  (make-c-fmt (string #\% #\" "PRI" [if signed #\d #\u] bits #\"))) (def c-fmt-string  "C nul-terminated string formatter."  (make-c-fmt "%s")) ;; Basic OTF types.(mktype uint8 8 u8int [c-fmt-int 8])(mktype int8 8 s8int [c-fmt-int 8 :signed])(mktype uint16 16 u16int [c-fmt-int 16])(mktype int16 16 s16int [c-fmt-int 16 :signed])(mktype uint24 24 u32int [c-fmt-int 32])(mktype uint32 32 u32int [c-fmt-int 32])(mktype int32 32 s32int [c-fmt-int 32 :signed])(mktype UFWORD 16 u16int [c-fmt-int 16])(mktype FWORD 16 s16int [c-fmt-int 16 :signed])(mktype Offset16 16 u16int [c-fmt-int 16])(mktype Offset24 24 u32int [c-fmt-int 32])(mktype Offset32 32 u32int [c-fmt-int 32])(mktype String 8 char c-fmt-string)(mktype String-UTF16 16 char c-fmt-string)(mktype Tag 32 u32int [make-c-fmt "%c%c%c%c" (λ (v) (string v">>24, "v">>16, "v">>8, "v">>0"))]) (def (assert-type name)  "Throw an error if not a valid basic OTF type."  (or (has? otf-types name)      (error "invalid type: " name))) (def (assert-types names)  (and (every assert-type names) names)) (def (type-index? type)  "Return T if the basic OTF type is allowed to be used for indexing."  (assert-type type)  (member type (assert-types '(uint16 uint32)))) (def (type-offset? type)  "Return T if the basic OTF type defines an offset within the file or section."  (assert-type type)  (member type (assert-types '(Offset16 Offset24 Offset32)))) (def (type-number? type)  "Return T if the basic OTF type is a number."  (assert-type type)  (member type (assert-types '(uint8 int8 uint16 int16 uint24 uint32 int32                               Version16Dot16 Offset16 Offset24 Offset32)))) (def (type-comparable? type)  "Return T if two values of the basic OTF can be compared."  (assert-type type)  (member type (assert-types '(uint8 int8 uint16 int16 uint24 uint32 int32                               Version16Dot16))))