racket-kaitai/kaitai/main.rkt

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