From 64140b45541b94e3d761fb9f20173354f02c2121 Mon Sep 17 00:00:00 2001
From: Samuel Hunter <samuel@shunter.xyz>
Date: Mon, 7 Nov 2022 14:13:26 -0800
Subject: [PATCH] Add compiler macro foreign-type-size

The compiler macro is a first-pass that should fix most use cases
without breakage. It checks to see if the foreign type is constant, and
if so, expands into its foreign type size, falling back to the old form
if an error is signaled.
---
 src/early-types.lisp |  7 +++++++
 tests/misc.lisp      | 30 ++++++++++++++++++++++++++++++
 2 files changed, 37 insertions(+)

diff --git a/src/early-types.lisp b/src/early-types.lisp
index aa13c013e9e6..ff94c9ca1fea 100644
--- a/src/early-types.lisp
+++ b/src/early-types.lisp
@@ -164,6 +164,13 @@ Signals an error if FOREIGN-TYPE is undefined."))
   (:documentation
    "Return the size in bytes of a foreign type."))
 
+(define-compiler-macro foreign-type-size (&whole form foreign-type)
+  ;; Don't pass &environment to CONSTANTP or MACROEXPAND as LOAD-TIME-VALUE is
+  ;; executed in a null lexical environment.
+  (if (constantp (macroexpand foreign-type))
+      `(load-time-value (locally (declare (notinline foreign-type-size)) ,form))
+      form))
+
 (defgeneric unparse-type (foreign-type)
   (:documentation
    "Unparse FOREIGN-TYPE to a type specification (symbol or list)."))
diff --git a/tests/misc.lisp b/tests/misc.lisp
index d46ca453ebab..a57925ee5b59 100644
--- a/tests/misc.lisp
+++ b/tests/misc.lisp
@@ -130,3 +130,33 @@
           (strcpy pointer "xpto")
           (return vector))))
   #(120 112 116 111 0))
+
+;;; Inline foreign-type-size
+
+(deftest foreign-type-size.inline.int
+    (eql (foreign-type-size :int) (locally (declare (notinline foreign-type-size)) (foreign-type-size :int)))
+  t)
+
+(deftest foreign-type-size.inline.uint32
+    (eql (foreign-type-size :uint32) (locally (declare (notinline foreign-type-size)) (foreign-type-size :uint32)))
+  t)
+
+(deftest foreign-type-size.inline.ptrdiff
+    (eql (foreign-type-size :ptrdiff) (locally (declare (notinline foreign-type-size)) (foreign-type-size :ptrdiff)))
+  t)
+
+(deftest foreign-type-size.inline.size
+    (eql (foreign-type-size :size) (locally (declare (notinline foreign-type-size)) (foreign-type-size :size)))
+  t)
+
+(deftest foreign-type-size.inline.offset
+    (eql (foreign-type-size :offset) (locally (declare (notinline foreign-type-size)) (foreign-type-size :offset)))
+  t)
+
+(deftest foreign-type-size.inline.uintptr
+    (eql (foreign-type-size :uintptr) (locally (declare (notinline foreign-type-size)) (foreign-type-size :uintptr)))
+  t)
+
+(deftest foreign-type-size.inline.intptr
+    (eql (foreign-type-size :intptr) (locally (declare (notinline foreign-type-size)) (foreign-type-size :intptr)))
+  t)