(module chambers mzscheme

;  (require-extension syntax-case)
;  (require-extension environments)
;  (use test)

  (define make-environment make-hash-table)
  (define (environment-ref env name)
    (hash-table-get env name))
  (define (environment-has-binding? env name)
    (hash-table-get env name (lambda () #f)))
  (define (environment-extend! env name thing)
    (hash-table-put! env name thing))
  
  

  (define-syntax compose-reverse-help
    (syntax-rules ()
      ((_ args f)
       (apply f args))
      ((_ args f g ...)
       (compose-reverse-help (apply f args) g ...))))

  ;; Compose backwards:
  ;; (compose-reverse f g) = (g (f ...))
  (define-syntax compose-reverse
    (syntax-rules ()
      ((_ f ...)
       (lambda args (compose-reverse-help args f ...)))))

  ;; An environment containing all the primitives that we've defined
  (define cat-primitives (make-environment))

  ;; A definition of the valid primitives
  (define (valid-primitive? prim)
    (environment-has-binding? cat-primitives prim))

  ;; Convert a single expression into a function
  
  ;; TODO: I'd like to convert this to syntax-case and put the
  ;; valid-primitive?  as the fender, but unfortunately the
  ;; environment stuff doesn't seem to be usable in macros
  (define-syntax cat-cmd
    (syntax-rules ()
      ((_ (x ...)) (lambda s (cons (cat-compile x ...) s)))
      ((_ x)
       (if (and (symbol? 'x) (valid-primitive? 'x))
           (environment-ref cat-primitives 'x)
           (lambda s (cons x s))))))

  ;; Convert into a cat-expression
  (define-syntax cat-compile
    (syntax-rules ()
      ((_ exps ...)
       (compose-reverse (cat-cmd exps) ...))))

  ;; Macro for defining a new cat-primitive.  Ideally I wouldn't have
  ;; to pass the env in, but that would violate hygiene, and I'm not
  ;; sure how to do that using syntax-rules.
  (define-syntax cat-prim
    (syntax-rules (=>)
      ;; This syntax is kind of the most general -- lets them specify
      ;; an arbitrary scheme vararg expression
      ((_ env prim definition)
       (environment-extend! env 'prim definition))
      ;; This syntax allows them to specify only the arguments they need
      ;; and automatically adds it to the front of the list, also binds
      ;; top to the value on top of the stack
      ((_ env prim (args ...) top => definition ...)
       (cat-prim env prim
                 (lambda (args ... . s)
                   (let ((top (car s)))
                     (append (reverse (list definition ...)) s)))))
      ;; This syntax allows them to specify only the arguments they need
      ;; and automatically adds it to the front of the list
      ((_ env prim (args ...) => definition ...)
       (cat-prim env prim
                 (lambda (args ... . s)
                   (append (reverse (list definition ...)) s))))))

  ;; A macro for defining a bunch of primitives
  (define-syntax cat-prims
    (syntax-rules ()
      ((_ env (prim ...) ...)
       (begin
         (cat-prim env prim ...) ...))))

  ;; Rename apply for running cat expressions
  (define run-cat apply)

  ;; Add the level-0 primitives
  (cat-prims cat-primitives
             (add_int (x y) => (+ x y))
             (swap    (x y) => x y)
             (dup     () x  =>  x)
             (apply   (lambda (proc . s) (run-cat proc s))))

  ;; Run cat expression on the empty list
  (define-syntax cat-main
    (syntax-rules ()
      ((_ exp ...)
       (run-cat (cat-compile exp ...) ()))))

;;   ;; Macro for defining test cases
;;   ;; usage: (cat-test (expected list) (cat expressions))
;;   (define-syntax cat-test
;;     (syntax-rules (=>)
;;       ((_ (cat ...) => (exp ...))
;;        (test (list exp ...) (cat-main cat ...)))))

;;   ;; Tests for each of the individual operations
;;   (cat-test (8 5) => (5 8))
;;   (cat-test (8 5 swap) => (8 5))
;;   (cat-test (8 dup) => (8 8))
;;   (cat-test (8 5 add_int) => (13))
;;   (cat-test ((8 5 add_int) apply) => (13))

  )