racket-kaitai/kaitai/main.rkt

51 lines
1.5 KiB
Racket

#lang racket/base
(require (for-syntax racket/base racket/list))
(provide (rename-out [kaitai:module-begin #%module-begin])
(except-out (all-from-out racket/base) #%module-begin))
;; meow
;; makes a syntax error raiser
(define-for-syntax (rse msg)
(lambda () (raise-syntax-error #f msg)))
;; converts a ksy id to a racket id
;; maps _ to -
(define-for-syntax (kaitai-str->sym str)
(string->symbol (regexp-replace* #px"_" str "-")))
;; generates struct definitions
(define-for-syntax (gen-struct top [given-id #f])
(define id (or given-id (hash-ref (hash-ref top "meta" (hash)) "id"
(rse "type has no meta.id and none was provided"))))
(define id-sym (kaitai-str->sym id))
(define seq (hash-ref top "seq" (rse "form must have a seq element")))
(define instances (hash-ref top "instances" (hash)))
#`((provide [struct-out #,id-sym])
(struct #,id-sym
[#,@(map (lambda (a) (kaitai-str->sym (hash-ref a "id" (rse "seq element has no id"))))
seq)] #:transparent)))
;; language infrastructure
(define-syntax (kaitai:module-begin stx)
(define body (second (syntax-e stx)))
(define top-struct (gen-struct (syntax->datum body)))
; (displayln top-struct)
#`(#%module-begin
#,@top-struct))
(module reader syntax/module-reader
#:read kaitai-read
#:read-syntax kaitai-read
#:language 'kaitai
(require yaml)
(define (kaitai-read path port)
(or (read-yaml port) eof))
(define (kaitai-read-syntax path port)
(datum->syntax #f (kaitai-read path port))))