(define compile
  (lambda (& exp env embedded code)
     (if (number? exp)
         (compile-constant exp env embedded code)
         (if (named-object? exp) 
             (compile-variable exp env embedded code)
             (if (sequence? exp)
                 (compile-form exp env embedded code)
                 (error-in-compile-bad-expression))))))

(define compile-constant
  (lambda (& exp env embedded code)
     (append
        (& (& @const exp))
        (if (not embedded) (& (& @return)) code) )))

(define compile-variable
  (lambda (& exp env embedded code)
     (append 
        (& (& @var exp))
        (if (not embedded) (& (& @return)) code) )))


(set global-contour (&))


(define compile-form
  (lambda (& exp env embedded code)
    (let (& (& s (first exp)))
      (if (= s @lambda)
          (compile-lambda exp env embedded code)
          (if (= s @if)
              (compile-if exp env embedded code)
              (if (= s @apply)
                  (compile-application exp env embedded code)
                  (if (= s @scons)
                      (compile-rail (rest exp) env embedded code)
                      (error-unrecognized-form))))))))

(define compile-lambda
  (lambda (& exp env embedded code)
    (let (& (& pattern (second exp))
            (& body (third exp)))
      (let (& (& pattern-type
                 (if (named-object? pattern)
                     @no-spread
                     (length pattern)))
              (& variable-list
                 (if (named-object? pattern)
                     (& pattern)
                     pattern)))
         (let (& (& compiled-body 
                  (compile body 
                     env
                     $f
                     (&))))  
            (append (& (& @lambda
                          (& pattern-type pattern)
                          compiled-body))
                  (if (not embedded) (& (& @return)) code) ))))))

(define compile-if
  (lambda (& exp env embedded code)
    (let (& (& premise (second exp))
            (& consequent (third exp))
            (& alternate (fourth exp)))
       
       (compile premise env $t  
          (& (& @if
                (compile consequent env embedded code)
                (compile alternate env embedded code)))))))

(define compile-application
  (lambda (& exp env embedded code)
    (let (& (& proc (second exp))
            (& mark (third exp))
            (& args (rest (rest exp))))
       (compile proc env $t
          (append  
               (& (& @pcheck))
               (if (= mark @.)
                   (compile (second args) env $t
                      (if embedded 
                          (append (& (& @ocall)) code) 
                          (& (& @tail-ocall))))
                   (compile-tail args env $t
                      (if embedded 
                          (append 
                              (& (& @call (length args))) 
                              code) 
                          (& (& @tail-call (length args)))))
               ))))))

(define compile-tail
  (lambda (& exp env embedded code)
     (if (empty? exp)
         code
         (compile (first exp) env $t
            (compile-tail (rest exp) env $t code)))))

(define compile-rail
  (lambda (& exp env embedded code)
     (compile-tail exp env $t 
         (append
            (& (& @rcons (length exp)))   
            (if (not embedded) (& (& @return)) code) ))))


@eof