;; meta code for generating usb client/server code

;; usb is an object system with an assymetric client/server
;; architecture. the host (client) sends request to the device
;; (server).

;; it's implemented as a 'load-usb' function which just defines a
;; number of functions in a staapl forth file.


;; this is best implemented directly in forth, since it's quite
;; straightforward.

;; simplified, the general idea is this:
;; - host sends SETUP/OUT packet
;; - device usb hardware buffers + sends ack
;; - usb hardware signals software
;; - software processes the OUT buffer, and synthesizes an IN (reply)
;; - usb hardware waits for host to poll reply, sends IN buffer

;; EP0 receives all control and status requests


;; http://www.beyondlogic.org/usbnutshell/usb5.htm#DeviceDescriptors

;; The most trouble is in the descriptor data. It would be nice to
;; make a mini-language to generate most of the red tape, and some
;; small forth wrappers around the data structures.

;; only device, configuration and string will be requested during
;; enumeration. (others can follow?)

;; a configuration request will return configuration, interface and
;; endpoint descriptors: CIEEEIEEEIEEE in a single reply, so we
;; compile them in this sequence.

;; what can be automated?

;; - record length
;; - string references and management
;; - low/high words
;; - number of configurations

;; instead of gluing the type description to the name, it's probably
;; best to put a space there to avoid parsing. note that the device
;; descriptor has 2 records sharing the same identifier, but with
;; different type (idProduct and iProduct). the latter one i'm
;; renaming to iProductName.

;; i don't need to make it too general at first, just make sure the
;; general approach is not too hard to extend.

;; links
;; http://www.beyondlogic.org/usbnutshell/
;; http://www.beyondlogic.org/usbnutshell/usb3.htm

#lang scheme/base


(provide define-usb-device)

;; *** GENERATOR ***

(define-syntax (define-usb-device stx)

  (define (interleave lst sym)
    (map (lambda (x) (list x sym)) lst))
  ;; create a forth string from a list of bytes
  (define (fstring name lst)
    `(,#':forth ,name
                  (cons (length lst) lst) ;; not the same as add-length
  ;; create route + error code
  (define (route name lst error)
    `(,#':forth ,name
                ,(length lst) route/e
                ,(interleave lst #'|.|)
                ,error ,#'exit))
  ;; generate a list of symbols with number postfix
  (define (namegen name n)
    (for/list ((i (in-range n)))
      (string->symbol (format "~a~a" name i))))

  ;; transform the data structure
  (define (generate-forth
           [stx #f] ;; for lexical context
           [string-descriptor (datum->syntax stx 'string-descriptor)]
           [device-descriptor (datum->syntax stx 'device-descriptor)]
           [configuration-descriptor (datum->syntax stx  'configuration-descriptor)]
           [config-error #'reset]
           [string-error #'reset])
    (match dev
           ((struct usb-device (desc confs strs))
            (let ((string-names (namegen 'string (length strs)))
                  (config-names (namegen 'config (length confs))))

              ;; Generate forth code.  It's flattened once on the top.  All
              ;; the subgens can return s-expressions.
              (let ((expr
                       (fstring device-descriptor desc)
                       (map fstring string-names strs)
                       (map fstring config-names confs)
                       (route string-descriptor string-names string-error)
                       (route configuration-descriptor config-names config-error)))))
                ;; (pretty-print expr)
                   :forth table _x> exit
                   :forth route/e min xskip exit
                   #,@(flatten expr)))))))

  (syntax-case stx ()
    ((_ dev)
      (usb-device-compile (syntax->datum #'dev))