#lang scheme/base
(require
"../scat.ss"
(for-syntax
"../scat-tx.ss"
"parser-tx.ss"
syntax/stx
scheme/base))
(provide
define-words scat/:
(rename-out (module-begin #%module-begin))
(except-out (all-from-out scheme/base) #%module-begin)
(all-from-out "../scat.ss"))
(define-syntax-ns (scat) : :-tx)
(define-syntax (define-words stx)
(syntax-case stx ()
((_ . code)
#`(begin
#,@(map
(lambda (record)
(syntax-case record (forth)
((#f _ _ _)
#`(void))
((name forth srcloc rep)
#`(define-ns (scat) name rep))))
(with-scat-syntax
(lambda ()
(forth->records
#'forth #'void #'void
#'code))))))))
(define-syntax (module-begin stx)
(define (top form)
(datum->syntax stx form))
(syntax-case stx ()
((_ code ...)
#`(#%plain-module-begin
#,(top '(provide
(all-defined-out))) (define-words code ...)))))