#lang scheme/base
(provide
(all-defined-out))
(require
syntax/stx
"rpn-tx.ss"
"ns-tx.ss"
(for-template
"rep.ss"
"stack.ss"
scheme/base))
(define (scat-immediate im e) #`(stack-cons #,im #,e))
(define (scat-function fn e) #`(#,fn #,e))
(define (scat-lambda body)
#`(make-word
#,(rpn-default-lambda body)))
(define (scat-map-identifier id)
(ns-prefixed #'(scat) id))
(define (with-scat-syntax thunk)
(parameterize
((rpn-immediate scat-immediate)
(rpn-function scat-function)
(rpn-lambda scat-lambda)
(rpn-map-identifier scat-map-identifier)
(rpn-context with-scat-syntax))
(thunk)))
(define (scat:-tx stx)
(syntax-case stx ()
((_ . code)
(with-scat-syntax
(lambda () (rpn-compile #'code))))))