fixing indentation, enabling comments in emitted source

compiler/compiler.rkt

@@ -648,7 +648,6 @@
      (let ([evaluate-and-save-first-expression
             (let ([after-first-seq (make-label 'afterFirstSeqEvaluated)])
               (append-instruction-sequences
-               (make-Comment "begin0")
                ;; Evaluate the first expression in a multiple-value context, and get the values on the stack.
                (compile (first seq) cenv 'val next-linkage/keep-multiple-on-stack)
                
@@ -764,7 +763,6 @@
      (append-instruction-sequences
       ;; Make some temporary space for the lambdas
       
-      (make-Comment "scratch space for case-lambda")
       (make-PushEnvironment n #f)
       
       ;; Compile each of the lambdas
@@ -870,10 +868,18 @@
       singular-context-check))))
 
 
+
+;; We keep track of which lambda is currently being compiled for potential optimizations
+;; e.g. self tail calls.
+(: current-lambda-body-being-compiled (Parameterof (U #f Lam)))
+(define current-lambda-body-being-compiled (make-parameter #f))
+
+
 (: compile-lambda-body (Lam CompileTimeEnvironment -> InstructionSequence))
 ;; Compiles the body of the lambda in the appropriate environment.
 ;; Closures will target their value to the 'val register, and use return linkage.
 (define (compile-lambda-body exp cenv)
+  (parameterize ([current-lambda-body-being-compiled exp])
     (let: ([maybe-unsplice-rest-argument : InstructionSequence
                                          (if (Lam-rest? exp)
                                              (make-Perform 
@@ -885,7 +891,6 @@
            [maybe-install-closure-values : InstructionSequence
                                          (if (not (empty? (Lam-closure-map exp)))
                                              (append-instruction-sequences
-                                            (make-Comment (format "installing closure for ~s" (Lam-name exp)))
                                               (make-Perform (make-InstallClosureValues!
                                                              (length (Lam-closure-map exp)))))
                                              empty-instruction-sequence)]
@@ -897,9 +902,10 @@
       
       (append-instruction-sequences      
        (Lam-entry-label exp)
+       (Comment (format "lambda body for ~a" (Lam-name exp)))
        maybe-unsplice-rest-argument
        maybe-install-closure-values
-     lam-body-code)))
+       lam-body-code))))
 
 
 (: compile-case-lambda-body (CaseLam CompileTimeEnvironment -> InstructionSequence))
@@ -1058,7 +1064,6 @@
                                                'val))))])    
     (append-instruction-sequences
      
-     (make-Comment "scratch space for general application")
      (make-PushEnvironment (length (App-operands exp)) #f)
      proc-code
      (juggle-operands operand-codes)
@@ -1428,7 +1433,6 @@
                                'proc
                                next-linkage/expects-single)])    
       (append-instruction-sequences
-       (make-Comment "scratch space for statically known lambda application")
        (make-PushEnvironment (length (App-operands exp)) #f)
        (apply append-instruction-sequences operand-codes)
        proc-code
@@ -1784,7 +1788,6 @@
      linkage
      extended-cenv
      (append-instruction-sequences
-      (make-Comment "scratch space for let1")
       (make-PushEnvironment 1 #f)
       rhs-code
       body-code
@@ -1859,7 +1862,6 @@
      linkage
      extended-cenv
      (append-instruction-sequences 
-      (make-Comment "scratch space for let-void")
       (make-PushEnvironment n (LetVoid-boxes? exp))
       body-code
       after-body-code
@@ -1952,7 +1954,6 @@
              (map (lambda: ([lam : Lam]
                             [i : Natural])
                     (append-instruction-sequences
-                     (make-Comment (format "Installing shell for ~s\n" (Lam-name lam)))
                      (make-Perform (make-FixClosureShellMap! i 
                                                              (Lam-closure-map lam)))))
                   (LetRec-procs exp)
@@ -1968,7 +1969,6 @@
 (: compile-install-value (InstallValue CompileTimeEnvironment Target Linkage -> InstructionSequence))
 (define (compile-install-value exp cenv target linkage)
   (append-instruction-sequences
-   (make-Comment "install-value")
    (let ([count (InstallValue-count exp)])
      (cond [(= count 0)
             (end-with-linkage
@@ -1980,8 +1980,6 @@
                       (make-NextLinkage 0)))]
            [(= count 1)
             (append-instruction-sequences
-             (make-Comment (format "installing single value into ~s"
-                                   (InstallValue-depth exp)))
              (end-with-linkage
               linkage
               cenv
@@ -1994,7 +1992,6 @@
              linkage
              cenv
              (append-instruction-sequences
-              (make-Comment "install-value: evaluating values")
               (compile (InstallValue-body exp)
                        cenv
                        'val
@@ -2003,7 +2000,6 @@
                      (map (lambda: ([to : EnvLexicalReference]
                                     [from : OpArg])
                             (append-instruction-sequences
-                             (make-Comment "install-value: installing value")
                              (make-AssignImmediate to from)))
                           (build-list count (lambda: ([i : Natural])
                                               (make-EnvLexicalReference (+ i 

compiler/optimize-il.rkt

@@ -193,8 +193,8 @@
           ]
 
          [(Comment? a-stmt)
-          (loop (rest stmts))
+          ;(loop (rest stmts))
-          ;(cons a-stmt (loop (rest stmts)))
+          (cons a-stmt (loop (rest stmts)))
           ]
          
          [(AssignImmediate? a-stmt)
@@ -386,7 +386,7 @@
     [(PopControlFrame? stmt)
      #f]
     [(Comment? stmt)
-     #t]))
+     #f]))
 
 
 

js-assembler/assemble.rkt

@@ -13,8 +13,7 @@
          "../sets.rkt"
          "../helpers.rkt"
          racket/string
-         racket/list
+         racket/list)
-         racket/match)
 (require/typed "../logger.rkt"
                [log-debug (String -> Void)])
 
@@ -26,7 +25,7 @@
 
 
 ;; Parameter that controls the generation of a trace.
-(define current-emit-debug-trace? (make-parameter #f))
+(define emit-debug-trace? #f)
 
 
 
@@ -635,10 +634,9 @@ EOF
                                                          blockht)])])
                  val-string))]
       [(Comment? stmt)
-      ;; TODO: maybe comments should be emitted as JavaScript comments.
+       (format "//~s\n" (Comment-val stmt))]))
-      ""]))
   (cond
-   #;[(current-emit-debug-trace?)
+    [emit-debug-trace?
      (string-append 
       (format "if(window.console!==void(0)&&typeof(window.console.log)==='function'){window.console.log(~s);\n}"
               (format "~a" stmt))

version.rkt

@@ -7,4 +7,4 @@
 (provide version)
 (: version String)
 
-(define version "1.195")
+(define version "1.198")