From 2e20dca7a090b3821e78451f83930b689f5499c7 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <andrea_corallo@yahoo.it>
Date: Sat, 13 Jul 2019 17:08:15 +0200
Subject: [PATCH] add discard aref aset

---
 lisp/emacs-lisp/comp.el | 21 ++++++++++++++++++---
 test/src/comp-tests.el  | 18 +++++++++---------
 2 files changed, 27 insertions(+), 12 deletions(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 1094acf1ea3..712cade3829 100644
--- 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 64edddf4c04..00bb2e09321 100644
--- 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."
-- 
2.39.5