add discard aref aset

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 1094acf1ea32caf8cd4dbe5831f74f4ff8e7502d..712cade38296d118957ac7424e5ee65c31b7532e 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -198,12 +198,14 @@ To be used when ncall-conv is nil.")
   (push x comp-limple))
 
 (defun comp-emit-set-call (call)
-  "Emit CALL assigning the result the the current slot frame.."
+  "Emit CALL assigning the result the the current slot frame.
+If the calle function is known to have a return type propagate it."
   (cl-assert call)
   (setf (comp-slot)
         (make-comp-mvar :slot (comp-sp)
-                        :type (alist-get (cadr call)
-                                         comp-known-ret-types)))
+                        :type (when (> comp-speed 0)
+                                (alist-get (cadr call)
+                                           comp-known-ret-types))))
   (comp-emit (list 'set (comp-slot) call)))
 
 (defun comp-push-call (call)
@@ -262,6 +264,8 @@ VAL is known at compile time."
   "Limplify LAP instruction INST accumulating in `comp-limple'."
   (let ((op (car inst)))
     (pcase op
+      ('byte-discard
+       (comp-pop 1))
       ('byte-dup
        (comp-push-slot-n (comp-sp)))
       ('byte-varref
@@ -281,6 +285,17 @@ VAL is known at compile time."
       ('byte-plus
        (comp-pop 1)
        (comp-emit-set-call `(callref Fplus 2 ,(comp-sp))))
+      ('byte-aref
+       (comp-pop 1)
+       (comp-emit-set-call `(call Faref
+                                  ,(comp-slot)
+                                  ,(comp-slot-next))))
+      ('byte-aset
+       (comp-pop 2)
+       (comp-emit-set-call `(call Faset
+                                  ,(comp-slot)
+                                  ,(comp-slot-next)
+                                  ,(comp-slot-n (+ 2 (comp-sp))))))
       ('byte-cons
        (comp-pop 1)
        (comp-emit-set-call `(call Fcons ,(comp-slot) ,(comp-slot-next))))

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 64edddf4c0422ff6ba9d45f9fe9912bd28142460..00bb2e09321df4764c611ca08598821b893a5ddd 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -113,15 +113,15 @@
 
   (should (= (comp-tests-length-f) 3)))
 
-;; (ert-deftest  comp-tests-aref-aset ()
-;;   "Testing aref and aset."
-;;   (defun comp-tests-aref-aset-f ()
-;;     (let ((vec [1 2 3]))
-;;       (aset vec 2 100)
-;;       (aref vec 2)))
-;;   (native-compile #'comp-tests-aref-aset-f)
-
-;;   (should (= (comp-tests-aref-aset-f) 100)))
+(ert-deftest  comp-tests-aref-aset ()
+  "Testing aref and aset."
+  (defun comp-tests-aref-aset-f ()
+    (let ((vec [1 2 3]))
+      (aset vec 2 100)
+      (aref vec 2)))
+  (native-compile #'comp-tests-aref-aset-f)
+
+  (should (= (comp-tests-aref-aset-f) 100)))
 
 ;; (ert-deftest  comp-tests-symbol-value ()
 ;;   "Testing aref and aset."