#lang scheme/base

(require
 "../target.ss"
 "../scat.ss"
 (for-syntax
  "../tools-tx.ss"
  "../scat-tx.ss"
  "../forth-tx.ss"
  scheme/base))

(provide (all-defined-out))

;; The 'derived: language will perform translation of derived Forth
;; constructs in terms of the 'macro: language.


(define (derived-interpret fn e)
  (cond
   ((procedure? fn) (fn e))
   ((derived-word? fn) ((scat: ',(derived-word-address fn) texec/w) e))
   (else (error 'derived-interpret))))

(define-syntax (derived: stx)
  (define (immediate im e) #`((macro: #,im hilo) #,e))
  (define (function fn e)  #`(#,fn #,e))
  (define (map-id id) (ns-prefixed #'(derived) id))

  (with-scat-syntax
   (lambda ()
     (parameterize
         ((rpn-map-identifier map-id)
          (rpn-immediate      immediate)
          (rpn-function       function)
          (rpn-lambda         scat-lambda)
          (rpn-context        with-scat-syntax)) ;; FIXME
       (rpn-compile (stx-cdr stx))))))

(define-syntax (derived-compile stx)
  (syntax-case stx ()
    ((_ str) #`(forth-begin #,@(string->forth-syntax #'str)))))