#lang scheme/base

(require
 "pattern.ss"
 (for-syntax
  scheme/base
  "../tools.ss"))
(provide
 meta-pattern)

;; META PATTERNS

;; I've spent quite some time on this already. This is aproblem
;; that's not so intuitive, at least not in my intuition at this
;; moment. I'd like to write this:
;;
;;   (asm-meta-pattern unary (word opcode)
;;     (([movf f 0 0] word) ([opcode f 0 0]))
;;     ((word)              ([opcode 'WREG 0 0])))
;;
;;   (unary (macro)
;;          (1-     decf))
;;
;; to expand to this:
;;
;;   (define-syntax unary
;;     (syntax-rules ()
;;       ((unary namespace (word opcode) ...)
;;        (asm-transforms namespace
;;                        (([movf f 0 0] word) ([opcode f 0 0])) ...
;;                        ((word)              ([opcode 'WREG 0 0])) ...))))
;;



;; The problem here is to insert the ellipsis at the right place. I
;; couldn't do it with syntax-rules, so I'm inserting the ellipsis
;; manually using a fold. Also, this cannot be in pattern-tx.ss
;; because of a dependency on pattern.ss (which depends in turn on
;; pattern-tx.ss)


(define-syntax (meta-pattern stx)
  (syntax-case stx ()
    ((_ name spec  clause ...)
     #`(define-syntax name
         (syntax-rules ()
           ((name namespace spec (... ...))
            (patterns
             namespace
             #,@(foldr
                 (lambda (stx rest)
                   (list* stx #'(... ...) rest))
                 '()
                 (syntax->list #'(clause ...))))))))))