;; sharable cat syntax + scheme snarfing

(module rpn mzscheme

  (require "rep.ss")

  (require-for-syntax "for-stx-utils.ss"
                      "list-utils.ss")

  ;; EXPRESSION SYNTAX

  ;; These macros implement the core structure of the CAT language.
  ;; They pass around the 'c' macro object which can be used to
  ;; custimize compilation behaviour.
  
  ;; This is the default 'c' object. Specialize/override this to
  ;; change language characteristics.
  
  (define-syntax rpn-compile
    (lambda (stx)

      ;; The syntax type dispatcher represents the fixed language
      ;; structure. Extensions can only be made for each of the cases:
      ;; constant, lexical, global and program. However, you are free to
      ;; override dispatch in the compile object, so this macro goes
      ;; unused.
    
      ;; To keep the language compositional, the special forms are limited
      ;; and implemented here. We only have 'quote', which is a necessary
      ;; evil.

      (define (_dispatch  c x e)
        (syntax-case x (quote)

          ;; special forms
          ((quote atom)
           #`(#,c #,c quote atom #,e))
          
          ;; quoted programs
          ((atoms ...)
           #`(#,c #,c program (atoms ...) #,e))
          
          ;; leaf nodes
          (atom
           (if (identifier? #'atom)
               (if (lexical-binding? #'atom)
                   #`(#,c #,c lexical atom #,e)
                   #`(#,c #,c global atom #,e))
               #`(#,c #,c constant atom #,e)))))

      


      ;; However, quote has special behaviour when the quoted expression
      ;; contains symbols with lexical bindings: then they will assume the
      ;; lexical values.
  
      (define (lex-uq stx)
        (syntax-case stx ()
          ((car . cdr) 
           #`(#,(lex-uq #'car) . #,(lex-uq #'cdr)))
          (atom
           (if (and (identifier? #'atom)
                    (eq? 'lexical
                         (identifier-binding #'atom)))
               #'(unquote atom)
               #'atom))))

      (define (_quote c x e)
        #`(#,c #,c
               constant
               (quasiquote #,(lex-uq x))
               #,e))

      ;; This is the generic compiler for quoted program expressions.
      ;; Quoted programs are treated as data after they are compiled to an
      ;; abstract representation using 'rpn-abstract'.

      (define (_program c lst e)
        #`(#,c #,c
               constant
               (rpn-abstract #,c #,lst)
               #,e))
      
      (syntax-case stx (dispatch program constant lexical global quote)

        ;; The complex expanders are factored in the code above.
        ((_ c dispatch  x e) (_dispatch #'c #'x #'e))
        ((_ c quote     x e) (_quote    #'c #'x #'e))
        ((_ c program   l e) (_program  #'c #'l #'e))

        ;; Constants are just copied onto the stack using 'cons'.
        ((_ c constant  x e) #`(cons x e))

        ;; Here we don't distinguish them. You probably want to
        ;; override the 'global' behaviour.
        ((_ c lexical   s e) #`(apply s e))
        ((_ c global    s e) #`(apply s e))

        
        )))


  


  ;; Moving down to the lower levels: the implementation of
  ;; 'rpn-abstract' which maps RPN code to some executable scheme
  ;; representation.

  ;; The underlying language is scheme, which is PN. We use intrinsic
  ;; reversal in 'fold' (left fold) to go from RPN->PN.

  (define-syntax (rpn-abstract stx)
    (syntax-case stx ()
      ((_ compile source)
       #`(make-word-compiled
          'source
          (lambda s
            #,(fold
               (lambda (stx expr)
                 #`(compile compile
                            dispatch
                            #,stx #,expr))
               #'s
               (syntax->list #'source)))))))
        
  

  ;; Done.

  ;; Now we have all the elements to build a language compiler using
  ;; just the 'compile' macro to specialize the behaviour of the
  ;; generic compiler above.

  (define-syntax rpn-transformer
    (syntax-rules ()
      ((_ name compile)
       (define-syntax name
         (syntax-rules ()
           ((_ source (... ...))
            (rpn-abstract compile
                          (source (... ...)))))))))

  ;; For testing only. This has no namespace attached.
  (rpn-transformer rpn: rpn-compile)

  ;; Exporting only minimal functionality.
  (provide
   rpn-transformer  ;; make a transformer based on word compiler
   rpn-compile)     ;; default word compiler
  ;; (provide (all-defined))
  
  
)