Replace etypecase-error compiler macro with transform

This isolates it to cclasp, and will help in removing the
multiple-value-foreign-call special operator. The other ERROR cases
are up next.

Author: Bike

src/core/commonLispPackage.cc

@@ -175,6 +175,7 @@ SYMBOL_EXPORT_SC_(ClPkg, eql);
 SYMBOL_EXPORT_SC_(ClPkg, equal);
 SYMBOL_EXPORT_SC_(ClPkg, equalp);
 SYMBOL_EXPORT_SC_(ClPkg, error);
+SYMBOL_EXPORT_SC_(ClPkg, etypecase);
 SYMBOL_EXPORT_SC_(ClPkg, eval);
 SYMBOL_EXPORT_SC_(ClPkg, every);
 SYMBOL_EXPORT_SC_(ClPkg, extended_char);

src/lisp/kernel/cleavir/bir-to-bmir.lisp

@@ -170,6 +170,8 @@
 
 (deftransform random-state-p (core::headerq random-state) t)
 
+(deftransform core::etypecase-error core::etypecase-error t t)
+
 (deftransform core:to-single-float core::double-to-single double-float)
 (deftransform core:to-single-float core::fixnum-to-single fixnum)
 (deftransform core:to-double-float core::single-to-double single-float)

src/lisp/kernel/cleavir/primop.lisp

@@ -130,6 +130,9 @@
 ;;; Particular primops
 ;;;
 
+(defvprimop-intrinsic core::etypecase-error ((:object) :object :object)
+  "cc_etypecase_error")
+
 (macrolet ((def-float-compare (sfname dfname op reversep)
              `(progn
                 (deftprimop ,sfname (:single-float :single-float)

src/lisp/kernel/cleavir/type.lisp

@@ -303,6 +303,10 @@
   (declare (ignore datum arguments))
   (ctype:values-bottom *clasp-system*))
 
+(define-deriver core::etypecase-error (datum types)
+  (declare (ignore datum types))
+  (ctype:values-bottom *clasp-system*))
+
 ;;; I extremely doubt these matter, but why not.
 (define-deriver cerror (cfc datum &rest arguments)
   (declare (ignore cfc datum arguments))

src/lisp/kernel/cmp/opt/opt-condition.lisp

@@ -27,13 +27,3 @@
              default)))
       ;; this will include the non-constant case (datum = nil)
       (otherwise default))))
-
-;; Ditto for ETYPECASE
-#+(and (not bytecode) (or cclasp eclasp))
-(define-compiler-macro core::etypecase-error (&whole whole value types &environment env)
-  (if (constantp types env)
-      (let ((types (ext:constant-form-value types env)))
-        `(core:multiple-value-foreign-call
-          "cc_error_case_failure"
-          ,value '(or ,@types) 'etypecase ',types))
-      whole))

src/lisp/kernel/cmp/primitives.lisp

@@ -88,7 +88,7 @@
 
          (primitive-unwinds "cc_error_type_error" :void (list :t* :t*) :does-not-return t)
          (primitive-unwinds "cc_error_array_out_of_bounds" :void (list :t* :t* :t*) :does-not-return t)
-         (primitive-unwinds "cc_error_case_failure" :void (list :t* :t* :t* :t*) :does-not-return t)
+         (primitive-unwinds "cc_etypecase_error" :void (list :t* :t*) :does-not-return t)
 
          (primitive-unwinds "gdb" :void nil)
          (primitive         "debugInspectTPtr" :void (list :t*))

src/llvmo/link_intrinsics.cc

@@ -1059,13 +1059,15 @@ void cc_error_array_out_of_bounds(T_O* index, T_O* expected_type, T_O* array) {
 
 SYMBOL_EXPORT_SC_(CorePkg, case_failure);
 SYMBOL_EXPORT_SC_(KeywordPkg, possibilities);
-NEVER_OPTIMIZE void cc_error_case_failure(T_O* datum, T_O* expected_type, T_O* name, T_O* possibilities) {
+NEVER_OPTIMIZE void cc_etypecase_error(T_O* datum, T_O* possibilities) {
   core::T_sp tdatum((gctools::Tagged)datum);
-  core::T_sp texpected_type((gctools::Tagged)expected_type);
-  core::T_sp tname((gctools::Tagged)name);
   core::T_sp tpossibilities((gctools::Tagged)possibilities);
-  core::eval::funcall(cl::_sym_error, core::_sym_case_failure, kw::_sym_datum, tdatum, kw::_sym_expected_type, texpected_type,
-                      kw::_sym_name, tname, kw::_sym_possibilities, tpossibilities);
+  core::T_sp expected = core::Cons_O::create(cl::_sym_or, tpossibilities);
+  core::eval::funcall(cl::_sym_error, core::_sym_case_failure,
+                      kw::_sym_datum, tdatum,
+                      kw::_sym_expected_type, expected,
+                      kw::_sym_name, cl::_sym_etypecase,
+                      kw::_sym_possibilities, tpossibilities);
 }
 
 core::T_O* cc_enclose(core::T_O* simpleFunInfo, std::size_t numCells) {