anchor.diff:  (defparameter *builtin-suppression-mode* :default)
   
   (defun fastload-form (form)
  -  (when (and (listp form)
  -             (= (list-length form) 4)
  -             (eql (first form) (genesis-intern "FUNCALL"))
  -             (listp (second form))
  -             (= (list-length (second form)) 2)
  -             (eql (first (second form)) (genesis-intern "FUNCTION"))
  -             (listp (second (second form)))
  -             (= (list-length (second (second form))) 2)
  -             (eql (first (second (second form))) (genesis-intern "SETF"))
  -             (eql (second (second (second form))) (genesis-intern "FDEFINITION"))
  -             (listp (third form))
  -             (= (list-length (third form)) 2)
  -             (eql (first (third form)) (genesis-intern "FUNCTION"))
  -             (listp (second (third form)))
  -             (eql (first (second (third form))) (genesis-intern "LAMBDA"))
  -             (listp (third form))
  -             (= (list-length (fourth form)) 2)
  -             (eql (first (fourth form)) (genesis-intern "QUOTE")))
  -    ;; FORM looks like (FUNCALL #'(SETF FDEFINITION) #'(LAMBDA ...) 'name)
  -    ;; Check if there's an existing function or an existing preload.
  -    (let ((name (resolve-function-name (second (fourth form)))))
  -      (when (and (not (assoc name *function-preloads*))
  -                 (not (and (fboundp name)
  -                           (gethash (symbol-function name) *function-info*))))
  -        (push (cons name (make-genesis-function :source (second (third form))
  -                                                :source-environment nil
  -                                                :suppress-builtins *builtin-suppression-mode*))
  -              *function-preloads*)
  -        t))))
  +  (cond ((and (listp form)
  +              (= (list-length form) 4)
  +              (eql (first form) (genesis-intern "FUNCALL"))
  +              (listp (second form))
  +              (= (list-length (second form)) 2)
  +              (eql (first (second form)) (genesis-intern "FUNCTION"))
  +              (listp (second (second form)))
  +              (= (list-length (second (second form))) 2)
  +              (eql (first (second (second form))) (genesis-intern "SETF"))
  +              (eql (second (second (second form))) (genesis-intern "FDEFINITION"))
  +              (listp (third form))
  +              (= (list-length (third form)) 2)
  +              (eql (first (third form)) (genesis-intern "FUNCTION"))
  +              (listp (second (third form)))
  +              (eql (first (second (third form))) (genesis-intern "LAMBDA"))
  +              (listp (third form))
  +              (= (list-length (fourth form)) 2)
  +              (eql (first (fourth form)) (genesis-intern "QUOTE")))
  +         ;; FORM looks like (FUNCALL #'(SETF FDEFINITION) #'(LAMBDA ...) 'name)
  +         ;; Check if there's an existing function or an existing preload.
  +         (let ((name (resolve-function-name (second (fourth form)))))
  +           (when (and (not (assoc name *function-preloads*))
  +                      (not (and (fboundp name)
  +                                (gethash (symbol-function name) *function-info*))))
  +             ;; FIXME: macrolet and symbol-macrolet must be tracked.
  +             (push (cons name (make-genesis-function :source (second (third form))
  +                                                     :source-environment nil
  +                                                     :suppress-builtins *builtin-suppression-mode*))
  +                   *function-preloads*)
  +             t)))
  +        ((and (listp form)
  +              (>= (list-length form) 3)
  +              (eql (first form) (genesis-intern "DEFINE-LAP-FUNCTION"))
  +              (listp (third form))
  +              (= (list-length (third form)) 0))
  +         ;; FORM looks like (DEFINE-LAP-FUNCTION name (options) code...)
  +         (let ((name (resolve-function-name (second form))))
  +           (when (or (assoc name *function-preloads*)
  +                     (and (fboundp name)
  +                          (gethash (symbol-function name) *function-info*)))
  +             (error "TODO: define-lap-function ~S conflicts with existing function." (second form)))
  +           (push (cons name (make-genesis-function :source (list* (genesis-intern "LAMBDA-LAP")
  +                                                                  (list (second form))
  +                                                                  (cdddr form))
  +                                                   :source-environment nil
  +                                                   :lap-function t))
  +                 *function-preloads*)
  +           t))))
   
   (defun make-toplevel-function (&rest files)
     (let ((toplevel-forms '()))
  
positive.code: (in-package #:genesis)
  
  (defstruct genesis-function
    source
    source-environment
    (suppress-builtins :default)
  
negative.code: 		     nil)))
  	(t vector)))
  
  (defun assemble-lap (code &optional name)
    (multiple-value-bind (mc constants)
        (genesis-eval (list (genesis-eval (list (genesis-intern "INTERN") "ASSEMBLE" "SYS.LAP-X86"))
                            (list (genesis-intern "QUOTE") code)
                            (genesis-intern "BASE-ADDRESS" t) 12
                            (genesis-intern "INITIAL-SYMBOLS" t) (list (genesis-intern "QUOTE") *lap-symbols*)
                            (genesis-intern "INFO" t) (list (genesis-intern "QUOTE") (list name))))
      (values (strip-array-header mc) (strip-array-header constants))))
  
  (defun compile-genesis-function (object)
    (cond ((genesis-function-lap-function object)
           (multiple-value-bind (assembled-code constants)
               (assemble-lap (cddr (genesis-function-source object))
                             (first (second (genesis-function-source object))))
             (setf (genesis-function-lap-code object) (cddr (genesis-function-source object))
                   (genesis-function-assembled-code object) (strip-array-header assembled-code)
                   (genesis-function-constants object) (strip-array-header constants))))
          (t (progv (list (genesis-eval (list (genesis-intern "INTERN") "*SUPPRESS-BUILTINS*" "SYS.C")))
                 (list (cond ((eql (genesis-function-suppress-builtins object) :default)
                              (symbol-value (genesis-eval (list (genesis-intern "INTERN") "*SUPPRESS-BUILTINS*" "SYS.C"))))
                             (t (genesis-function-suppress-builtins object))))
               (let ((fn (genesis-eval (list (genesis-eval (list (genesis-intern "INTERN") "COMPILE-LAMBDA" "SYS.C"))
                                             (list (genesis-intern "QUOTE") (genesis-function-source object))
                                             (list (genesis-intern "QUOTE") (convert-environment (genesis-function-source-environment object)))))))
                 #+nil(let ((*print-circle* nil))
                        (format t "Asm: ~S~%" (genesis-function-lap-code fn)))
                 (setf (genesis-function-lap-code object) (genesis-function-lap-code fn)
                       (genesis-function-assembled-code object) (genesis-function-assembled-code fn)
                       (genesis-function-constants object) (genesis-function-constants fn))))))
    object)
  
  (defbuiltin #:assemble-lap (code &optional name)
    (multiple-value-bind (mc constants)
        (assemble-lap code name)
      (make-genesis-function :lap-code code
  			   :assembled-code (strip-array-header mc)
  			   :constants (strip-array-header constants))))
  