correcting a soundness bug: I need to explicitly mark the lambdas so we can properly annotate the functions.

whalesong/compiler/compiler.rkt

@@ -844,6 +844,7 @@
       
       (append-instruction-sequences      
        (Lam-entry-label exp)
+       (make-MarkEntryPoint (Lam-entry-label exp))
        (Comment (format "lambda body for ~a" (Lam-name exp)))
        maybe-unsplice-rest-argument
        maybe-install-closure-values

whalesong/compiler/il-structs.rkt

@@ -167,6 +167,7 @@
 (define-type StraightLineStatement (U
                                     DebugPrint
                                     Comment
+                                    MarkEntryPoint
                                     
                                     AssignImmediate
                                     AssignPrimOp
@@ -293,6 +294,11 @@
   #:transparent)
 
 
+;; Marks the head of every lambda.
+(define-struct: MarkEntryPoint ([label : Symbol])
+  #:transparent)
+
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Primitive Operators

whalesong/compiler/optimize-il.rkt

@@ -196,6 +196,9 @@
           ;(loop (rest stmts))
           (cons a-stmt (loop (rest stmts)))
           ]
+
+         [(MarkEntryPoint? a-stmt)
+          (cons a-stmt (loop (rest stmts)))]
          
          [(AssignImmediate? a-stmt)
           (cons (make-AssignImmediate (rewrite-target (AssignImmediate-target a-stmt))
@@ -347,6 +350,9 @@
      #f
      #;#t]
     
+    [(MarkEntryPoint? stmt)
+     #f]
+    
     [(AssignImmediate? stmt)
      (equal? (AssignImmediate-target stmt)
              (AssignImmediate-value stmt))]

whalesong/js-assembler/assemble.rkt

@@ -170,6 +170,8 @@ EOF
           (next)]
          [(DebugPrint? stmt)
           (next)]
+         [(MarkEntryPoint? stmt)
+          (next)]
          [(AssignImmediate? stmt)
           (next)]
          [(AssignPrimOp? stmt)
@@ -293,6 +295,9 @@ EOF
         [else
          (define stmt (first stmts))
          (cond
+           [(MarkEntryPoint? stmt)
+            (default stmt)]
+           
            [(DebugPrint? stmt)
             (default stmt)]
            
@@ -430,6 +435,9 @@ EOF
           [else
            (define stmt (first stmts))
            (cond
+             [(MarkEntryPoint? stmt)
+              (default)]
+             
              [(DebugPrint? stmt)
               (default)]
              
@@ -496,6 +504,10 @@ EOF
 (define (assemble-statement stmt blockht)
   (define assembled
     (cond
+      [(MarkEntryPoint? stmt)
+       ;; Marking the entry point to the lambda should have no other effect.
+       ""]
+
       [(DebugPrint? stmt)
        (format "M.params.currentOutputPort.writeDomNode(M, $('<span/>').text(~a));"
                (assemble-oparg (DebugPrint-value stmt)
@@ -667,6 +679,9 @@ EOF
     [else
      (define first-stmt (first stmts))
      (cond
+       [(MarkEntryPoint? first-stmt)
+        (cons (MarkEntryPoint-label first-stmt)
+              (get-function-entry-and-exit-names (rest stmts)))]
        [(LinkedLabel? first-stmt)
         (cons (LinkedLabel-label first-stmt)
               (cons (LinkedLabel-linked-to first-stmt)

whalesong/js-assembler/collect-jump-targets.rkt

@@ -25,6 +25,8 @@
              (LinkedLabel-linked-to stmt))]
       [(DebugPrint? stmt)
        empty]
+      [(MarkEntryPoint? stmt)
+       (list (MarkEntryPoint-label stmt))]
       [(AssignImmediate? stmt)
        (let: ([v : OpArg (AssignImmediate-value stmt)])
          (collect-input v))]
@@ -172,6 +174,8 @@
       [(LinkedLabel? stmt)
        (list (LinkedLabel-label stmt)
              (LinkedLabel-linked-to stmt))]
+      [(MarkEntryPoint? stmt)
+       (list (MarkEntryPoint-label stmt))]
       [(DebugPrint? stmt)
        empty]
       [(AssignImmediate? stmt)

whalesong/repl-prototype/server.rkt

@@ -78,7 +78,7 @@
                     (define assembled-op (open-output-string))
                     (define assembled (assemble/write-invoke compiled-bytecode #f assembled-op))
                     (cons (get-output-string assembled-op) (loop))])))
-         #;(printf "assembled codes ~a\n" assembled-codes)
+         (printf "assembled codes ~a\n" assembled-codes)
          (write-json (hash 'compiledCodes assembled-codes)
                      op)]
         [else