]> git.eshelyaron.com Git - emacs.git/commitdiff
move out comp-limplify-listn
authorAndrea Corallo <andrea_corallo@yahoo.it>
Mon, 8 Jul 2019 07:15:09 +0000 (09:15 +0200)
committerAndrea Corallo <akrl@sdf.org>
Wed, 1 Jan 2020 10:33:50 +0000 (11:33 +0100)
lisp/emacs-lisp/comp.el

index 8740779b8b3d01c873c5ffbb8df0dbf68a493800..e3594227e278bbf2181ac1d51df7c1b98598d73e 100644 (file)
@@ -168,47 +168,48 @@ VAL is known at compile time."
   "Pop N elements from the meta-stack."
   (cl-decf (comp-sp) n))
 
+(defun comp-limplify-listn (n)
+  (comp-pop 1)
+  (comp-push-call `(call Fcons ,(comp-slot-next) nil))
+  (dotimes (_ (1- n))
+    (comp-pop 2)
+    (comp-push-call `(call Fcons
+                           ,(comp-slot-next)
+                           ,(comp-slot-n (+ 2 (comp-sp)))))))
+
 (defun comp-limplify-lap-inst (inst)
   "Limplify LAP instruction INST in current frame accumulating in `comp-limple'
  for current `func'."
-  (cl-flet ((do-list (n)
-               (comp-pop 1)
-               (comp-push-call `(call Fcons ,(comp-slot-next) nil))
-               (dotimes (_ (1- n))
-                 (comp-pop 2)
-                 (comp-push-call `(call Fcons
-                                        ,(comp-slot-next)
-                                        ,(comp-slot-n (+ 2 (comp-sp))))))))
-    (let ((op (car inst)))
-      (pcase op
-        ('byte-dup
-         (comp-push-slot-n (comp-sp)))
-        ('byte-varref
-         (comp-push-call `(call Fsymbol_value ,(second inst))))
-        ('byte-constant
-         (comp-push-const (second inst)))
-        ('byte-stack-ref
-         (comp-push-slot-n (- (comp-sp) (cdr inst))))
-        ('byte-plus
-         (comp-pop 2)
-         (comp-push-call `(callref Fplus 2 ,(comp-sp))))
-        ('byte-car
-         (comp-pop 1)
-         (comp-push-call `(call Fcar ,(comp-sp))))
-        ('byte-cdr
-         (comp-pop 1)
-         (comp-push-call `(call Fcdr ,(comp-sp))))
-        ('byte-list1
-         (do-list 1))
-        ('byte-list2
-         (do-list 2))
-        ('byte-list3
-         (do-list 3))
-        ('byte-list4
-         (do-list 4))
-        ('byte-return
-         `(return ,(comp-slot)))
-        (_ (error "Unexpected LAP op %s" (symbol-name op)))))))
+  (let ((op (car inst)))
+    (pcase op
+      ('byte-dup
+       (comp-push-slot-n (comp-sp)))
+      ('byte-varref
+       (comp-push-call `(call Fsymbol_value ,(second inst))))
+      ('byte-constant
+       (comp-push-const (second inst)))
+      ('byte-stack-ref
+       (comp-push-slot-n (- (comp-sp) (cdr inst))))
+      ('byte-plus
+       (comp-pop 2)
+       (comp-push-call `(callref Fplus 2 ,(comp-sp))))
+      ('byte-car
+       (comp-pop 1)
+       (comp-push-call `(call Fcar ,(comp-sp))))
+      ('byte-cdr
+       (comp-pop 1)
+       (comp-push-call `(call Fcdr ,(comp-sp))))
+      ('byte-list1
+       (comp-limplify-listn 1))
+      ('byte-list2
+       (comp-limplify-listn 2))
+      ('byte-list3
+       (comp-limplify-listn 3))
+      ('byte-list4
+       (comp-limplify-listn 4))
+      ('byte-return
+       `(return ,(comp-slot)))
+      (_ (error "Unexpected LAP op %s" (symbol-name op))))))
 
 (defun comp-limplify (func)
   "Given FUNC and return LIMPLE."