79 lines
2.2 KiB
Racket
79 lines
2.2 KiB
Racket
#lang racket/base
|
|
|
|
(require (for-syntax racket/base racket/list racket/match))
|
|
(provide (rename-out [kaitai:module-begin #%module-begin])
|
|
(except-out (all-from-out racket/base) #%module-begin))
|
|
|
|
;; meow
|
|
|
|
;; utility to concat symbol stuff
|
|
(define-for-syntax (sym+ . args)
|
|
(define (->string a) (if (symbol? a) (symbol->string a) a))
|
|
(string->symbol (apply string-append (map ->string args))))
|
|
|
|
;; makes a syntax error raiser
|
|
(define-for-syntax (make-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 "-")))
|
|
|
|
;; returns either the given id or meta.id
|
|
;; otherwise raises syntax error
|
|
(define-for-syntax (get-id top given-id)
|
|
(kaitai-str->sym
|
|
(or given-id (hash-ref (hash-ref top "meta" (hash)) "id"
|
|
(make-rse "type has no meta.id and none was provided")))))
|
|
|
|
;; helper for types meta lookup
|
|
(define-for-syntax (get-id-seq top given-id)
|
|
(define id-sym (get-id top given-id))
|
|
(define seq (hash-ref top "seq" (make-rse "form must have a seq element")))
|
|
(values id-sym seq))
|
|
|
|
;; generates struct definitions
|
|
(define-for-syntax (gen-struct top [given-id #f])
|
|
(define-values [id-sym seq] (get-id-seq top given-id))
|
|
(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" (make-rse "seq element has no id"))))
|
|
seq)] #:transparent)))
|
|
|
|
;; runtime lib
|
|
|
|
(module runtime racket/base
|
|
(provide (all-defined-out))
|
|
(define (kaitai:->binaryio thing)
|
|
;; TODO
|
|
thing)
|
|
(define (kaitai:uwu)
|
|
(displayln "uwu")))
|
|
|
|
(require 'runtime)
|
|
(provide (all-from-out 'runtime))
|
|
|
|
;; language infrastructure
|
|
|
|
(define-syntax (kaitai:module-begin stx)
|
|
(define body (second (syntax-e stx)))
|
|
(displayln (syntax->datum body))
|
|
#`(#%module-begin
|
|
(module+ main
|
|
(kaitai:uwu))))
|
|
|
|
(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))))
|