dfmc-optimization: Warn when inline-only inlining fails

documentation/source/library-reference/language-extensions/inlining.rst

@@ -22,8 +22,10 @@ and have included those same adjectives in our language extension
 - ``inline`` Inline this item wherever the compiler can do so.
 
 In addition, ``define constant`` and ``define function`` permit the
-adjective ``inline-only``, which forces every reference to the constant
-or function to be inlined.
+adjective ``inline-only``, which forces every reference to the
+constant or function to be inlined. If a call can not be inlined
+(because, for example, the argument types are not known with enough
+specificity at compile time), then the compiler will issue a warning.
 
 .. note:: If you export from a library any variables created with
    ``may-inline``, ``inline``, or ``inline-only``, and then change the

documentation/source/release-notes/2025.2.rst

@@ -20,6 +20,11 @@ this release.
 Compiler
 ========
 
+* The compiler will now issue a warning when it is unable to inline a
+  call to a function or method marked as ``inline-only``, and signal
+  an error if it does not inline a function with raw argumennt or
+  return values.
+
 Tools
 =====
 

sources/corba/orb/protocols/corba/typecode.dylan

@@ -53,13 +53,13 @@ define method object-typecode (object :: CORBA/<TypeCode>)
   corba/$TypeCode-typecode;
 end method;
 
-define inline-only function CORBA/TCKind/as-symbol (integer :: <integer>)
+define inline function CORBA/TCKind/as-symbol (integer :: <integer>)
  => (s :: <symbol>)
   let typecode = class-typecode(CORBA/<TCKind>);
   typecode-members(typecode)[integer];
 end function;
 
-define inline-only function CORBA/TCKind/as-integer (symbol :: <symbol>)
+define inline function CORBA/TCKind/as-integer (symbol :: <symbol>)
  => (i :: <integer>)
   let typecode = class-typecode(CORBA/<TCKind>);
   typecode-symbol-index(typecode)[symbol];

sources/corba/scepter/console/parse-arguments.dylan

@@ -53,7 +53,7 @@ define method canonicalize-arguments (arguments :: <sequence>)
  => (canonicalized-arguments :: <deque>)
   let canonicalized-arguments = make(<deque>);
   let skip? = #f;
-  for (argument in arguments)
+  for (argument :: <string> in arguments)
     if (skip? & keyword-argument?(argument))
       skip? := #f;
     end if;

sources/dfmc/modeling/machine-word-primitives-support.dylan

@@ -108,7 +108,7 @@ end function extract-mw-operand-signed;
 /// Identical to make-raw-literal but checks that the value will actually
 /// fit into a <machine-word> on the target system for use by folders for
 /// primitives which are supposed to signal overflow.
-define inline-only function make-raw-literal-with-overflow (object :: <abstract-integer>)
+define inline function make-raw-literal-with-overflow (object :: <abstract-integer>)
  => (literal :: <&raw-machine-word>)
   if (instance?(object, <integer>))
     make-raw-literal(object)

sources/dfmc/modeling/primitive-macros.dylan

