;; Pprimitive snarfing. These macros are syntax only: they do not
;; depend on ns.ss

(module rpn-snarf mzscheme

  (require "rep.ss")
  (require-for-syntax "tx-utils.ss")

  (provide as-push as-void     ;; wrap scheme function -> rpn primitive
           pn-lambda-annotate  ;; lambda with specified annotation
           make-scheme-word    ;; annotate with expression
           )


  (define-syntax make-scheme-word
    (syntax-rules ()
      ((_ code)
       (make-word 'scheme:
                  'code
                  code))))
  
  ;; To steal behaviour from scheme, we need to know the number of
  ;; arguments and the way the arguments are re-arrange, and what to
  ;; do with the return value(s).

  (define-syntax scheme->cat/perm
    (syntax-rules ()
      
      ((_ combine fn (dsta ...) (srca ...))
       (make-scheme-word
        (lambda (dsta ... . stack)
          (combine (fn srca ...) stack))))))

  ;; Usually, just reversing the argument list is enough: this
  ;; preserves the argument ordering when converting PN -> RPN.
  
  (define-syntax scheme->cat/rev
    (lambda (stx)
      (syntax-case stx ()
        ((_ combine fn args ...)
         #`(scheme->cat/perm combine fn
                             #,(reverse-stx #'(args ...))  ;; reversed
                             (args ...))))))

  (define-syntax as-push
    (syntax-rules ()
      ((_ fn args ...) (scheme->cat/rev cons fn args ...))))

  (define-syntax as-void
    (syntax-rules ()
      ((_ fn args ...) (scheme->cat/rev begin fn args ...))))


  ;; Like scheme's lambda, but with specified annotation. This is
  ;; useful for temporary words that have no source representation.
  
  (define-syntax pn-lambda-annotate
    (syntax-rules ()
      ((_ annotation formals body ...)
       (make-word 'abstract:
                  annotation
                  (lambda formals body ...)))))
        
        


  
  )