diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm
index 6c55d64eb..c40330ce7 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -769,8 +769,7 @@ it does not handle <fix> and <let-values>, it should be called before
                (($ <primitive-ref> _ (? constructor-primitive? name))
                 (case ctx
                   ((effect test)
-                   (let ((exp (for-value exp))
-                         (res (if (eq? ctx 'effect)
+                   (let ((res (if (eq? ctx 'effect)
                                   (make-void #f)
                                   (make-const #f #t))))
                      (match (for-value exp)
@@ -783,7 +782,12 @@ it does not handle <fix> and <let-values>, it should be called before
                        (($ <application> _ ($ <primitive-ref> _ 'vector) elts)
                         (for-tail
                          (make-sequence src (append elts (list res)))))
-                       (_ exp))))
+                       (($ <application> _ ($ <primitive-ref> _ 'make-prompt-tag) ())
+                        res)
+                       (($ <application> _ ($ <primitive-ref> _ 'make-prompt-tag)
+                           (($ <const> _ (? string?))))
+                        res)
+                       (exp exp))))
                   (else
                    (match (cons name (map for-value orig-args))
                      (('cons head tail)
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 9bb45eede..cd3314307 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -1282,10 +1282,16 @@
      (call-with-prompt tag
                        (lambda () 1)
                        (lambda args args)))
-   ;; FIXME: elide the (make-prompt-tag) call
-   (begin
-     (apply (primitive make-prompt-tag))
-     (const 1)))
+   (const 1))
+  
+  (pass-if-peval
+   resolve-primitives
+   ;; Prompt is removed if tag is unreferenced, with explicit stem
+   (let ((tag (make-prompt-tag "foo")))
+     (call-with-prompt tag
+                       (lambda () 1)
+                       (lambda args args)))
+   (const 1))
   )