@@ -153,6 +153,8 @@ override-parameters:
     { \#rest ?:name } => { #rest ?name }
     { ?variable-name, ... } => { ?variable-name, ... }
 variable-name:
+  { ?:name :: <raw-machine-word> }
+    => { ?name :: <&raw-machine-word> }
   { ?:name :: ?:expression ?ignore:* }
     => { ?name }
 end macro;

sources/dfmc/optimization/check.dylan

@@ -10,11 +10,20 @@ define program-warning <calling-inline-only-function-out-of-line>
   slot condition-inline-only-function,
     required-init-keyword: inline-only-function:;
   format-string
-    "Failed to inline call to the inline-only function %s - making a "
+    "Failed to inline call to inline-only %s - making a "
     "local copy to call out of line";
   format-arguments inline-only-function;
 end program-warning;
 
+define program-error <calling-raw-value-function-out-of-line>
+  slot condition-raw-value-function,
+    required-init-keyword: raw-value-function:;
+  format-string
+    "Calls to %s with raw argument or return values must be inlined, "
+    "but could not be";
+  format-arguments raw-value-function;
+end program-error;
+
 define method check-optimized-computations (o :: <&lambda>)
   let checker = if (lambda-initializer?(o))
                   rcurry(check-optimized-reference, #t);
@@ -58,7 +67,16 @@ end method;
 define method check-optimized-reference
     (c :: <computation>, ref :: <object-reference>, f :: <&function>,
      check-forward-refs? :: <boolean>) => ()
-  if (model-compile-stage-only?(f) | inlined-inline-only-function?(f))
+  if (raw-value-function?(f))
+    note(<calling-raw-value-function-out-of-line>,
+	 source-location: dfm-source-location(c),
+	 context-id:      dfm-context-id(c),
+	 raw-value-function: f);
+  elseif (model-compile-stage-only?(f) | inlined-inline-only-function?(f))
+    note(<calling-inline-only-function-out-of-line>,
+	 source-location: dfm-source-location(c),
+	 context-id:      dfm-context-id(c),
+	 inline-only-function: f);
     let copy = find-inline-copy(current-compilation-record(), f);
     reference-value(ref) := copy
   end;
@@ -74,9 +92,17 @@ end method;
 define method check-optimized-reference
     (c :: <engine-node-call>, ref :: <object-reference>, e :: <&cache-header-engine-node>,
      check-forward-refs? :: <boolean>) => ()
-  // format-out(">>> check-optimized-reference CHEN (%=) %= %= %=\n", object-class(c), c, ref, e);
   let f :: <&generic-function> = ^cache-header-engine-node-parent(e);
-  if (model-compile-stage-only?(f) | inlined-inline-only-function?(f))
+  if (raw-value-function?(f))
+    note(<calling-raw-value-function-out-of-line>,
+	 source-location: dfm-source-location(c),
+	 context-id:      dfm-context-id(c),
+	 raw-value-function: f);
+  elseif (model-compile-stage-only?(f) | inlined-inline-only-function?(f))
+    note(<calling-inline-only-function-out-of-line>,
+	 source-location: dfm-source-location(c),
+	 context-id:      dfm-context-id(c),
+	 inline-only-function: f);
     let copy = find-inline-copy(current-compilation-record(), f);
     ^cache-header-engine-node-parent(e) := copy;
   end;
@@ -124,6 +150,13 @@ define method generators-through-merges
 end method;
 */
 
+define function raw-value-function?
+    (f :: <&function>) => (well? :: <boolean>)
+  let sig = ^function-signature(f);
+  any?(raw-type?, sig.^signature-required)
+    | any?(raw-type?, sig.^signature-values)
+end function;
+
 // An inlined inline-only function is one that's called from some function
 // that is itself declared inline and so is a copy that has ended up
 // inlined elsewhere. In that case, we have to copy again.

sources/duim/win32/wgadgets.dylan

@@ -1793,7 +1793,7 @@ end method handle-scrolling;
 /// General collection gadget handling
 
 define class <win32-collection-gadget-mixin>
-    (<win32-gadget-mixin>)
+    (<collection-gadget>, <win32-gadget-mixin>)
 end class <win32-collection-gadget-mixin>;
 
 define sealed domain gadget-selection-mode (<win32-collection-gadget-mixin>);

sources/dylan/float.dylan

@@ -152,13 +152,13 @@ define sealed inline method as (class == <single-float>, x :: <double-float>)
     (primitive-double-float-as-single(primitive-double-float-as-raw(x)))
 end method as;
 
-define inline-only function decode-single-float (x :: <single-float>)
+define inline function decode-single-float (x :: <single-float>)
  => (decoded :: <machine-word>)
   primitive-wrap-machine-word
     (primitive-cast-single-float-as-machine-word(primitive-single-float-as-raw(x)))
 end function decode-single-float;
 
-define inline-only function encode-single-float (x :: <machine-word>)
+define inline function encode-single-float (x :: <machine-word>)
  => (encoded :: <single-float>)
   primitive-raw-as-single-float
     (primitive-cast-machine-word-as-single-float(primitive-unwrap-machine-word(x)))
@@ -277,14 +277,14 @@ define sealed inline method as (class == <double-float>, x :: <single-float>)
     (primitive-single-float-as-double(primitive-single-float-as-raw(x)))
 end method as;
 
-define inline-only function decode-double-float (x :: <double-float>)
+define inline function decode-double-float (x :: <double-float>)
  => (low :: <machine-word>, high :: <machine-word>)
   let (low :: <raw-machine-word>, high :: <raw-machine-word>)
     = primitive-cast-double-float-as-machine-words(primitive-double-float-as-raw(x));
   values(primitive-wrap-machine-word(low), primitive-wrap-machine-word(high))
 end function decode-double-float;
 
-define inline-only function encode-double-float
+define inline function encode-double-float
     (low :: <machine-word>, high :: <machine-word>) => (encoded :: <double-float>)
   primitive-raw-as-double-float
     (primitive-cast-machine-words-as-double-float(primitive-unwrap-machine-word(low),

sources/io/streams/typed-stream.dylan

@@ -22,16 +22,25 @@ define function byte-to-byte (byte :: <byte>) => (byte :: <byte>)
   byte
 end function byte-to-byte;
 
+define function typed-tsm
+    (s :: <sequence>, ss :: <integer>, d :: <mutable-sequence>, ds :: <integer>, n :: <integer>)
+ => ()
+  copy-bytes(d, ds, s, ss, n);
+end;
+
+define function typed-fsm
+    (s :: <sequence>, ss :: <integer>, d :: <mutable-sequence>, ds :: <integer>, n :: <integer>)
+ => ()
+  copy-bytes(d, ds, s, ss, n)
+end;
 
 define open abstract class <typed-stream> (<basic-stream>)
   // Assume that
   slot sequence-type /* ---*** :: subclass(<sequence>) */ = <byte-string>;
   slot to-element-mapper    :: <function> = byte-to-byte-char;
   slot from-element-mapper  :: <function> = byte-char-to-byte;
-  constant slot to-sequence-mapper   :: <function> =
-      method (s, ss, d, ds, n) => () copy-bytes(d, ds, s, ss, n) end;
-  constant slot from-sequence-mapper :: <function> =
-      method (s, ss, d, ds, n) => () copy-bytes(d, ds, s, ss, n) end;
+  constant slot to-sequence-mapper   :: <function> = typed-tsm;
+  constant slot from-sequence-mapper :: <function> = typed-fsm;
 end class <typed-stream>;
 
 define open abstract class <general-typed-stream> (<typed-stream>)

sources/network/unix-sockets/bsd-address-data.dylan

@@ -63,25 +63,25 @@ define constant $INADDR-NONE = as(<machine-word>, #xffffffff);
 define constant <uint16-t> = <C-unsigned-short>;
 define constant <uint32-t> = <C-raw-unsigned-int>;
 
-define inline-only C-function ntohl
+define inline C-function ntohl
   parameter netlong :: <uint32-t>;
   result val :: <uint32-t>;
   c-name: "ntohl";
 end C-function;
 
-define inline-only C-function ntohs
+define inline C-function ntohs
   parameter netshort :: <uint16-t>;
   result val :: <uint16-t>;
   c-name: "ntohs";
 end C-function;
 
-define inline-only C-function htonl
+define inline C-function htonl
   parameter hostlong :: <uint32-t>;
   result val :: <uint32-t>;
   c-name: "htonl";
 end C-function;
 
-define inline-only C-function htons
+define inline C-function htons
   parameter hostshort :: <uint16-t>;
   result val :: <uint16-t>;
   c-name: "htons";

sources/network/unix-sockets/linux-address-data.dylan

@@ -74,25 +74,25 @@ define constant $INADDR-NONE = as(<machine-word>, #xffffffff);
 define constant <uint16-t> = <C-unsigned-short>;
 define constant <uint32-t> = <C-raw-unsigned-int>;
 
-define inline-only C-function ntohl
+define inline C-function ntohl
   parameter netlong :: <uint32-t>;
   result val :: <uint32-t>;
   c-name: "ntohl";
 end C-function;
 
-define inline-only C-function ntohs
+define inline C-function ntohs
   parameter netshort :: <uint16-t>;
   result val :: <uint16-t>;
   c-name: "ntohs";
 end C-function;
 
-define inline-only C-function htonl
+define inline C-function htonl
   parameter hostlong :: <uint32-t>;
   result val :: <uint32-t>;
   c-name: "htonl";
 end C-function;
 
-define inline-only C-function htons
+define inline C-function htons
   parameter hostshort :: <uint16-t>;
   result val :: <uint16-t>;
   c-name: "htons";

sources/network/unix-sockets/sockets-extras.dylan

@@ -15,7 +15,7 @@ define C-struct <timeval>
   c-name: "timeval";
 end;
 
-define inline-only C-function unix-recv-buffer
+define inline C-function unix-recv-buffer
   parameter socket :: <C-int>;
   parameter buffer :: <C-buffer-offset>;
   parameter length :: <size-t>;
@@ -24,7 +24,7 @@ define inline-only C-function unix-recv-buffer
   c-name: "recv";
 end C-function;
 
-define inline-only C-function unix-send-buffer
+define inline C-function unix-send-buffer
   parameter socket :: <C-int>;
   parameter buffer :: <C-buffer-offset>;
   parameter length :: <size-t>;
@@ -33,7 +33,7 @@ define inline-only C-function unix-send-buffer
   c-name: "send";
 end C-function;
 
-define inline-only C-function unix-recv-buffer-from
+define inline C-function unix-recv-buffer-from
   parameter socket :: <C-int>;
   parameter buffer :: <C-buffer-offset>;
   parameter length :: <size-t>;
@@ -44,7 +44,7 @@ define inline-only C-function unix-recv-buffer-from
   c-name: "recvfrom";
 end C-function;
 
-define inline-only C-function unix-send-buffer-to
+define inline C-function unix-send-buffer-to
   parameter socket :: <C-int>;
   parameter message :: <C-buffer-offset>;
   parameter length :: <size-t>;

sources/network/unix-sockets/sockets-interfaces.dylan

@@ -15,15 +15,15 @@ define inline-only C-function ioctl
   c-name: "ioctl";
 end C-function;
 
-define inline-only C-function accept
+define inline C-function accept
   parameter socket :: <C-int>;
   parameter address :: <sockaddr*>;
   parameter address-len :: <socklen-t*>;
   result val :: <C-int>;
   c-name: "accept";
 end C-function;
 
-define inline-only C-function bind
+define inline C-function bind
   parameter socket :: <C-int>;
   parameter address :: <sockaddr*>;
   parameter address-len :: <socklen-t>;
@@ -32,13 +32,13 @@ define inline-only C-function bind
 end C-function;
 
 // TODO: Shared: close
-define inline-only C-function close
+define inline C-function close
   parameter socket :: <C-int>;
   result val :: <C-int>;
   c-name: "close";
 end C-function;
 
-define inline-only C-function connect
+define inline C-function connect
   parameter socket :: <C-int>;
   parameter address :: <sockaddr*>;
   parameter address-len :: <socklen-t>;
@@ -51,15 +51,15 @@ end C-function;
 // Shared: fsetpos
 // Shared: ftell
 
-define inline-only C-function getpeername
+define inline C-function getpeername
   parameter socket :: <C-int>;
   parameter address :: <sockaddr*>;
   parameter address-len :: <socklen-t*>;
   result val :: <C-int>;
   c-name: "getpeername";
 end C-function;
 
-define inline-only C-function getsockname
+define inline C-function getsockname
   parameter socket :: <C-int>;
   parameter address :: <sockaddr*>;
   parameter address-len :: <socklen-t*>;
@@ -77,7 +77,7 @@ define inline-only C-function getsockopt
   c-name: "getsockopt";
 end C-function;
 
-define inline-only C-function listen
+define inline C-function listen
   parameter socket :: <C-int>;
   parameter backlog :: <C-int>;
   result val :: <C-int>;
@@ -146,7 +146,7 @@ define inline-only C-function sendto
   c-name: "sendto";
 end C-function;
 
-define inline-only C-function setsockopt
+define inline C-function setsockopt
   parameter socket :: <C-int>;
   parameter level :: <C-int>;
   parameter option-name :: <C-int>;
@@ -156,14 +156,14 @@ define inline-only C-function setsockopt
   c-name: "setsockopt";
 end C-function;
 
-define inline-only C-function shutdown
+define inline C-function shutdown
   parameter socket :: <C-int>;
   parameter how :: <C-int>;
   result val :: <C-int>;
   c-name: "shutdown";
 end C-function;
 
-define inline-only C-function socket
+define inline C-function socket
   parameter domain :: <C-int>;
   parameter type :: <C-int>;
   parameter protocol :: <C-int>;