(define-library (csc macros)
  (export
    expand
    test-environment)
  (import (scheme base)
          (only (csc gensym) gensym)
          (only (csc hash-map)
            alist->map
            hash-bytevector
            insert
            key-not-found-error?
            lookup)
          (only (csc ir1)
            make-call
            make-constant
            make-lambda
            make-lambda-case)
          (only (csc list) revappend)
          (only (csc match) match))
  (begin


    (define-record-type <macro-transformer>
      (make-macro-transformer transformer)
      macro-transformer?
      (transformer transformer-function))


    (define-record-type <macro-syntax-error>
      (make-macro-syntax-error message irritants)
      macro-syntax-error?
      (message syntax-error-object-message)
      (irritants syntax-error-object-irritants))


    (define (raise-syntax-error message . irritants)
      (raise (make-macro-syntax-error message irritants)))


    ; symbols is a map with symbols as keys, and the values can be one of:
    ; - <lexical-ref>,
    ; - <module-ref>,
    ; - or <macro-transformer>.
    ; The first two correspond to variables bound lexically or from a module,
    ; and the third represents a macro transformer bound in the
    ; current context.
    ;
    ; library is the current library name being compiled. A nil library
    ; corresponds to top level expressions.
    (define-record-type <environment>
      (make-environment symbols library)
      environment?
      (symbols environment-symbols)
      (library environment-library))


    (define (with-binding environment symbol binding)
      (make-environment (insert (environment-symbols environment) symbol binding) (environment-library environment)))


    (define (expand-procedure-call procedure arguments environment)
      (let*-values (((expanded-procedure environment) (expand procedure environment))
                    ((expanded-arguments environment)
                     (let loop ((arguments arguments)
                                (environment environment)
                                (expanded-arguments '()))
                       (match arguments
                         ('() (values (reverse expanded-arguments) environment))
                         ((argument . rest)
                          (let-values (((expanded-argument environment) (expand argument environment)))
                            (loop
                              rest
                              environment
                              (cons expanded-argument expanded-arguments))))
                         (_ (raise-syntax-error "arguments to a procedure call must be a list" procedure arguments))))))
        (make-call expanded-procedure expanded-arguments)))


    ; expand can be thought of as a compiler from Scheme to IR1. Macros
    ; included in the environment can be used to extend the syntax. Returns an
    ; IR1 expression and an environment which has been modified with any new
    ; bindings introduced by the expression.
    (define (expand expression environment)
      (cond
        ((null? expression) (raise-syntax-error "nil by itself is an error (did you mean to use quote?)" expression))
        ((and (pair? expression)
              (symbol? (car expression)))
         (let* ((macro-name (car expression))
                (macro-body
                  (guard (e ((key-not-found-error? e) (raise-syntax-error "undefined symbol" macro-name)))
                    (lookup (environment-symbols environment) macro-name))))
           (if (macro-transformer? macro-body)
             ((transformer-function macro-body) expression environment)
             (expand-procedure-call macro-name (cdr expression) environment))))
        ((pair? expression)
         (let ((procedure (car expression))
               (arguments (cdr expression)))
           (expand-procedure-call procedure arguments environment)))
        ((symbol? expression)
         (let ((binding
                 (guard (e ((key-not-found-error? e) (raise-syntax-error "undefined symbol" expression)))
                   (lookup (environment-symbols environment) expression))))
           (if (macro-transformer? binding)
             (raise-syntax-error "macro is not allowed in this context" expression)
             (values binding environment))))
        ((or (boolean? expression)
             (bytevector? expression)
             (char? expression)
             (number? expression)
             (string? expression)
             (vector? expression))
         (values (make-constant expression) environment))
        (else (raise-syntax-error "unexpected expression type" expression))))


    (define builtin-quote
      (make-macro-transformer
        (lambda (expression environment)
          (match expression
            ((_ datum) (values (make-constant datum) environment))
            (_ (raise-syntax-error "invalid form for quote" expression))))))


    (define builtin-lambda
      (make-macro-transformer
        (lambda (expression environment)
          (match expression
            ((_ formals body)
             (let loop ((formals formals)
                        (environment environment)
                        (argument-names '())
                        (gensyms '()))
               (match formals
                 ('()
                  (make-lambda
                    (make-lambda-case
                      (reverse argument-names)
                      #f
                      (reverse gensyms)
                      (expand body environment)
                      #f)))
                 ((variable . variables) (when (symbol? variable))
                  (let ((sym (gensym)))
                    (loop
                      variables
                      (with-binding environment variable sym)
                      (cons variable argument-names)
                      (cons sym gensyms))))
                 (variable (when (symbol? variable))
                   (let ((sym (gensym)))
                     (make-lambda
                       (make-lambda-case
                         (reverse argument-names)
                         variable
                         (revappend gensyms (list sym))
                         (expand body (with-binding environment variable sym))
                         #f))))
                 (_ (raise-syntax-error "invalid form for lambda arguments" expression)))))
            (_ (raise-syntax-error "invalid form for lambda" expression))))))


    #;(define builtin-syntax-rules
      (make-macro-transformer
        (lambda (expression environment)
          (match expression))))


    (define (hash-symbol s)
      (hash-bytevector (string->utf8 (symbol->string s))))


    (define (symbol<? s1 s2)
      (string<? (symbol->string s1) (symbol->string s2)))


    (define test-environment
      (make-environment
        (alist->map
          hash-symbol
          symbol<?
          (list
            (cons 'quote builtin-quote)
            (cons 'lambda builtin-lambda)))
        '()))))