Bad idea, removed optional defun?

svn: r6372

collects/web-server/prototype-web-server/lang.ss

@@ -6,24 +6,17 @@
                       "lang/elim-letrec.ss"
                       "lang/anormal.ss"
                       "lang/elim-callcc.ss"
-                      "lang/defun.ss"
-                      "lang/mark-lambda.ss")
+                      "lang/defun.ss")
   (require "lang-api.ss")
   (provide (rename lang-module-begin #%module-begin))
   (provide (all-from "lang-api.ss"))
   
-  ; XXX We could optimize this process by marking user-provided lambdas and only defunctionalizing those.
-  
   (define-syntax lang-module-begin 
     (make-lang-module-begin 
      make-labeling
      (make-module-case/new-defs
       (make-define-case/new-defs
        (compose #;(lambda (stx) (values stx empty))
-                #;(lambda (stx)
-                  (parameterize ([defun? marked-lambda?])
-                    (defun stx)))
                 defun
                 elim-callcc
-                (make-anormal-term elim-letrec-term)
-                #;mark-lambda))))))
+                (make-anormal-term elim-letrec-term)))))))

collects/web-server/prototype-web-server/lang/anormal.ss

@@ -28,7 +28,7 @@
   
   (define (make-anormal-term elim-letrec-term)
     (define (anormal-term stx)
-      (anormal id stx))  
+      (anormal id stx))
     
     (define (anormal ctxt stx)
       (recertify

collects/web-server/prototype-web-server/lang/defun.ss

@@ -6,15 +6,12 @@
            "util.ss"
            "freevars.ss"
            "../private/closure.ss")
-  (provide defun
-           defun?)
+  (provide defun)
   
   ; make-new-clouse-label : (syntax -> syntax) syntax -> syntax
   (define (make-new-closure-label labeling stx)
     (labeling stx))
   
-  (define defun? (make-parameter (lambda _ #t)))
-  
   ; defun : syntax[1] -> (values syntax?[2] (listof syntax?)[3])
   ; defunctionalizes the first syntax, returning the second and the lifted lambdas [3]
   (define (defun stx)  
@@ -64,35 +61,29 @@
          [(lambda formals be ...)
           (let-values ([(nbes be-defs) (defun* (syntax->list #'(be ...)))])
             (with-syntax ([(nbe ...) nbes])
-              (if ((defun?) stx)
-                  (let ([fvars (free-vars stx)])
-                    (let-values ([(make-CLOSURE new-defs)
-                                  (make-closure-definition-syntax 
-                                   (make-new-closure-label (current-code-labeling) stx)
-                                   fvars 
-                                   (syntax/loc stx (lambda formals nbe ...)))])
-                      (values (if (empty? fvars)
-                                  (quasisyntax/loc stx (#,make-CLOSURE))
-                                  (quasisyntax/loc stx (#,make-CLOSURE (lambda () (values #,@fvars)))))
-                              (append be-defs new-defs))))
-                  (values (quasisyntax/loc stx (lambda formals nbe ...))
-                          be-defs))))]
+              (let ([fvars (free-vars stx)])
+                (let-values ([(make-CLOSURE new-defs)
+                              (make-closure-definition-syntax 
+                               (make-new-closure-label (current-code-labeling) stx)
+                               fvars 
+                               (syntax/loc stx (lambda formals nbe ...)))])
+                  (values (if (empty? fvars)
+                              (quasisyntax/loc stx (#,make-CLOSURE))
+                              (quasisyntax/loc stx (#,make-CLOSURE (lambda () (values #,@fvars)))))
+                          (append be-defs new-defs))))))]
          [(case-lambda [formals be ...] ...)       
           (let-values ([(nbes be-defs) (defun** (syntax->list #'((be ...) ...)))])
             (with-syntax ([((nbe ...) ...) nbes])
-              (if ((defun?) stx)
-                  (let ([fvars (free-vars stx)])
-                    (let-values ([(make-CLOSURE new-defs)
-                                  (make-closure-definition-syntax 
-                                   (make-new-closure-label (current-code-labeling) stx)
-                                   fvars 
-                                   (syntax/loc stx (case-lambda [formals nbe ...] ...)))])
-                      (values (if (empty? fvars)
-                                  (quasisyntax/loc stx (#,make-CLOSURE))
-                                  (quasisyntax/loc stx (#,make-CLOSURE (lambda () (values #,@fvars)))))
-                              (append be-defs new-defs))))
-                  (values (quasisyntax/loc stx (case-lambda [formals nbe ...] ...))
-                          be-defs))))]
+              (let ([fvars (free-vars stx)])
+                (let-values ([(make-CLOSURE new-defs)
+                              (make-closure-definition-syntax 
+                               (make-new-closure-label (current-code-labeling) stx)
+                               fvars 
+                               (syntax/loc stx (case-lambda [formals nbe ...] ...)))])
+                  (values (if (empty? fvars)
+                              (quasisyntax/loc stx (#,make-CLOSURE))
+                              (quasisyntax/loc stx (#,make-CLOSURE (lambda () (values #,@fvars)))))
+                          (append be-defs new-defs))))))]
          [(if te ce ae)
           (let-values ([(es defs) (defun* (syntax->list #'(te ce ae)))])
             (values (quasisyntax/loc stx (if #,@es))

collects/web-server/prototype-web-server/private/web.ss

@@ -54,6 +54,7 @@
                      (session-url ses)
                      (session-mod-path ses)))))))
   
+  ; XXX Changing embedding to be a param
   (define embed-label 'superkont)  
   (define (embed-proc/url k-url proc)
     (define ses (current-session))