Convert multi-LETREC to internal definitions.
authorTaylor R Campbell <campbell@mumble.net>
Sun, 10 Feb 2019 22:25:12 +0000 (22:25 +0000)
committerTaylor R Campbell <campbell@mumble.net>
Sun, 10 Feb 2019 22:25:12 +0000 (22:25 +0000)
The compressor turns up hot in profiles.  This doesn't make a big
difference but it saves some closure consing and reduces some
indentation levels.

src/runtime/cpress.scm

index 4fce40335bbbd6c545c1e514d91ccd8d58e454f1..9d815961c6e511d3fb6f7498ace8e17ddbd222e1 100644 (file)
@@ -144,50 +144,47 @@ USA.
 
 (define (generate-literal state)
   (guarantee-buffer-space state (fix:+ literal-max 2))
-  (letrec
-      ((loop
-       (lambda (nb)
-         (let ((node (match-first state)))
+  (define (loop nb)
+    (let ((node (match-first state)))
+      (if (not node)
+         (continue nb)
+         (let ((node (match-next state node 1)))
            (if (not node)
                (continue nb)
-               (let ((node (match-next state node 1)))
+               (let ((node (match-next state node 2)))
                  (if (not node)
-                     (continue nb)
-                     (let ((node (match-next state node 2)))
-                       (if (not node)
+                     (begin
+                       (unread-byte state)
+                       (continue nb))
+                     (let ((nb*
+                            (let ((cbp (current-bp state))
+                                  (nbp (node-bp node)))
+                              (fix:- (if (fix:< cbp nbp)
+                                         (fix:+ cbp buffer-size)
+                                         cbp)
+                                     nbp))))
+                       (if (fix:< nb* 3)
+                           ;; Don't consider matches that
+                           ;; would result in a copy that is
+                           ;; copying from itself.
                            (begin
-                             (unread-byte state)
+                             (unread-bytes state 2)
                              (continue nb))
-                           (let ((nb*
-                                  (let ((cbp (current-bp state))
-                                        (nbp (node-bp node)))
-                                    (fix:- (if (fix:< cbp nbp)
-                                               (fix:+ cbp buffer-size)
-                                               cbp)
-                                           nbp))))
-                             (if (fix:< nb* 3)
-                                 ;; Don't consider matches that
-                                 ;; would result in a copy that is
-                                 ;; copying from itself.
-                                 (begin
-                                   (unread-bytes state 2)
-                                   (continue nb))
-                                 (begin
-                                   (write-literal state nb)
-                                   (generate-copy state node 3))))))))))))
-       (continue
-       (lambda (nb)
-         (increment-current-pointer state)
-         (increment-bp state)
-         (let ((nb (fix:+ nb 1)))
-           (if (fix:< nb literal-max)
-               (loop nb)
-               (begin
-                 (write-literal state nb)
-                 (idle state)))))))
+                           (begin
+                             (write-literal state nb)
+                             (generate-copy state node 3)))))))))))
+  (define (continue nb)
     (increment-current-pointer state)
     (increment-bp state)
-    (loop 1)))
+    (let ((nb (fix:+ nb 1)))
+      (if (fix:< nb literal-max)
+         (loop nb)
+         (begin
+           (write-literal state nb)
+           (idle state)))))
+  (increment-current-pointer state)
+  (increment-bp state)
+  (loop 1))
 \f
 (define (generate-copy state node nb)
   (guarantee-buffer-space state copy-max)