inline calls to (memv foo CONSTANT-LIST)

* module/language/tree-il/primitives.scm
  (*interesting-primitive-names*): Recognize memv and memq as well.

* module/language/tree-il/inline.scm (inline!): Inline calls to memq and
  memv where the list is a constant.

module/language/tree-il/inline.scm

@@ -50,27 +50,51 @@
                           (or (inline1 x) x))
                         (lp alternate)))))))
 
-         ;; (call-with-values (lambda () foo) (lambda (a b . c) bar))
-         ;; => (let-values (((a b . c) foo)) bar)
-         ;;
-         ;; Note that this is a singly-binding form of let-values. Also
-         ;; note that Scheme's let-values expands into call-with-values,
-         ;; then here we reduce it to tree-il's let-values.
          ((<primitive-ref> name)
-          (and (eq? name '@call-with-values)
+          (case name
-               (pmatch args
+            ((@call-with-values)
-                 ((,producer ,consumer)
+             (pmatch args
-                  (guard (lambda? consumer)
+               ;; (call-with-values (lambda () foo) (lambda (a b . c) bar))
-                         (lambda-case? (lambda-body consumer))
+               ;; => (let-values (((a b . c) foo)) bar)
-                         (not (lambda-case-opt (lambda-body consumer)))
+               ;;
-                         (not (lambda-case-kw (lambda-body consumer)))
+               ;; Note that this is a singly-binding form of let-values.
-                         (not (lambda-case-alternate (lambda-body consumer))))
+               ;; Also note that Scheme's let-values expands into
-                  (make-let-values
+               ;; call-with-values, then here we reduce it to tree-il's
-                   src
+               ;; let-values.
-                   (let ((x (make-application src producer '())))
+               ((,producer ,consumer)
-                     (or (inline1 x) x))
+                (guard (lambda? consumer)
-                   (lambda-body consumer)))
+                       (lambda-case? (lambda-body consumer))
-                 (else #f))))
+                       (not (lambda-case-opt (lambda-body consumer)))
+                       (not (lambda-case-kw (lambda-body consumer)))
+                       (not (lambda-case-alternate (lambda-body consumer))))
+                (make-let-values
+                 src
+                 (let ((x (make-application src producer '())))
+                   (or (inline1 x) x))
+                 (lambda-body consumer)))
+               (else #f)))
+
+            ((memq memv)
+             (pmatch args
+               ((,k ,l) (guard (const? l) (list? (const-exp l)))
+                (let lp ((elts (const-exp l)))
+                  (if (null? elts)
+                      (make-const #f #f)
+                      (make-conditional
+                       src
+                       (make-application
+                        #f
+                        (make-primitive-ref #f (case name
+                                                 ((memq) 'eq?)
+                                                 ((memv) 'eqv?)
+                                                 (else (error "what"))))
+                        (list k (make-const #f (car elts))))
+                       (make-const #f #t)
+                       (lp (cdr elts))))))
+
+               (else #f)))
+
+            (else #f)))
 
          (else #f)))
        

module/language/tree-il/primitives.scm

@@ -34,6 +34,7 @@
     call/cc
     values
     eq? eqv? equal?
+    memq memv
     = < > <= >= zero?
     + * - / 1- 1+ quotient remainder modulo
     ash logand logior logxor