#lang scheme

; implements a mini-language for making the revbayes inline macro

(require "revbayes-model.ss")

#|
replace-revbayes-context

The same as replace-context, but replaces #'unquote with unquote-stx
and does not recurse into the unquote
|#
(define-for-syntax (replace-revbayes-context unquote-stx ctx e)
  (cond
   [(and (syntax? e)
         (pair? (syntax-e e))
         (identifier? (car (syntax-e e)))
         (free-identifier=? (car (syntax-e e)) #'unquote))
    (datum->syntax e
                   (cons unquote-stx (cdr (syntax-e e)))
                   e
                   e)]
   [(syntax? e)
    (datum->syntax ctx
                   (replace-revbayes-context unquote-stx ctx (syntax-e e))
                   e
                   e)]
   [(pair? e) (cons (replace-revbayes-context unquote-stx ctx (car e))
                    (replace-revbayes-context unquote-stx ctx (cdr e)))]
   [(vector? e) (list->vector
                 (map (lambda (e) (replace-revbayes-context unquote-stx ctx e))
                      (vector->list e)))]
   [(box? e) (box (replace-revbayes-context unquote-stx ctx (unbox e)))]
   [(prefab-struct-key e)
    => (lambda (k)
         (apply make-prefab-struct
                k
                (replace-revbayes-context unquote-stx ctx (cdr (vector->list (struct->vector e))))))]
   [else e]))

(define-syntax (module-begin stx)
  (syntax-case stx ()
    [(_ req)
     #'(#%plain-module-begin
        (require req)
        
        (define-syntax (revbayes stx)
          (syntax-case stx ()
            [(_ expr)
             (replace-revbayes-context #'unrevbayes #'req #'expr)]))
        
        (define-syntax unrevbayes
          (syntax-rules ()
            [(_ expr)
             (constant->rb:constant expr)]))
        
        (provide revbayes))]))

(provide (rename-out [module-begin #%module-begin]))