some code cleanup

compiler/compiler.rkt

@@ -10,7 +10,6 @@
          "analyzer-structs.rkt"
          "../parameters.rkt"
          "../sets.rkt"
-         racket/bool
          racket/list
          racket/match)
 
@@ -42,18 +41,17 @@
 ;; Note: the toplevel generates the lambda body streams at the head, and then the
 ;; rest of the instruction stream.
 (define (-compile exp target linkage)
-  (let* ([after-lam-bodies (make-label 'afterLamBodies)]
+  (define lambda-bodies (collect-all-lambdas-with-bodies exp))
-         [before-pop-prompt-multiple (make-label 'beforePopPromptMultiple)]
+  (define after-lam-bodies (make-label 'afterLamBodies))
-         [before-pop-prompt (make-LinkedLabel
+  (define-values (before-pop-prompt-multiple before-pop-prompt)
-                             (make-label 'beforePopPrompt)
+    (new-linked-labels 'beforePopPrompt))
-                             before-pop-prompt-multiple)])
   (optimize-il
    (statements
     (append-instruction-sequences 
      
      ;; Layout the lambda bodies...
      (make-Goto (make-Label after-lam-bodies))
-       (compile-lambda-bodies (collect-all-lambdas-with-bodies exp))
+     (compile-lambda-bodies lambda-bodies)
      after-lam-bodies
      
      ;; Begin a prompted evaluation:
@@ -66,7 +64,7 @@
      before-pop-prompt
      (if (eq? target 'val)
          empty-instruction-sequence
-           (make-AssignImmediate target (make-Reg 'val))))))))
+         (make-AssignImmediate target (make-Reg 'val)))))))
 
 
 
@@ -518,10 +516,8 @@
     [(kernel-module-name? a-module-name)
      empty-instruction-sequence]
     [else
-     (let* ([linked (make-label 'linked)]
+     (define linked (make-label 'linked))
-            [on-return-multiple (make-label 'onReturnMultiple)]
+     (define-values (on-return-multiple on-return) (new-linked-labels 'onReturn))
-            [on-return (make-LinkedLabel (make-label 'onReturn)
-                                         on-return-multiple)])
      (append-instruction-sequences
       (make-TestAndJump (make-TestTrue (make-ModulePredicate a-module-name 'linked?))
                         linked)
@@ -541,7 +537,7 @@
       (make-PopEnvironment (new-SubtractArg (make-Reg 'argcount)
                                             (make-Const 1))
                            (make-Const 0))
-        on-return))]))
+      on-return)]))
 
 
 
@@ -752,9 +748,8 @@
   (cond [(empty? seq)
          (end-with-linkage linkage cenv empty-instruction-sequence)]
         [(empty? (rest seq))
-         (let* ([on-return/multiple (make-label 'beforePromptPopMultiple)]
+         (define-values (on-return/multiple on-return)
-                [on-return (make-LinkedLabel (make-label 'beforePromptPop)
+           (new-linked-labels 'beforePromptPop))
-                                             on-return/multiple)])
          (end-with-linkage 
           linkage
           cenv
@@ -765,11 +760,10 @@
            (emit-values-context-check-on-procedure-return (linkage-context linkage)
                                                           on-return/multiple
                                                           on-return)
-             (make-AssignImmediate target (make-Reg 'val)))))]
+           (make-AssignImmediate target (make-Reg 'val))))]
         [else
-         (let* ([on-return/multiple (make-label 'beforePromptPopMultiple)]
+         (define-values (on-return/multiple on-return)
-                [on-return (make-LinkedLabel (make-label 'beforePromptPop)
+           (new-linked-labels 'beforePromptPop))
-                                             on-return/multiple)])
          (append-instruction-sequences 
           (make-PushControlFrame/Prompt (make-DefaultContinuationPromptTag)
                                         on-return)
@@ -780,7 +774,7 @@
                                                 (make-Const 1))
                                (make-Const 0))
           on-return
-            (compile-splice (rest seq) cenv target linkage)))]))
+          (compile-splice (rest seq) cenv target linkage))]))
 
 
 (: compile-begin0 ((Listof Expression) CompileTimeEnvironment Target Linkage -> InstructionSequence))
@@ -1767,33 +1761,30 @@
 ;;    2.  Non-tail calls (next/label linkage) that write to val
 ;;    3.  Calls in argument position (next/label linkage) that write to the stack.
 (define (compile-compiled-procedure-application cenv number-of-arguments entry-point target linkage)
-  (let* ([entry-point-target
+  (define entry-point-target
     ;; Optimization: if the entry-point is known to be a static label,
     ;; use that.  Otherwise, grab the entry point from the proc register.
     (cond [(Label? entry-point)
            entry-point]
           [(eq? entry-point 'dynamic)
-                 (make-CompiledProcedureEntry (make-Reg 'proc))])]
+           (make-CompiledProcedureEntry (make-Reg 'proc))]))
   
   ;; If the target isn't val, migrate the value from val into it.
-         [maybe-migrate-val-to-target
+  (define maybe-migrate-val-to-target
     (cond
       [(eq? target 'val)
        empty-instruction-sequence]
       [else
-             (make-AssignImmediate target (make-Reg 'val))])]
+       (make-AssignImmediate target (make-Reg 'val))]))
   
-         [on-return/multiple (make-label 'procReturnMultiple)]
+  (define-values (on-return/multiple on-return) (new-linked-labels 'procReturn))
-         
-         [on-return (make-LinkedLabel (make-label 'procReturn)
-                                      on-return/multiple)]
   
   ;; This code does the initial jump into the procedure.  Clients of this code
   ;; are expected to generate the proc-return-multiple and proc-return code afterwards.
-         [nontail-jump-into-procedure
+  (define nontail-jump-into-procedure
     (append-instruction-sequences 
      (make-PushControlFrame/Call on-return)
-           (make-Goto entry-point-target))])
+     (make-Goto entry-point-target)))
   
   (cond [(ReturnLinkage? linkage)
          (cond
@@ -1836,7 +1827,7 @@
             nontail-jump-into-procedure
             check-values-context-on-procedure-return
             maybe-migrate-val-to-target
-              maybe-jump-to-label))])))
+            maybe-jump-to-label))]))
 
 
 
@@ -2228,18 +2219,18 @@
   
   (: in-other-context ((U NextLinkage LabelLinkage) -> InstructionSequence))
   (define (in-other-context linkage)
-    (let* ([on-return/multiple: (make-label 'procReturnMultiple)]          
+    (define-values (on-return/multiple: on-return:)
-           [on-return: (make-LinkedLabel (make-label 'procReturn) on-return/multiple:)]
+      (new-linked-labels 'procReturn))
-           [context (linkage-context linkage)]
+    (define context (linkage-context linkage))
-           [check-values-context-on-procedure-return
+    (define check-values-context-on-procedure-return
       (emit-values-context-check-on-procedure-return
-             context on-return/multiple: on-return:)]
+       context on-return/multiple: on-return:))
-           [maybe-migrate-val-to-target
+    (define maybe-migrate-val-to-target
       (cond
         [(eq? target 'val)
          empty-instruction-sequence]
         [else
-               (make-AssignImmediate target (make-Reg 'val))])])
+         (make-AssignImmediate target (make-Reg 'val))]))
     (append-instruction-sequences
      (make-PushControlFrame/Call on-return:)
      (compile (WithContMark-key exp) cenv 'val next-linkage/expects-single)
@@ -2249,7 +2240,7 @@
      (make-Perform (make-InstallContinuationMarkEntry!))
      (compile (WithContMark-body exp) cenv 'val return-linkage/nontail)
      check-values-context-on-procedure-return
-       maybe-migrate-val-to-target)))
+     maybe-migrate-val-to-target))
   (cond
     [(ReturnLinkage? linkage)
      (in-return-context)]

compiler/il-structs.rkt

@@ -206,6 +206,18 @@
   #:transparent)
 
 
+;; Returns a pair of labels, the first being the mutiple-value-return
+;; label and the second its complementary single-value-return label.
+(: new-linked-labels (Symbol -> (Values Symbol LinkedLabel)))
+(define (new-linked-labels sym)
+  (define a-label-multiple (make-label (string->symbol (format "~aMultiple" sym))))
+  (define a-label (make-LinkedLabel (make-label sym) a-label-multiple))
+  (values a-label-multiple a-label))
+
+
+
+
+
 ;; FIXME: it would be nice if I can reduce AssignImmediate and
 ;; AssignPrimOp into a single Assign statement, but I run into major
 ;; issues with Typed Racket taking minutes to compile.  So we're

version.rkt

@@ -7,4 +7,4 @@
 (provide version)
 (: version String)
 
-(define version "1.228")
+(define version "1.229")